' PROG Dragon
$INCLUDE "rapidq.inc"
$TYPECHECK on
'''----Event driven Sub Routines
DECLARE SUB Init
DECLARE SUB Mayshun ' Time out developemental informashun
DECLARE SUB ButtonClick (Sender AS QButton)
DECLARE SUB Hook
' ~~~~~General purpose variables~~~~~~~~~~
DEFSTR n$, i$ ' working string
DEFBYTE n?, i? ' working byte 1 00 FF
DEFWORD n??,i?? ' working word 2 0000 FFFF
DEFINT n&, i& ' working integer 4 -2147483648..2147483647
DEFSNG n, i ' working variable 4 big
DEFDBL n#, i# ' working doubleword 8 bigger
DEFSNG rad = 3.1415927/180 ' to convert to radians
' ~~~~~House-keeping variables~~~~~~~~~~
DEFBYTE Hookflag = 0
DEFSTR fname$ = ""
DEFSNG Formcol = &HC0C0C0
DEFSNG BUMPcol = &H000000
' ~~~~~~Draw function parms~~~~~~
DEFSNG x1,y1,x2,y2 ' absissa & ordinate
DEFSHORT beans ' bean counter number of iterations
DEFSHORT Nuf=390 ' high count for bean counter
DEFSNG hue ' pixel color
'''~~~~~~~~~~~~~~~~~~~~ Create Objects ~~~~~~~~~~~~~~~~~~~
DIM SaveD as QSaveDialog ' save dialog
'''-----main picture bitmap
DIM Bump as QBITMAP
Bump.width = 400: Bump.height = 400
Bump.fillrect(0,0,400,400,BUMPcol)
'''-----Entire form (including developemental area)
DIM Form as QForm
Form.top = 10 : Form.left= 100
Form.width = 600 : Form.height = 490
Form.Color =Formcol: Form.borderstyle=1
'''----control buttons, labels and edit boxes
DIM DrawB as QBUTTON ' draw main bitmap
DrawB.parent = Form
DrawB.caption = "Draw"
DrawB.top = 185
DrawB.left = 460
DrawB.showhint= 1
DrawB.hint = "draw the curve"
DrawB.onclick = ButtonClick
DIM EraseB as QBUTTON
EraseB.parent = Form
EraseB.caption = "Erase"
EraseB.top = 215
EraseB.left = 460
EraseB.showhint= 1
EraseB.hint = "Erase the display"
EraseB.onclick = ButtonClick
DIM SaveB as QBUTTON ' save bitmap
SaveB.parent = Form
SaveB.caption = "Save"
SaveB.top = 245
SaveB.left = 460
SaveB.showhint= 1
SaveB.hint = "Save to disk file"
SaveB.onclick = ButtonClick
'''-----Labels and Edit Boxes
DIM OrderL as QLABEL : OrderL.parent = Form
OrderL.Left= 450 : OrderL.caption ="Curve Number"
OrderL.Top = 290 : OrderL.Width = 100
OrderL.OndblClick = Hook
DIM MinusB as QBUTTON : MinusB.parent = Form
MinusB.left = 450 : MinusB.caption = "-"
MinusB.top = 315 : MinusB.showhint= 1
MinusB.Width = 20 : MinusB.hint = "Decrement Order Number"
MinusB.height = 20 : MinusB.onclick = ButtonClick
DIM EditOrder as QEDIT : EditOrder.parent = Form
EditOrder.Left = 480 : EditOrder.text = " 11 "
EditOrder.Top = 310 : EditOrder.ShowHint = 1
EditOrder.Width = 30 : EditOrder.Hint = "curve order number"
DIM PlusB as QBUTTON : PlusB.parent = Form
PlusB.left = 520 : PlusB.caption = "+"
PlusB.top = 315 : PlusB.showhint= 1
PlusB.Width = 20 : PlusB.hint = "Increment Order Number"
PlusB.height = 20 : PlusB.onclick = ButtonClick
DIM ExitB as QBUTTON ' exit program
ExitB.parent = Form
ExitB.caption = "Exit"
ExitB.top = 370
ExitB.left = 460
ExitB.showhint = 1
ExitB.hint = "Terminate the program"
ExitB.onclick = ButtonClick
'''---Timer for developement InForMayshun
DIM Irig as QTIMER
Irig.interval= 100: Irig.OnTimer= Init
'''----- Initalize and Wait for an event
Form.caption= "<< Dragon Curve generation by Old bob>> "
Form.showmodal
showmessage "you could have used the exit button......"
END
'''~~~~~~~ Event driven sub routines ~~~~~~~~~~~~~~
'''~~~~~ Timer driven Initalization Sub ~~~~~~~~~
SUB init
Form.Draw (0,0,bump.bmp) ' clear picture
Irig.OnTimer= 0
END SUB
'''~~~~~ Subroutines dependent on Button Clicks ~~~~~~~~~
SUB ButtonClick (Sender AS Qbutton)
SELECT CASE (Sender.Caption)
'~~~~~~~~~~~~~~~
CASE "Draw"
Form.caption= "Draw"
n??= int(abs(val(EditOrder.text)))
if n??
< 1 then n??=5
if n?? >12 then n??=12
EditOrder.text= str$(n??)
i$="R"
for i= 1 to n??: i$=i$+"R"
for n= len(i$)-1 to 1 step -1: n$= mid$(i$,n,1)
if n$="R" then i$=i$+"L"
if n$="L" then i$=i$+"R"
next n: next i
x1=270: y1=265: x2=270: y2=265: i??=4
for n=0 to len(i$): n$= mid$(i$,n,1)
i??= i?? + (n$="L") - (n$="R")
if i??
<1 then i??=4
if i??>4 then i??=1
if i??= 1 then x2=x1+3
if i??= 2 then y2=y1+3
if i??= 3 then x2=x1-3
if i??= 4 then y2=y1-3
Bump.line(x1,y1,x2,y2,&HFFFFFF)
Form.line(x1,y1,x2,y2,&HFFFFFF)
x1=x2: y1=y2
next n
'~~~~~~~~~~~~~~~~~~
CASE "Erase"
Form.caption = "
< display cleared >"
Bump.fillrect(0,0,400,400,BUMPcol) ' erase old picture
Form.Draw (0,0,bump.bmp) ' draw new picture
Return
'~~~~~~~~~~~~~~
CASE "Save"
Form.caption = "<< Saving in progress >>"
SaveD.FileName = "NewFile.bmp"
SaveD.caption = "Select a file.bmp for saving"
SaveD.Filter = "Picture files|*.BMP;*.ICO|All Files|*.*"
SaveD.FilterIndex = 2 ' Use "All Files" as our default
IF SaveD.execute = 0 then Return ' Cancel out
fname$= SaveD.FileName
i$= right$(fname$,4)
IF i$
<>".bmp" AND i$<>".BMP" then fname$= fname$+".bmp"
Bump.SaveToFile (fname$) ' bmp structure to disk
Form.caption = "<< Saving is complete >>"
'~~~~~~~~~~~~~~~
CASE "-"
n= int(abs(val(editorder.text)))
if n=> 2 then EditOrder.text = str$(n-1)
'~~~~~~~~~~~~~~~
CASE "+"
n= int(abs(val(editorder.text)))
if n=< 11 then EditOrder.text = str$(n+1)
'~~~~~~~~~~~~~~~
CASE "Exit"
END ' gracefully exit,
''''~~~~~~~~~~~~~~~~~~end of button click selections~~~~~~~
END SELECT
END SUB
'''~~~~~~~~~~~~~~~~~ Mouse driven Sub routines ~~~~~~~~~~~~~~~~~
'''~~~~~~~~~~ developement aid soft hook
SUB Hook
HookFlag= HookFlag XOR 1
IF Hookflag=0 then
Form.height = 550
Irig.OnTimer= Mayshun
End IF
IF Hookflag=1 then
Form.fillrect (0,415,600,540,FormCol)
Form.height = 490
Irig.OnTimer= 0
End IF
END SUB
'''~~~~~~~~~ Subroutine dependent on Timer time out ~~~~~~~~~
''' Post some In Form Mashun below the canvas
''' as an analitical tool for program developement
SUB Mayshun
Form.TextOut( 0,425," mousex= "+STR$(mousex)+" ",0,Formcol)
Form.TextOut( 0,440," mousey= "+STR$(mousey)+" ",0,Formcol)
END SUB
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ KALAS ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~