AMOS PD CD/amospdcd.iso/401-425/apd425/sources/ampp.asc

Text File | 1991-09-09 | 52KB | 1,892 lines

'
'     The (Am)os (P)ainting (P)ackage,   AmPP    by Mark Burbidge.
'                    Version 0.9
'
'    This is my second Amos program, my first was AMOS-BROT,
'  which came packaged with the ConvFormat Utility also.
'
'  This pre-release was finished in under a week, on the 23rd August 1991
'  It has all features enabled except text and magnify.
'
'  Actually, I never got around to releasing it as I got a job in
'  September, went to University in October (Birmingham, Physics) and
'  have only just come back. As a 'new user' to my own program (it's
'  a long time) I've ironed out some little foibles, and will release
'  this version, all release notes the same inc. Version number.
'
'  AmPP, as with my previous release AMOS-BROT and CONVFORMAT is freely
'  distributable, as long as all Docs and Rem statements remain intact.
'  It can be updated as long as the original is included in your release.
'  The `disk' in `diskware' means that if you use it then send me a disk
'  with some Public Domain on it. I'll send your disk back A.S.A.P. with
'  some other PD. NO OBLIGATION. NO PIRATES. Archive the disk where possible.
'  Please specify archiving program.
'
'  My Address is 107 Heron Rd. Larkfield, Kent, ME 20 6JL.
'
'               signed
'
'                      Mark Burbidge.
'
'
'
'  UPDATERS ONLY - Always work on a backup of this source.
'
'  The Panel icons and About screen are in permenant banks, ie they are
'  saved with the program. If you change the panel/about, LEAVE MY CREDIT, then
'  change ABOT and PANEL to false initially,  take away the comma from the
'  reserve below, and also remove the comma for the CLEARMEM
'  Run the program, change it all back, as below, and then save it off.
'  The Banks will be saved too. Panel.abk must be taken from a picture by
'  the GET ICON command, to work without program modification.
'
'  If you do need to do the above, if you change the ToolBox, then don't
'  forget to run ALL sections whose memory banks are to be saved with the
'  program, the the first version you should call the ABOUT procedure.
'  If you fail to do this, when you change the parameters back as described
'  and usually a few sessions later, you will get an error when the procedure
'  is run. In the case of ABOUT the error occurs on the line Unpack 10 to 2
'
Set Buffer 15
Auto View Off
Default
Palette 0,0
Auto View On
'CLEARMEM
'Reserve As Data 10,7060
Reserve As Work 9,15000 : Rem **** This mustn't be REM
Rem ****** Global Variables *******
Flash Off
Global WIDTH,HEIGHT,CLR,CURCOL,PALFOR,PALBAK,INITFOR,INITBAK,REQON,MSTORE
Global CLGO,OPEN,CLPAL,TTOOLS,PANEL,CURROP,FIN,PAL,NOW,FXIT,WONCE,BUT,ABOT
Global VDIV,HDIV,BON,DPT,IT,INBOB,ST_AMAL,AMLON,FX,CLRSB
WIDTH=320 : HEIGHT=256 : CLR=16 : MSTORE=2 : NOW=False : OPEN=False
CURCOL=2 : ABOT=True : PANEL=True : FIN=False : CURROP=1 : CLPAL=True
CLGO=False : BON=True : DPT=5 : IT=20 : INBOB=False : AMLON=False
ST_AMAL=False : OLOP=1 : FX=False : CLRSB=Colour(0)
INITFOR=0 : INITBAK=2 : Rem ** Done this way so DEFPAL returns to original**
PALFOR=INITFOR : PALBAK=INITBAK : REQON=True : TTOOLS=True : WONCE=True
'
'
Rem ***** Program Start *****
REQON=False
SCRMODE
Limit Mouse
REQON=True
DEFMENU
TTOOLBOX
Change Mouse MSTORE
Rem ****** I realise much of this should be in a procedure, so what? ***
Repeat
   If NOW
      If Not CLPAL
         Reserve Zone 17
      End If
   End If
   OK=False
   If CLPAL
      If CLGO
         OK=True
         CLGO=False
         If TTOOLS
            NOW=True
         End If
         Reserve Zone 17+CLR
      End If
   End If
   If NOW : Rem ****** Set up Panel icons ******
      Menu Off
      NOW=False
      TP=229
      If WIDTH>320
         SCL=2
      Else
         SCL=1
      End If
      If Not PAL
         TP=TP-64
      End If
      For T=1 To 6
         Set Zone T,SCL*(223+(T-1)*16),TP To SCL*(222+T*16),TP+15
         Set Zone T+6,SCL*(223+(T-1)*16),TP+16 To SCL*(222+T*16),TP+31
      Next T
      Set Zone 13,1,TP+2 To SCL*10,TP+10
      Set Zone 14,125*SCL,TP To 180*SCL,HEIGHT
      Set Zone 15,1,TP+20 To SCL*10,HEIGHT-2
      Set Zone 16,179,TP+20 To SCL*187,HEIGHT-2
      Set Zone 17,188,TP+20 To SCL*196,HEIGHT-2
      Menu On
   End If
   If OK
      Menu Off
      For I=0 To CLR-1
         XP=1+(I mod VDIV)*(80/VDIV)
         YP=1+(I/VDIV)*(80/HDIV)
         Ink I
         XP2=XP+(80/VDIV)-2
         YP2=YP+(80/HDIV)-2
         Set Zone I+18,XP,YP To XP2,YP2
      Next I
      Menu On
   End If
   Rem ********* end of the `procedure' stuff *****
   Rem ********* Now for the stuff which should be here *****
   Rem ********* The above isn't executed every loop ******
   Rem ********* only when the panel or colour box is turned on ******
   BUT=Mouse Key
   BUTTON=False
   If BUT=1
      BUTTON=True
   Else
      If BUT>2
         BUTTON=True : Rem Done like this to allow for 3rd button
      End If : Rem If available. Instead of right and left.(line & filled)
   End If
   If BUTTON : Rem  **** If Mouse used used then go to Panel testing**
      Z=Mouse Zone : Rem *** and drawing control procedure ***
      TESTALL[Z]
   End If
   FXIT=Choice : Rem Here's that fix again, to make more than one menu work
   If FXIT
      ACTION
   End If
   Screen 0
   If INBOB
      If AMLON or Not(OLOP=CURROP)
         If Not(CURROP=11)
            Bob Update Off : Bob Clear : AMLON=False : ST_AMAL=True
         Else
            If CURROP=11
               If ST_AMAL
                  If FX
                     Bob Draw : Bob Update On
                  Else
                     Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),1
                     Channel 1 To Bob 1
                     G$="AU (I R0<>XS(0,XM) J U I R1<>YS(0,YM) J U X U:"
                     G$=G$+"L R0=XS(0,XM);"
                     G$=G$+"L R1=YS(0,YM); D M) M: M R0-X,R1-Y,1 W;"
                     Amal 1,G$ : Amal On : FX=True
                  End If
                  AMLON=True
                  ST_AMAL=False
               End If
            End If
         End If
      End If
   End If
   OLOP=CURROP
Until FIN
If PANEL
   Reserve Zone
End If
If INBOB
   Erase 1
End If
Erase 9
'
'
'
'
'
'
'
Edit
Rem **** Procedures ****
Procedure CLPALETTE
   '
   ' This procedure draws that colourbox, you know that one that you can
   ' In the top left. It also wipes it again, depending on CLPAL. OPEN is
   ' Global. Initilaised to false at the start. Not accessed elsewhere.
   '
   Screen 0
   If AMLON
      Bob Update Off
      Bob Clear
   End If
   If CLPAL
      ' Draw the colourbox
      If Not OPEN
         OPEN=True
         Get Cblock 1,0,0,96,81
         Curs Off
         Flash Off
      End If
      ' Flag to indicate DO COLOURBOX ZONES
      CLGO=True
      Ink PALBAK
      Box 0,0 To 80,80
      Box 80,0 To 88,80
      Ink CURCOL
      Bar 81,1 To 87,79
      Ink PALBAK
      ' I know the next bit is used more than once and should be in a proc
      ' if it bothers you, you do it, I don't care!
      If CLR=2
         HLINE=2
         VLINE=3
      Else
         If CLR<16
            HLINE=3
            If CLR=4
               VLINE=3
            Else
               VLINE=5
            End If
         Else
            HLINE=5
            If CLR=16
               VLINE=5
            Else
               If CLR=32
                  VLINE=9
               Else
                  VLINE=17
               End If
            End If
         End If
      End If
      HDIV=HLINE-1
      VDIV=VLINE-1
      For I=0 To HDIV
         Draw 0,I*(80/HDIV) To 80,I*(80/HDIV)
      Next I
      For I=0 To VDIV
         Draw I*(80/VDIV),0 To I*(80/VDIV),80
      Next I
      For I=0 To CLR-1
         XP=1+(I mod VDIV)*(80/VDIV)
         YP=1+(I/VDIV)*(80/HDIV)
         Ink I
         XP2=XP+(80/VDIV)-2
         YP2=YP+(80/HDIV)-2
         Bar XP,YP To XP2,YP2
      Next I
   Else
      ' Wipe the colourbox
      CLGO=False
      If OPEN
         Put Cblock 1
         Del Cblock 1
         OPEN=False
      End If
   End If
   If AMLON
      Bob Draw
      Bob Update On
   End If
End Proc
Procedure CLPAN
   '
   ' Get rid of the Tollbox. Once is a safeguard, to stop the Screenclose
   ' being called twice. Did it several times in developement. Shouldn't
   ' happen now though, but I've left it to save upgraders some grief.
   ' Upgraders say thank you!!  Oh by the way. If you Upgrade this program you
   ' MUST DISTRIBUTE the original source unaltered, ie this program, and the
   ' accompanying Docs with your release.
   '
   If PANEL and Not TTOOLS
      If Not WONCE : Rem *** safeguard against calling twice, causing error ***
         WONCE=True : Rem ** Pronounced Once ***
         Screen 0
         Reserve Zone
         NOW=False
         Screen Close 2
      End If
   End If
End Proc
Procedure TTOOLBOX
   '
   ' Display or get rid of that toolbox
   ' The Exist bit is used when the bank hasn't been saved with the prog.
   ' PANEL must be initialised to false if this is the case. See the first
   ' lot of REM statements
   '
   If PANEL or Exist("sources:graphics/panel.abk")
      If TTOOLS
         NOW=True
         WONCE=False
         Screen Open 2,320,30,16,Lowres
         Screen 2
         HERE=270
         If Not PAL
            HERE=HERE-56
         End If
         Screen Display 2,,HERE,,
         Curs Off
         Flash Off
         If Not PANEL
            Load "sources:graphics/panel.abk",2
            PANEL=True
         End If
         Get Icon Palette
         Paste Icon 0,0,1
         Colour 0,CLRSB
         CLPALETTE
         TESTALL[CURROP]
      Else
         CLPALETTE
         NOW=False
         CLPAN
      End If
   Else
      TTOOLS=False
      REQ["File Missing","Graphics","Panel.abk"]
   End If
   DEFMENU
End Proc
Procedure SHICON
   '
   ' This proc displays the selected icon over the top of the Toolbox
   ' Called only from Testall
   '
   Paste Icon 203,15,2
   Screen 0
End Proc
Procedure TESTALL[GAD]
   '
   ' This tests the gadgets and calls procedures for the Toolbox.
   ' It's the Toolbox equivalent of ACTION
   '
   Menu Off
   Clear Key
   If Not CLPAL
      If GAD>17
         GAD=0
      End If
   End If
   GADGET=GAD>0
   GADGET=GAD<13 and GADGET
   If GADGET
      If TTOOLS
         GADG=True
         CURROP=GAD
         If BON
            Bell
         End If
         Screen 2
         Ink 3
         Get Icon 2,2,223+((GAD-1) mod 6)*16,((GAD-1)/6)*16 To 223+(((GAD-1) mod 6)+1)*16,14+((GAD-1)/6)*16
         SHICON
      End If
   Else
      If GAD=13
         TTOOLS= Not TTOOLS
         If TTOOLS
            Menu$(1,8)="Toolbox off   <help>"
         Else
            Menu$(1,8)="Toolbox on    <help>"
         End If
         TTOOLBOX
      Else
         If GAD=14
            ABOUT
         Else
            If GAD=15
               CLPAL= Not CLPAL
               CLPALETTE
               If CLPAL
                  Menu$(1,9)="Colourbox Off   C   "
               Else
                  Menu$(1,9)="Colourbox On    C   "
               End If
            Else
               If GAD=16
                  CLPAL=False
                  TTOOLS=False
                  TTOOLBOX
                  SCRMODE
                  CLPAL=True
                  TTOOLS=True
                  TTOOLBOX
               Else
                  If GAD=17
                     PAL
                     OPEN=False
                     TTOOLBOX
                  Else
                     If GAD=0
                        Screen 0
                        If(CURROP=1) or(CURROP=7)
                           SKETCH[CURROP]
                        End If
                        If CURROP=2
                           BBOX
                        End If
                        If CURROP=3
                           EELLIPSE
                        End If
                        If CURROP=4
                           SPRAY
                        End If
                        If CURROP=5
                           CUT
                        End If
                        If CURROP=8
                           CCIRCLE
                        End If
                        If CURROP=9
                           FFILL
                        End If
                        If CURROP=10
                           LINE
                        End If
                        If CURROP=11
                           PPASTE
                        End If
                        If CURROP=5
                           CURROP=11
                           TTOOLBOX
                        End If
                     Else
                        If CLPAL
                           CURCOL=GAD-18
                           If OPEN
                              Ink CURCOL
                              Screen 0
                              Bar 81,1 To 87,79
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         End If
      End If
   End If
   Repeat : Rem **** Program moves faster than fingers.
   Until Mouse Key=0 : Rem *** Allow fingers to catch up.
   CLPALETTE
   Menu On
End Proc
Procedure DEFMENU
   '
   ' Defines the menu
   '
   Screen 0
   Menu$(1)="General  "
   Menu$(1,1)="Clear Screen  <esc> "
   Menu Key(1,1) To 69
   Menu$(1,2)="--------------------"
   Menu Inactive(1,2)
   Menu$(1,3)="Load Picture    L   "
   Menu Key(1,3) To 40
   Menu$(1,4)="Save Picture    S   "
   Menu Key(1,4) To 33
   Menu$(1,5)="--------------------"
   Menu Inactive(1,5)
   Menu$(1,6)="Screen Mode     M   "
   Menu Key(1,6) To 55
   Menu$(1,7)="Palette         P   "
   Menu Key(1,7) To 25
   If TTOOLS
      Menu$(1,8)="Toolbox off   <help>"
   Else
      Menu$(1,8)="Toolbox on    <help>"
   End If
   Menu Key(1,8) To 95
   If CLPAL
      Menu$(1,9)="Colourbox Off   C   "
   Else
      Menu$(1,9)="Colourbox On    C   "
   End If
   Menu Key(1,9) To 51
   Menu$(1,10)="About           A   "
   Menu Key(1,10) To 32
   If BON
      Menu$(1,11)="Bell off        B   "
   Else
      Menu$(1,11)="Bell on         B   "
   End If
   Menu Key(1,11) To 53
   Menu$(1,12)="-------------------"
   Menu Inactive(1,12)
   Menu$(1,13)="Quit            Q   "
   Menu Key(1,13) To 16
   Menu$(2)="Panel  "
   Menu$(2,1)="  Sketch  "
   Menu$(2,2)="  Draw    "
   Menu$(2,3)="  Box     "
   Menu$(2,4)="  Circle  "
   Menu$(2,5)="  Ellipse "
   Menu$(2,6)="  Fill    "
   Menu$(2,7)="  Spray   "
   Menu$(2,8)="  Line    "
   Menu$(2,9)="  Cut     "
   Menu$(2,10)="  Paste   "
   Menu$(2,11)="  Zoom    "
   Menu$(2,12)="  Text    "
   Menu$(2,13)="----------------"
   Menu Inactive(2,13)
   Menu$(2,14)="  Arrow   "
   Menu$(2,15)="  Cross   "
   Menu$(2,16)="----------------"
   Menu Inactive(2,16)
   Menu$(2,17)="Spray Size  "+Str$(IT)
   Menu$(2,18)="   Density  "+Str$(DPT)
   Menu On
   On Menu Proc ACTION
   On Menu On
End Proc
Procedure CLEARMEM
   '
   ' Clears all memory banks.
   ' IMPORTANT - Only call when you wish to use a new Toolbox panel
   ' as described in the initial REM statements. I should have included
   ' The original Panel file under the name Panel.bak if you need to renew
   ' it.
   '
   For I=1 To 15
      If Length(I)>0
         Erase I
      End If
   Next I
End Proc
Procedure CHNGVARY[MX]
   Menu Off
   C1=Colour(1)
   C2=Colour(2)
   Colour 1,$0
   Colour 2,$FFF
   Get Block 1,0,0,WIDTH,16
   Set Slider 1,2,1,1,1,2,1,2
   OLD=-10
   Repeat
      If Not(OLD=VARY)
         Wait Vbl
         Hslider 0,0 To WIDTH-100.0,15,50,VARY,1
      End If
      OLD=VARY
      VARY=50*(((X Screen(X Mouse))/(WIDTH-100.0)))
      If VARY<1
         VARY=1
      End If
      If VARY>MX
         VARY=MX
      End If
      Locate X Text(WIDTH-90.0),1
      Print VARY; : Print "  "
   Until Mouse Key>0
   Set Pattern 0
   Put Block 1
   Del Block 1
   Colour 1,C1
   Colour 2,C2
   Menu On
End Proc[VARY]
Procedure SKETCH[TYPE]
   '
   ' Sketches
   '
   TMPL=CLPAL
   If TMPL
      CLPAL=False
      CLPALETTE
   End If
   Ink CURCOL
   X1=X Screen(X Mouse)
   Y1=Y Screen(Y Mouse)
   Repeat
      Wait Vbl
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      If TYPE=1
         Plot X2,Y2
      Else
         Draw X1,Y1 To X2,Y2
         X1=X2
         Y1=Y2
      End If
   Until Mouse Key=0
   If TMPL
      CLPAL=True
      CLPALETTE
   End If
End Proc
Procedure BBOX
   '
   ' Does boxes. If you just use the left button they are hollow
   ' but if while drawing your hollow box you press the right button
   ' and then release the left followed by the right you get a solid box.
   ' You SHOULD also get a solid box if you use the third mouse button
   ' I haven't been able to test this, I don't have three buttons
   '
   TMPL=CLPAL
   If TMPL
      CLPAL=False
      CLPALETTE
   End If
   Gr Writing 2
   XB1=X Screen(X Mouse)
   YB1=Y Screen(Y Mouse)
   XB2=X Screen(X Mouse)
   YB2=Y Screen(Y Mouse)
   C=Colour(2)
   Colour 2,$FFF
   Ink 2
   Box XB1,YB1 To XB2,YB2
   Repeat
      OLDX2=XB2
      OLDY2=YB2
      XB2=X Screen(X Mouse)
      YB2=Y Screen(Y Mouse)
      Box XB1,YB1 To OLDX2,OLDY2
      Box XB1,YB1 To XB2,YB2
      B=Mouse Key
      If Not(B=0)
         BUT=B
      End If
   Until B=0
   Box XB1,YB1 To XB2,YB2
   Gr Writing 1
   Colour 2,C
   Ink CURCOL
   If XB1>XB2
      Swap XB1,XB2
   End If
   If YB1>YB2
      Swap YB1,YB2
   End If
   If BUT=1
      Box XB1,YB1 To XB2,YB2
   Else
      Bar XB1,YB1 To XB2,YB2
   End If
   If TMPL
      CLPAL=True
      CLPALETTE
   End If
End Proc
Procedure CCIRCLE
   '
   ' Draws Circles
   '
   TMPL=CLPAL
   If TMPL
      CLPAL=False
      CLPALETTE
   End If
   Gr Writing 2
   XB1=X Screen(X Mouse)
   YB1=Y Screen(Y Mouse)
   XB2=X Screen(X Mouse)
   YB2=Y Screen(Y Mouse)
   C=Colour(2)
   Colour 2,$FFF
   Ink 2
   DIF2=(YB2-YB1)*(YB2-YB1)+(XB2-XB1)*(XB2-XB1)
   DIF=Sqr(DIF2)
   If DIF=0
      DIF=1
   End If
   Repeat
      OLDDIF=DIF
      XB2=X Screen(X Mouse)
      YB2=Y Screen(Y Mouse)
      DIF=(YB2-YB1)*(YB2-YB1)+(XB2-XB1)*(XB2-XB1)
      DIF=Sqr(DIF)
      If DIF=0
         DIF=1
      End If
      If OLDDIF=DIF
         Circle XB1,YB1,OLDDIF
         Circle XB1,YB1,DIF
      End If
      B=Mouse Key
      If Not(B=0)
         BUT=B
      End If
   Until B=0
   Gr Writing 1
   Colour 2,C
   Ink CURCOL
   If DIF=0
      Plot XB1,XB2
   Else
      Circle XB1,YB1,DIF
   End If
   If TMPL
      CLPAL=True
      CLPALETTE
   End If
End Proc
Procedure EELLIPSE
   '
   ' Draws Ellipses
   '
   TMPL=CLPAL
   If TMPL
      CLPAL=False
      CLPALETTE
   End If
   BUT=Mouse Click : Rem ***** Clear Bits *****
   Gr Writing 2
   XB1=X Screen(X Mouse)
   YB1=Y Screen(Y Mouse)
   XB2=X Screen(X Mouse)
   YB2=Y Screen(Y Mouse)
   R1=Sqr((XB2-XB1)*(XB2-XB1))
   R2=Sqr((YB2-YB1)*(YB2-YB1))
   C=Colour(2)
   Colour 2,$FFF
   Ink 2
   If R1=0
      R1=1
   End If
   If R2=0
      R2=1
   End If
   Ellipse XB1,YB1,R1,R2
   Repeat
      OLDR1=R1
      OLDR2=R2
      XB2=X Screen(X Mouse)
      YB2=Y Screen(Y Mouse)
      R1=Sqr((XB2-XB1)*(XB2-XB1))
      R2=Sqr((YB2-YB1)*(YB2-YB1))
      If R1=0
         R1=1
      End If
      If R2=0
         R2=1
      End If
      If(R1=OLDR1) and(R2=OLDR2)
      Else
         Ellipse XB1,YB1,OLDR1,OLDR2
         Ellipse XB1,YB1,R1,R2
      End If
      B=Mouse Key
      If Not(B=0)
         BUT=B
      End If
   Until B=0
   Gr Writing 1
   Colour 2,C
   Ink CURCOL
   Ellipse XB1,YB1,R1,R2
   If TMPL
      CLPAL=True
      CLPALETTE
   End If
End Proc
Procedure FFILL
   '
   ' Fills areas
   '
   TMPL=CLPAL
   If TMPL
      CLPAL=False
      CLPALETTE
   End If
   A=X Mouse : B=Y Mouse
   A=X Screen(A) : B=Y Screen(B)
   Ink CURCOL
   Paint A,B,1
   If TMPL
      CLPAL=True
      CLPALETTE
   End If
End Proc
Procedure SPRAY
   '
   ' Spraycan. IT and DPT are globals controlling the density and size of the
   ' spray. I may add a facility to alter these. If you use the right
   ' button (or the third if available - untested) then you get a star
   ' star spray. If I work out how to read the colour of a single pixel
   ' onscreen then I'll change the star spray into a mix.
   '
   TMPL=CLPAL
   If TMPL
      CLPAL=False
      CLPALETTE
   End If
   Repeat
      Wait Vbl : X1=X Mouse : Y1=Y Mouse
      X1=X Screen(X1) : Y1=Y Screen(Y1) : BU=Mouse Key
      If BU>0
         For I=1 To DPT
            Ink CURCOL
            A=Rnd(IT) : B=Rnd(360) : B#=B*Pi# : B#=B#/180
            If BU=1
               Plot X1+A*Cos(B#),Y1+A*Sin(B#)
            Else
               CL1=Point(X1-A*Cos(B#),Y1-A*Sin(B#)) : CL2=Point(X1+A*Cos(B#),Y1+A*Sin(B#))
               If(CL1*CL2)>0.0
                  Plot X1+A*Cos(B#),Y1+A*Sin(B#),CL1
                  Plot X1-A*Cos(B#),Y1-A*Sin(B#),CL2
               End If
               'Draw X1,Y1 To X1+A*Cos(B#),Y1+A*Sin(B#)
            End If
         Next I
      End If
   Until BU=0
   If TMPL
      CLPAL=True
      CLPALETTE
   End If
End Proc
Procedure LINE
   '
   ' Draws Straight lines
   ' If you tap the right button whilst preparing your line, (or use your
   ' third button from the off- again untested) you get a fan effect.
   ' This is active when the left button is pressed, inactive when it isn't
   ' Because FAN is an extended operation and it is very easy to draw on
   ' the colourbox using this operation only to find the screen unaffected
   ' The colourbox can be switched on and off in FAN mode using the C key.
   ' Colours can be changed by clicking on the appropriate colour in the
   ' Colourbox with THE RIGHT MOUSEBUTTON. This is a major anomaly with
   ' the rest of AmPP, but isn't too much hassle.
   '
   TEMP=CLPAL
   Gr Writing 2
   XB1=X Screen(X Mouse)
   YB1=Y Screen(Y Mouse)
   XB2=X Screen(X Mouse)
   YB2=Y Screen(Y Mouse)
   C=Colour(2)
   Colour 2,$FFF
   Ink 2
   Draw XB1,YB1 To XB2,YB2
   Repeat
      OLDX2=XB2
      OLDY2=YB2
      XB2=X Screen(X Mouse)
      YB2=Y Screen(Y Mouse)
      Draw XB1,YB1 To OLDX2,OLDY2
      Draw XB1,YB1 To XB2,YB2
      B=Mouse Key
      If B>1
         Draw XB1,YB1 To XB2,YB2
         Repeat
         Until Mouse Key<2
         TEST=False
         Repeat
            OLDX2=XB2
            OLDY2=YB2
            XB2=X Mouse : YB2=Y Mouse
            XB2=X Screen(XB2) : YB2=Y Screen(YB2)
            B=Mouse Key
            If B=1
               If PALON
                  CLPAL=False
                  CLPALETTE
                  PALON=CLPAL
               End If
            Else
               If Not PALON
                  CLPAL=TEMP
                  If CLPAL
                     CLPALETTE
                     PALON=CLPAL
                  End If
               End If
            End If
            If Upper$(Inkey$)="C"
               CLPAL= Not CLPAL
               TEMP=CLPAL
               CLPALETTE
            End If
            If B>1
               Z=Mouse Zone
               FINI=(Z=0)
               If Not FINI
                  If Z>17
                     If OPEN
                        CURCOL=Z-18
                        Screen 0
                        Ink CURCOL
                        Bar 81,1 To 87,79
                     End If
                  End If
               End If
            End If
            If B=0
               Gr Writing 2
               If TEST
                  Draw XB1,YB1 To OLDX2,OLDY2
               End If
               Draw XB1,YB1 To XB2,YB2
               TEST=True
               Gr Writing 1
            Else
               If TEST
                  Gr Writing 2
                  Draw XB1,YB1 To OLDX2,OLDY2
               End If
               TEST=False
               Gr Writing 1
               Ink CURCOL
               If Z<18
                  Draw XB1,YB1 To XB2,YB2
               Else
                  Z=0
               End If
            End If
         Until FINI
         B=0
      End If
   Until B=0
   Gr Writing 1
   Colour 2,C
   Ink CURCOL
   Draw XB1,YB1 To XB2,YB2
   CLPAL=TEMP
   CLPALETTE
End Proc
Procedure CUT
   '
   ' Cuts out BOBS for use with PPaste
   '
   If INBOB
      Bob Update Off
      Bob Clear
   End If
   Gr Writing 2
   XB1=X Screen(X Mouse)
   YB1=Y Screen(Y Mouse)
   XB2=X Screen(X Mouse)
   YB2=Y Screen(Y Mouse)
   C=Colour(2)
   Colour 2,$FFF
   Ink 2
   Box XB1,YB1 To XB2,YB2
   Repeat
      OLDX2=XB2
      OLDY2=YB2
      XB2=X Screen(X Mouse)
      YB2=Y Screen(Y Mouse)
      Box XB1,YB1 To OLDX2,OLDY2
      Box XB1,YB1 To XB2,YB2
      B=Mouse Key
      If Not(B=0)
         BUT=B
      End If
   Until B=0
   Box XB1,YB1 To XB2,YB2
   Plot XB1,YB1 : Rem **** Stops a dot in top left of cut
   Gr Writing 1
   Colour 2,C
   Ink CURCOL
   If XB1>XB2
      Swap XB1,XB2
   End If
   If YB1>YB2
      Swap YB1,YB2
   End If
   Get Bob 1,XB1,YB1 To XB2+1,YB2+1
   INBOB=True
   ST_AMAL=True
   AMLON=False
   Hot Spot 1,17
End Proc
Procedure PPASTE
   '
   ' Pastes the bobs.
   ' I did have a really good AMAL program to make the BOB follow the mouse
   ' when in PASTE mode. but due to the screen saving I got wierd effects
   ' Pasting the BOBS. The solution is to turn off the AMAL program, and
   ' then paste the BOB and turn it back on. Who knows? By the time
   ' you read this I might have done it. If I do, I'll leave this message.
   ' what am I saying? If I delete this message you'll be none the wiser!
   '
   ' I decided to leave the message!!! (as a word to the wise)
   TMPL=CLPAL
   If TMPL
      CLPAL=False
      CLPALETTE
   End If
   If INBOB
      Repeat
         Put Bob 1
      Until Mouse Key=0
   Else
      Bell 10
   End If
   AMLON=True
   If TMPL
      CLPAL=True
      CLPALETTE
   End If
End Proc
Procedure ZOOOM
   Bell 10
   ' Not implemeted in pre-release. In time I want to do a fully
   ' featured zoom function. But, hey, it's only taken me a week to get
   ' This far. It's only two and a half weeks since I started programming
   ' AMOS in earnest. The Zoom might take a little longer to appear as
   ' my freetime is about to vanish!.
   '
   ' I got AMOS at the last Computer shopper show in the winter, for about
   ' 25 Pounds. Sure I'd tinkered with it, entered a few listings but never
   ' got that far, as my A-Levels were looming ever nearer etc. But now
   ' they're over, I'm going to Uni in October, and I couldn't get a
   ' temporary job for the summer ( who says the recessions over? ).
   ' So I sat down a couple of weeks ago, and it's easier than I thought,
   ' not sitting down stupid, AMOS. Okay, I can't do without the manual,
   ' buts that's because each command has more parameters than Gorbachev has
   ' supporters. (topical, eh? He got his Job back TODAY, 22rd Aug 1991)
   ' But I've got a job coming up soon, and that's why I've left this
   ' open-ended with a pre-release. Sorry.
   '
End Proc
Procedure TTEXT
   '
   ' See Zooom
   '
   ' It's not that this procedure would be too time consuming It's just that
   ' I can't think of a nice way to do it. Y'see, I can't add another menu
   ' for Fonts as this would take me of the edge of a lowres screen, and
   ' text can't be entered directly on the screen as I have no UNDO.
   ' I need a window or something to edit the text FIRST.
   ' Basically, I can't be bothered, but the main prob is choosing the fonts.
   ' Anyway, what are you complaining about, No Text? Stop wibbling, you've
   ' got a Painting Oackage you didn't have yesterday, and how much did
   ' it cost you? Next to nothing, I'll bet. Oh yeah, and a postage stamp.
   ' Postage stamp? Yup, to send that PD disk to me, (see diskware), I
   ' didn't count the disk price in the cost as you get it back, with some
   ' other stuff on it!!!  Oh, you only get it back if I get your address
   ' as well. Mine is 107 Heron Rd. Larkfield, Kent, England. See top of file
   '
End Proc
Procedure ACTION
   '
   ' Process menus
   ' FXIT is used in a Bug fix of AMOS 1.2, I must tell Mandarin about that
   ' and the suspected bug when Input is used with a real variable.
   ' Amos_Brot V1.0 uses input, and it crashes periodically, the program
   ' does not seem to move on from the input call. (all that follows it is
   ' another input!)
   '
   BUT=0
   If Choice or FXIT
      FXIT=False
      TEMP=TTOOLS
      TTOOLS=False
      TTOOLBOX
      TTOOLS=TEMP
      If Choice(1)=1
         If Choice(2)=1
            REQ["Clear Screen?","Yes","No"]
            If Left$(Param$,1)="Y"
               Screen 0
               TEMP=CLPAL
               CLPAL=False
               CLPALETTE
               CLPAL=TEMP
               If AMLON
                  Bob Update Off
                  Bob Clear
               End If
               Cls 0
               If AMLON
                  Bob Draw
                  Bob Update On
               End If
               CLPALETTE
            End If
         End If
         If Choice(2)=3
            LPIC
         End If
         If Choice(2)=4
            SPIC
         End If
         If Choice(2)=6
            SCRMODE
         End If
         If Choice(2)=7
            PAL
         End If
         If Choice(2)=8
            TTOOLS= Not TTOOLS
         End If
         If Choice(2)=9
            CLPAL= Not CLPAL
         End If
         If Choice(2)=10
            ABOUT
         End If
         If Choice(2)=11
            BON= Not BON
         End If
         If Choice(2)=13
            REQ["Positive?","Yes","No"]
            If Left$(Param$,1)="Y"
               FIN=True
            End If
         End If
      Else
         If Choice(1)=2
            If Choice(2)=1
               CURROP=1
            End If
            If Choice(2)=2
               CURROP=7
            End If
            If Choice(2)=3
               CURROP=2
            End If
            If Choice(2)=4
               CURROP=8
            End If
            If Choice(2)=5
               CURROP=3
            End If
            If Choice(2)=6
               CURROP=9
            End If
            If Choice(2)=7
               CURROP=4
            End If
            If Choice(2)=8
               CURROP=10
            End If
            If Choice(2)=9
               CURROP=5
            End If
            If Choice(2)=10
               CURROP=11
            End If
            If Choice(2)=11
               CURROP=6
            End If
            If Choice(2)=12
               CURROP=12
            End If
            If Choice(2)=14
               MSTORE=1
            End If
            If Choice(2)=15
               MSTORE=2
            End If
            If Choice(2)=17
               CHNGVARY[50]
               IT=Param
            End If
            If Choice(2)=18
               CHNGVARY[50]
               DPT=Param
            End If
            Change Mouse MSTORE
         End If
      End If
      Screen 0
      TTOOLBOX
   End If
   DEFMENU
   Clear Key
   On Menu On
End Proc
Procedure ABOUT
   '
   ' Show my details to all those who haven't got AMOS to read these REMS
   ' Updaters may add there own credit screens if my credit screen comes
   ' up first and unaltered. If you update the prog send your RAMOS disk
   ' to me, you'll get it back, with info on your version number ( we don't
   ' want different programs knocking around with identical version numbers!)
   ' I'll use a letter system, a big renovation might go from 1.0 to 1.1
   ' or 1.0f say, a smaller revision might get less of a leap due to being
   ' slotted between other updates.
   '
   ' Anyone sending a disk under Diskware will receive the latest/best
   ' revision (or both) if available.
   '
   Boom
   Hide
   TEMP=TTOOLS
   TTOOLS=False
   TTOOLBOX
   TTOOLS=TEMP
   Menu Off
   Clear Key
   If ABOT or Exist("Sources:Graphics/About.ABK")
      If Not ABOT
         Load "Sources:Graphics/About.abk",10
         ABOT=True
      End If
      Unpack 10 To 5
      'Screen Open 1,160,187,16,Lowres
      'screen Display 1,220,60,,'
      Repeat
         FINI=(Mouse Key=1)
         K$=Inkey$
         If Not(K$="")
            FINI=True
         End If
      Until FINI
      Screen Close 5
   Else
   End If
   Show
   Clear Key
   Menu On
   TTOOLBOX
End Proc
Procedure LPIC
   '
   ' Loads a picture
   '
   T=REQON
   AML=AMLON
   AMLON=False
   If AML
      Amal Freeze
      Bob Clear
      Amal Off
   End If
   TMP=CLPAL : CLPAL=False : CLPALETTE
   TEMP=TTOOLS : TTOOLS=False : TTOOLBOX : TTOOLS=TEMP : CLPAL=TMP
   F$=Fsel$("**.**","","(AM)os (P)ainting (P)ackage "," Load a Picture")
   If Not F$=""
      If Upper$(Right$(F$,3))="PCK"
         Load F$,9
         Unpack 9 To 0
      Else
         Load Iff F$,0
      End If
      If Screen Colour<65
         If Screen Width mod 320=0
            If(Screen Height=200) or(Screen Height=256)
               HEIGHT=Screen Height
               PAL=(HEIGHT=256)
               WIDTH=Screen Width
               CLR=Screen Colour
            Else
               REQ["Screen size is iffy","Oh","Bugger!"]
               REQON=False
               SCRMODE
            End If
         Else
            Cls 0
            REQ["Screen size is iffy","Oh","Bugger!"]
            REQON=False
            SCRMODE
         End If
      Else
         REQ["HAM not supported","Oh","No!"]
         REQON=False
         SCRMODE
         Cls 0
      End If
   End If
   REQON=T
   TTOOLBOX
   If AML
      Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),1
      Channel 1 To Bob 1
      G$="AU (I R0<>XS(0,XM) J U I R1<>YS(0,YM) J U X U:"
      G$=G$+"L R0=XS(0,XM);"
      G$=G$+"L R1=YS(0,YM); D M) M: M R0-X,R1-Y,1 W;"
      Amal 1,G$
      Amal On
   End If
   AMLON=AML
End Proc
Procedure SPIC
   '
   ' Saves a picture
   '
   If AMLON
      Amal Freeze
      Bob Clear
      Amal Off
   End If
   TMP=CLPAL : CLPAL=False : CLPALETTE
   TEMP=TTOOLS : TTOOLS=False : TTOOLBOX : TTOOLS=TEMP : CLPAL=TMP
   F$=Fsel$("**.**","","(AM)os (P)ainting (P)ackage "," Load a Picture")
   If Not F$=""
      STAN=(Upper$(Right$(F$,3))="IFF")
      PCK=(Upper$(Right$(F$,3))="PCK")
      If Not(STAN or PCK)
         REQ["File Format?","Iff","Pck"]
         If Upper$(Left$(Param$,1))="I"
            F$=F$+".IFF"
            STAN=True
         Else
            F$=F$+".PCK"
            PCK=True
         End If
      End If
      If PCK
         REQ["Hold on a mo","Okay","Matey"]
         Hide
         Spack 0 To 9
         Save F$,9
         Show
      Else
         REQ["Iff Compression?","Yup","No thanks."]
         If Upper$(Left$(Param$,1))="Y"
            COMP=1
         Else
            COMP=0
         End If
         Save Iff F$,COMP
      End If
   End If
   If AMLON
      Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),1
      Channel 1 To Bob 1
      G$="AU (I R0<>XS(0,XM) J U I R1<>YS(0,YM) J U X U:"
      G$=G$+"L R0=XS(0,XM);"
      G$=G$+"L R1=YS(0,YM); D M) M: M R0-X,R1-Y,1 W;"
      Amal 1,G$
      Amal On
   End If
   TTOOLBOX
End Proc
Procedure SCRMODE
   '
   ' Changes the screen MOde. C'mon Mandarin, where's interlace?
   '
   Clear Key
   Menu Off
   REQ["Change Screen?","Yes","No"]
   If Left$(Param$,1)="Y"
      Change Mouse 1
      Limit Mouse
      If HEIGHT=256
         PAL=True
      End If
      ZNNUM=11
      INBOB=False
      WDT=320
      HTH=150
      WDT=WDT
      HTH=HTH
      FINISHED=False
      Screen Open 1,WDT+16,HTH+8,2,Lowres
      Flash Off
      Curs Off
      Palette $0,$DDD
      Cls 1
      Paper 1
      Pen 0
      Reserve Zone ZNNUM
      If PAL
         RES$="256"
      Else
         RES$="200"
      End If
      PAL$=Border$(Zone$("Pal.",1),1)
      NTSC$=Border$(Zone$("Ntsc.",2),1)
      LOW$=Border$(Zone$("320x"+RES$,3),1)
      HI$=Border$(Zone$("640x"+RES$,4),1)
      TWO$=Border$(Zone$(" 2 ",5),1)
      FUR$=Border$(Zone$(" 4 ",6),1)
      AYT$=Border$(Zone$(" 8 ",7),1)
      SXT$=Border$(Zone$("16 ",8),1)
      TRT$=Border$(Zone$("32 ",9),1)
      SXF$=Border$(Zone$("EHB",10),1)
      FIN$=Border$(Zone$("Okay.",11),1)
      L=11 : G=6 : T=3 : S=3
      Locate L,T : Print PAL$
      Locate L+6,T : Print NTSC$
      Locate L,T+2*S : Print LOW$
      Locate L,T+3*S : Print HI$
      Locate L+14,T : Print TWO$
      Locate L+14+G,T : Print SXT$
      Locate L+14,T+S : Print FUR$
      Locate L+14+G,T+S : Print TRT$
      Locate L+14,T+2*S : Print AYT$
      Locate L+14+G,T+2*S : Print SXF$
      Locate L+15,T+3*S : Print FIN$
      Locate L,T+4*S
      Print Str$(WIDTH)+"x"+RES$+"  "+Str$(CLR)+" colours. ";
      Repeat
         K$=Inkey$
         If Mouse Key=1
            Locate L,T+4*S
            Print Str$(WIDTH)+"x"+RES$+"  "+Str$(CLR)+" colours. "
            Z=Mouse Zone
            If Z>0
               If Z<ZNNUM+1
                  If Z<3
                     If Z=1
                        PAL=True
                     Else
                        PAL=False
                     End If
                     If PAL
                        RES$="256"
                     Else
                        RES$="200"
                     End If
                     LOW$=Border$(Zone$("320x"+RES$,3),1)
                     HI$=Border$(Zone$("640x"+RES$,4),1)
                     Locate L+X,T+2*S : Print LOW$
                     Locate L+X,T+3*S : Print HI$
                  End If
                  If Z=3
                     WIDTH=320
                  End If
                  If Z=4
                     WIDTH=640
                     If CLR>16
                        CLR=16
                     End If
                  End If
                  If(Z>4) and(Z<11)
                     I=Z-4
                     CLR=1
                     For P=1 To I
                        CLR=2*CLR
                     Next P
                     If CLR>16
                        WIDTH=320
                     End If
                  End If
                  If Z=11
                     FINISHED=True
                  End If
               End If
            End If
         End If
         If Not K$=""
            FINISHED=True
         End If
      Until FINISHED
      Reserve Zone
      Screen Close 1
      If PAL
         HEIGHT=256
      Else
         HEIGHT=200
      End If
      If WIDTH=320
         Screen Open 0,WIDTH,HEIGHT,CLR,Lowres
      Else
         Screen Open 0,WIDTH,HEIGHT,CLR,Hires
      End If
      Curs Off
      Flash Off
      Cls 0
      DEFPAL
   End If
   Menu On
   Change Mouse MSTORE
   Screen To Back 0
   Limit Mouse 128,42 To 127+WIDTH,41+HEIGHT
End Proc
Procedure REQ[MS$,V1$,V2$]
   Clear Key
   Rem *************************************
   Rem **      REQUEST BOX CONTROLLER     **
   Rem *************************************
   Rem **   PLEASE MAKE V1$ YOUR DEFAULT  **
   Rem **   This will be returned if the  **
   Rem **      boxes are turned off,      **
   Rem **   MS$ is the box message, the   **
   Rem **         two are gadgets         **
   Rem *************************************
   If REQON
      If AMLON
         Amal Freeze
         Bob Clear
         Amal Off
      End If
      REQBOX[MS$,V1$,V2$]
      If AMLON
         Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),1
         Channel 1 To Bob 1
         G$="AU (I R0<>XS(0,XM) J U I R1<>YS(0,YM) J U X U:"
         G$=G$+"L R0=XS(0,XM);"
         G$=G$+"L R1=YS(0,YM); D M) M: M R0-X,R1-Y,1 W;"
         Amal 1,G$
         Amal On
      End If
      V$=Param$
   Else
      V$=V1$
   End If
   Clear Key
End Proc[V$]
Procedure REQBOX[MES$,G1$,G2$]
   '
   ' Actual request Box
   '
   Rem ********************
   Rem ** Use my Colours **
   Rem ********************
   C1=Colour(1)
   C2=Colour(2)
   Colour 1,$A40
   Colour 2,$FFF
   If CLR>2
      Pen 2
      Paper 1
   Else
      Pen 1
      Paper 0
   End If
   Rem *********************************
   Rem ***    Do that Request Box    ***
   Rem *********************************
   Change Mouse 1
   A$=Left$(G1$,1) : Rem **** Work out first letters ****
   B$=Left$(G2$,1) : Rem **** in gadgets ***
   If Asc(A$)>96 Then A$=Chr$(Asc(A$)-32) : Rem ***Convert case ***
   If Asc(B$)>96 Then B$=Chr$(Asc(B$)-32) : Rem *** myself ***
   I=Len(MES$)+6 : Rem *** Work out title length ***
   If I<(Len(G1$+G2$)+9) Then I=(Len(G1$+G2$)+9) : Rem ** see if it's **
   Rem ******* Longer than the gadget lengths ******
   J=I*8 : Rem Hash together a block save
   K=J/16
   If Not(J=K*16)
      J=J+8
   End If
   J=J+16 : Rem to be sure of size
   Rem *********************************************************
   Rem ** I used the blocks as they are quicker than windsave **
   Rem ** I know on page 101 it says to create a Dummy window **
   Rem ** But how? and if you could open the dummy window,    **
   Rem ** without affecting the screen why didn't it do that  **
   Rem **                     anyway?                         **
   Rem *********************************************************
   Get Block 1,0,0,J,80
   Wind Open 1,0,0,I,8,1 : Rem ***Save background open box ***
   Curs Off
   Flash Off
   Reserve Zone 2 : Rem ****reserve two Zones*****
   Window 1
   Title Top MES$ : Rem ****Put in the box title***
   Locate 2,3
   Print Border$(Zone$(G1$,1),1) : Rem **** Add the gadgets ***
   T=I-Len(G2$)-4 : Rem *** Find posn of right gadget ***
   Locate T,3
   Print Border$(Zone$(G2$,2),1)
   Repeat : Rem ***Wait for a response or a keypress ****
      I=Mouse Key : Rem *** Keypress only works if first letters ***
      OK=((I=1) or(I=3)) : Rem *** are different ***
      A=Mouse Zone
      INZ=((1=A) or(2=A))
      If Not(A$=B$)
         X$=Inkey$
         If Asc(X$)>96
            X$=Chr$(Asc(X$)-32)
         End If
         LETT=((X$=A$) or(X$=B$))
         If LETT
            If X$=A$
               A=1
            Else
               A=2
            End If
         End If
      End If
   Until LETT or(OK and INZ)
   Wind Close
   Rem *************************
   Rem ** Put Background Back **
   Rem *************************
   Put Block 1
   Del Block 1
   Reset Zone 1
   Reset Zone 2
   If A=1
      A$=G1$
   Else
      A$=G2$
   End If
   Colour 1,C1
   Colour 2,C2
   Change Mouse MSTORE
   Rem ***** Return the selected variable *****
End Proc[A$]
Procedure PAL
   '
   ' Do Palette, procedure has been changed by neccesity since AMOS_BROT
   ' But you wouldn't know it would you?
   '
   Rem **************************************************
   Rem ** I worked out how to do this all on my own   ***
   Rem ** I'm quite proud of it, even if it is clumsy ***
   Rem **************************************************
   Rem ** This version is uodated to that found in    ***
   Rem ** Amos Brot in that it now operates up to 64  ***
   Rem ** Colours ***************************************
   Rem **************************************************
   TEMP=CLPAL
   CLPAL=False
   CLPALETTE
   CLPAL=True
   Clear Key
   Volume 10
   Change Mouse 1
   Menu Off
   STX=0
   STY=0
   WDT=304
   HTH=104
   Get Cblock 1,0,0,WDT+16,HTH+8
   Curs Off
   Reserve Zone CLR+8
   Repeat
      K$=Inkey$
      FINISHED=False
      CHNGPAL=False
      Flash Off
      Curs Off
      Ink PALFOR
      Set Pattern 0
      Box STX,STY To STX+WDT,STY+HTH
      Ink PALBAK
      Bar STX+1,STY+1 To STX+WDT-1,STY+HTH-1
      Ink PALFOR
      GP=8
      DIFX=WDT/2-GP*2
      DIFY=HTH/2-GP/2
      DIFX=DIFX-(DIFX mod 8) : Rem ** to ensure even boxes **
      DIFY=DIFY-(DIFY mod 4)
      XSTART=WDT/2+GP+STX
      YSTART=STY+GP/2
      Box XSTART,YSTART To XSTART+DIFX,YSTART+DIFY
      If CLR=2
         HLINE=2
         VLINE=3
      Else
         If CLR<16
            HLINE=3
            If CLR=4
               VLINE=3
            Else
               VLINE=5
            End If
         Else
            HLINE=5
            If CLR=16
               VLINE=5
            Else
               If CLR=32
                  VLINE=9
               Else
                  VLINE=17
               End If
            End If
         End If
      End If
      HDIV=HLINE-1
      VDIV=VLINE-1
      For I=0 To HDIV
         Draw XSTART,YSTART+I*(DIFY/HDIV) To XSTART+DIFX,YSTART+I*(DIFY/HDIV)
      Next I
      For I=0 To VDIV
         Draw XSTART+I*(DIFX/VDIV),YSTART To XSTART+I*(DIFX/VDIV),YSTART+DIFY
      Next I
      For I=0 To CLR-1
         XP=XSTART+1+(I mod VDIV)*(DIFX/VDIV)
         YP=YSTART+1+(I/VDIV)*(DIFY/HDIV)
         Ink I
         XP2=XP+(DIFX/VDIV)-2
         YP2=YP+(DIFY/HDIV)-2
         Bar XP,YP To XP2,YP2
         Set Zone I+1,XP,YP To XP2,YP2
      Next I
      X1=STX+WDT-DIFX/3-GP
      Y1=YSTART+DIFY+2
      X2=XSTART+DIFX
      Y2=STY+HTH-3
      Ink PALFOR
      Box X1,Y1 To X2,Y2
      Ink CURCOL
      Bar(X1+1),(Y1+1) To(X2-1),(Y2-1)
      Pen PALFOR
      Locate X Text(XSTART),Y Text(YSTART+GP+DIFY)
      Paper PALBAK
      Print Border$(Zone$("Swap",CLR+1),1);Cright$;Cright$;Border$(Zone$("Use",CLR+2),1)
      Locate X Text(STX+2*GP),Y Text(YSTART+4*GP+DIFY)
      FO$=Border$(Zone$("Foreground",CLR+3),1)
      BA$=Border$(Zone$("Background",CLR+4),1)
      RE$=Border$(Zone$("Reset",CLR+5),1)
      Print FO$;Cright$;Cright$;BA$;Cright$;Cright$;RE$
      C=Colour(CURCOL)
      BLUE=C mod 16
      GREEN=(C/16) mod 16
      RED=(C/256) mod 16
      T1=STY+GP
      GAP=30
      STGP=20
      Set Zone CLR+6,STX+STGP,T1 To STX+STGP+GAP,YSTART+2*GP+DIFY
      Set Zone CLR+7,STX+STGP+GAP+GP,T1 To STX+STGP+GP+2*GAP,YSTART+2*GP+DIFY
      Set Zone CLR+8,STX+STGP+2*GAP+2*GP,T1 To STX+STGP+2*GP+3*GAP,YSTART+2*GP+DIFY
      VSLIDE[STX+STGP,T1,STX+STGP+GAP,YSTART+2*GP+DIFY,RED]
      VSLIDE[STX+STGP+GAP+GP,T1,STX+STGP+GP+2*GAP,YSTART+2*GP+DIFY,GREEN]
      VSLIDE[STX+STGP+2*GAP+2*GP,T1,STX+STGP+2*GP+3*GAP,YSTART+2*GP+DIFY,BLUE]
      Repeat
         FINISHED=False
         CHNGPAL=False
         Z=Mouse Zone
         K=Mouse Key
         If K=1
            If(Z<CLR+1) and(Z>0)
               Set Pattern 0
               CURCOL=Z-1
               C=Colour(CURCOL)
               Ink CURCOL
               Bar(X1+1),(Y1+1) To(X2-1),(Y2-1)
               BLUE=C mod 16
               GREEN=(C/16) mod 16
               RED=(C/256) mod 16
               VSLIDE[STX+STGP,T1,STX+STGP+GAP,YSTART+2*GP+DIFY,RED]
               VSLIDE[STX+STGP+GAP+GP,T1,STX+STGP+GP+2*GAP,YSTART+2*GP+DIFY,GREEN]
               VSLIDE[STX+STGP+2*GAP+2*GP,T1,STX+STGP+2*GP+3*GAP,YSTART+2*GP+DIFY,BLUE]
            End If
            If Z>CLR
               If Z=CLR+1
                  Repeat
                     U=0
                     If Not(A=X Mouse)
                        If Not(B=Y Mouse)
                           Bell 20
                        End If
                     End If
                     U=Mouse Zone : K=Mouse Key
                     A=X Mouse : B=Y Mouse
                  Until((U>0) and(U<CLR+1)) and(K=1)
                  U=U-1
                  If U>31
                     U=U-32 : Rem To avoid errors working in EHB mode
                  End If
                  If CURCOL>31
                     CURCOL=CURCOL-32
                  End If
                  TEMP=Colour(CURCOL)
                  Colour CURCOL,Colour(U)
                  Colour U,TEMP
               End If
               If Z=CLR+2
                  FINISHED=True
               End If
               If Z=CLR+3 or Z=CLR+4
                  Repeat
                     If Not(A=X Mouse)
                        If Not(B=Y Mouse)
                           Bell 20
                        End If
                     End If
                     U=Mouse Zone : K=Mouse Key
                     A=X Mouse : B=Y Mouse
                  Until((U>0) and(U<CLR+1)) and(K=1)
                  If Z=CLR+3
                     PALFOR=U-1
                  Else
                     PALBAK=U-1
                  End If
                  FINISHED=True
                  CHNGPAL=True
               End If
               If Z=CLR+5
                  DEFPAL
                  FINISHED=True
                  CHNGPAL=True
               End If
               If(Z>CLR+5) and(Z<CLR+9)
                  Repeat
                     POS=(16*(YSTART+2*GP+DIFY-Y Screen(Y Mouse)))/(YSTART+2*GP+DIFY-T1)
                     If POS<1
                        POS=1
                     End If
                     If POS>16
                        POS=16
                     End If
                     If Z=CLR+6
                        RED=POS
                        VSLIDE[STX+STGP,T1,STX+STGP+GAP,YSTART+2*GP+DIFY,RED]
                        RED=RED-1
                     Else
                        If Z=CLR+7
                           GREEN=POS
                           VSLIDE[STX+STGP+GAP+GP,T1,STX+STGP+GP+2*GAP,YSTART+2*GP+DIFY,GREEN]
                           GREEN=GREEN-1
                        Else
                           If Z=CLR+8
                              BLUE=POS
                              VSLIDE[STX+STGP+2*GAP+2*GP,T1,STX+STGP+2*GP+3*GAP,YSTART+2*GP+DIFY,BLUE]
                              BLUE=BLUE-1
                           End If
                        End If
                     End If
                     Set Pattern 0
                     If CURCOL>31
                        CURCOL=CURCOL-32
                     End If
                     Colour CURCOL,(RED*256)+(GREEN*16)+BLUE
                  Until Not(Mouse Key mod 2)=1
               End If
            End If
         End If
      Until FINISHED
      Put Cblock 1
   Until Not CHNGPAL
   Del Cblock 1
   Reserve Zone
   Change Mouse MSTORE
   Volume 63
   Set Pattern 0
   CLRSB=Colour(0)
   If TTOOLS
      Screen 2
      Colour 0,CLRSB
      Screen 0
   End If
   Menu On
End Proc
Procedure DEFPAL
   '
   ' My Default Palette
   '
   Colour 0,0
   Colour 1,$A40
   If CLR>2
      Colour 2,$FFF
      Colour 3,0
      If CLR>4
         Colour 4,$F00
         Colour 5,$F0
         Colour 6,$F
         Colour 7,$666
         If CLR>8
            Colour 8,$555
            Colour 9,$333
            Colour 10,$733
            Colour 11,$373
            Colour 12,$773
            Colour 13,$337
            Colour 14,$737
            Colour 15,$377
            If CLR>16
               Colour 16,$0
               Colour 17,$EC8
               Colour 18,$C60
               Colour 19,$EA0
               Colour 20,$27F
               Colour 21,$49D
               Colour 22,$5AE
               Colour 23,$ADF
               Colour 24,$BDF
               Colour 25,$CEF
               Colour 26,$FFF
               Colour 27,$408
               Colour 28,$A0E
               Colour 29,$E0E
               Colour 30,$E08
               Colour 31,$EEE
            End If
         End If
      End If
   End If
   PALFOR=INITFOR
   PALBAK=INITBAK
End Proc
Procedure VSLIDE[A,B,C,D,P]
   '
   ' My Slider Bars for procedure PAL,
   ' It's here to cut down on the number of parameters I had to remember
   ' whilst writing PAL. (Believe it or not, this procedure, I found was one
   ' of the trickier ones! It was originally written, with PAL, REQ and REQBOX
   ' for AMOS_BROT V1.0 )
   '
   Set Slider PALFOR,PALBAK,PALFOR,,PALBAK,PALBAK,PALFOR,
   Vslider A,B To C,D,16,16-P,1
End Proc