home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 015.lha / FScapePlus (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1986-11-10  |  24.1 KB  |  873 lines
  1. '*** FScapePlus *** 30-Nov-86 *** Mike Steed *** Public Domain ***
  2.  
  3.   IF FRE(-1)<80000 OR FRE(-3)<50000 THEN PRINT "Sorry, not enough memory." : END
  4.   CLEAR ,50000   'make room
  5.   GOSUB Init
  6.  
  7. Main:
  8.   Mode = 1 : Idle = 1 : GOSUB MenuUpdate
  9.   MenuVec = 0
  10. MainLp:  'can't SLEEP (?)
  11.   IF INKEY$ = CHR$(139) THEN Help
  12.   ON MenuVec GOTO MenuProject,Main,MenuWindow,MenuColor
  13.   GOTO MainLp
  14.  
  15. '***  Menu Control  ***
  16. MenuProject:
  17.   ON MenuSubVec GOTO DoFscape,ReDraw,CycleScape,Main,Quit
  18.   GOTO Main
  19.  
  20. MenuFile:  'come here from CtrlPanel
  21.   ON MenuSubVec GOTO LoadFScape,SaveFScape
  22.  
  23. MenuWindow:
  24.   ON MenuSubVec GOSUB DsplyWindow,CtrlWindow
  25.   GOTO Main
  26.  
  27. MenuColor:
  28.   ColorMode = MenuSubVec : GOSUB SetColors
  29.   GOTO Main
  30.  
  31. Help:
  32.   CALL YesNoReq("For help with FScapePlus,|see the file FScapePlus.doc","","OK",200,64,Dummy)
  33.   GOTO Main
  34.  
  35. '***  Hi Level Stuff  ***
  36.  
  37. DsplyWindow:
  38.   WINDOW 2
  39.   RETURN
  40.  
  41. CtrlWindow:
  42.   Mode = 0 : GOSUB MenuUpdate
  43.   WINDOW 1
  44.   GOSUB SetControls
  45.   GOSUB CtrlLoop
  46.   GOSUB GetControls
  47.   WINDOW 2 : RETURN
  48.  
  49. DoFscape:
  50.   IF AutoSeed THEN GOSUB GenSeed
  51.   GOSUB Fscape
  52.   GOTO Main
  53.  
  54. ReDraw:  'Redraw existing array
  55.   Idle = 0 : GOSUB MenuUpdate
  56.   GOSUB FDraw
  57.   GOTO Main
  58.  
  59. CycleScape:  'Continuous FScapes
  60.   OldSeed% = Seed%
  61. CycleScape2:
  62.   GOSUB GenSeed
  63.   GOSUB Fscape
  64.   GOTO CycleScape2  'Menu Stop gets us out
  65.  
  66. Fscape:  'Create & draw an FScape
  67.   Idle = 0 : GOSUB MenuUpdate
  68.   GOSUB FInit
  69.   GOSUB FCreate
  70.   GOSUB FDraw
  71.   RETURN
  72.  
  73. Quit:  'That's all, folks!
  74.   CALL YesNoReq("Exit to:","System","Basic",200,64,Systm%)
  75.   MENU RESET
  76.   WINDOW 1 : CLS
  77.   WINDOW CLOSE 2 : SCREEN CLOSE 2
  78.   IF Systm% THEN SYSTEM :ELSE END
  79.  
  80. FDraw:  'Draw FScape
  81.   OldSeed% = Seed%
  82.   IF ClrScn THEN COLOR 1,0 : CLS
  83.   GOSUB PlotZ
  84.   GOSUB PlotY
  85.   GOSUB PlotX
  86.   RETURN
  87.  
  88. '***  File Routines  ***
  89.  
  90. LoadFScape:
  91.   CALL StringReq("Load FScape File:",FileName$,"Load","",200,64,DoIt)
  92.   IF NOT DoIt THEN RETURN
  93.   OPEN FileName$+".fscape" FOR INPUT AS 1
  94.   INPUT #1, Seed%,le,rg,cx,cy,xs,ys,zs,AutoSeed,ClrScn,SeaLev%
  95.   CLOSE #1
  96.   GOSUB SetControls
  97.   d(1,0) = 0  'no redraw
  98.   RETURN
  99.  
  100. SaveFScape:
  101.   CALL StringReq("Save FScape File:",FileName$,"Save","",200,64,DoIt)
  102.   IF NOT DoIt THEN RETURN
  103.   GOSUB GetControls  'update variables
  104.   OPEN FileName$+".fscape" FOR OUTPUT AS 1
  105.   WRITE #1, Seed%,le,rg,cx,cy,xs,ys,zs,0,ClrScn,SeaLev%  'auto seed always off
  106.   CLOSE #1
  107.   RETURN
  108.  
  109. ErrorHandler:  'come here on error
  110.   IF ERR = 53 THEN ErrMsg$ = "Can't find that file." : GOTO GiveError
  111.   IF ERR = 64 THEN ErrMsg$ = "Can't use that filename." : GOTO GiveError
  112.   IF ERR = 70 THEN ErrMsg$ = "Disk is write-protected." : GOTO GiveError
  113.   IF ERR = 49 THEN ErrMsg$ = "Can't find that volume." : GOTO GiveError
  114.   IF ERR = 61 THEN ErrMsg$ = "The disk is full." : GOTO GiveError
  115.   ON ERROR GOTO 0  'let Basic handle others
  116. GiveError:
  117.   CALL YesNoReq (ErrMsg$,"","Oops",200,64,Dummy%)
  118.   CLOSE
  119.   RESUME MenuFile
  120.  
  121. '***  Fractal Landscape Subroutines  ***
  122.  
  123. FInit:  'Init for create or draw
  124.   Dummy = RND(Seed%)
  125.   ds = 2^le+1
  126.   mx = ds-1 : my = mx/2 : rh = Pi/6 : vt = -Pi/5
  127.   rc = COS(rh) : rs = SIN(rh)
  128.   vc = COS(vt) : vs = SIN(vt)
  129.   RETURN
  130.  
  131. FCreate:  'Create a fractal array
  132.   FOR n = 1 TO le
  133.     l = rg/1.8^n : L2 = l/2 : L4 = l/4
  134.     ib = mx/2^n : sk = ib*2
  135.     GOSUB XHeight
  136.     GOSUB YHeight
  137.     GOSUB ZHeight
  138.   NEXT
  139.   RETURN
  140.  
  141. DefSettings:  'Defaults for adjustable parms
  142.   xs = 0.04 : ys = 0.04 : zs = 0.05 : cx = 0 : cy = 48 : rg = 12000
  143.   SeaLev% = 0 : le = 5 : ClrScn = -1 : AutoSeed = -1
  144.   RETURN
  145.  
  146. XHeight:  'Calculate heights along X axis
  147.   FOR ye = 0 TO mx-1 STEP sk
  148.     FOR xe = ib+ye TO mx STEP sk
  149.       ax = xe-ib : ay = ye : GOSUB GetDat : d1 = d : ax = xe+ib : GOSUB GetDat : d2 = d
  150.       d = (d1+d2)/2+RND*L2-L4 : ax = xe : ay = ye : GOSUB PutDat
  151.     NEXT xe
  152.   NEXT ye
  153.   RETURN
  154.  
  155. YHeight:  'Calculate heights along Y axis
  156.   FOR xe = mx TO 1 STEP -sk
  157.     FOR ye = ib TO xe STEP sk
  158.       ax = xe : ay = ye+ib : GOSUB GetDat : d1 = d : ay = ye-ib : GOSUB GetDat : d2 = d
  159.       d = (d1+d2)/2+RND*L2-L4 : ax = xe : ay = ye : GOSUB PutDat
  160.     NEXT ye
  161.   NEXT xe
  162.   RETURN
  163.  
  164. ZHeight:  'Calculate heights along Z axis
  165.   FOR xe = 0 TO mx-1 STEP sk
  166.     FOR ye = ib TO mx-xe STEP sk
  167.       ax = xe+ye-ib : ay = ye-ib : GOSUB GetDat : d1 = d
  168.       ax = xe+ye+ib : ay = ye+ib : GOSUB GetDat : d2 = d
  169.       ax = xe+ye : ay = ye : d = (d1+d2)/2+RND*L2-L4 : GOSUB PutDat
  170.       NEXT ye
  171.     NEXT xe
  172.   RETURN
  173.  
  174. GetDat:  'Get a data point from array
  175.   IF ay > my THEN
  176.     by = mx+1-ay : bx = mx-ax
  177.   ELSE
  178.     by = ay : bx = ax
  179.   END IF
  180.   d = d(bx,by)
  181.   RETURN
  182.  
  183. PutDat:  'Put a data point into array
  184.   IF ay > my THEN
  185.     by = mx+1-ay : bx = mx-ax
  186.   ELSE
  187.     by = ay : bx = ax
  188.   END IF
  189.   d(bx,by) = d
  190.   RETURN
  191.  
  192. SeaLevel:  'this code is a bit ugly...
  193.   IF NOT SeaLev% THEN GOTO Colors  'not doing sea level
  194.   IF xo <> -999 THEN SeaLevel2
  195.   IF zz < 0 THEN
  196.     Colr = 5 : z2 = zz : zz = 0
  197.   ELSE
  198.     Colr = 2 : z2 = zz
  199.   END IF
  200.   GOTO ExitSeaLevel
  201. SeaLevel2:
  202.   IF z2 > 0 AND zz > 0 THEN GOSUB Colors : z2 = zz : GOTO ExitSeaLevel
  203.   IF z2 < 0 AND zz < 0 THEN z2 = zz : zz = 0 : GOTO ExitSeaLevel
  204.   IF zz = z2 THEN w3 = 0.5 :ELSE w3 = zz/(zz-z2)
  205.   x3 = (x2-xx)*w3+xx : y3 = (y2-yy)*w3+yy : z3 = 0
  206.   zt = zz : yt = yy : xt = xx
  207.   IF zz > 0 THEN  'coming out of water
  208.     zz = z3 : yy = y3 : xx = x3 : GOSUB Plot2
  209.     Colr = 2 : zz = zt : yy = yt : xx = xt : z2 = zz
  210.   ELSE  'going into water
  211.     zz = z3 : yy = y3 : xx = x3 : GOSUB Plot2
  212.     Colr = 5 : zz = 0 : yy = yt :xx = xt : z2 = zt
  213.   END IF
  214. ExitSeaLevel:
  215.   x2 = xx : y2 = yy : RETURN
  216.  
  217. Colors:  'convert altitude to color
  218.   IF zz < 0 THEN BelowWater
  219.   IF zz < 250 THEN Colr = 2 : RETURN  'dk green
  220.   IF zz < 550 THEN Colr = 3 : RETURN  'med green
  221.   IF zz < 950 THEN Colr = 4 : RETURN  'lt brown
  222.   Colr = 1 : RETURN  'white
  223. BelowWater:
  224.   IF zz > -600 THEN Colr = 5 : RETURN  'blue
  225.   Colr = 6 : RETURN  'med blue
  226.  
  227. Plot:  'Draw a line between two points
  228.   GOSUB SeaLevel
  229. Plot2:   'skip sea level
  230.   xx = xx*xs : yy = yy*ys : zz = zz*zs
  231.   ox = xx   'Rotation
  232.   xx = xx*rc-yy*rs
  233.   yy = ox*rs+yy*rc
  234.   ox = xx   'Tilt down
  235.   xx = vc*xx-vs*zz
  236.   zz = vs*ox+vc*zz
  237.   xp = INT(yy) : yp = INT(zz)
  238.   xp = xp*1.38+cx : yp = cy-0.663*yp
  239.   IF xo = -999 THEN PSET (xp,yp),Colr :ELSE LINE -(xp,yp),Colr
  240.   x8 = xp : y8 = yp : xo = xp
  241.   RETURN
  242.  
  243. PlotX:  'Plot X axis
  244.   FOR ax = 0 TO mx : xo = -999
  245.     FOR ay = 0 TO ax
  246.       GOSUB GetDat : zz = d : yy = ay/mx*EE4 : xx = ax/mx*EE4-yy/2
  247.       GOSUB Plot
  248.     NEXT ay
  249.   NEXT ax
  250.   RETURN
  251.  
  252. PlotY:  'Plot Y axis
  253.   FOR ay = 0 TO mx : xo = -999
  254.     FOR ax = ay TO mx
  255.       GOSUB GetDat : zz = d : yy = ay/mx*EE4 : xx = ax/mx*EE4-yy/2
  256.       GOSUB Plot
  257.     NEXT ax
  258.   NEXT ay
  259.   RETURN
  260.  
  261. PlotZ:  'Plot Z azis
  262.   FOR ex = 0 TO mx : xo = -999
  263.     FOR ey = 0 TO mx-ex
  264.       ax = ex+ey : ay = ey : GOSUB GetDat : zz = d : yy = ay/mx*EE4
  265.       xx = ax/mx*EE4-yy/2
  266.       GOSUB Plot
  267.     NEXT ey
  268.   NEXT ex
  269.   RETURN
  270.  
  271. '***  Menu Subroutines  ***
  272.  
  273. MenuSel:  'come here on menu select
  274.   MSVOld = MenuSubVec  'where were we?
  275.   MenuVec = MENU(0) : MenuSubVec = MENU(1)
  276.   IF MenuVec = 1 AND MenuSubVec = 4 THEN  'Stop
  277.     IF MSVOld = 1 THEN d(1,0) = 0  'disable redraw
  278.     IF MSVOld = 3 THEN Seed% = OldSeed%
  279.     RETURN Main
  280.   END IF
  281.   RETURN
  282.  
  283. MenuSetup:  'Create menus
  284.   MENU 1,0,0,"Project"
  285.     MENU 1,1,1,"New   "
  286.     MENU 1,2,1,"Redraw"
  287.     MENU 1,3,1,"Cycle "
  288.     MENU 1,4,1,"Stop  "
  289.     MENU 1,5,1,"Quit  "
  290.   MENU 2,0,0,"File"
  291.     MENU 2,1,1,"Load"
  292.     MENU 2,2,1,"Save"
  293.   MENU 3,0,0,"Window"
  294.     MENU 3,1,1,"Display"
  295.     MENU 3,2,1,"Control"
  296.   MENU 4,0,0,"Color"
  297.     MENU 4,1,2,"  Normal     "
  298.     MENU 4,2,1,"  Color Print"
  299.     MENU 4,3,1,"  B&W Print  "
  300.   RETURN
  301.  
  302. MenuUpdate:  'Update menus
  303.   MnuMode = Idle AND Mode  'Mode: 1 = Display, 0 = CtrlPanel; Idle: 1 = stopped, 0 = running
  304.   MnuReDraw = Idle AND (d(1,0) <> 0)  'can't redraw if no array
  305.   MnuColr1 = 1-(ColorMode = 1)
  306.   MnuColr2 = 1-(ColorMode = 2)
  307.   MnuColr3 = 1-(ColorMode = 3)
  308.   PALETTE 7,1-MnuMode,MnuMode,0  'Green for go, red for stop
  309.   MENU 1,0,Mode
  310.     MENU 1,1,Idle
  311.     MENU 1,2,MnuReDraw
  312.     MENU 1,3,Idle
  313.     MENU 1,4,1-Idle
  314.     MENU 1,5,Idle
  315.   MENU 2,0,1-Mode
  316.   MENU 3,0,Idle
  317.     MENU 3,1,1-Mode
  318.     MENU 3,2,Mode
  319.   MENU 4,0,MnuMode
  320.     MENU 4,1,MnuColr1
  321.     MENU 4,2,MnuColr2
  322.     MENU 4,3,MnuColr3
  323.   RETURN
  324.  
  325. '***  Initialize  ***
  326.  
  327. Init:
  328.   DEFINT a-n
  329.   WINDOW 1,"Control Panel",(0,1)-(617,186),23,-1
  330.   SCREEN 2,640,200,3,2
  331.   WINDOW 2,"FScapePlus",(0,1)-(631,186),0,2
  332.   Mode = 1 : GOSUB MenuSetup  'Idle = 0
  333.   ColorMode = 1 : GOSUB SetColors
  334.   ON MENU GOSUB MenuSel : MENU ON
  335.   COLOR 2,0 : LOCATE 8,27 : PRINT "=====  FScapePlus  ====="
  336.   LOCATE 10,27 : PRINT "===  By  Mike Steed  ==="
  337.   LOCATE 12,27 : PRINT "==== v1.0  Nov. '86 ===="
  338.   COLOR 5,0 : LOCATE 18,26 : PRINT "Be with you in a moment..."
  339.   ON ERROR GOTO ErrorHandler
  340.   ON BREAK GOSUB Quit : BREAK ON  'exit gracefully
  341.   RANDOMIZE TIMER : GOSUB GenSeed
  342.   DIM d(128,64)
  343.   Pi = 3.14159 : Pi2 = Pi/2 : EE4 = 10000
  344.   GOSUB DefSettings
  345.   WINDOW OUTPUT 1 : GOSUB CtrlInit : GOSUB DrawCtrlPanel  'Init control panel
  346.   WINDOW OUTPUT 2 : CLS
  347.   RETURN
  348.  
  349. '***  Subroutines  ***
  350.  
  351. SetColors:
  352.   ON ColorMode GOTO NormColor,ColorPrint,BWPrint
  353.  
  354. NormColor:
  355.   PALETTE 0,0,0,0 : PALETTE 1,1,1,1
  356.   PALETTE 4,9/15,9/15,3/15 : PALETTE 2,2/15,7/15,0/15
  357.   PALETTE 3,0,10/15,2/15 : PALETTE 5,0,0,12/15
  358.   PALETTE 6,0,0,7/15
  359.   RETURN
  360.  
  361. ColorPrint:
  362.   GOSUB NormColor
  363.   PALETTE 0,1,1,1 : PALETTE 1,11/15,11/15,11/15
  364.   RETURN
  365.  
  366. BWPrint:
  367.   PALETTE 0,1,1,1
  368.   FOR i = 1 TO 6
  369.     PALETTE i,0,0,0
  370.   NEXT
  371.   RETURN
  372.  
  373. GenSeed:  'generate a random seed number
  374.   Seed% = -32767*RND-1
  375.   FileName$ = ""  'new seed = new 'scape
  376.   RETURN
  377.  
  378. '***  Control Panel  ***
  379.  
  380. CtrlInit:  'init control arrays
  381.   DIM SHARED Ctrl.PotX(5) : DIM SHARED Ctrl.PotY(5)  'X,Y of title
  382.   DIM SHARED Ctrl.PotUL(5,1) : DIM SHARED Ctrl.PotLR(5,1)  'X,Y of slider
  383.   DIM SHARED Ctrl.PotTitle$(5)  'title
  384.   DIM SHARED Ctrl.PotValue(5)  '0-286
  385.   DIM SHARED Ctrl.SwX(2) : DIM SHARED Ctrl.SwY(2)  'X,Y of title
  386.   DIM SHARED Ctrl.SwUL(2,1) : DIM SHARED Ctrl.SwLR(2,1)  'X,Y of switch
  387.   DIM SHARED Ctrl.SwTitle$(2)  'title
  388.   DIM SHARED Ctrl.SwLab$(2)  'On-Off labels
  389.   DIM SHARED Ctrl.SwOnOff(2)  '-1=on, 0=off
  390.   DIM SHARED Ctrl.BtnX(1) : DIM SHARED Ctrl.BtnY(1)  'X,Y of 1st title line
  391.   DIM SHARED Ctrl.BtnUL(1,1) : DIM SHARED Ctrl.BtnLR(1,1)  'X,Y of button
  392.   DIM SHARED Ctrl.BtnTitle$(1,1)  'title lines
  393.   DIM SHARED Ctrl.BtnOnOff(1)  '-1=on, 0=off
  394.   DIM SHARED Ctrl.SelX(0) : DIM SHARED Ctrl.SelY(0)  'X,Y of title
  395.   DIM SHARED Ctrl.SelUL(0,1) : DIM SHARED Ctrl.SelLR(0,1)  'X,Y of sel. box
  396.   DIM SHARED Ctrl.SelTitle$(0)  'title
  397.   DIM SHARED Ctrl.SelPosns(0)  'no. of sel. positions
  398.   DIM SHARED Ctrl.SelSetting(0)  'current setting
  399.   DIM SHARED Ctrl.TBoxX(0) : DIM SHARED Ctrl.TBoxY(0)  'X,Y of title
  400.   DIM SHARED Ctrl.TBoxUL(0,1) : DIM SHARED Ctrl.TBoxLR(0,1)  'X,Y of text box
  401.   DIM SHARED Ctrl.TBoxTitle$(0)  'title
  402.   DIM SHARED Ctrl.TBoxWidth(0)  '# of chars allowed
  403.   DIM SHARED Ctrl.TBoxText$(0)  'contents of box
  404.   RETURN
  405.  
  406. DrawCtrlPanel:   'draw outlines
  407.   RESTORE CtrlData
  408.   FOR i = 0 TO 5
  409.     READ Ctrl.PotX(i) : READ Ctrl.PotY(i) : READ Ctrl.PotTitle$(i)
  410.     CALL DrawPot(i)
  411.   NEXT
  412.   FOR i = 0 TO 2
  413.     READ Ctrl.SwX(i) : READ Ctrl.SwY(i) : READ Ctrl.SwTitle$(i) : READ Ctrl.SwLab$(i)
  414.     CALL DrawSwitch(i)
  415.   NEXT
  416.   FOR i = 0 TO 1
  417.     READ Ctrl.BtnX(i) : READ Ctrl.BtnY(i) : READ Ctrl.BtnTitle$(i,0) : READ Ctrl.BtnTitle$(i,1)
  418.     CALL DrawButton(i)
  419.   NEXT
  420.   FOR i = 0 TO 0
  421.     READ Ctrl.SelX(0) : READ Ctrl.SelY(0) : READ Ctrl.SelTitle$(0) : READ Ctrl.SelPosns(0)
  422.     CALL DrawSelector(0)
  423.   NEXT
  424.   FOR i = 0 TO 0
  425.     READ Ctrl.TBoxX(i) : READ Ctrl.TBoxY(i) : READ Ctrl.TBoxTitle$(i) : READ Ctrl.TBoxWidth(i)
  426.     CALL DrawTextBox(i)
  427.   NEXT
  428.   LOCATE 23,32 : COLOR 3,0 : PRINT "F S c a p e P l u s";
  429.   GOSUB SetControls  'draw controls
  430.   RETURN
  431.  
  432. CtrlData:
  433.   DATA 5,2,"Flatlands      Terrain         Rugged"
  434.   DATA 5,6,"Left    Horizontal Position     Right"
  435.   DATA 5,9,"Down      Vertical Position        Up"
  436.   DATA 5,13,"Small       X Scale Factor      Large"
  437.   DATA 5,16,"Small       Y Scale Factor      Large"
  438.   DATA 5,19,"Small       Z Scale Factor      Large"
  439.   DATA 47,9," Auto Seeding","Yes         No"
  440.   DATA 62,13,"Auto Scrn Clr","Yes         No"
  441.   DATA 47,13,"  Sea Level","On         Off"
  442.   DATA 53,19,"Restore","Defaults"
  443.   DATA 62,9," Manual"," Reseed"
  444.   DATA 47,2,"1 (Fast)    Level   (Slow) 7",7
  445.   DATA 47,6,"Seed Number        (1-32768)",5
  446.  
  447. SetControls:  'transfer variables to controls
  448.   Ctrl.PotValue(0) = (rg-1000)/67 : CALL AdjPot(0)
  449.   Ctrl.PotValue(1) = (cx+300)/3 : CALL AdjPot(1)
  450.   Ctrl.PotValue(2) = 286-cy*2 : CALL AdjPot(2)
  451.   Ctrl.PotValue(3) = (xs-0.01)*3178 : CALL AdjPot(3)
  452.   Ctrl.PotValue(4) = (ys-0.01)*3178 : CALL AdjPot(4)
  453.   Ctrl.PotValue(5) = (zs-0.01)*3178 : CALL AdjPot(5)
  454.   Ctrl.SwOnOff(0) = AutoSeed : CALL AdjSwitch(0)
  455.   Ctrl.SwOnOff(1) = ClrScn : CALL AdjSwitch(1)
  456.   Ctrl.SwOnOff(2) = SeaLev% : CALL AdjSwitch(2)
  457.   Ctrl.BtnOnOff(0) = 0 : CALL AdjButton(0)
  458.   Ctrl.BtnOnOff(1) = 0 : CALL AdjButton(1)
  459.   Ctrl.SelSetting(0) = le : CALL AdjSelector(0)
  460. SetSeed:  'just set seed box
  461.   Ctrl.TBoxText$(0) = MID$(STR$(ABS(Seed%)),2) : CALL SetTextBox(0)  'no leading blank
  462.   RETURN
  463.  
  464. GetControls:  'read controls into variables
  465.   rg = 1000+67*Ctrl.PotValue(0)
  466.   cx = Ctrl.PotValue(1)*3-300
  467.   cy = 143-Ctrl.PotValue(2)/2
  468.   xs = Ctrl.PotValue(3)/3178+0.01
  469.   ys = Ctrl.PotValue(4)/3178+0.01
  470.   zs = Ctrl.PotValue(5)/3178+0.01
  471.   AutoSeed = Ctrl.SwOnOff(0)
  472.   ClrScn = Ctrl.SwOnOff(1)
  473.   SeaLev% = Ctrl.SwOnOff(2)
  474.   le = Ctrl.SelSetting(0)
  475. GetSeed:  'get just seed
  476.   Seed% = -VAL(Ctrl.TBoxText$(0))
  477.   RETURN
  478.  
  479. CtrlLoop:  'run Control Panel
  480.   WHILE MOUSE(0) = 0  'wait for click
  481.     IF MenuVec = 2 THEN GOSUB MenuFile : MenuVec = 0
  482.     IF MenuVec = 3 AND MenuSubVec = 1 THEN RETURN  'back to display
  483.     FOR i = 0 TO 1 : Ctrl.BtnOnOff(i) = 0 : CALL AdjButton(i) : NEXT  'all buttons off
  484.   WEND
  485.   mousex = MOUSE (1) : mousey = MOUSE(2)
  486.   IF mousex<350 THEN  'left half of screen
  487.     FOR i = 0 TO 5  'do pots
  488.       IF mousey>=Ctrl.PotUL(i,1) AND mousey<=Ctrl.PotLR(i,1) THEN
  489.         IF mousex>=Ctrl.PotUL(i,0)+5 AND mousex<=Ctrl.PotLR(i,0)-5 THEN
  490.           Ctrl.PotValue(i) = mousex-5-Ctrl.PotUL(i,0) : CALL AdjPot(i)
  491.           IF i = 0 THEN d(1,0) = 0
  492.         END IF
  493.       END IF
  494.     NEXT
  495.   ELSE  'right half of screen
  496.     FOR i = 0 TO 0  'do selectors
  497.       IF mousey>=Ctrl.SelUL(i,1) AND mousey<=Ctrl.SelLR(i,1) THEN
  498.         IF mousex>=Ctrl.SelUL(i,0) AND mousex<=Ctrl.SelLR(i,0) THEN
  499.           SelWidth% = (226-3*(Ctrl.SelPosns(i)+1))/Ctrl.SelPosns(0)
  500.           FOR j = 0 TO Ctrl.SelPosns(i)-1
  501.             LftEdge = Ctrl.SelUL(i,0)+1+j*(SelWidth%+3)
  502.             IF (mousex>=LftEdge%) AND (mousex<=LftEdge+SelWidth%+1) THEN Ctrl.SelSetting(SelNum%) = j+1 : CALL AdjSelector(i)
  503.             d(1,0) = 0  'no redraw
  504.           NEXT
  505.         END IF
  506.       END IF
  507.     NEXT
  508.     FOR i = 0 TO 2  'do switches
  509.       IF mousey>=Ctrl.SwUL(i,1) AND mousey<=Ctrl.SwLR(i,1) THEN
  510.         IF mousex>=Ctrl.SwUL(i,0) AND mousex<=Ctrl.SwLR(i,0) THEN
  511.           IF mousex<Ctrl.SwUL(i,0)+23 THEN Ctrl.SwOnOff(i) = -1 :ELSE Ctrl.SwOnOff(i) = 0
  512.           CALL AdjSwitch(i)
  513.         END IF
  514.       END IF
  515.     NEXT
  516.     FOR i = 0 TO 1  'do buttons
  517.       IF mousey>=Ctrl.BtnUL(i,1) AND mousey<=Ctrl.BtnLR(i,1) THEN
  518.         IF mousex>=Ctrl.BtnUL(i,0) AND mousex<=Ctrl.BtnLR(i,0) THEN
  519.           Ctrl.BtnOnOff(i) = -1 : CALL AdjButton(i)
  520.         ELSE
  521.           Ctrl.BtnOnOff(i) = 0
  522.         END IF
  523.       ELSE
  524.         Ctrl.BtnOnOff(i) = 0
  525.       END IF
  526.     NEXT
  527.     FOR i = 0 TO 0  'do text boxes
  528.       IF mousey>=Ctrl.TBoxUL(i,1) AND mousey<=Ctrl.TBoxLR(i,1) THEN
  529.         IF mousex>=Ctrl.TBoxUL(i,0) AND mousex<=Ctrl.TBoxLR(i,0) THEN
  530.           bx = Ctrl.TBoxX(i)+1 : by = Ctrl.TBoxY(i)+1
  531.           bw = Ctrl.TBoxWidth(i) : bt$ = Ctrl.TBoxText$(i)
  532.           CALL GetString(Ctrl.TBoxText$(i),bx,by,bw)
  533.           IF VAL(Ctrl.TBoxText$(i))>32768 THEN Ctrl.TBoxText$(i) = "32768"
  534.           IF VAL(Ctrl.TBoxText$(i))=0 THEN Ctrl.TBoxText$(i) = "1"
  535.           CALL SetTextBox(i) : GOSUB GetSeed
  536.           Ctrl.SwOnOff(0) = 0 : CALL AdjSwitch(0)  'auto seed off
  537.         END IF
  538.       END IF
  539.     NEXT
  540.     WHILE MOUSE(0) <> 0 : WEND  'wait for release (right half only)
  541.   END IF
  542.   IF Ctrl.BtnOnOff(0) = -1 THEN GOSUB DefSettings : GOSUB SetControls  'restore defaults
  543.   IF Ctrl.BtnOnOff(1) = -1 THEN GOSUB GenSeed : GOSUB SetSeed : Ctrl.SwOnOff(0) = 0 : CALL AdjSwitch(0)
  544.   GOTO CtrlLoop
  545.  
  546. '***  Subprograms  ***
  547.  
  548. SUB DrawPot(PotNum%) STATIC
  549.  
  550.   x% = (Ctrl.PotX(PotNum%)-1)*8 : y% = (Ctrl.PotY(PotNum%)-1)*8+9
  551.   Ctrl.PotUL(PotNum%,0) = x%+2 : Ctrl.PotUL(PotNum%,1) = y%+2
  552.   Ctrl.PotLR(PotNum%,0) = x%+298 : Ctrl.PotLR(PotNum%,1) = y%+8
  553.   LINE (x%-5,y%-11)-STEP(310,24),1,b
  554.   LINE (x%,y%)-STEP(300,10),2,bf
  555.   LOCATE Ctrl.PotY(PotNum%),Ctrl.PotX(PotNum%)
  556.   PRINT Ctrl.PotTitle$(PotNum%)
  557.  
  558. END SUB
  559. '------
  560. SUB AdjPot(PotNum%) STATIC
  561.  
  562.   x% = Ctrl.PotUL(PotNum%,0) : y% = Ctrl.PotUL(PotNum%,1)
  563.   LINE (x%,y%)-STEP(296,6),1,bf
  564.   LINE (x%+Ctrl.PotValue(PotNum%),y%)-STEP(10,6),3,bf
  565.  
  566. END SUB
  567. '------
  568. SUB DrawSwitch(SwNum%) STATIC
  569.  
  570.   x% = (Ctrl.SwX(SwNum%)+3)*8 : y% = (Ctrl.SwY(SwNum%)-1)*8+8
  571.   Ctrl.SwUL(SwNum%,0) = x%+2 : Ctrl.SwUL(SwNum%,1) = y%+2
  572.   Ctrl.SwLR(SwNum%,0) = x%+44 : Ctrl.SwLR(SwNum%,1) = y%+8
  573.   LINE (x%-36,y%-10)-STEP(118,22),1,b
  574.   LOCATE Ctrl.SwY(SwNum%),Ctrl.SwX(SwNum%) : PRINT Ctrl.SwTitle$(SwNum%)
  575.   LOCATE Ctrl.SwY(SwNum%)+1,Ctrl.SwX(SwNum%) : PRINT Ctrl.SwLab$(SwNum%)
  576.   LINE (x%,y%)-STEP(48,10),2,bf
  577.  
  578. END SUB
  579. '------
  580. SUB AdjSwitch(SwNum%) STATIC
  581.  
  582.   x% = Ctrl.SwUL(SwNum%,0) : y% = Ctrl.SwUL(SwNum%,1)
  583.   LINE (x%,y%)-STEP(44,6),1,bf
  584.   IF Ctrl.SwOnOff(SwNum%) = -1 THEN Offset% = 0 :ELSE Offset% = 22
  585.   LINE (x%+Offset%,y%)-STEP(22,6),3,bf
  586.  
  587. END SUB
  588. '------
  589. SUB DrawButton(BtnNum%) STATIC
  590.  
  591.   x% = (Ctrl.BtnX(BtnNum%)+7)*8+2 : y% = (Ctrl.BtnY(BtnNum%)-1)*8
  592.   Ctrl.BtnUL(BtnNum%,0) = x%+2 : Ctrl.BtnUL(BtnNum%,1) = y%+2
  593.   Ctrl.BtnLR(BtnNum%,0) = x%+42 : Ctrl.BtnLR(BtnNum%,1) = y%+15
  594.   LINE (x%-70,y%-2)-STEP(118,22),1,b
  595.   LOCATE Ctrl.BtnY(BtnNum%),Ctrl.BtnX(BtnNum%) : PRINT Ctrl.BtnTitle$(BtnNum%,0)
  596.   LOCATE Ctrl.BtnY(BtnNum%)+1,Ctrl.BtnX(BtnNum%) : PRINT Ctrl.BtnTitle$(BtnNum%,1)
  597.   LINE (x%,y%)-STEP(44,17),2,bf
  598.  
  599. END SUB
  600. '------
  601. SUB AdjButton(BtnNum%) STATIC
  602.  
  603.   x% = Ctrl.BtnUL(BtnNum%,0) : y% = Ctrl.BtnUL(BtnNum%,1)
  604.   IF Ctrl.BtnOnOff(BtnNum%) = -1 THEN Colr% = 3 :ELSE Colr% = 1
  605.   LINE (x%,y%)-STEP(40,13),Colr%,bf
  606.  
  607. END SUB
  608. '------
  609. SUB DrawSelector(SelNum%) STATIC
  610.  
  611.   x% = (Ctrl.SelX(SelNum%)-1)*8 : y% = (Ctrl.SelY(SelNum%)-1)*8+9
  612.   Ctrl.SelUL(SelNum%,0) = x%+2 : Ctrl.SelUL(SelNum%,1) = y%+2
  613.   Ctrl.SelLR(SelNum%,0) = x%+232 : Ctrl.SelLR(SelNum%,1) = y%+8
  614.   LINE (x%-4,y%-11)-STEP(238,24),1,b
  615.   LOCATE Ctrl.SelY(SelNum%),Ctrl.SelX(SelNum%) : PRINT Ctrl.SelTitle$(SelNum%)
  616.   LINE (x%,y%)-STEP(226,10),2,bf
  617.   SelWidth% = (226-3*(Ctrl.SelPosns(SelNum%)+1))/Ctrl.SelPosns(SelNum%)  'width of each button
  618.   FOR i% = 0 TO Ctrl.SelPosns(SelNum%)-1
  619.     LftEdge% = x%+3+i%*(SelWidth%+3)
  620.     LINE (LftEdge%,y%+2)-STEP(SelWidth%,6),1,bf
  621.   NEXT i%
  622.  
  623. END SUB
  624. '------
  625. SUB AdjSelector(SelNum%) STATIC
  626.  
  627.   x% = Ctrl.SelUL(SelNum%,0) : y% = Ctrl.SelUL(SelNum%,1)
  628.   SelWidth% = (226-3*(Ctrl.SelPosns(SelNum%)+1))/Ctrl.SelPosns(SelNum%)  'width of each button
  629.   FOR i% = 0 TO Ctrl.SelPosns(SelNum%)-1
  630.     LftEdge% = x%+1+i%*(SelWidth%+3)
  631.     IF i%+1 = Ctrl.SelSetting(SelNum%) THEN Colr% = 3 :ELSE Colr% = 1
  632.     LINE (LftEdge%,y%)-STEP(SelWidth%,6),Colr%,bf
  633.   NEXT
  634.  
  635. END SUB
  636. '------
  637. SUB DrawTextBox(TBoxNum%) STATIC
  638.  
  639.   x% = (Ctrl.TBoxX(TBoxNum%)-1)*8 : y% = (Ctrl.TBoxY(TBoxNum%)-1)*8+8
  640.   Ctrl.TBoxUL(TBoxNum%,0) = x% : Ctrl.TBoxUL(TBoxNum%,1) = y%
  641.   Ctrl.TBoxLR(TBoxNum%,0) = x%+226 : Ctrl.TBoxLR(TBoxNum%,1) = y%+9
  642.   LINE (x%-4,y%-11)-STEP(238,24),1,b
  643.   LOCATE Ctrl.TBoxY(TBoxNum%),Ctrl.TBoxX(TBoxNum%) : PRINT Ctrl.TBoxTitle$(TBoxNum%)
  644.   LINE (x%,y%)-STEP(226,9),2,bf
  645.  
  646. END SUB
  647. '------
  648. SUB SetTextBox(TBoxNum%) STATIC
  649.  
  650.   x% = Ctrl.TBoxUL(TBoxNum%,0) : y% = Ctrl.TBoxUL(TBoxNum%,1)
  651.   LINE (x%,y%)-STEP(226,9),2,bf
  652.   COLOR 1,2
  653.   LOCATE Ctrl.TBoxY(TBoxNum%)+1,Ctrl.TBoxX(TBoxNum%)+1 : PRINT Ctrl.TBoxText$(TBoxNum%)
  654.   COLOR 1,0
  655.  
  656. END SUB
  657.  
  658. '*** GetString *** M. Steed *** 21-Sep-86 ***
  659.  
  660. SUB GetString (Text$,TextX%,TextY%,Length%) STATIC
  661.  
  662. '***  Collect an input string  ***
  663.  
  664.   Cursor% = 1
  665.   InText$ = Text$  'Save a copy in case of cancel
  666.  
  667. GSPrintString:
  668.   Lngth% = LEN(Text$)
  669.   IF Lngth% > Length% THEN Text$ = LEFT$(Text$,Length%) : GOTO GSPrintString
  670.   IF Cursor% > Lngth%+1 THEN Cursor% = Lngth%+1
  671.   IF Cursor% < 1 THEN Cursor% = 1
  672.   CrsrChar$ = MID$(Text$,Cursor%,1)  'cursor
  673.   FirstPt$ = LEFT$(Text$,Cursor%-1)  'before cursor
  674.   LastPt$ = MID$(Text$,Cursor%+1,Length%)  'after cursor
  675.   LOCATE TextY%,TextX%
  676.   COLOR 1,2 : PRINT FirstPt$;
  677.   COLOR 2,3 : IF CrsrChar$ <> "" THEN PRINT CrsrChar$; :ELSE PRINT " "; : Lngth% = Lngth%+1  'compensate for blank cursor
  678.   COLOR 1,2 : PRINT LastPt$;
  679.   PRINT SPACE$(Length%-Lngth%+1)
  680.  
  681. GSGetChar:
  682.   Char$ = INKEY$
  683.   IF Char$ = "" THEN GSGetChar
  684.   IF Char$ = CHR$(13) THEN GSEnd  'Return
  685.   IF Char$ = CHR$(17) THEN Text$ = InText$ : Cursor% = 1 : GOTO GSPrintString  'CTL-Q restores initial
  686.   IF Char$ = CHR$(31) THEN Cursor% = Cursor%-1 : GOTO GSPrintString  '<-
  687.   IF Char$ = CHR$(30) THEN Cursor% = Cursor%+1 : GOTO GSPrintString  '->
  688.   IF Char$ = CHR$(24) THEN Text$ = "" : GOTO GSPrintString  'CTL-X Deletes all
  689.   IF Char$ = CHR$(127) THEN Text$ = FirstPt$ + LastPt$ : GOTO GSPrintString  'Delete deletes beneath
  690.   IF Char$ = CHR$(8) AND Cursor% > 1 THEN  'Backspace deletes to left
  691.     FirstPt$ = LEFT$(FirstPt$,LEN(FirstPt$)-1)
  692.     Text$ = FirstPt$ + CrsrChar$ + LastPt$
  693.     Cursor% = Cursor%-1 : GOTO GSPrintString
  694.   END IF
  695.   IF Char$ < "0" OR Char$ > "9" THEN GSGetChar
  696.   'add new char to string
  697.   Text$ = FirstPt$ + Char$ + CrsrChar$ + LastPt$
  698.   Cursor% = Cursor% +1 : GOTO GSPrintString
  699.  
  700. GSEnd:
  701.   LOCATE TextY%,TextX%
  702.   Lngth% = LEN(Text$)
  703.   COLOR 1,2 : PRINT Text$ + SPACE$(Length%-Lngth%+1)
  704.  
  705. END SUB
  706.  
  707. '*** String Requester *** M. Steed *** 14-Oct-86 ***
  708.  
  709. SUB StringReq (Message$,Text$,Yes$,No$,Xposn%,Yposn%,YesNo%) STATIC
  710.  
  711.   DIM SaveBox%(2450)  'Init storage array
  712.   Size%=2
  713.   Cursor% = 1
  714.   Length% = 15*Size%
  715.   InText$ = Text$  'Save a copy in case of cancel
  716.   IF No$="" THEN No$="Cancel"
  717.   Dummy% = MOUSE(0)  'clear initial 'hit'
  718.  
  719.   '*** Create the Strings ***
  720.   TextX% = Xposn%/8 : TextY% = Yposn%/8
  721.   x% = TextX%*8 : y% = TextY%*8  'force box to align to text
  722.   TextX% = TextX%+2 : TextY% = TextY%+2  'offset for text
  723.   Message$ = LEFT$(Message$,Size%*16)
  724.   Yes$ = LEFT$(Yes$,Size%*6)
  725.   Yes$ = SPACE$((Size%*6-LEN(Yes$))/2)+Yes$  'center Yes$
  726.   No$ = LEFT$(No$,Size%*6)
  727.   No$ = SPACE$((Size%*6-LEN(No$))/2)+No$  'center No$
  728.   GET (x%,y%)-STEP(266,47),SaveBox%  'save the background
  729.  
  730.   '*** Draw Requester ***
  731.   LINE (x%,y%)-STEP(266,47),1,bf  'main box
  732.   LINE (x%+1,y%+1)-STEP(264,45),2,b  'outline
  733.   LINE (x%+5,y%+16)-STEP(255,8),0,bf  'text box
  734.   LINE (x%+5,y%+29)-STEP(104,12),2,b  'yes box
  735.   LINE (x%+157,y%+29)-STEP(104,12),2,b  'no box
  736.   COLOR 0,1  'fill in the text
  737.   LOCATE TextY%,TextX% : PRINT Message$
  738.   LOCATE TextY%+3,TextX% : PRINT Yes$
  739.   LOCATE TextY%+3,TextX%+19 : PRINT No$
  740.  
  741.   '*** Collect the String ***
  742. TRPrintString:
  743.   Lngth% = LEN(Text$)
  744.   IF Lngth% > Length% THEN Text$ = LEFT$(Text$,Length%) : GOTO SRPrintString
  745.   IF Cursor% > Lngth%+1 THEN Cursor% = Lngth%+1
  746.   IF Cursor% < 1 THEN Cursor% = 1
  747.   CrsrChar$ = MID$(Text$,Cursor%,1)  'cursor
  748.   FirstPt$ = LEFT$(Text$,Cursor%-1)  'before cursor
  749.   LastPt$ = MID$(Text$,Cursor%+1,Length%)  'after cursor
  750.   LOCATE TextY%+1,TextX%
  751.   COLOR 1,0 : PRINT FirstPt$;
  752.   COLOR 0,3 : IF CrsrChar$ <> "" THEN PRINT CrsrChar$; :ELSE PRINT " "; : Lngth% = Lngth%+1  'compensate for blank cursor
  753.   COLOR 1,0 : PRINT LastPt$;
  754.   PRINT SPACE$(Length%-Lngth%+1)
  755.  
  756. TRGetChar:
  757.   IF MOUSE(0) <> 0 THEN TRClick  'check on mouse pos'n
  758.   Char$ = INKEY$
  759.   IF Char$ = "" THEN TRGetChar
  760.   IF Char$ = CHR$(13) THEN TRYesSel
  761.   IF Char$ = CHR$(17) THEN Text$ = InText$ : Lngth% = LEN(Text$) : GOTO TRPrintString   'CTL-Q cancels
  762.   IF Char$ = CHR$(31) THEN Cursor% = Cursor%-1 : GOTO TRPrintString  '<-
  763.   IF Char$ = CHR$(30) THEN Cursor% = Cursor%+1 : GOTO TRPrintString  '->
  764.   IF Char$ = CHR$(24) THEN Text$ = "" : GOTO TRPrintString  'CTL-X Deletes all
  765.   IF Char$ = CHR$(127) THEN Text$ = FirstPt$ + LastPt$ : GOTO TRPrintString   'Delete deletes beneath
  766.   IF Char$ = CHR$(8) AND Cursor% > 1 THEN   'Backspace deletes to left
  767.     FirstPt$ = LEFT$(FirstPt$,LEN(FirstPt$)-1)
  768.     Text$ = FirstPt$ + CrsrChar$ + LastPt$
  769.     Cursor% = Cursor%-1 : GOTO TRPrintString
  770.   END IF
  771.   IF Char$ < " " OR Char$ > "~" THEN TRGetChar
  772.   Text$ = FirstPt$ + Char$ + CrsrChar$ + LastPt$  'add new char to string
  773.   Cursor% = Cursor%+1 : GOTO TRPrintString
  774.  
  775. TRClick:
  776.   mousex%=MOUSE(1) : mousey%=MOUSE(2)  'get mouse position
  777.   IF mousey% < y%+29 OR mousey% > y%+41 THEN TRPrintString
  778.   IF mousex% > x%+5 AND mousex% < x%+109 THEN TRYesSel
  779.   IF mousex% > x%+157 AND mousex% < x%+261 THEN TRNoSel
  780.   GOTO TRPrintString
  781.  
  782. TRYesSel:  'Yes box selected
  783.   YesNo% = -1
  784.   LINE (x%+6,y%+30)-STEP(102,10),3,bf  'color box
  785.   COLOR 0,3 : LOCATE TextY%+3,TextX% : PRINT Yes$  'replace text
  786.   GOTO TREnd
  787.  
  788. TRNoSel:  'No box selected
  789.   YesNo% = 0
  790.   LINE (x%+158,y%+30)-STEP(102,10),3,bf  'color box
  791.   COLOR 0,3 : LOCATE TextY%+3,TextX%+19 : PRINT No$  'replace text
  792.  
  793. TREnd:
  794.   LOCATE TextY%+1,TextX%
  795.   Lngth% = LEN(Text$)
  796.   COLOR 1,0 : PRINT Text$ + SPACE$(Length%-Lngth%+1)
  797.   FOR i% = 0 TO 500 : NEXT i%  'brief delay
  798.   PUT (x%,y%),SaveBox%,PSET  'restore the background
  799.   ERASE SaveBox%
  800.  
  801. END SUB
  802.  
  803. '*** Yes/No Requester *** M. Steed *** 14-Oct-86 ***
  804.  
  805. SUB YesNoReq (Message$,Yes$,No$,Xposn%,Yposn%,YesNo%) STATIC
  806.  
  807.   DIM SaveBox%(2450)  'Init storage array
  808.   Size% = 2
  809.   Ybox% = 0
  810.   Dummy% = MOUSE(0)  'clear initial 'hit'
  811.  
  812.   '*** Create the Strings ***
  813.   TextX% = Xposn%/8 : TextY% = Yposn%/8
  814.   x% = TextX%*8 : y% = TextY%*8  'force box to align to text
  815.   TextX% = TextX%+2 : TextY% = TextY%+2  'offset for text
  816.   Delim% = INSTR(Message$,"|")  'create the print strings
  817.   IF Delim% THEN
  818.     FirstLn$ = LEFT$(Message$,Delim%-1) : SecndLn$ = MID$(Message$,Delim%+1)
  819.   ELSE
  820.     FirstLn$ = Message$ : SecndLn$=""
  821.   END IF
  822.   FirstLn$ = LEFT$(FirstLn$,Size%*16)
  823.   IF Delim% THEN SecndLn$ = LEFT$(SecndLn$,Size%*16)
  824.   IF Yes$<>"" THEN
  825.     Ybox% = -1
  826.     Yes$ = LEFT$(Yes$,Size%*6)
  827.     Yes$ = SPACE$((Size%*6-LEN(Yes$))/2)+Yes$  'center Yes$
  828.   END IF
  829.   No$ = LEFT$(No$,Size%*6)
  830.   No$ = SPACE$((Size%*6-LEN(No$))/2)+No$  'center No$
  831.   GET (x%,y%)-STEP(266,47),SaveBox%  'save the background
  832.  
  833.   '*** Draw Requester ***
  834.   LINE (x%,y%)-STEP(266,47),1,bf  'main box
  835.   LINE (x%+1,y%+1)-STEP(264,45),2,b  'outline
  836.   IF Ybox% THEN LINE (x%+5,y%+29)-STEP(104,12),2,b  'yes box (if present)
  837.   LINE (x%+157,y%+29)-STEP(104,12),2,b   'no box
  838.   COLOR 0,1   'fill in the text
  839.   LOCATE TextY%,TextX% : PRINT FirstLn$
  840.   LOCATE TextY%+1,TextX% : PRINT SecndLn$
  841.   IF Ybox% THEN LOCATE TextY%+3,TextX% : PRINT Yes$
  842.   LOCATE TextY%+3,TextX%+19 : PRINT No$
  843.   COLOR 0,3   'set colors for mouse select
  844.  
  845. YNMonMouse:
  846.   WHILE MOUSE(0)=0  'wait 'till the button is clicked
  847.   WEND
  848.   mousex%=MOUSE(1) : mousey%=MOUSE(2)  'get mouse position
  849.   IF mousey% < y%+29 OR mousey% > y%+41 THEN YNMonMouse
  850.   IF (mousex% > x%+5 AND mousex% < x%+109) AND Ybox% THEN YNYesSel
  851.   IF mousex% > x%+157 AND mousex% < x%+261 THEN YNNoSel
  852.   GOTO YNMonMouse
  853.  
  854. YNYesSel:   'Yes box selected
  855.   YesNo% = -1
  856.   LINE (x%+6,y%+30)-STEP(102,10),3,bf  'color box
  857.   LOCATE TextY%+3,TextX% : PRINT Yes$  'replace text
  858.   GOTO YNDelay
  859.  
  860. YNNoSel:  'No box selected
  861.   YesNo% = 0
  862.   LINE (x%+158,y%+30)-STEP(102,10),3,bf  'color box
  863.   LOCATE TextY%+3,TextX%+19 : PRINT No$  'replace text
  864.  
  865. YNDelay:  'delay before returning
  866.   FOR i% = 0 TO 500 : NEXT i%
  867.   PUT (x%,y%),SaveBox%,PSET  'restore the background
  868.   ERASE SaveBox%
  869.   COLOR 1,0
  870.  
  871. END SUB
  872.  
  873.