PureBasic Forums - English

Posted: **Fri Oct 10, 2008 4:16 pm**

Tesseract or Hypercube is a four-dimensional object.
http://en.wikipedia.org/wiki/Hypercube
http://members.shaw.ca/johnhendricksmath/tesseracts.htm

Code: Select all

;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

Posted: **Fri Oct 10, 2008 10:28 pm**

Yeah! that is a real 4D cube, a step ahead

Nice code, i didn't know the power of gdi+

Anyway i'd like to see this rotating tesseract:

and other not so simple tesseract rotations would be awesome.

Posted: **Sat Oct 11, 2008 1:32 pm**

Very Good Great Job

I watch something on u tube with Carl Sagan who was talking about them

Best Regards
Kevin

Posted: **Sat Oct 11, 2008 4:44 pm**

Thanks!

@Psychophanta:
You know where can I find more animations like the rotating tesseract?
I'd try to make a rotating one with PB.

Posted: **Sun Oct 12, 2008 11:13 am**

einander wrote:You know where can I find more animations like the rotating tesseract?
I'd try to make a rotating one with PB.

Sorry, I don't.
Keep in mind that all those segments are the projections (shadows) of a spatial 4D world "real" tesseract (aka 4D cube or hypercube) into a 3D world; and then projected to a 2D one: our LCD or CRT monitor.
So then we can only infer it at flashes in our brains, and making a lot of efforts. That is not due to the fact that our brain is a crap (even in fact it is), but to the fact that our brain is in use with spatial 3D world and not 4D one. That is why we must to resort to maths; maths are a layer beyond our neocortex which allows us to make calculations without the need of infering (even without the need of a minimum understanding) the things we are calculating.
Notice that the animation in the wikipedia which shows a more complex rotations is bad done, by the way.

Posted: **Mon Oct 13, 2008 1:30 am**

I get a COMPILER: Syntax Error in ine 82

81 For Vrtx=0 To 3 ;vertex for each face
82 Read.l a
83 HC\Pts[Vrtx]\x = _HC\Vrtx[a]\x : _HC\Pts[Vrtx]\y = _HC\Vrtx[a]\y

(I added the line numbers to the quote!

PB 4.2final

in 4.3 it works fine...

Posted: **Mon Oct 13, 2008 11:25 am**

Hi Rook:
it IS for 4.3

October 2008 - PB 4.30 beta 3

For PB 4.2 change

Code: Select all

Read.l

for

Code: Select all

Read

and add

Code: Select all

CreateGadgetList(hwnd)

after OpenWindow()
(Sure you know that)

PureBasic Forums - English

Hypercube-Tesseract

Hypercube-Tesseract