Code
;Hypercube by einander
;October 2008 - PB 4.30 beta 3
; <Escape> to close window
#GDIP=1
Structure PointF : x.f : y.f : EndStructure
Structure HyperCube
Vrtx.PointF[16]
Color.l[16]
Pts.PointF[4]
OffX.l
OffY.l
EndStructure
Structure GdiplusStartupInput
GdiPlusVersion.l
DebugEventCallback.l
SuppressBackgroundThread.l
SuppressExternalCodecs.l
EndStructure
Global _Img,_ImGad,_GDIP,_DRAWING,_GRAPH
Global _HC.HyperCube
Macro GName : GetFunction(#GDIP,Name) : EndMacro
Prototype GdiplusStartup(*a,*b,c=0)
Prototype P1(a) : Macro M1(Name,a) : GF.P1=GName:GF(a) :EndMacro
Prototype p2(a,b) : Macro M2(Name,a,b) : GF.P2=GName:GF(a,b) :EndMacro
Prototype P4(a,b,c,d) : Macro M4(Name,a,b,c,d) : GF.P4=GName:GF(a,b,c,d) :EndMacro
Prototype P5(a,b,c,d,E) : Macro M5(Name,a,b,c,d,E) : GF.P5=GName:GF(a,b,c,d,E) :EndMacro
Prototype P6(a,b,c,d,E,F) : Macro M6(Name,a,b,c,d,E,F) : GF.P6=GName:GF(a,b,c,d,E,F) :EndMacro
Prototype P1F2(a,b.f,c,d) : Macro M1F2(Name,a,b,c,d) : GF.P1f2=GName:GF(a,b,c,d) :EndMacro
Macro GdipClose ;- GdipClose
If _GDIP
M1("GdipDeleteGraphics",_GRAPH)
M1("GdiplusShutdown",_GDIP)
CloseLibrary(#GDIP)
_GDIP=0
EndIf
EndMacro
Macro GdipInit(Mode=2) ;- GdipInit(Mode) ; Mode 1=Fast,2 =HiRes
GdipClose
If OpenLibrary(#GDIP,"GDIPlus.DLL")
Gdip.GdiplusStartupInput\GdiPlusVersion=1
Gdip\DebugEventCallback = 0
Gdip\SuppressBackgroundThread = 0
Gdip\SuppressExternalCodecs = 0
GF.GdiplusStartup = GetFunction(#GDIP, "GdiplusStartup") : GF(@_GDIP,@Gdip)
M2("GdipCreateFromHDC",_DRAWING,@_GRAPH)
M2("GdipSetSmoothingMode",_GRAPH,Mode)
Else
MessageRequester("Error !","GDIPlus.DLL Not found",0)
EndIf
EndMacro
Macro RGB2ARGB(RGB,Alpha=$FF) ;- RGB2ARGB(RGB,Alpha=$FF) - convert RGB to Alpha RGB
Blue(RGB)|Green(RGB)<<8|Red(RGB)<<16|Alpha<<24
EndMacro
Macro ARGB(RGB=0,Alpha=255) ;- ARGB((RGB=0,Transp=255)
RGB2ARGB(RGB,Alpha)
EndMacro
Macro DrawGDIP ;- DrawGDIP ; hace nuevo _GRAPH con mode HiRes segun _Drawing
If _GRAPH : M1("GdipDeleteGraphics",_GRAPH) : EndIf
M2("GdipCreateFromHDC",_DRAWING, @_GRAPH)
M2("GdipSetSmoothingMode",_GRAPH,2)
EndMacro
Procedure DrawCubes()
; make Corner Indexes for each Face
Restore Vertex
_DRAWING=StartDrawing(ImageOutput(_Img))
DrawGDIP
M2("GdipGraphicsClear",_GRAPH,ARGB)
With _HC
For Face=0 To 15
For Vrtx=0 To 3 ;vertex for each face
Read.l a
_HC\Pts[Vrtx]\x = _HC\Vrtx[a]\x : _HC\Pts[Vrtx]\y = _HC\Vrtx[a]\y
Next
FirstPOINT.POINT\x=\Pts[0]\x : FirstPOINT\y=\Pts[0]\y
LastPOINT.POINT\x =\Pts[3]\x : LastPOINT\y= \Pts[3]\y
M6("GdipCreateLineBrushI",FirstPOINT,LastPOINT,\Color[Face],ARGB(#White,80), 3, @GpBrush)
M1F2("GdipCreatePen1",ARGB(#White,40),0.4,0,@GpPen)
M4("GdipDrawPolygon",_GRAPH, GpPen, @\Pts[0], 4)
;<<<<<<<<<<<< Comment next line to view only skeleton
M5("GdipFillPolygon",_GRAPH, GpBrush, @\Pts[0], 4, 0)
M1("GdipDeleteBrush",GpBrush)
M1("GdipDeletePen",GpPen)
Next
StopDrawing()
SetGadgetState(_ImGad,ImageID(_Img))
EndWith
EndProcedure
Procedure HyperCube(a,A2.f,A3.f,cx.f,cy.f) ;Make 16 default vertex
With _HC
\Vrtx[0]\x=a+\OffX :\Vrtx[0]\y=a+\OffY ; internal vertex
\Vrtx[1]\x=A2+\OffX :\Vrtx[1]\y=a+\OffY
\Vrtx[2]\x=A2+\OffX :\Vrtx[2]\y=A2+\OffY
\Vrtx[3]\x=a+\OffX :\Vrtx[3]\y=A2+\OffY
\Vrtx[4]\x=a+cx+\OffX :\Vrtx[4]\y=a-cy+\OffY
\Vrtx[5]\x=A2+cx+\OffX :\Vrtx[5]\y=a-cy+\OffY
\Vrtx[6]\x=A2+cx+\OffX :\Vrtx[6]\y=A2-cy+\OffY
\Vrtx[7]\x=a+cx+\OffX :\Vrtx[7]\y=A2-cy+\OffY
\Vrtx[8]\x =\Vrtx[0]\x-A3 :\Vrtx[8]\y =\Vrtx[0]\y-A3 ; external vertex
\Vrtx[9]\x =\Vrtx[1]\x+A3 :\Vrtx[9]\y =\Vrtx[1]\y-A3
\Vrtx[10]\x=\Vrtx[9]\x :\Vrtx[10]\y=\Vrtx[2]\y+A3
\Vrtx[11]\x=\Vrtx[8]\x :\Vrtx[11]\y=\Vrtx[10]\y
\Vrtx[12]\x=\Vrtx[4]\x-A3 :\Vrtx[12]\y=\Vrtx[4]\y-A3
\Vrtx[13]\x=\Vrtx[5]\x+A3 :\Vrtx[13]\y=\Vrtx[12]\y
\Vrtx[14]\x=\Vrtx[6]\x+A3 :\Vrtx[14]\y=\Vrtx[6]\y+A3
\Vrtx[15]\x=\Vrtx[12]\x :\Vrtx[15]\y=\Vrtx[14]\y
EndWith
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
;hwnd=OpenWindow(0, 100, 100,700,500 ,"", #WS_OVERLAPPEDWINDOW | #WS_MAXIMIZE)
hwnd=OpenWindow(0, 100, 100,700,500 ,"", #PB_Window_BorderLess | #WS_MAXIMIZE)
Wi=WindowWidth(0):He=WindowHeight(0)
GdipInit()
For i=0 To 15
_HC\Color[i]=ARGB(Random(#White),Random(200))
Next
_ImGad=ImageGadget(-1,0,0,0,0,0)
_Img=CreateImage(-1,Wi,He,32)
_HC\OffX=Wi/2.5
_HC\OffY=He/2.5
Side=Random(250) ; starting values
A2.f=80
A3.f=35
cx.f=-16
cy.f=-31
IncSide=1 ; increments
IncA2.f=0.1
IncA3.f=0.03
IncCx.f=0.05
IncCy.f=0.6
Repeat
If GetAsyncKeyState_(#VK_ESCAPE) :Break:EndIf
EV = WindowEvent()
HyperCube(Side,A2,A3,cx,cy)
Side+IncSide:If Side <-100 Or Side>300:IncSide=-IncSide:EndIf
A2+IncA2:If A2<-400 Or A2>400:IncA2=-IncA2:EndIf
A3+IncA3:If A3<-400 Or A3>400:IncA3=-IncA3:EndIf
cx+IncCx:If cx<-200 Or cx>200:IncCx=-IncCx:EndIf
cy+IncCy:If cy<-200 Or cy>100:IncCy=-IncCy:EndIf
DrawCubes()
Delay(25)
Until EV = #PB_Event_CloseWindow
GdipClose
End
DataSection
Vertex: ;
Data.l 0,1,2,3,4,5,6,7,1,5,6,2,0,4,5,1,0,4,7,3,3,7,6,2
Data.l 8,9,10,11,12,13,14,15,9,13,14,10,8,12,13,9,8,12,15,11,11,15,14,10
Data.l 8,12,4,0,1,9,13,5,2,6,14,10,11,3,7,15
EndDataSection