PureBasic Forum

;- ==== Maurer rose ====
EnableExplicit
Global.i desk = ExamineDesktops()-1
Global.i desk_x0 , desk_y0 , desk_x1 , desk_y1
#winsc = 1.3 ; Set windowscreen desktop scale
#Fdesk = 1   ; set fullscreen desktop nr.

InitSprite()
InitKeyboard()
Global.i xx , gadgetx , center , radie , size
Global.s win$ = Space(20)+"Pure Basic"+Space(70)+"Maurer rose"
Global.f n , d
Global.i nf , df
Global.i ii , speed.i , speed2.i , onoff.i , a

desk_x0 = DesktopX(0)
desk_y0 = DesktopY(0)
If #Fdesk <= desk : desk = #Fdesk : Else : desk = 0 : EndIf
desk_x1 = DesktopX(desk)
desk_y1 = DesktopY(desk)

Enumeration 4
  #screen : #red1: #red2 : #red3 : #blue1 : #blue2 : #blue3
  #q1 : #q2 : #speed_a1 : #speed_a2 : #speed_b1 : #speed_b2 : #time
EndEnumeration
#xxx = 45
#speedmax = 2000
LoadFont(0 , "Tahoma" , 14)
SetGadgetFont(#PB_Default , FontID(0))
Procedure set_gadgets()
  SetGadgetState(#red1 , n)
  SetGadgetState(#red2 , nf)
  n+nf/10000
  SetGadgetText(#red3 , StrF(n , 4))
  SetGadgetState(#blue1 , d)
  SetGadgetState(#blue2 , df)
  d+df/10000
  SetGadgetText(#blue3 , StrF(d , 4))
  SetGadgetState (#q1 , ii)
  SetGadgetText(#q2 , Str(ii))
  SetGadgetState (#speed_a1 , speed)
  SetGadgetText(#speed_a2 , Str(speed))
  SetGadgetState (#speed_b1 , speed2)
  SetGadgetText(#speed_b2 , Str(speed2))
  For a = 0 To 2 : SetGadgetState(a , 1&(onoff>>a)) : Next a
EndProcedure
Procedure onoff()
  onoff = 0
  For a = 0 To 2 : onoff|GetGadgetState(a)<<a : Next a
EndProcedure
Procedure get_n()
  nf = GetGadgetState(#red2)
  n = GetGadgetState(#red1)+nf/10000
  SetGadgetText(#red3 , StrF(n , 4))
EndProcedure
Procedure get_d()
  df = GetGadgetState(#blue2)
  d = GetGadgetState(#blue1)+df/10000
  SetGadgetText(#blue3 , StrF(d , 4))
EndProcedure
Procedure get_ii()
  ii = GetGadgetState(#q1)
  SetGadgetText(#q2 , Str(ii))
EndProcedure
Procedure get_speed()
  speed = GetGadgetState(#speed_a1)
  SetGadgetText(#speed_a2 , Str(speed))
EndProcedure
Procedure get_speed2()
  speed2 = GetGadgetState(#speed_b1)
  SetGadgetText(#speed_b2 , Str(speed2))
EndProcedure
Procedure gadgets()
  ButtonGadget(#screen , gadgetx+20 , 20 , 90 , 28 , "screen")
  CheckBoxGadget(0 , gadgetx+20 , 70 , 90 , 28 , "red top") : BindGadgetEvent (0 , @onoff())
  CheckBoxGadget(1 , gadgetx+20 , 100 , 90 , 28 , "red on") : BindGadgetEvent (1 , @onoff())
  CheckBoxGadget(2 , gadgetx+20 , 130 , 90 , 28 , "blue on"): BindGadgetEvent (2 , @onoff())
  TextGadget (80 , gadgetx+4 , 175 , 190 , 23 , "Red        Blue" , #PB_Text_Center)
  TrackBarGadget (#red1 , gadgetx+20 , 200 , 25 , 200 , 1 , 1000 , #PB_TrackBar_Vertical)
  TrackBarGadget (#red2 , gadgetx+20+#xxx*1 , 200 , 25 , 200 , 0 , 10000 , #PB_TrackBar_Vertical)
  TextGadget     (#red3 , gadgetx +6 , 404 , 90 , 23 , "" , #PB_Text_Center)
  BindGadgetEvent(#red1 , @get_n()) : BindGadgetEvent(#red2 , @get_n())
 
  TrackBarGadget (#blue1 , gadgetx+20+#xxx*2 , 200 , 25 , 200 , 1 , 1000 , #PB_TrackBar_Vertical)
  TrackBarGadget (#blue2 , gadgetx+20+#xxx*3 , 200 , 25 , 200 , 0 , 10000 , #PB_TrackBar_Vertical)
  TextGadget     (#blue3 , gadgetx+6+ #xxx*2 , 404 , 90 , 23 , "" , #PB_Text_Center)
  BindGadgetEvent(#blue1 , @get_d()) : BindGadgetEvent(#blue2 , @get_d())
 
  TextGadget (81 , gadgetx+6 , 430 , 190 , 23 , "   Q            Speed")
 
  TrackBarGadget (#q1 , gadgetx+20+#xxx*0 , 460 , 25 , 200 , 10 , 10000 , #PB_TrackBar_Vertical)
  TextGadget     (#q2 , gadgetx+1+#xxx*0 , 664 , #xxx+10 , 23 , "" , #PB_Text_Center)
  BindGadgetEvent(#q1 , @get_ii())
 
  TrackBarGadget (#speed_a1 , gadgetx+20+#xxx*1.5 , 460 , 25 , 200 , 0 , #speedmax , #PB_TrackBar_Vertical)
  TextGadget     (#speed_a2 , gadgetx+2+#xxx*1.5 , 664 , #xxx+10 , 23 , "" , #PB_Text_Center)
  BindGadgetEvent(#speed_a1 , @get_speed())
 
  TrackBarGadget (#speed_b1 , gadgetx+20+#xxx*3 , 460 , 25 , 200 , 0 , #speedmax , #PB_TrackBar_Vertical)
  TextGadget     (#speed_b2 , gadgetx+2+#xxx*3 , 664 , #xxx+10 , 23 , "" , #PB_Text_Center)
  BindGadgetEvent(#speed_b1 , @get_speed2())
 
  TextGadget (#time , gadgetx+50 , 730 , 70 , 23 , "1234567" , #PB_Text_Center)
EndProcedure

Procedure scrw()
  Protected.i panel = 200
  OpenWindow(0 , desk_x0 , desk_y0 , 5 , 5 , "" , #PB_Window_Maximize | #PB_Window_BorderLess )
  size = WindowHeight(0)/#winsc : center = size/2 : radie = center-15
  OpenWindow(0 , 0 , 0 , size + panel , size , win$ , #PB_Window_ScreenCentered |  #PB_Window_SystemMenu )
  ResizeWindow(0 , #PB_Ignore , 24 , #PB_Ignore , #PB_Ignore)
  OpenWindowedScreen(WindowID(0) , 0 , 0 , size , size)
 
  CreateSprite(0 , size , size)
  gadgetx = size
  gadgets()
  nf=0: df=0
  set_gadgets()
  Repeat : Until WindowEvent() = 275
EndProcedure

Procedure scrf()
  Protected.i Width , panel = 200
  OpenWindow(0 , desk_x1 , desk_y1 , 5 , 5 , "" , #PB_Window_Maximize + #PB_Window_BorderLess )
  SetWindowColor(0 , 0)
  size = WindowHeight(0) : center = size/2 : radie = center-15
  Width = WindowWidth(0)
  OpenWindowedScreen(WindowID(0) , (Width-panel)/2-size/2 , 0 , size , size)
 
  CreateSprite(0 , size , size)
  gadgetx = Width-panel-100
  gadgets()
  nf=0: df=0
  set_gadgets()
  Repeat : Until WindowEvent() = 275
EndProcedure

Procedure roseblue(ff.d , kk.d)
  Protected.i i , x , y , x2 , y2
  Protected.d k , r , theta
  For i = 0 To ii
    theta = i*(360/ii)+ff / d
    k = theta * d * #PI / 180 ;
    r = radie * Sin(n*k)      ;
    x = r * Cos(k+kk)
    y = r * Sin(k+kk)
    If i>0 : LineXY(x , y , x2 , y2 , #Blue) : EndIf
    x2 = x : y2 = y
  Next i
EndProcedure
Procedure rosered(ff.d , kk.d)
  Protected.i i , x , y , x2 , y2
  Protected.d k , r , theta
  For i = 0 To ii
    theta = i*(360/ii)+ff
    k = theta * #PI / 180
    r = radie * Sin(n*k) ;
    x = r * Cos(k+kk)
    y = r * Sin(k+kk)
    If i>0 : LineXY(x , y , x2 , y2 , #Red) : EndIf
    Circle(x , y , 2 , #Red)
    x2 = x : y2 = y
  Next i
EndProcedure
Procedure SetClipb()
  Protected.s clip$
  clip$= "n = "+Str(Int(n))+" : "
  clip$+ "nf = "+Str(nf)+" : "
  clip$+ "d = "+Str(Int(d))+" : "
  clip$+ "df = "+Str(df)+" : "
  clip$+ "ii = "+Str(ii)+" : "
  clip$+ "speed = "+Str(speed)+" : "
  clip$+ "speed2 = "+Str(speed2)+" : "
  clip$+ "onoff = %"+Bin(onoff)
  SetClipboardText(clip$)
  Debug "ff"
EndProcedure

n = 5 : nf = 0 : d = 29 : df = 0 : ii = 360 : speed = 0 : speed2 = 0 : onoff = %111
scrw()
Define.i flag , time , scr , ff.d , kk.d
Repeat
  time = ElapsedMilliseconds()
    ff+speed/1000
    kk+speed2/1000
    StartDrawing(SpriteOutput(0))
      Box(0 , 0 , size , size , #Black)
      SetOrigin(center , center)
      If onoff&5 = 5 : roseblue(ff , kk) : EndIf
      If onoff&2 : rosered(ff , kk) : EndIf
      If onoff&5 = 4 : roseblue(ff , kk) : EndIf
    StopDrawing()
    DisplaySprite(0 , 0 , 0)
  SetGadgetText(#time , Str(ElapsedMilliseconds()-time))   
  FlipBuffers()

  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_All) = 0 : flag = 0 : EndIf
 
  If (KeyboardPushed(#PB_Key_F) And flag = 0) Or EventGadget() = #screen : scr!1
    If scr = 1 : scrf() : Else : scrw() : EndIf
  EndIf
  If KeyboardPushed(#PB_Key_All) And flag = 0
    If KeyboardPushed(#PB_Key_C) : SetClipb() : flag = 2
    ElseIf KeyboardPushed(#PB_Key_0) : flag = 1
      n = 5 : nf = 0 : d = 29 : df = 0 : ii = 360 : speed = 0 : speed2 = 0 : onoff = %111
    ElseIf KeyboardPushed(#PB_Key_1) : flag = 1
      n = 121 : nf = 96 : d = 38 : df = 9969 : ii = 130 : speed = 1 : speed2 = 1 : onoff = %110
    ElseIf KeyboardPushed(#PB_Key_2) : flag = 1
      n = 121 : nf = 2676 : d = 687 : df = 0 : ii = 916 : speed = 21 : speed2 = 0 : onoff = %100
    ElseIf KeyboardPushed(#PB_Key_3) : flag = 1
      n = 13 : nf = 0 : d = 152 : df = 0 : ii = 805 : speed = 69 : speed2 = 1 : onoff = %110
    ElseIf KeyboardPushed(#PB_Key_4) : flag = 1
      n = 13 : nf = 0 : d = 164 : df = 9143 : ii = 805 : speed = 69 : speed2 = 1 : onoff = %110
    ElseIf KeyboardPushed(#PB_Key_5) : flag = 0
    ElseIf KeyboardPushed(#PB_Key_6) : flag = 0
    ElseIf KeyboardPushed(#PB_Key_7) : flag = 0
    ElseIf KeyboardPushed(#PB_Key_8) : flag = 0
    ElseIf KeyboardPushed(#PB_Key_9) : flag = 1
      n = 5 : nf = 0 : d = 286 : df = 0 : ii = 6175 : speed = 0 : speed2 = 23 : onoff = %111
    ElseIf KeyboardPushed(#PB_Key_Escape) : End
    EndIf
    If flag = 1 : set_gadgets() : EndIf
  EndIf
Until WindowEvent() = #PB_Event_CloseWindow