RosettaCodeData/Task/Pythagoras-tree/PureBasic/pythagoras-tree.basic

62 lines
1.5 KiB
Plaintext

EnableExplicit
DisableDebugger
Procedure.d maxXY(a.d,b.d,c.d,d.d)
If a<b : Swap a,b : EndIf
If a<c : Swap a,c : EndIf
If a<d : Swap a,d : EndIf
ProcedureReturn a
EndProcedure
Procedure.d minXY(a.d,b.d,c.d,d.d)
If a>b : Swap a,b : EndIf
If a>c : Swap a,c : EndIf
If a>d : Swap a,d : EndIf
ProcedureReturn a
EndProcedure
Procedure Ptree(x1.d, y1.d, x2.d, y2.d, d.i=0)
If d>10 : ProcedureReturn : EndIf
Define dx.d=x2-x1,
dy.d=y1-y2,
x3.d=x2-dy,
y3.d=y2-dx,
x4.d=x1-dy,
y4.d=y1-dx,
x5.d=x4+(dx-dy)/2.0,
y5.d=y4-(dx+dy)/2.0,
p1.d=(maxXY(x1,x2,x3,x4)+minXY(x1,x2,x3,x4))/2.0,
p2.d=(maxXY(y1,y2,y3,y4)+minXY(y1,y2,y3,y4))/2.0,
p3.d=(maxXY(x1,x2,x3,x4)-minXY(x1,x2,x3,x4))
FrontColor(RGB(Random(125,1),Random(255,125),Random(125,1)))
LineXY(x1,y1,x2,y2)
LineXY(x2,y2,x3,y3)
LineXY(x3,y3,x4,y4)
LineXY(x4,y4,x1,y1)
BoxedGradient(minXY(x1,x2,x3,x4),minXY(y1,y2,y3,y4),p3,p3)
FillArea(p1,p2,-1)
Ptree(x4,y4,x5,y5,d+1)
Ptree(x5,y5,x3,y3,d+1)
EndProcedure
Define w1.i=800,
h1.i=w1*11/16,
w2.i=w1/2,
di.i=w1/12
If OpenWindow(0,#PB_Ignore,#PB_Ignore,w1,h1,"Pythagoras tree")
If CreateImage(0,w1,h1,24,0) And StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Gradient)
BackColor($000000)
Ptree(w2-di,h1-10,w2+di,h1-10)
StopDrawing()
EndIf
ImageGadget(0,0,0,0,0,ImageID(0))
Repeat : Until WaitWindowEvent(50)=#PB_Event_CloseWindow
EndIf
End