Draw arcs, polygons, pies, thick lines, no API calls
Posted: Sun Mar 31, 2013 4:52 pm
I needed a procedure to draw arcs. As a bonus I made one that would also draw regular polygons.
BP
BP
Code: Select all
Procedure Arc(x, y, start.f, finish.f, radius.f, color = 0, mode = 0)
; BasicallyPure 4.2.2013
; purpose: draw an arc or regular polygon
; this procedure must be used inside a StartDrawing() StopDrawing() block.
;
; Syntax: Arc(x, y, start, finish, radius, [color], [mode])
;
; x, y | the center location of the arc or polygon.
; start | the starting angle in degrees.
; finish | a dual purpose parameter, depends on mode.
; | if mode = #Arc_Mode_Arc then finish is the arc end point in degrees.
; | if mode = #Arc_Mode_Polygon then finish is the number of polygon sides.
; color | optional, sets the line color (default is black).
; mode | optional, draws arc or polygon (default is Arc).
#Arc_Mode_Arc = 0
#Arc_Mode_Polygon = 1
Protected xx, yy, px, py, inc.f, ang.f, fin.f
Select mode
Case #Arc_Mode_Arc
If start > finish : Swap start, finish : EndIf
If finish - start > 360 : finish = start + 360 : EndIf
inc = 0.1 ; arc smoothness
Case #Arc_Mode_Polygon
If finish < 3 : finish = 3 : EndIf
If finish > 64 : finish = 64 : EndIf
inc = Radian(360 / finish)
finish = start + 360
Default
ProcedureReturn 0
EndSelect
ang = Radian(start)
fin = Radian(finish)
px = x + Cos(ang) * radius
py = y + Sin(ang) * radius
Repeat
ang + inc
If ang > fin : ang = fin : EndIf
xx = x + Cos(ang) * radius
yy = y + Sin(ang) * radius
LineXY(px, py, xx, yy, color)
px = xx
py = yy
Until ang = fin
EndProcedure
; <><><><><><><><><> and now a demonstration <><><><><><><><><>
Procedure InitGUI()
Global s = 0, f = 180, r = 150
If Not OpenWindow(0, 200, 100, 800, 800, "ARC & POLYGON DEMO") : End : EndIf
CanvasGadget(0, 0, 0, 800, 650)
TrackBarGadget(1, 60, 700, 600, 25, 0, 300) : SetGadgetState(1, r) ; radius
TrackBarGadget(2, 60, 730, 600, 25, 0, 720) : SetGadgetState(2, s+360) ; start
TrackBarGadget(3, 60, 760, 600, 25, 0, 720) : SetGadgetState(3, f+360) ; finish
TextGadget(#PB_Any,10, 670, 45, 25, "Mode")
TextGadget(#PB_Any,10, 700, 45, 25, "Radius")
TextGadget(#PB_Any,10, 730, 45, 25, "Start")
TextGadget(#PB_Any,10, 760, 45, 25, "Finish")
StringGadget(4, 670, 700, 45, 25, Str(r))
StringGadget(5, 670, 730, 45, 25, Str(s))
StringGadget(6, 670, 760, 45, 25, Str(f))
OptionGadget(7, 060, 670, 45, 25, "Arc") : SetGadgetState(7,1)
OptionGadget(8, 115, 670, 55, 25, "Polygon")
EndProcedure
Procedure DrawObject()
StartDrawing(CanvasOutput(0))
Box(0,0,800,650, $0B94CB)
;Circle(400, 330, 2, 0) ; optional
If GetGadgetState(7)
arc(400, 325, s, f, r, 0, #Arc_Mode_Arc)
Else
arc(400, 325, s, f, r, 0, #Arc_Mode_Polygon)
EndIf
StopDrawing()
EndProcedure
Procedure EventLoop()
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case 1 ; radius
r = GetGadgetState(1)
SetGadgetText(4, Str(r))
DrawObject()
Case 2 ; start
s = GetGadgetState(2) - 360
SetGadgetText(5, Str(s))
DrawObject()
Case 3 ; finish
f = GetGadgetState(3) - 360
If GetGadgetState(8)
f = Abs(f) / 36
EndIf
SetGadgetText(6, Str(f))
DrawObject()
Case 7 ; Arc mode
f = GetGadgetState(3) - 360
SetGadgetText(6, Str(f))
DrawObject()
Case 8 ; polygon mode
f = Abs(f) / 36
SetGadgetText(6, Str(f))
DrawObject()
EndSelect
Case #PB_Event_CloseWindow
Break
EndSelect
ForEver
EndProcedure
InitGUI()
DrawObject()
EventLoop()
End
