Hypercube-Tesseract

Share your advanced PureBasic knowledge/code with the community.
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Hypercube-Tesseract

Post by einander »

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
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

Yeah! that is a real 4D cube, a step ahead :)
Nice code, i didn't know the power of gdi+ :shock:
Anyway i'd like to see this rotating tesseract:
Image
and other not so simple tesseract rotations would be awesome.
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
SoulReaper
Enthusiast
Enthusiast
Posts: 372
Joined: Sun Apr 03, 2005 2:14 am
Location: England

Post by SoulReaper »

Very Good Great Job :)

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

Best Regards
Kevin
:)
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

Thanks!

@Psychophanta:
You know where can I find more animations like the rotating tesseract?
I'd try to make a rotating one with PB.
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:

Post by Psychophanta »

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.
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
User avatar
Rook Zimbabwe
Addict
Addict
Posts: 4322
Joined: Tue Jan 02, 2007 8:16 pm
Location: Cypress TX
Contact:

Post by Rook Zimbabwe »

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! :D

PB 4.2final

in 4.3 it works fine...
Binarily speaking... it takes 10 to Tango!!!

Image
http://www.bluemesapc.com/
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Post by einander »

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) :wink:
Post Reply