* * *    
Главная » Статьи » Код PB

Просмотров: 1712 | Дата: 23.04.2024 | Коментарии (0)

Гиперкуб-Tesseract



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










Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.