Code: Select all
;- ==== Maurer rose ====
EnableExplicit
InitSprite()
InitKeyboard()
;- -------- window
Global.i xx,xx2,yy,yy2,yy3
Global.s win$=Space(20)+"Pure Basic"+Space(70)+"Maurer rose"
Define.i desk=ExamineDesktops()-1
; desk=0
Global.i desk_xx=DesktopX(desk)
Global.i desk_yy=DesktopY(desk)
Global.i desk_x=DesktopWidth(desk)
Global.i desk_y=DesktopHeight(desk)
Procedure scrw()
yy = 800 : yy2=yy/2 : yy3=yy2-15
xx = 800 : xx2=xx/2
OpenWindow(0 , 0 , 0 , xx + 200 , yy ,win$ , 13107201 )
ResizeWindow(0 , #PB_Ignore , 24 , #PB_Ignore , #PB_Ignore)
OpenWindowedScreen(WindowID(0) , 0 , 0 , xx , yy)
EndProcedure
Procedure scrf()
yy = desk_y : yy2 = yy/2 : yy3 = yy2-15
xx = desk_x : xx2 = yy2
xx = xx/2-yy/2
OpenWindow(0 , desk_xx , desk_yy , desk_x , desk_y , "" , #PB_Window_BorderLess )
SetWindowColor(0,0)
OpenWindowedScreen(WindowID(0) , xx/2 , 0 , yy , yy)
xx = xx+yy
EndProcedure
scrw()
Global.f n , d
Global.i nf , df
Global.i ii , speed.i , speed2.i , onoff.i , a.i
n= 5 : nf= 0 : d= 29 : df= 0 : ii= 360 : speed= 0 : speed2= 0 : onoff= %111
#speedmax=2000
LoadFont(0 , "Tahoma" , 14)
SetGadgetFont(#PB_Default , FontID(0))
#xxx=45
Enumeration 4
#screen: #red1: #red2: #red3: #blue1: #blue2: #blue3
#q1: #q2: #speed_a1: #speed_a2: #speed_b1: #speed_b2
EndEnumeration
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,xx+20 ,20 ,90 ,28 ,"screen")
CheckBoxGadget(0,xx+20 ,70 ,90 ,28 ,"red top")
CheckBoxGadget(1,xx+20 ,100 ,90 ,28 ,"red on")
CheckBoxGadget(2,xx+20 ,130 ,90 ,28 ,"blue on")
For a= 0 To 2: SetGadgetState(a,1&(onoff>>a)):BindGadgetEvent (a , @onoff()): Next a
TextGadget (80 ,xx+4,175 ,190 ,23 , "Red Blue", #PB_Text_Center)
TrackBarGadget (#red1 ,xx+20 ,200 ,25 ,200 ,1, 1000, #PB_TrackBar_Vertical)
TrackBarGadget (#red2 ,xx+20+#xxx*1,200 ,25 ,200 ,0, 10000, #PB_TrackBar_Vertical)
TextGadget (#red3 ,xx +6 ,404 ,90 ,23 , "", #PB_Text_Center)
SetGadgetState (#red1 ,Int(n)): SetGadgetState (#red2, nf):get_n()
BindGadgetEvent(#red1 ,@get_n()): BindGadgetEvent(#red2, @get_n())
TrackBarGadget (#blue1 ,xx+20+#xxx*2 ,200 ,25 ,200 ,1, 1000, #PB_TrackBar_Vertical)
TrackBarGadget (#blue2 ,xx+20+#xxx*3 ,200 ,25 ,200 ,0, 10000, #PB_TrackBar_Vertical)
TextGadget (#blue3 ,xx+6+ #xxx*2 ,404 ,90 ,23 , "", #PB_Text_Center)
SetGadgetState (#blue1 ,Int(d)): SetGadgetState (#blue2, df):get_d()
BindGadgetEvent(#blue1 ,@get_d()): BindGadgetEvent(#blue2, @get_d())
; ================
TextGadget (81 ,xx+6,430 ,190 ,23 , " Q Speed")
TrackBarGadget (#q1 ,xx+20+#xxx*0 ,460 ,25 ,200 ,10, 1000, #PB_TrackBar_Vertical)
TextGadget (#q2 ,xx+1+#xxx*0 ,664 ,#xxx+10 ,23 , "", #PB_Text_Center)
SetGadgetState (#q1,ii):get_ii()
BindGadgetEvent(#q1 ,@get_ii())
TrackBarGadget (#speed_a1 ,xx+20+#xxx*1.5 ,460 ,25 ,200 , 0,#speedmax, #PB_TrackBar_Vertical)
TextGadget (#speed_a2 ,xx+2+#xxx*1.5 ,664 ,#xxx+10 ,23 , "", #PB_Text_Center)
SetGadgetState (#speed_a1,speed):get_speed()
BindGadgetEvent(#speed_a1 , @get_speed())
TrackBarGadget (#speed_b1 ,xx+20+#xxx*3 ,460 ,25 ,200 , 0,#speedmax, #PB_TrackBar_Vertical)
TextGadget (#speed_b2 ,xx+2+#xxx*3 ,664 ,#xxx+10 ,23 , "", #PB_Text_Center)
SetGadgetState (#speed_b1,speed2):get_speed2()
BindGadgetEvent(#speed_b1 , @get_speed2())
Repeat : Until WaitWindowEvent()=275
EndProcedure
gadgets()
Global.i i ,x,y,x2,y2,scr
Global.d k,kk,r, theta,ff
Procedure roseblue()
For i = 0 To ii
theta = i*(360/ii)+ff / d
k = theta * d * #PI / 180;
r = yy3 * 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()
For i = 0 To ii
theta = i*(360/ii)+ff
k = theta * #PI / 180
r = yy3 * 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$)
EndProcedure
Define.i flagg
Repeat
ff+speed/1000
kk+speed2/1000
ClearScreen(0)
StartDrawing(ScreenOutput())
SetOrigin(xx2, yy2)
If onoff&5=5 : roseblue(): EndIf
If onoff&2 : rosered() : EndIf
If onoff&5=4 : roseblue(): EndIf
StopDrawing()
FlipBuffers()
ExamineKeyboard()
If KeyboardReleased(#PB_Key_F) Or EventGadget()=#screen :scr!1
If scr=1 : scrf() : Else : scrw(): EndIf
gadgets()
EndIf
If KeyboardPushed(#PB_Key_All)=0 : flagg=0 : EndIf
If KeyboardPushed(#PB_Key_All) And flagg=0
If KeyboardPushed(#PB_Key_C) : SetClipb(): flagg=2
ElseIf KeyboardPushed(#PB_Key_0): flagg=1
n= 5 : nf= 0 : d= 29 : df= 0 : ii= 360 : speed= 0 : speed2= 0 : onoff= %111
ElseIf KeyboardPushed(#PB_Key_1): flagg=1
n= 121 : nf= 96 : d= 38 : df= 9969 : ii= 130 : speed= 1 : speed2= 1 : onoff= %110
ElseIf KeyboardPushed(#PB_Key_2): flagg=1
n= 121 : nf= 2676 : d= 687 : df= 0 : ii= 916 : speed= 21 : speed2= 0 : onoff= %100
ElseIf KeyboardPushed(#PB_Key_3): flagg=1
ElseIf KeyboardPushed(#PB_Key_4): flagg=1
ElseIf KeyboardPushed(#PB_Key_5): flagg=1
ElseIf KeyboardPushed(#PB_Key_6): flagg=1
ElseIf KeyboardPushed(#PB_Key_7): flagg=1
ElseIf KeyboardPushed(#PB_Key_8): flagg=1
ElseIf KeyboardPushed(#PB_Key_9): flagg=1
ElseIf KeyboardPushed(#PB_Key_Escape): End
EndIf
If flagg=1
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))
EndIf
EndIf
Until WindowEvent()=#PB_Event_CloseWindow
key "c" = clip = variables
then copy clip in row 183 and forwards you have "hotkeys" 0 to 9
a save/load maybe vill work better but i stop here