Correct name for the function should be "Regular polygon function".
Test it:
Code: Select all
; DrawStar function:
; Author: Psychophanta
; Date: 5 Nov 2004
;Ported to PB4.0 5 Feb 2006
;-INITS:
Global bitplanes.b=32,RX.w=GetSystemMetrics_(#SM_CXSCREEN),RY.w=GetSystemMetrics_(#SM_CYSCREEN),r1.l=70,r2.l=90,p.l=3,incl.f=0.0
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
MessageRequester("Error","Can't access DirectX",0)
End
EndIf
While OpenScreen(RX.w,RY.w,bitplanes.b,"")=0
If bitplanes.b>16:bitplanes.b-8
ElseIf RY.w>600:RX.w=800:RY.w=600
ElseIf RY.w>480:RX.w=640:RY.w=480
ElseIf RY.w>400:RX.w=640:RY.w=400
ElseIf RY.w>240:RX.w=320:RY.w=240
ElseIf RY.w>200:RX.w=320:RY.w=200
Else:MessageRequester("VGA","Can't open Screen!",0):End
EndIf
Wend
Procedure DrawStar(x.l,y.l,intrad.l,extrad.l,n.l,inclination.l,phase.f,color.l)
Protected alpha.f=2*#PI/n,i.d=inclination/20-1/2,t.l,d1.f,d2.f,d3.f
For t.l=1 To n:d1.f=(t-1)*alpha+phase:d2.f=t*alpha+phase:d3.f=(t+i)*alpha+phase
LineXY(x+intrad*Cos(d1),y+intrad*Sin(d1),x+extrad*Cos(d3),y+extrad*Sin(d3),color)
LineXY(x+intrad*Cos(d2),y+intrad*Sin(d2),x+extrad*Cos(d3),y+extrad*Sin(d3),color)
Next
EndProcedure
;-MAIN:
MouseLocate(333,333)
Repeat
ClearScreen(0)
ExamineKeyboard()
ExamineMouse():mx.l=MouseX():my.l=MouseY()
StartDrawing(ScreenOutput())
DrawStar(RX/2,RY/2,r1.l,r2.l,p,incl,pha.f,$aaaaaa)
pha+MouseDeltaX()*0.01:r2-MouseDeltaY()
If MouseButton(1):While MouseButton(1):Delay(16):ExamineMouse():Wend
p+1:If p>80:p=80:EndIf
ElseIf MouseButton(2):While MouseButton(2):Delay(16):ExamineMouse():Wend
p-1:If p<2:p=2:EndIf
EndIf
If KeyboardPushed(#PB_Key_Z)
incl-0.3
ElseIf KeyboardPushed(#PB_Key_X)
incl+0.3
EndIf
StopDrawing()
FlipBuffers():Delay(16)
Until KeyboardPushed(#PB_Key_Escape)
Modified code and function for vectorial drawing lib:
Code: Select all
; Vectorial DrawStar function:
; Author: Psychophanta
; Date: May 2017
Global bitplanes.b=32,RX.w=GetSystemMetrics_(#SM_CXSCREEN),RY.w=GetSystemMetrics_(#SM_CYSCREEN),rix.w=400,riy.w=225,r1.l=40,r2.l=60,p.l=3,incl.f=0.0
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
MessageRequester("Error","Can't access DirectX",0)
End
EndIf
While OpenScreen(RX.w,RY.w,bitplanes.b,"")=0
If bitplanes.b>16:bitplanes.b-8
ElseIf RY.w>600:RX.w=800:RY.w=600
ElseIf RY.w>480:RX.w=640:RY.w=480
ElseIf RY.w>400:RX.w=640:RY.w=400
ElseIf RY.w>240:RX.w=320:RY.w=240
ElseIf RY.w>200:RX.w=320:RY.w=200
Else:MessageRequester("VGA","Can't open Screen!",0):End
EndIf
Wend
Procedure DrawStar(x.l,y.l,intrad.l,extrad.l,n.l,inclination.f,phase.f,color.l=$AAAAAAAA,filled.b=0)
Protected alpha.f=2*#PI/n,i.f=inclination/20-1/2,t.u,d1.f,d2.f
MovePathCursor(x+intrad*Cos(phase),y+intrad*Sin(phase))
For t.u=1 To n:d2.f=t*alpha+phase:d1.f=(t+i)*alpha+phase
AddPathLine(x+extrad*Cos(d1),y+extrad*Sin(d1),#PB_Path_Default)
AddPathLine(x+intrad*Cos(d2),y+intrad*Sin(d2),#PB_Path_Default)
Next
VectorSourceColor(color)
If filled
FillPath(#PB_Path_Default)
Else
StrokePath(1,#PB_Path_RoundCorner)
EndIf
EndProcedure
Procedure clearimage(a.i,col.l)
StartDrawing(ImageOutput(a))
Box(0,0,ImageWidth(a),ImageHeight(a),col)
StopDrawing()
EndProcedure
CreateImage(0,rix,riy,bitplanes,$000000)
;-MAIN:
MouseLocate(33,33)
Repeat
clearimage(0,$11111111)
ExamineKeyboard()
ExamineMouse():mx.l=MouseX():my.l=MouseY()
StartVectorDrawing(ImageVectorOutput(0,#PB_Unit_Pixel))
DrawStar(rix/2,riy/2,r1.l,r2.l,p,incl,pha.f,$778899aa,1)
pha+MouseDeltaX()*0.01:r2-MouseDeltaY()
If MouseButton(#PB_MouseButton_Left):While MouseButton(1):Delay(16):ExamineMouse():Wend
p+1:If p>80:p=80:EndIf
ElseIf MouseButton(#PB_MouseButton_Right):While MouseButton(2):Delay(16):ExamineMouse():Wend
p-1:If p<2:p=2:EndIf
EndIf
If KeyboardPushed(#PB_Key_Z)
incl-0.3
ElseIf KeyboardPushed(#PB_Key_X)
incl+0.3
EndIf
StopVectorDrawing()
StartDrawing(ScreenOutput())
DrawImage(ImageID(0),0,0,RX,RY)
StopDrawing()
FlipBuffers():Delay(15)
Until KeyboardPushed(#PB_Key_Escape)
A remember code with a similar function i called DrawCogged2D():
Code: Select all
; Author: Psychophanta
; Date: 18 Jan 2011
;PB4.51
;-INITS:
Define .d
bitplanes.b=32:RX.l=GetSystemMetrics_(#SM_CXSCREEN):RY.l=GetSystemMetrics_(#SM_CYSCREEN)
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
MessageRequester("Error","Can't access DirectX",0)
End
EndIf
While OpenScreen(RX,RY,bitplanes.b,"")=0
If bitplanes.b>16:bitplanes.b-8
ElseIf RY>600:RX=800:RY=600
ElseIf RY>480:RX=640:RY=480
ElseIf RY>400:RX=640:RY=400
ElseIf RY>240:RX=320:RY=240
ElseIf RY>200:RX=320:RY=200
Else:MessageRequester("VGA","Can't open Screen!",0):End
EndIf
Wend
Procedure.d myATan2(y.d,x.d)
!fld qword[p.v_y]
!fld qword[p.v_x]
!fpatan
ProcedureReturn
EndProcedure
Procedure DrawCogged2D(x.d,y.d,intrad.d,extrad.d,n.l,phase.d,color.l,x2.d,y2.d,color2.l)
If n<2:n=2:EndIf:If intrad<1:intrad=1:EndIf:If extrad<1:extrad=1:EndIf:phase=Mod(phase,#PI)
Protected dx.d=x2-x,dy.d=y2-y,d.d=Sqr(dx*dx+dy*dy)
If d>extrad
Protected alfa.d=2*#PI/n,t.l,d1.d,d2.d,d3.d
For t=1 To n:d1=(t-1)*alfa+phase:d2=t*alfa+phase:d3=(t-0.5)*alfa+phase
LineXY(x+intrad*Cos(d1),y+intrad*Sin(d1),x+extrad*Cos(d3),y+extrad*Sin(d3),color)
LineXY(x+intrad*Cos(d2),y+intrad*Sin(d2),x+extrad*Cos(d3),y+extrad*Sin(d3),color)
Next
Protected intrad2.d=d-extrad,extrad2.d=d-intrad
Protected A.d=extrad/extrad2; <- gear ratio
n/A
alfa=#PI/n
Protected phase2.d=#PI+alfa-A*phase+myATan2(dy,dx)*(A+1)
alfa*2
For t=1 To n:d1=(t-1)*alfa+phase2:d2=t*alfa+phase2:d3=(t-0.5)*alfa+phase2
LineXY(x2+intrad2*Cos(d1),y2+intrad2*Sin(d1),x2+extrad2*Cos(d3),y2+extrad2*Sin(d3),color2)
LineXY(x2+intrad2*Cos(d2),y2+intrad2*Sin(d2),x2+extrad2*Cos(d3),y2+extrad2*Sin(d3),color2)
Next
EndIf
EndProcedure
r1.l=70:r2.l=90:p.l=18:x1=RX/2:y1=RY/2:x2=0.66*RX:y2=0.76*RY
;-MAIN:
MouseLocate(333,333)
Repeat
ClearScreen(0)
ExamineKeyboard()
ExamineMouse():mx.l=MouseX():my.l=MouseY()
StartDrawing(ScreenOutput())
DrawCogged2D(x1,y1,r1.l,r2.l,p,pha,$aaaaaa,x2,y2,$23b367)
If KeyboardPushed(#PB_Key_LeftControl)
If MouseButton(1):Repeat:Delay(16):ExamineMouse():Until MouseButton(1)=0
p+1:If p>80:p=80:EndIf
EndIf
If MouseButton(2):Repeat:Delay(16):ExamineMouse():Until MouseButton(2)=0
p-1:If p<2:p=2:EndIf
EndIf
Else
pha=Mod(pha+MouseDeltaX()*0.01,#PI)
If MouseButton(1)
x1=Mod(x1+MouseDeltaX(),RX)
y1=Mod(y1+MouseDeltaY(),RY)
ElseIf MouseButton(2)
x2=Mod(x2+MouseDeltaX(),RX)
y2=Mod(y2+MouseDeltaY(),RY)
EndIf
EndIf
StopDrawing()
FlipBuffers():Delay(16)
Until KeyboardPushed(#PB_Key_Escape)