AMOS PD CD/amospdcd.iso/401-425/apd425/sources/ampp2.amos/ampp2.amosSourceCode

AMOS Source Code | 1991-09-09 | 52KB | 2,390 lines

' This is the sequel To AmPP
Auto View Off
Dim CLRS(32)
Global CLRS(),SPR
SPR=True

MAIN_LOOP

Procedure MAIN_LOOP

   GO=False : FIN=False : TTOOL=1 : PPEN=2 : BAK=0 : RAD=5
   Break Off
   REGISTER=GO
   SCLOSE
   _SMALL_COPYRIGHT[140]
   ABOUT
   SCR_MODE
   Get Rom Fonts
   Set Font 1

   Change Mouse 2

   On Error Proc ERR
   Repeat

      Repeat
      Until Mouse Key=0

      If GO
         Show On
      Else
         If TTOOL=17
            Hide On
         Else
            Show On
         End If
      End If

      Repeat
         Repeat
            Multi Wait
            KYS=Mouse Key
         Until Not(KYS=0)
      Until Amos Here

      If GO
         Z=Mouse Zone
         GO= Not GO
         ICONS[GO]

         Repeat
         Until Mouse Key=0

         IMMEDIATE[Z,TTOOL]
         Change Mouse 2
         TTOOL=Param
         If TTOOL=17
            If Length(1)>5
               Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),6
               Channel 1 To Bob 1
               Bob Update On
               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
         End If
         FIN=(TTOOL=40)
      Else
         If KYS<3
            If KYS=2
               GO=True
               Bob Off
               ICONS[GO]
               Show On
               Change Mouse 1
            Else
               D0_DRAW[TTOOL]
            End If
         End If
      End If

   Until FIN

   SCLOSE

End Proc

Procedure ERR
   REQ["An error has Occured",Str$(Errn),"Please Tell ","The Author "]
   Direct
End Proc

Procedure PAL

   Def Fn RED(TTUM)=TTUM/256
   Def Fn GREEN(TTUM)=(TTUM/16) mod 16
   Def Fn BLUE(TTUM)=TTUM mod 16
   On Error Proc ERR
   IND=0 : STT=0
   Screen 0
   C=Screen Colour
   HAM=(Screen Colour=4096)
   EHB=(Screen Colour=64)
   CL=C
   If HAM
      C=32
      CL=32
   Else
      If EHB
         C=64
         CL=32
      End If
   End If
   FYN=CL-1

   Unpack 9 To 1
   _APPEAR[1,1]
   INIT_SPRITES
   Screen Open 2,320,10,C,Lowres
   Flash Off : Curs Off : WD=320/C
   For T=0 To CL-1
      Colour T,CLRS(T)
   Next T
   For T=0 To C-1
      Ink T
      Bar T*WD,0 To T*WD+WD,9
   Next T
   Screen Display 2,,201,,
   _APPEAR[1,0]
   Screen 1

   CLR=PPEN : FINI=False : OKAY=False
   SPC=22 : XSPR1=146 : YS=176 : S=8

   XSPR2=XSPR1+SPC : XSPR3=XSPR2+SPC : YPTR=195 : XDSP=128

   Repeat

      Repeat
      Until Mouse Key=0

      Screen 2
      CLT=Colour(CLR)
      Y1=YS-S* Fn RED(CLT) : Y2=YS-S* Fn GREEN(CLT) : Y3=YS-S* Fn BLUE(CLT)
      Screen 1

      If IND=0
         Sprite Off 14
      Else
         Sprite 14,332+28*IND,118,2
      End If

      Sprite 8,XSPR1,Y1,1
      Sprite 9,XSPR2,Y2,1
      Sprite 10,XSPR3,Y3,1
      Sprite 11,STT*WD+XDSP,YPTR,3
      Sprite 12,FYN*WD+XDSP+WD-4,YPTR,3

      Repeat
      Until Mouse Key=1

      Bell
      Screen 2
      R= Fn RED(CLT)
      G= Fn GREEN(CLT)
      B= Fn BLUE(CLT)
      X=X Mouse
      Y=Y Mouse
      VL=(182-Y)/8

      If Y>54
         If Y<182
            If X<158
               If X>144
                  R=VL
               End If
            Else
               If X<180
                  If X>165
                     G=VL
                  End If
               Else
                  If X<202
                     If X>188
                        B=VL
                     End If
                  End If
               End If
            End If
         End If
      End If

      If Y<106
         If X>238
            If Y>60
               If X<390
                  If Y<80
                     If X<292
                        '
                        ' Okay
                        FINI=True
                        OKAY=True
                     Else
                        If X>322
                           ' Cancel
                           FINI=True
                        End If
                     End If
                  Else
                     If Y>92
                        If X<292
                           STT=CLR
                           If Max(STT,FYN)=STT
                              Swap STT,FYN
                           End If
                        Else
                           If X>322
                              FYN=CLR
                              If Max(STT,FYN)=STT
                                 Swap STT,FYN
                              End If
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         End If
      End If

      If Y>119
         If Y<139
            If X>360
               If X<444
                  If X<385
                     If IND=1
                        IND=0
                     Else
                        IND=1
                     End If
                  End If
                  If X>420
                     If IND=3
                        IND=0
                     Else
                        IND=3
                     End If
                  End If
                  If X>389
                     If X<416
                        If IND=2
                           IND=0
                        Else
                           IND=2
                        End If
                     End If
                  End If
               End If
            End If
         End If
      End If

      Screen 2
      Colour CLR,R*256+G*16+B

      If Y>201
         If Y<210
            X=X-128
            CLR=(X*C)/320
            If CLR=C
               CLR=CLR-1
            End If
            If EHB
               If CLR>31
                  CLR=CLR-32
                  Bell 20
               End If
            End If
         End If
      End If

      If Not(IND=0)
         If Y>119
            If Y<138
               If X>221
                  If Not(FYN-STT)=0
                     If X<356
                        If X<245
                           Screen 2
                           STP=Sgn(FYN-STT)
                           For T=STT To FYN Step STP
                              V=Colour(T)
                              R= Fn RED(V)
                              G= Fn GREEN(V)
                              B= Fn BLUE(V)
                              V=(15*(T-STT))/(FYN-STT)
                              If IND=1
                                 R=V
                              Else
                                 If IND=2
                                    G=V
                                 Else
                                    B=V
                                 End If
                              End If
                              TP=R*256+G*16+B
                              Colour T,TP
                           Next T
                        End If
                        If X>332
                           Screen 2
                           CPS=Colour(STT)
                           CPF=Colour(FYN)
                           If IND=1
                              VS= Fn RED(CPS)
                              VF= Fn RED(CPF)
                           Else
                              If IND=2
                                 VS= Fn GREEN(CPS)
                                 VF= Fn GREEN(CPF)
                              Else
                                 VS= Fn BLUE(CPS)
                                 VF= Fn BLUE(CPF)
                              End If
                           End If
                           STP=Sgn(FYN-STT)
                           For T=STT To FYN Step STP
                              V=Colour(T)
                              R= Fn RED(V)
                              G= Fn GREEN(V)
                              B= Fn BLUE(V)
                              V=((VF-VS)*(T-STT))/(FYN-STT)+VS
                              If IND=1
                                 R=V
                              Else
                                 If IND=2
                                    G=V
                                 Else
                                    B=V
                                 End If
                              End If
                              TP=R*256+G*16+B
                              Colour T,TP
                           Next T
                        End If
                     End If
                  End If
               End If
            End If
         End If
      End If

      If FYN>STT
         If Y>119
            If Y<139
               If(X>249) and(X<273)
                  Screen 2
                  TEMP=Colour(FYN)
                  For T=FYN To STT+1 Step -1
                     Colour T,Colour(T-1)
                  Next T
                  Colour STT,TEMP
               End If
               If(X>276) and(X<300)
                  Screen 2
                  TEMP=Colour(STT)
                  For T=STT To FYN-1
                     Colour T,Colour(T+1)
                  Next T
                  Colour FYN,TEMP
               End If
               If(X>304) and(X<328)
                  Screen 2
                  T=STT-1
                  Repeat
                     T=T+1
                     TEMP=Colour(T)
                     TEMP2=Colour(FYN-T+STT)
                     Colour T,TEMP2
                     Colour STT+FYN-T,TEMP
                     Wait Vbl
                  Until(T>(STT+FYN-T-2))
               End If
            End If
         End If
      End If
      Screen 0
   Until FINI

   If OKAY
      For T=0 To CL-1
         Screen 2
         CLRS(T)=Colour(T)
         If Not HAM
            Screen 0
            Colour T,CLRS(T)
         End If
      Next T
   End If
   Sprite Off : Bob Off
   Screen 2 : Fade 1 : Wait 10 : Screen 1 : Fade 1
   Wait 5 : Screen Close 2 : Wait 10 : Screen Close 1
   Screen 0

End Proc

Procedure SCR_MODE

   Shared PPEN,BAK,RAD
   On Error Proc ERR
   RAD=10
   CL=16
   PL=False
   R=0 : Bob Update On
   Unpack 8 To 1
   _APPEAR[1,0]
   INIT_SPRITES

   FIN=False
   YSC=103
   YSM=YSC+25
   If CL=2 Then C=0
   If CL=4 Then C=1
   If CL=8 Then C=2
   If CL=16 Then C=3
   If CL=32 Then C=4
   If CL=64 Then C=5
   If CL=4096 Then C=6
   View

   Repeat

      Repeat
      Until Mouse Key=0

      Sprite 8,195+C*32,YSC,4
      Sprite 9,168+R*60,YSM,5
      Bob 1,225+PL*60,78,5

      Repeat
      Until Not(Mouse Key=0)
      X=X Mouse : Y=Y Mouse

      Bell

      If Y>134
         If Y<145
            If X<284
               If X>170
                  If X>235
                     R=1
                     If C>3
                        C=3
                     End If
                  End If
                  If X<223
                     R=0
                  End If
               End If
            End If
            If X>306
               If X>361
                  PL=False
               End If
               If X<336
                  PL=True
               End If
            End If
         End If
      End If

      If Y<123
         If Y>112
            If X>205
               If X<419
                  If X<219
                     C=0
                  End If
                  If X>235
                     If X<248
                        C=1
                     End If
                     If X>266
                        If X<282
                           C=2
                        End If
                        If X>300
                           If X<314
                              C=3
                           End If
                           If R=0
                              If X>330
                                 If X<346
                                    C=4
                                 End If
                                 If X>355
                                    If X<384
                                       C=5
                                    End If
                                    If X>388
                                       C=6
                                    End If
                                 End If
                              End If
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         End If
      End If

      If Y>167
         If Y<179
            If X>403
               If X<427
                  FIN=True
               End If
            End If
         End If
      End If

      If C=6
         Bell 20 : Rem Take Out when Ham is implemented
         C=5
      End If

   Until FIN

   If C=0 Then CL=2
   If C=1 Then CL=4
   If C=2 Then CL=8
   If C=3 Then CL=16
   If C=4 Then CL=32
   If C=5 Then CL=64
   If C=6 Then CL=4096

   If PL
      HT=256
   Else
      HT=200
   End If

   If R=0
      Screen Open 0,320,HT,CL,Lowres
   Else
      Screen Open 0,640,HT,CL,Hires
   End If
   Limit Mouse 120,40 To 460+Screen Width-320,300
   Flash Off : Curs Off : Cls 0

   Sprite Off
   Screen 1
   Fade 1 : Wait 15
   Screen Close 1
   Screen 0
   SPR=True
   INIT_CLRS[True]
   View
End Proc

Procedure INIT_SPRITES
   On Error Proc ERR
   Colour 17,Colour(1)
   Colour 18,Colour(1)
   Colour 19,Colour(7)
   For S=1 To 3
      For T=1 To 3
         Colour T*4+S+16,Colour(16+S)
      Next T
   Next S
End Proc

Procedure INIT_CLRS[FL]

   Shared PPEN,BAK
   On Error Proc ERR
   Screen 0
   If FL
      If SPR
         If Length(2)=64
            Copy Start(2),Start(2)+Length(2) To Screen Base+98
         Else
            Get Sprite Palette
         End If
      End If
   End If
   CL=Screen Colour
   If CL>32
      STP=32
   Else
      STP=CL
   End If

   If CL<4096
      For T=0 To STP-1
         CLRS(T)=Colour(T)
      Next T
   Else
      ' Do Summat else for HAM
   End If
   PPEN=2
   BAK=0
   PPEN=Min(PPEN,CL-1)

End Proc

Procedure ABOUT

   On Error Proc ERR
   Hide On
   Unpack 11 To 2
   Repeat
   Until Mouse Key=0

   SPLERGE[1,2,1]

   Repeat
   Until Not(Mouse Key=0)

   Repeat
   Until(Mouse Key=0)

   Show On
   Screen 1 : Fade 1 : Wait 15 : Screen Close 1
End Proc

Procedure ICONS[FLG]

   On Error Proc ERR
   Shared REGISTER

   Repeat
   Until Mouse Key=0

   If FLG

      Hide On
      EHB=False : HAM=False
      Screen 0
      C=Screen Colour
      CLU=C
      CL=C
      If C>32
         CL=32
         If C=64
            EHB=True
         Else
            HAM=True
            CLU=32
         End If
      End If

      Screen Open 4,320,10,C,Lowres
      Screen Display 4,,83,,
      Flash Off : Curs Off

      For T=0 To CL-1
         Colour T,CLRS(T)
      Next T
      WD=320/CLU
      For T=0 To CLU-1
         Ink T
         Bar T*WD,0 To T*WD+WD,9
      Next T
      Unpack 10 To 3
      _APPEAR[0,0]

      Screen 0
      If Screen Height>250
         OFF=8
      Else
         OFF=0
      End If
      SC=1
      If Screen Width=640
         SC=2
      End If
      Reserve Zone 40+CLU
      For T=1 To 20
         For S=1 To 2
            Set Zone T*2+S-2,SC*(T*16-16),S*16-16+OFF To SC*(T*16-1),S*16-1+OFF
         Next S
      Next T
      For T=0 To CLU-1
         Set Zone T+41,SC*T*WD,33+OFF To SC*(T*WD+WD-1),43+OFF
      Next T
      Show On

   Else
      If REGISTER
         Hide On
         WIPE[4,0]
         WIPE[3,0]
         Reserve Zone
         Screen 0
         Show On
      End If
   End If
   REGISTER=True
End Proc

Procedure IMMEDIATE[Z,TTOOL]

   Shared PPEN,BAK,RAD
   On Error Proc ERR
   PS=False

   Amal Off
   Bob Update Off
   Bob Clear
   If Z=0
      PS=True
   End If
   If(Z=16) or(Z=18) or(Z=20)
      SPR=False
      A$="This will Remove ALL the "
      If Z=16
         M$="Red"
      Else
         If Z=18
            M$="Green"
         Else
            M$="Blue"
         End If
      End If
      A$=A$+M$
      PS=True
      REQ["Are you Sure?",A$,"Forget it then.","Do it NOW"]
      If Param=2
         RMOVECL[Z/2-7]
      End If
      INIT_CLRS[False]
   End If
   If Z=15
      Z=17
      CUT
   End If
   If Z=22
      PS=True
      Screen 0
      SET_PATTERN[Colour(PPEN),Colour(BAK)]
   End If
   If Z=23
      PS=True
      ZZOOM
   End If
   If Z=24
      PS=True
      PAL
   End If
   If(Z=25) or(Z=26)
      PS=True
      FILE_PAL[26-Z]
   End If
   If Z=28
      SPRAY[1]
      Z=27
   End If
   If Z=31
      PS=True
      REQ["Not implemented, I tried using","Screenswaps & Double Buffer","But had Bob troubles","With Paste"]
   End If
   If Z=32
      Z=19
      FONTS
   End If
   If Z=33
      PS=True
      REQ["Draw a Grid?","(Useful for Sprites etc.)","No Way","Yes Please"]
      If Param=2
         REQ["What Grid Size?","","16 x 16","32 x 32"]
         If Param=1
            SZ=16
         Else
            SZ=32
         End If
         GRID[SZ]
      End If
   End If
   If Z=34
      PS=True
      CYCLE
   End If
   If(Z=35) or(Z=36)
      PS=True
      FILE_PIC[Z-35]
   End If
   If Z=37
      PS=True
      Screen 0
      Repeat
      Until Not(Mouse Key=0)
      PPN=Point(X Screen(X Mouse),Y Screen(Y Mouse))
      If BAK=(PPN)
         Swap BAK,PPEN
      Else
         If Not(PPEN=PPN)
            BAK=PPEN
            PPEN=PPN
         End If
      End If
   End If
   If Z=38
      PS=True
      REQ["Clear The Screen?!","You sure??","Erm, actually..","Of Course!!"]
      If Param=2
         REQ["Change Screen Mode?","","Naah.","Okay Then"]
         If Param=2
            SCR_MODE
         Else
            Cls 0
         End If
      End If
   End If
   If Z=39
      PS=True
      ABOUT
      Screen 0
   End If
   If Z=40
      PS=True
      REQ["Are you sure","you want to leave AmPP2?","No","Yes"]
      If Param=2
         PS=False
      End If
   End If
   If Z>40
      If BAK=(Z-41)
         Swap BAK,PPEN
      Else
         If Not(PPEN=Z-41)
            BAK=PPEN
            PPEN=Z-41
         End If
      End If
      PS=True
   End If

   If PS
      Z=TTOOL
   End If

End Proc[Z]

Procedure REQ[MESS$,MESS2$,RP1$,RP2$]
   '   Shift Off
   '   Set Rainbow 0,0,50,"(10,1,5)","","(1,5,1)(10,-1,5)"
   On Error Proc ERR
   EXTEND[MESS$] : MESS$=Param$
   EXTEND[MESS2$] : MESS2$=Param$
   EXTEND[RP1$] : RP1$=Param$
   EXTEND[RP2$] : RP2$=Param$
   If GO=1
      ICONS[0]
   End If
   S=True
   R1=Asc(Left$(RP1$,1))
   R2=Asc(Left$(RP2$,1))
   If R1=R2
      S=False
   End If
   Screen Open 3,640,50,4,Hires
   Curs Off
   Screen Display 3,,100,,
   '   Rainbow 0,1,100,50
   Palette $6,$BB2,$FF3,$BB2
   Cls 0 : Pen 2 : Paper 0
   Flash 3,"(ff0,5)(ee0,5)(cc0,5)(aa0,5)(880,5)(aa0,5)(cc0,5)(ee0,5)"
   Flash 1,"(880,5)(aa0,5)(cc0,5)(ee0,5)(ff0,5)(ee0,5)(cc0,5)(aa0,5)"
   Ink 2
   Draw 0,0 To 640,0
   Draw 0,49 To 640,49
   Print
   Centre MESS$
   Print
   Centre MESS2$
   Locate 4,3
   Pen 2
   Print "L e f t"
   Locate 4,4
   Pen 3
   Print RP1$
   Locate 65,3
   Pen 2
   Print "R i g h t"
   Pen 1
   Locate 76-Len(RP2$),4
   Print RP2$
   View
   Repeat
      Clear Key
      Repeat
         KYS=Mouse Key
         If S
            KY=Asc(Inkey$)
            If(R1=KY) or(R2=KY)
               If RP1=KY
                  Z=1
               Else
                  Z=2
               End If
               KYS=Z
            End If
         End If
      Until Not(KYS=0)
      If KYS>2
         KYS=0
      End If
      Z=KYS
   Until Not(Z=0)
   Screen Close 3
   '   Rainbow 0,0,0,0
   View
   Repeat
   Until Mouse Key=0
   If GO=1
      ICONS[1]
   End If
End Proc[Z]

Procedure EXTEND[MESS$]
   On Error Proc ERR
   TEMP$=MESS$
   OP$=" "
   For T=1 To 2*Len(TEMP$)
      OP$=OP$+" "
   Next T
   For T=1 To Len(TEMP$)
      For S=1 To 2
         P=2*T-1
         If S=1
            Mid$(OP$,P,P+1)=Mid$(TEMP$,T,T+1)
         Else
            Mid$(OP$,P+1,P+2)=" "
         End If
      Next S
   Next T
End Proc[OP$]

Procedure D0_DRAW[CH]

   On Error Proc ERR
   Shared PPEN,BAK
   Shared RAD
   Ink PPEN,BAK
   If(CH=1) or(CH=2)
      SKETCH[CH]
   End If
   If CH=3
      LINE
   End If
   If CH=4
      RAY
   End If
   If(CH=5) or(CH=7)
      ELIPSE[CH]
   End If
   If(CH=6) or(CH=8)
      SIRCLE[CH]
   End If
   If(CH=9) or(CH=11)
      BBOX[CH]
   End If
   If(CH=10) or(CH=12)
      PARA[CH]
   End If
   If(CH=13) or(CH=14)
      TRIANGLE[CH]
   End If
If CH=17
PPASTE
End If
   If CH=19
      TXT
   End If
   If CH=21
      FYLL
   End If
   If(CH=27) or(CH=29) or(CH=30)
      SPRAY[CH-27]
   End If

End Proc

Procedure SKETCH[TYPE]

   On Error Proc ERR
   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

End Proc

Procedure LINE

   On Error Proc ERR
   Gr Writing 2
   Screen 0
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   X2=X Mouse : Y2=Y Mouse
   X2=X Screen(X2) : Y2=Y Screen(Y2)
   Draw X,Y To X2,Y2
   Repeat
      Draw X,Y To X2,Y2
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      OLX2=X2
      OLY2=Y2
      Draw X,Y To OLX2,OLY2
      Wait Vbl
   Until Mouse Key=0
   Gr Writing 1
   Draw X,Y To OLX2,OLY2

End Proc

Procedure RAY

   On Error Proc ERR
   Screen 0
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   Repeat
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      Draw X,Y To X2,Y2
   Until Mouse Key=0

End Proc

Procedure ELIPSE[C]

   On Error Proc ERR
   Gr Writing 2
   Screen 0
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   X2=X Mouse : Y2=Y Mouse
   X2=X Screen(X2) : Y2=Y Screen(Y2)
   Repeat
      R1=Abs(X2-X) : R2=Abs(Y2-Y)
      R1=Max(1,R1) : R2=Max(R2,1)
      Ellipse X,Y,R1,R2
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      OLR1=R1
      OLR2=R2
      Ellipse X,Y,OLR1,OLR2
      Wait Vbl
   Until Mouse Key=0
   Gr Writing 1
   R1=OLR1 : R2=OLR2
   Ellipse X,Y,R1,R2
   If C=7
      If Max(R1,R2)=R1
         Draw X-R1,Y To X+R1,Y
         For T=1 To R2
            Ellipse X,Y,R1,T
         Next T
      Else
         Draw X,Y-R2 To X,Y+R2
         For T=1 To R1
            Ellipse X,Y,T,R2
         Next T
      End If
   End If

End Proc

Procedure SIRCLE[C]

   On Error Proc ERR
   Gr Writing 2
   Screen 0
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   X2=X Mouse : Y2=Y Mouse
   X2=X Screen(X2) : Y2=Y Screen(Y2)
   Repeat
      R=Sqr((X2-X)*(X2-X)+(Y2-Y)*(Y2-Y))
      R=Max(1,R)
      Circle X,Y,R
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      OLR=R
      Circle X,Y,OLR
      Wait Vbl
   Until Mouse Key=0
   Gr Writing 1
   R=OLR
   Circle X,Y,R
   If C=8
      Draw X-R,Y To X+R,Y
      For T=1 To R
         Ellipse X,Y,R,T
      Next T
   End If

End Proc

Procedure CUT

   On Error Proc ERR
   Gr Writing 2
   SPR=False
   Screen 0
   Change Mouse 2
   Repeat
   Until Mouse Key=0
   Repeat
   Until Not(Mouse Key=0)
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   X2=X Mouse : Y2=Y Mouse
   X2=X Screen(X2) : Y2=Y Screen(Y2)
   Plot X,Y
   Box X,Y To X2,Y2
   Repeat
      Box X,Y To X2,Y2
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      If X=X2
         If OLX2>X2
            Dec X2
         Else
            Inc X2
         End If
      End If
      If Y=Y2
         If OLY2>Y2
            Dec Y2
         Else
            Inc Y2
         End If
      End If
      OLX2=X2
      OLY2=Y2
      Box X,Y To OLX2,OLY2
      Wait Vbl
   Until Mouse Key=0
   Box X,Y To OLX2,OLY2
   Gr Writing 1
   If OLX2<X
      Swap X,OLX2
   End If
   If OLY2<Y
      Swap Y,OLY2
   End If
   Get Bob 6,X,Y To OLX2,OLY2
End Proc

Procedure PPASTE

   Bob Off
   Repeat
      X=X Mouse : Y=Y Mouse
      X=X Screen(X) : Y=Y Screen(Y)
      Paste Bob X,Y,6
   Until Mouse Key=0
   Wait Vbl : Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),6
   Channel 1 To Bob 1
   Bob Update On
   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 Proc

Procedure BBOX[C]

   On Error Proc ERR
   Gr Writing 2
   Screen 0
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   X2=X Mouse : Y2=Y Mouse
   X2=X Screen(X2) : Y2=Y Screen(Y2)
   Box X,Y To X2,Y2
   Repeat
      Box X,Y To X2,Y2
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      OLX2=X2
      OLY2=Y2
      Box X,Y To OLX2,OLY2
      Wait Vbl
   Until Mouse Key=0
   Gr Writing 1
   X2=OLX2 : Y2=OLY2
   If C=9
      Box X,Y To X2,Y2
   Else
      If(X=X2) or(Y=Y2)
         Draw X,Y To X2,Y2
      Else
         If X>X2
            Swap X,X2
         End If
         If Y>Y2
            Swap Y,Y2
         End If
         Bar X,Y To X2,Y2
      End If
   End If

End Proc

Procedure PARA[C]

   On Error Proc ERR
   Gr Writing 2
   Screen 0
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   X2=X Mouse : Y2=Y Mouse
   X2=X Screen(X2) : Y2=Y Screen(Y2)
   Draw X,Y To X2,Y2
   Repeat
      Draw X,Y To X2,Y2
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      OLX2=X2
      OLY2=Y2
      Draw X,Y To OLX2,OLY2
      Wait Vbl
   Until Mouse Key=0
   Gr Writing 1
   X2=OLX2 : Y2=OLY2
   Draw X,Y To X2,Y2

   X3=X Mouse : Y3=Y Mouse
   X3=X Screen(X3) : Y3=Y Screen(Y3)
   Gr Writing 2
   X4=X+X3-X2 : Y4=Y+Y3-Y2
   Polyline X,Y To X4,Y4 To X3,Y3 To X2,Y2
   Repeat
      Polyline X,Y To X4,Y4 To X3,Y3 To X2,Y2
      X3=X Mouse : Y3=Y Mouse
      X3=X Screen(X3) : Y3=Y Screen(Y3)
      X4=X+X3-X2 : Y4=Y+Y3-Y2
      OLX3=X3 : OLY3=Y3 : OLX4=X4 : OLY4=Y4
      Polyline X,Y To OLX4,OLY4 To OLX3,OLY3 To X2,Y2
      Wait Vbl
   Until Mouse Key=1
   X3=OLX3 : Y3=OLY3 : X4=OLX4 : Y4=OLY4
   Gr Writing 1
   If C=10
      Polyline X,Y To X2,Y2 To X3,Y3 To X4,Y4 To X,Y
   Else
      Polygon X,Y To X2,Y2 To X3,Y3 To X4,Y4 To X,Y
   End If

End Proc

Procedure TRIANGLE[C]

   On Error Proc ERR
   Gr Writing 2
   Screen 0
   X=X Screen(X Mouse)
   Y=Y Screen(Y Mouse)
   X2=X Mouse : Y2=Y Mouse
   X2=X Screen(X2) : Y2=Y Screen(Y2)
   Draw X,Y To X2,Y2
   Repeat
      Draw X,Y To X2,Y2
      X2=X Mouse : Y2=Y Mouse
      X2=X Screen(X2) : Y2=Y Screen(Y2)
      OLX2=X2
      OLY2=Y2
      Draw X,Y To OLX2,OLY2
      Wait Vbl
   Until Mouse Key=0
   Gr Writing 1
   Draw X,Y To X2,Y2

   X3=X Mouse : Y3=Y Mouse
   X3=X Screen(X3) : Y3=Y Screen(Y3)
   Gr Writing 2
   Polyline X,Y To X3,Y3 To X2,Y2
   Repeat
      Polyline X,Y To X3,Y3 To X2,Y2
      X3=X Mouse : Y3=Y Mouse
      X3=X Screen(X3) : Y3=Y Screen(Y3)
      OLX3=X3 : OLY3=Y3
      Polyline X,Y To OLX3,OLY3 To X2,Y2
      Wait Vbl
   Until Mouse Key=1
   X3=OLX3 : Y3=OLY3
   Gr Writing 1
   If C=14
      Polygon X,Y To X2,Y2 To X3,Y3 To X,Y
   Else
      Polyline X,Y To X2,Y2 To X3,Y3 To X,Y
   End If

End Proc

Procedure FYLL

   On Error Proc ERR
   Shared PPEN,BAK
   Screen 0
   Change Mouse 3
   Ink PPEN,BAK
   Paint X Screen(X Mouse),Y Screen(Y Mouse),0
   Change Mouse 2

End Proc

Procedure SET_PATTERN[C,C2]

   On Error Proc ERR
   Change Mouse 3
   Screen Open 1,320,64,4,Lowres
   Flash Off : Curs Off
   Palette C2,C,C-16,0
   Reserve Zone 35
   Cls 3
   For T=0 To 9
      For S=1 To 4
         If(T*4+S-1)<35
            Ink 2
            Box T*32,S*16-16 To T*32+31,S*16-1
            Set Zone T*4+S,T*32,S*16-16 To T*32+31,S*16-1
            Set Pattern T*4+S-1
            Ink 1,0
            Paint T*32+1,S*16-15,0
         End If
      Next S
   Next T
   View
   Change Mouse 1
   Repeat
      Repeat
         Z=Mouse Zone
      Until Not(Z=0)
   Until Not(Mouse Key=0)
   Screen Close 1
   Screen 0
   Set Pattern Z-1
   Ink PPEN

End Proc[Z-1]

Procedure ZZOOM

   Shared PPEN,BAK
   On Error Proc ERR
   Def Fn RED(TMP)=TMP/256
   Def Fn GREEN(TMP)=(TMP/16) mod 16
   Def Fn BLUE(TMP)=TMP mod 16

   Repeat
   Until Mouse Key=0

   Hide On
   Gr Writing 2
   BX=128
   Screen 0
   XMX=Screen Width
   YMX=Screen Height
   SZ=4
   X=X Mouse : Y=Y Mouse
   X=X Screen(X) : Y=Y Screen(Y)
   X2=X+BX/SZ-1 : Y2=Y+BX/SZ-1
   Bar X,Y To X2,Y2
   Repeat
      Bar X,Y To X2,Y2
      X=X Mouse : Y=Y Mouse
      X=X Screen(X) : Y=Y Screen(Y)
      X2=X+BX/SZ-1 : Y2=Y+BX/SZ-1
      OLX=X : OLX2=X2
      OLY=Y : OLY2=Y2
      Bar OLX,OLY To OLX2,OLY2
      Wait Vbl
   Until Mouse Key=1
   Bar X,Y To X2,Y2
   Gr Writing 1

   Screen 0
   C=Screen Colour
   HAM=(Screen Colour=4096)
   EHB=(Screen Colour=64)
   CL=C
   If HAM
      C=32
      CL=32
   Else
      If EHB
         C=64
         CL=32
      End If
   End If
   FYN=CL-1

   Screen Open 2,320,10,C,Lowres
   Flash Off : Curs Off : WD=320/C : PAUSE=True
   For T=0 To CL-1
      Colour T,CLRS(T)
   Next T
   For T=0 To C-1
      Screen 2
      Ink T
      Bar T*WD,0 To T*WD+WD,9
   Next T
   HT=158
   Screen Open 1,320,HT,C,Lowres
   Screen Display 1,,60,,
   Flash Off : Curs Off
   MX=0
   MN=4096
   For T=0 To CL-1
      Colour T,CLRS(T)
      TMP= Fn RED(CLRS(T))+ Fn GREEN(CLRS(T))+ Fn BLUE(CLRS(T))
      If Min(TMP,MN)=TMP
         BK=T
         MN=TMP
      End If
      If Max(TMP,MX)=TMP
         FG=T
         MX=TMP
      End If
   Next T
   FINI=False : XS=10 : YS=15 : XF=XS+BX : YF=YS+BX
   XS2=XF+10 : YS2=YS : XF2=XS2+BX/2 : YF2=YS2+BX/2 : FIRST=True
   UP$=Border$("  UP  ",1) : DWN$=Border$(" DOWN ",1)
   LFT$=Border$(" LEFT ",1) : RT$=Border$("RIGHT ",1)
   OK$=Border$(" OKAY ",1) : CNC$=Border$("CANCEL",1)
   Change Mouse 2
   Show On

   DX=BX/SZ
   DY=BX/SZ
   If X<0
      X=0
   End If
   If Y<0
      Y=0
   End If

   If(X+DX>XMX)
      X=XMX-DX
   End If
   If(Y+DX>YMX)
      Y=YMX-DY
   End If

   Repeat

      If Not FIRST
         Screen Copy 1,XS2,YS2,XS2+64,YS2+64 To 0,OX-ODD,OY-ODD
      End If

      Cls BK : Paper BK
      Ink FG : Pen FG : C=FG
      Box 0,0 To 319,HT-1
      Locate 30,2 : Print OK$ : Locate 30,5 : Print CNC$
      Locate 30,8 : Print UP$ : Locate 30,11 : Print DWN$
      Locate 30,14 : Print LFT$ : Locate 30,17 : Print RT$
      Locate 20,11 : Print "2" : Locate 23,11 : Print "4"
      Locate 20,14 : Print "8" : Locate 22,14 : Print "16"
      Locate 19,17 : Print "32" : Locate 22,17 : Print "64"
      Box XS-2,YS-2 To XF+1,YF+1
      Box XS2-2,YS2-2 To XF2+1,YF2+1

      DX=BX/SZ : DY=DX : D=DX/2 : DD=32-DX/2

      OX=X : OY=Y : ODD=DD
      Zoom 0,X,Y,X+DX,Y+DY To 1,XS,YS,XF,YF
      Screen Copy 0,X-DD,Y-DD,X+DX+DD,Y+DY+DD To 1,XS2,YS2
      View
      REFRESH=False
      FIRST=False
      Ink PPEN

      Repeat

         If PAUSE
            Repeat
            Until Mouse Key=0
         End If

         Repeat
         Until Not(Mouse Key=0)
         XM=X Mouse : YM=Y Mouse : PAUSE=True

         If YM<59
            If YM>50
               If XM>127
                  If XM<448
                     C=(XM-127)/WD
                     PAUSE=False
                     If BAK=C
                        Swap BAK,PPEN
                     Else
                        If Not(PPEN=C)
                           BAK=PPEN
                           PPEN=C
                        End If
                     End If
                     PS=True
                  End If
               End If
            End If
         End If

         If XM<265
            If XM>136
               If YM>73
                  If YM<202
                     H=XM-137 : H=H/SZ
                     V=YM-74 : V=V/SZ
                     PAUSE=False
                     Ink PPEN
                     SSX=XS+H*SZ : SSY=SY+V*SZ+15
                     Bar SSX,SSY To SSX+SZ-1,SSY+SZ-1
                     Plot XS2+DD+H,YS2+DD+V
                  End If
               End If
            End If
         End If

         If XM>364
            If XM<420
               If YM>70
                  If YM<208
                     If YM>190
                        X=X+D
                        REFRESH=True
                     Else
                        If YM>167
                           If YM<183
                              X=X-D
                              REFRESH=True
                           End If
                        Else
                           If YM>144
                              If YM<159
                                 Y=Y+D
                                 REFRESH=True
                              End If
                           Else
                              If YM>119
                                 If YM<135
                                    Y=Y-D
                                    REFRESH=True
                                 End If
                              Else
                                 If YM>95
                                    If Y<111
                                       REFRESH=True
                                       FINI=True
                                       OKAY=False
                                    End If
                                 Else
                                    If YM<87
                                       REFRESH=True
                                       FINI=True
                                       OKAY=True
                                    End If
                                 End If
                              End If
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         Else
            If XM<320
               If XM>280
                  If YM>145
                     If YM<205
                        If YM<155
                           If XM<300
                              SZ=2
                              REFRESH=True
                           Else
                              SZ=4
                              REFRESH=True
                           End If
                        Else
                           If YM>170
                              If YM<180
                                 If XM<300
                                    SZ=8
                                    REFRESH=True
                                 Else
                                    SZ=16
                                    REFRESH=True
                                 End If
                              Else
                                 If YM>195
                                    If YM<205
                                       If XM<300
                                          SZ=32
                                          REFRESH=True
                                       Else
                                          REFRESH=True
                                          SZ=64
                                       End If
                                    End If
                                 End If
                              End If
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         End If

         If X<0
            X=0
         End If
         If Y<0
            Y=0
         End If

         If(X+DX>XMX)
            X=XMX-DX
         End If
         If(Y+DX>YMX)
            Y=YMX-DY
         End If

      Until REFRESH

   Until FINI

   If OKAY
      Screen Copy 1,XS2,YS2,XS2+64,YS2+64 To 0,OX-ODD,OY-ODD
   End If

   Screen Close 2
   Screen Close 1
   Screen 0
   Reserve Zone

End Proc

Procedure SPRAY[C]

   On Error Proc ERR
   Shared RAD

   If C=1
      SPRAYPRMS
   Else
      Degree
      Screen 0
      Repeat
         R=Rnd(RAD)
         T=Rnd(359)
         X1=R*Cos(T)
         Y1=R*Sin(T)
         X=X Mouse : Y=Y Mouse
         X=X Screen(X) : Y=Y Screen(Y)

         If C=0
            Plot X+X1,Y+Y1
         Else

            If C=2
               Draw X,Y To X+X1,Y+Y1
            Else

               P1=Point(X+X1,Y+Y1) : P2=Point(X-X1,Y-Y1)
               If Max(P1,0)=P1
                  If Max(P2,0)=P2
                     Ink P2 : Plot X+X1,Y+Y1
                     Ink P1 : Plot X-X1,Y-Y1
                  End If
               End If

            End If
         End If
      Until Mouse Key=0
      Ink PPEN
   End If

End Proc

Procedure SPRAYPRMS

   On Error Proc ERR
   Shared RAD
   Hide On
   Gr Writing 2
   TT=0
   Ink 1
   Repeat
   Until Mouse Key=0
   Repeat
      Clear Key
      Repeat
         Text 50,50,"Spraysize :"+Str$(TT)
         Repeat
            K$=Inkey$ : S=Scancode
         Until S>0
         Text 50,50,"Spraysize :"+Str$(TT)
         If S<11
            T=S mod 10
            TT=10*TT+T
            TT=TT mod 1000
         Else
            If S=65
               TT=TT/10
            End If
         End If
      Until Not(S=65)
   Until S>10
   Gr Writing 0
   TT=Max(TT,5)
   RAD=TT
   Show On

End Proc

Procedure FILE_PIC[C]

   On Error Goto ERR
   SAV=(C=0)
   Screen 0
   PATH$="**.**"
   DEF$=""
   MESS$="Select a File"
   If SAV
      MESS2$="to Save."
   Else
      MESS2$="to Load."
   End If
   F$=Fsel$(PATH$,DEF$,MESS$,MESS2$)
   If Not(F$=DEF$)
      If SAV
         If Not(Upper$(Right$(F$,4))=".IFF")
            F$=F$+".IFF"
         End If
      End If
      DISK=Exist(F$)
      If SAV
         If DISK
            REQ["File Exists","Overwrite File??","No","Yes, Kill it!!"]
            SAV=(Param=2)
         End If
         If SAV
            Save Iff F$
         End If
      Else
         If DISK
            Load Iff F$,0
            INIT_CLRS[False]
            If Screen Width<320
               Screen Open 1,Screen Width,Screen Height,Screen Colour,Lowres
               Screen Copy 0 To 1
               Screen Open 0,320,Screen Height,Screen Colour,Lowres
               Screen Copy 1,0,0,Screen Width,Screen Height To 0,0,0
               Screen Close 1
            End If
            If Screen Height<200
               Screen Open 1,320,Screen Height,Screen Colour,Lowres
               Screen Copy 0 To 1
               Screen Open 0,320,200,Screen Colour,Lowres
               Screen Copy 1,0,0,320,Screen Height To 0,0,0
               Screen Close 1
            End If
            If Not Screen Colour=4096
               ' in case messed about with resolutions
               C=Screen Colour
               If C=64
                  C=32
               End If
               Dec C
               For T=0 To C
                  Colour T,CLRS(T)
               Next T
            End If
            _APPEAR[2,1]
            View
         Else
            REQ["No Such File","Cannot Load","Okay","Okay"]
         End If
      End If
   End If
   Goto HERE
   ERR: E=Errn
   MESS$="Error Number "
   MESS$=MESS$+Str$(E)
   M2$="Please Alert Author."
   M$="Oh" : M2$="No!!!"
   If E=88
      M2$="Disk Full"
   End If
   If E=83
      M2$="Disk not Validated"
   End If
   If E=84
      M2$="Disk Write Protected"
   End If
   If(E=89) or(E=90) or(E=91)
      M2$="File is Protected"
   End If
   If E=31
      M2$="Dodgy IFF Compression"
   End If
   If E=93
      M2$="Insert Disk"
   End If
   If E=92
      M2$="Not AmigaDOS"
   End If
   REQ[MESS$,M2$,M$,M1$]
   Resume HERE :
   HERE:
End Proc

Procedure RMOVECL[CL]

   Shared PPEN,BAK
   On Error Proc ERR
   Def Fn RED(TTUM)=TTUM/256
   Def Fn GREEN(TTUM)=(TTUM/16) mod 16
   Def Fn BLUE(TTUM)=TTUM mod 16

   Screen 0
   C=Screen Colour
   C=C-1
   If C<4095
      C=C mod 32
      For T=0 To C
         TMP=Colour(T)
         R= Fn RED(TMP)
         G= Fn GREEN(TMP)
         B= Fn BLUE(TMP)
         If CL=1
            R=0
         Else
            If CL=2
               G=0
            Else
               B=0
            End If
         End If
         TMP=R*256+G*16+B
         Colour T,TMP
      Next T
   End If

End Proc

Procedure GRID[S]

   On Error Proc ERR
   Shared PPEN

   Screen 0
   Ink PPEN
   WD=Screen Width
   HT=Screen Height
   For T=0 To WD Step S
      Draw T,0 To T,HT
   Next T

   For T=0 To HT Step S
      Draw 0,T To WD,T
   Next T

End Proc

Procedure FILE_PAL[C]

   Screen 0
   SAV=(C=1)
   PATHS$="**.**"
   DEF$=""
   MESS$="Select a Filename to"
   If SAV
      MESS2$="save palette as."
   Else
      MESS2$="load palette as."
   End If
   F$=Fsel$(PATH$,DEF$,MESS$,MESS2$)
   OK= Not(F$=DEF$)
   If OK
      If SAV
         If Not(Upper$(Right$(F$,4))=".PAL")
            F$=F$+".PAL"
         End If
      End If
      EXT=Exist(F$)
      If SAV
         If EXT
            OK=False
            REQ["File Already exists","Overwrite?","No","Yes"]
            OK=(Param=2)
         End If
      Else
         If Not EXT
            OK=False
            REQ["File Doesn't exist","","Oh","No!!"]
         End If
      End If
      If OK
         If SAV
            PAL_SAVE[0,F$]
         Else
            PAL_LOAD[0,F$]
            INIT_CLRS[False]
            View
         End If
      End If
   End If

End Proc

Procedure PAL_SAVE[SCR,NAME$]
   TEMP=Screen
   Screen SCR
   Bsave NAME$,Screen Base+98 To Screen Base+162
   Screen TEMP
End Proc

Procedure PAL_LOAD[SCR,NAME$]
   TEMP=Screen
   Screen SCR
   Bload NAME$,Screen Base+98
   Screen TEMP
End Proc

Procedure FONTS

   Hide On
   Get Fonts
   Show On
   Screen Open 1,320,100,2,Lowres
   Palette 0,$FFF
   Curs Off

   C=0
   Set Text 0
   Repeat
      Inc C
      A$=Font$(C)
   Until A$=""
   Dec C

   If C>0
      PTR=1 : ITALIC=0 : BOLD=0 : UNDER=0
      View
      Repeat

         Repeat
         Until Mouse Key=0

         F$=Font$(PTR)
         F=Instr(F$,".font")
         If F>0
            Mid$(F$,F,5)="     "
         End If
         NM$="Name :"+Left$(F$,29)
         SZ$="Size :"+Mid$(F$,30,4)
         Cls 0
         Pen 1 : Locate 1,1 : Print NM$ : Locate 1,2 : Print SZ$
         Locate 1,4 : Print "<" : Locate 4,4 : Print ">"
         Locate 7,4 : Print "Okay" : Locate 15,4 : Print "Italic"
         Locate 25,4 : Print "Bold" : Locate 19,5 : Print "UnderLine"
         Set Font PTR : Set Text STY : Ink 1
         Text 20,90,"Aa 123 Ss Mm ?"

         Repeat
         Until Not(Mouse Key=0)

         X=X Mouse : Y=Y Mouse

         If Y>80
            If Y<92
               If X>134
                  If X<214

                     If X<146
                        Dec PTR
                     Else
                        If X>157
                           If X<169
                              Inc PTR
                           Else
                              If X>182
                                 FIN=True
                              End If
                           End If
                        End If
                     End If

                  End If
               End If
            End If

            If Y<98
               If X>247
                  If X<360
                     If Y>90
                        If X>279
                           If X<352
                              UNDER=1-UNDER
                           End If
                        End If
                     Else
                        If Y>81
                           If X<295
                              ITALIC=1-ITALIC
                           Else
                              If X>325
                                 BOLD=1-BOLD
                              End If
                           End If
                        End If
                     End If
                  End If
               End If
            End If
         End If

         STY=ITALIC*4+BOLD*2+UNDER

         If PTR<1
            Inc PTR
         End If
         If PTR>C
            Dec PTR
         End If

      Until FIN

      Screen Close 1
      Screen 0
      Set Font PTR
      Set Text STY

   End If

End Proc

Procedure TXT

   Repeat
   Until Mouse Key=0

   Hide On
   Clear Key
   TX$="" : X=X Mouse : Y=Y Mouse
   X=X Screen(X) : Y=Y Screen(Y)
   Gr Writing 2
   P=1
   Repeat

      Text X,Y,TX$

      Repeat
         K$=Inkey$
         OK= Not(K$="")
      Until OK or Not(Mouse Key=0)

      Text X,Y,TX$

      If Not OK
         X=X Mouse : Y=Y Mouse
         X=X Screen(X) : Y=Y Screen(Y)
         FIN=(TX$="")
      Else
         FIN=(K$=Chr$(13))
         If Not FIN
            If K$=Chr$(8)
               If P>0
                  Dec P
                  TX$=Left$(TX$,P)
               End If
            Else
               TX$=TX$+K$
               Inc P
            End If
         End If
      End If

   Until FIN
   Gr Writing 0
   Show On
   Text X,Y,TX$

End Proc

Procedure CYCLE

   Shared PPEN,BAK

   A=Min(PPEN,BAK)
   B=Max(PPEN,BAK)
   Clear Key
   DEL=5
   UP=True : GO=True : F=False
   Hide On
   REQ["Rotate Colours","","Stop it!","Start it!"]
   Repeat
   Until Mouse Key=0

   If Param=2
      Repeat
         If Not GO
            Repeat
               K$=Inkey$
               F=(Mouse Key=0)
               F= Not F
            Until F or Not(K$="")
            S=Scancode
         End If

         If Not F

            If(S=76) or(S=62)
               UP=True : GO=True
            End If

            If(S=77) or(S=46)
               UP=False : GO=True
            End If

            If(S=74) or(S=11)
               Inc DEL : GO=True
            End If

            If(S=94) or(S=12)
               If DEL>1
                  Dec DEL : GO=True
               End If
            End If

            If GO
               GO=False
               Shift Off
               If UP
                  Shift Up DEL,A,B,1
               Else
                  Shift Down DEL,A,B,1
               End If
            End If
         End If

      Until(K$=Chr$(13)) or F

   Else
      Shift Off
      For T=0 To Screen Colour-1
         Colour T,CLRS(T)
      Next T
   End If
   Show On

End Proc

' You may find the following general purpose procedures useful.








' Splerge pours on a screen from the top, Source is the number of the
' Screen to be poured from. Dest is the unopened screen to be poured to.
' Speed is obiously the speed of the effect. the faster the messier though!
' Autoview should be off before the source screen is loaded, unpacked
' or whatever. the source will be closed after the pour.
Procedure SPLERGE[SPEED,SOURCE,DEST]
   If Not SOURCE=DEST
      Screen SOURCE
      V=Screen Height : H=Screen Width
      C=Screen Colour : R=Lowres
      If C<4096
         If H>320
            R=Hires
         End If
         If V>256
            R=R+Laced
         End If
         Repeat
         Until Mouse Key=0
         Screen Open DEST,H,V,C,R
         Flash Off : Curs Off
         For T=0 To C-1
            Screen SOURCE : CT=Colour(T)
            Screen DEST : Colour T,CT
         Next T
         View
         For LOP=V-SPEED To 0 Step -SPEED
            For LOP1=0 To LOP Step SPEED
               If Mouse Key>0
                  Goto OUCH
               End If
               Screen Copy SOURCE,0,LOP,H,LOP+SPEED To DEST,0,LOP1
            Next LOP1
         Next LOP
      End If
   End If
   Goto BACK
   OUCH: Screen Copy SOURCE To DEST
   Repeat
   Until Mouse Key=0
   BACK:
   If C<4096
      Screen Close SOURCE
   End If
   View
End Proc

' _Appear is a procedure Which I wrote and have submitted to the Amiga
' Shopper AMOS professional Contest. Del is the delay time, type can either
' be 0 or 1.
Procedure _APPEAR[DEL,TYPE]
   On Error Goto OHNO
   Def Fn RED(CLR)=CLR/256
   Def Fn GREEN(CLR)=(CLR/16) mod 16
   Def Fn BLUE(CLR)=CLR mod 16
   If TYPE>0
      TYPE=1
   Else
      TYPE=0
   End If
   CLRS=Screen Colour
   If CLRS=4096
   Else
      If CLRS=64
         CLRS=32
      End If
      CLRS=CLRS-1
      Dim CRED(CLRS),CGRN(CLRS),CBLU(CLRS)
      For T=0 To CLRS
         CLR=Colour(T)
         CRED(T)= Fn RED(CLR)
         CGRN(T)= Fn GREEN(CLR)
         CBLU(T)= Fn BLUE(CLR)
         Colour T,0
      Next T
      View
      STAGE=0
      If TYPE=0
         STAGE=3
      End If
      Repeat
         For S=0 To 15
            For T=0 To CLRS
               CLR=Colour(T)
               R= Fn RED(CLR)
               G= Fn GREEN(CLR)
               B= Fn BLUE(CLR)
               If TYPE=0
                  If R<CRED(T)
                     Inc R
                  End If
                  If G<CGRN(T)
                     Inc G
                  End If
                  If B<CBLU(T)
                     Inc B
                  End If
               Else
                  If STAGE=0
                     If R<CRED(T)
                        Inc R
                     End If
                  Else
                     If STAGE=1
                        If G<CGRN(T)
                           Inc G
                        End If
                     Else
                        If B<CBLU(T)
                           Inc B
                        End If
                     End If
                  End If
               End If
               CLR=R*256+G*16+B
               Colour T,CLR
            Next T
            T=0
            While T<DEL
               Wait Vbl
               T=T+1
            Wend
         Next S
         STAGE=STAGE+1
      Until STAGE>2
   End If
   Goto HERE
   OHNO: Resume HERE
   HERE:
End Proc

' From the AMOS Compiler disk. Shows the AMOS message. I have slightly
' changed it to fit in with my program. This is invisible to the user.
Procedure _SMALL_COPYRIGHT[YDISPLAY]
   '
   '
   Hide
   Break Off
   Screen Open 7,320,24,16,0 : Curs Off : Flash Off : Cls 0
   Screen Display 7,,-100,,
   Paste Bob 260,3,6
   Paper 0 : Pen 7 : Print At(1,1);"This program was written using"
   Get Sprite Palette
   View : Wait Vbl
   '
   For Y=1 To Screen Height/2
      Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
      Screen Offset 7,,Screen Height/2-Y
      View : Wait Vbl
   Next
   '
   Wait 100
   '
   For Y=Screen Height/2 To 0 Step -1
      Screen Display 7,,YDISPLAY+Screen Height/2-Y,,Y*2
      Screen Offset 7,,Screen Height/2-Y
      View : Wait Vbl
   Next
   '
   Screen Close 7
   Break On
   Show
   '
End Proc

' Wipes the screen s by drawing smaller and smaller boxes of colour 0.
' Then closing the screen. DEL is a delay
Procedure WIPE[S,DEL]

   Screen S : Ink 0
   W=Screen Width : H=Screen Height
   X1=0 : X2=W
   Y1=0 : Y2=H
   DL= Not(DEL=0)
   Dec DEL
   Repeat
      Box X1,Y1 To X2,Y2
      If DL
         For T=0 To DEL
            Wait Vbl
         Next T
      End If
      Inc X1 : Inc Y1
      Dec X2 : Dec Y2
      FIN=(Min(X1-1,X2)=X2) or(Min(Y1-1,Y2)=Y2)
      If Mouse Key>0
         FIN=True
      End If
   Until FIN
   Screen Close S
End Proc

' Closes all screens. Used at start to close default screen, and discovered
' errors in other procedures which would hav flummoxed me when I compiled
' without the default screen option. Closes screens using wipe.
Procedure SCLOSE

   S=Screen
   While S>-1
      WIPE[S,1]
      S=Screen
   Wend

End Proc