Amiga Format 42/af042a.adf/Sprite_Editor1_3.AMOS/Sprite_Editor1_3.amosSourceCode

AMOS Source Code | 1992-02-21 | 40KB | 1,984 lines

Set Buffer 11
Bgrab 1
A#=1.0
'Break Off
On Error Goto GENERALERROR
' do a Close Editor here if you desperately want more memory, but be
' warned, there is then no memory checking, so it could bomb out !
Dim C(7),C2(7),C3(7),SX(7),ST(7),NC(7),RGB(63),REZ$(7),OK$(1)
Dim LINE$(5),BUTTON$(2) : Rem for use with alert box routine
OK$(0)=" " : OK$(1)="*"
NCOLS=16 : XSIZE=32 : YSIZE=32
CVOL=62 : Rem click volume
APRD=6
AIR=4
STXSIZE=32 : STYSIZE=32 : STNCOLS=16
TPWIN=0
LFTWIN=0
REZ=1
XS=1
IN=1
FC=15
BC=2
FP=0
LEFTC=1 : RIGHTC=0
MDE=0 : Rem draw mode
Get Block 1,0,0,1,1 : Get Block 2,0,0,1,1
Fade 1
Rem Amos Sprite Editor V1.1 for AMOS1.3
Rem By Aaron Fothergill
Rem Shadow Software 1990
Rem for Mandarin/Jawx Software
For A=0 To 7 : Read SX(A),NC(A),ST(A),REZ$(A) : Next A
Data 320,8,Lowres,"Lowres 8 "
Data 320,16,Lowres,"Lowres 16"
Data 320,32,Lowres,"Lowres 32"
Data 320,64,Lowres,"Lowres 64"
Data 640,2,Hires,"Hires 2  "
Data 640,4,Hires,"Hires 4  "
Data 640,8,Hires,"Hires 8  "
Data 640,16,Hires,"Hires 16 "
Auto View Off
TITLEBAR
Auto View Off
Gosub SHWPSTE
CHANGEREZ
SPDISP=0
Screen To Front 1
Limit Mouse
Screen 1
CHANGEREZ
HILITE[21]
Screen 0
Limit Mouse
Reserve Zone 1
SETBUTZONE
SHWSPRITES[IN]
SHWFILL[FP]
Rem set up drawing screen zones
Gosub STORE
Do
   Screen 1
   If XSIZE mod 16>0
      XSIZE=(XSIZE/16)*16+16
      XSIZE=Min(96,XSIZE)
   End If
   If XSIZE>32 or YSIZE>32
      BIGSPR=1
      TPWO=-1 : LFTWO=-1
      LFTWIN=Max(0,Min(LFTWIN,XSIZE-32))
      TPWIN=Max(0,Min(TPWIN,YSIZE-32))
   Else
      BIGSPR=0
      LFTWIN=0
      TPWIN=0
   End If
   If NREZ=1
      If SPDISP=1
         Put Block 5,160*XS,7
         SPDISP=0
      End If
      Get Block 1,160*XS,7,XSIZE,YSIZE
   End If
   Wait Vbl
   Reserve Zone 8
   Set Zone 1,278*XS,3 To 310*XS,130
   FASTZOOM
   BXES
   FASTZOOM
   BIGBARS
   PALDRAW
   Screen To Front 1
   Auto View On
   NREZ=0
   MOF=1
   FXSCRN
   INO=IN
   While NREZ=0
      X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : K=Mouse Key
      SCRNCHK[X,Y]
      Z=Mouse Zone : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
      SHWSPO=SHWSP
      If SCRN=0 and((Z>44 and Z<50) or Z=39 or Z=40 or Z=9) and SPDISP=0 and IN<=Length(1)
         GMDE=0
         If Z=9
            GMDE=1
         End If
         SHWSP=1
      Else
         SHWSP=0
      End If
      If SPDISP=0
         If IN<>INO
            SHWSPO=-1
         End If
         INO=IN
         If SHWSP<>SHWSPO and SPDISP=0
            If SHWSP=1
               Screen 1
               If SHWSPO=0
                  Get Block 5,160*XS,7,96,128
                  B5=1
               End If
               Clip 160*XS,7 To 160*XS+95,135
               Ink 0 : Bar 160*XS,7 To 160*XS+95,135
               If GMDE=0
                  Paste Bob 160*XS,7,IN
               Else
                  Sprite 8,X Hard(1,160*XS),Y Hard(1,7),IN
               End If
               Screen 0
            Else
               If B5
                  TS=Screen
                  Screen 1
                  Put Block 5,160*XS,7
                  Sprite Off
                  Clip
                  Screen TS
               End If
            End If
         End If
      End If
      If((SCRN=0 and Z>10 and Z<19) or MDE=12) and SPDISP=0 and MDE<>13
         TS=Screen
         Screen 1
         XT=X : YT=Y : HTX=HX : HTY=HY
         X=(HX-LFTWIN)*MP+16 : Y=7+(HY-TPWIN)*MP
         Gosub GTBACK
         MT=MDE
         LC=LEFTC : RC=RIGHTC : LEFTC=NCOLS-1-Point(160*XS+HX,7+HY) : RIGHTC=LEFTC : MDE=0
         Gosub PLTPNT
         Wait Vbl
         Put Block 1,160*XS,7
         X=XT : Y=YT : HX=HTX : HY=HTY
         MDE=MT : LEFTC=LC : RIGHTC=RC
         FASTZOOM
         Screen TS
      End If
      A$=Inkey$
      If A$<>""
 SC=Scancode
SH=Scanshift
         Gosub KEYIN
      End If
      K=Mouse Key
      If K=0
         MOF=1 : TICK=0
      Else
         KPR=1
      End If
      If K=2 and MDE<>10
         DRG=1
      End If
      If(X<>XMSO or Y<>YMSO) and KPR=0 and SHWSP=0
         SC=Screen
         Screen 1
         Put Block 1,160*XS,7
         FASTZOOM
         Screen SC
      End If
      If SCRN=1 and SHWSP=0 and K=0 and Z=2 and DRG=0 and MDE>0 and SPDISP=0 and MDE<>8 and MDE<>13
         LPLT=1
         TIM=Timer
         If X<>XMSO or Y<>YMSO or(TIM mod 10<=4 and FLSH=0)
            FLSH=1
            If KPR=0
               Put Block 1,160*XS,7
            End If
            Gosub GTBACK
            KPR=0
            XT=X : YT=Y
            Gosub PLTPNT
            Wait Vbl
            Y=YT : X=XT
            FASTZOOM
         Else
            If TIM mod 10>4
               FLSH=0
            End If
         End If
      Else
         If LPLT=1
            LPLT=0
            SC=Screen
            Screen 1
            Put Block 1,160*XS,7
            FASTZOOM
            Screen SC
         End If
      End If
      YMSO=Y : XMSO=X
      If SCRN=1 and K>0 and SPDISP=0
         Rem see what happens when you put Z=mouse zone here !
         If Z=1
            Gosub STORE
            PICKCOL[X,Y,K]
         End If
         If Z=2
            REAL=1
            Gosub PLTPNT
            REAL=0
            Gosub GTBACK
            PLT=1
         End If
         If Z=3
            If MDE<>13
               If K=1
                  RESIZE[X,Y,K]
               End If
            Else
               REDUCEZOOM[X,Y,K]
            End If
         End If
      End If
      If SCRN=0 and K
         Gosub BUTTONS
      End If
   Wend
Loop
KEYIN:
A$=Upper$(A$)
KEYIN$=A$
SH=SH and 3
If BIGSPR
   FZ=0
   If SC=76 and SH=0
      TPWIN=Max(0,TPWIN-16)
      FZ=1
   End If
   If SC=77 and SH=0
      TPWIN=Max(0,Min(YSIZE-32,TPWIN+16))
      FZ=1
   End If
   If SC=79 and SH=0
      LFTWIN=Max(0,LFTWIN-16)
      FZ=1
   End If
   If SC=78 and SH=0
      LFTWIN=Max(0,Min(XSIZE-32*XS,LFTWIN+16))
      FZ=1
   End If
   If FZ
      FASTZOOM
      BIGBARS
   End If
End If
If SC=76 and SH
Bell
   Gosub GEDIT
   SHWSPRITES[IN]
End If
If SC=77 and SH
Bell
   Gosub SPGRAB
End If
If SC=79 and SH
Bell
   TI=IN-1
   Gosub GEDIT
   IN=Max(1,TI)
   Gosub SPGRAB
   SHWSPRITES[IN]
End If
If SC=78 and SH
Bell
   Gosub GEDIT
   If IN<Length(1)
      Inc IN
      Gosub SPGRAB
   End If
   SHWSPRITES[IN]
End If
If MDE<>6
   If SH=0 and SC>79 and SC<90
      If IN+SC-80<=Length(1)
Bell
         TI=IN : IN=IN+SC-80
         Gosub SPGRAB
         IN=TI
      End If
      SHWSPRITES[IN]
   End If
   If SH>0 and SC>79 and SC<90
      If IN+SC-80<=Length(1)+1
Bell
         TI=IN : IN=IN+SC-80
         Gosub GEDIT
         IN=TI
      End If
      SHWSPRITES[IN]
   End If
   If A$="L"
      Gosub LDSPRITES : A$=""
   End If
   If A$="S" and Length(1)>0
      Gosub SVSPRITES : A$=""
   End If
Else
   Gosub GTTXT
End If
Return
LDSPRITES:
Sprite Off
On Error Goto DISKERROR
F$=""
While F$=""
   F$=Fsel$("*.ABK","","Load A Sprite Bank")
   If F$<>""
      A$=Upper$(F$)
      If Right$(A$,4)=".ABK"
         Erase 1
         Load F$,1
         IN=1
         A$="" : For A=0 To 7 : A$=A$+Chr$(Peek(Start(1)-8+A)) : Next A
         If A$<>"Sprites "
            F$=""
            Erase 1
         End If
      Else
         F$=""
      End If
   Else
      F$=" "
   End If
Wend
NREZ=1
If Length(1)>0
   TS=Screen
   Screen 1
   Get Sprite Palette
   Screen TS
End If
On Error Goto GENERALERROR
Return
SVSPRITES:
Sprite Off
On Error Goto DISKERROR
F$="" : While F$=""
   F$=Fsel$("*.ABK","","Save a Sprite Bank")
   If F$<>""
      A$=Upper$(F$)
      If Right$(A$,4)=".ABK"
         Save F$,1
      Else
         F$=""
      End If
   Else
      F$=" "
   End If
Wend
NREZ=1
On Error Goto GENERALERROR
Return
PHONE:
T1=Z mod 8+64 : T2=Z mod 8+48+(Z/3) mod 3
Volume CVOL
Play 1,T1,0 : Play 2,T2,0
Play 3,T1,0 : Play 4,T2,0
Wait 2 : Volume 0
Return
BLL:
Volume CVOL
Bell
Wait 2 : Volume 0
Return
BUTTONS:
If Z>0
   On BLEEP+1 Gosub PHONE,BLL
End If
R=(Z-1)/10
C=(Z-1) mod 10
If Z=51
   R=4 : C=10
End If
If Z=52
   R=4 : C=11
End If
If(R<>2 or C<>9) and SPDISP=0 and MDE<>13
   Gosub STORE
End If
On R+1 Gosub ROW1,ROW2,ROW3,ROW4,ROW5
While Mouse Key<>0 and TICK<550
   If TICK>0
      Inc TICK
   End If
Wend : If TICK=550
   TICK=500
End If
Return
ROW1:
If C=9 and MDE<>13 and SPDISP=0
   SMDE=1
   Gosub SCRLLER
End If
If C=0
   MDE=9
   HILITE[Z]
End If
If C=1 and BLK4=1
   MDE=10
   DRG=0
   HILITE[Z]
End If
If C=2
   PSTMDE=1-PSTMDE
   Gosub SHWPSTE
End If
If C>2 and C<8
   On C-2 Gosub HNBR,HNTL,HNTR,HNBL,HNC
End If
If C=8
   GMDE=1-GMDE
End If
Return
HNBR:
HNX=XW : HNY=YH
Return
HNTL:
HNX=0 : HNY=0
Return
HNTR:
HNX=XW : HNY=0
Return
HNBL:
HNX=0 : HNY=YH
Return
HNC:
HNX=XW/2 : HNY=YH/2
Return
SHWPSTE:
Ink(1-PSTMDE)*5,0
Set Pattern 2*(1-PSTMDE)
Bar 82,21 To 89,28
Bar 77,27 To 89,28
Set Pattern 0
Return
ROW4:
If C=8 and IN>1
   TICK=Max(TICK,1)
   Dec IN
   SHWSPRITES[IN]
End If
If C=9
   IN=Max(1,Length(1))
   SHWSPRITES[IN]
End If
If C=0
   MDE=7
   DRG=1
   HILITE[Z]
End If
If C=4
   MDE=8
   HILITE[Z]
End If
If C=1 Then MDE=4 : DRG=1
If C=2 Then MDE=2 : DRG=1
If C=3 Then MDE=6 : DRG=0
If C>0 and C<4
   HILITE[Z]
End If
If C=5 and MDE<>13 and SPDISP=0
   Gosub VFLIP
End If
If C=6 and MDE<>13 and SPDISP=0
   SMDE=0
   Gosub SCRLLER
End If
If C=7 and MDE<>13 and SPDISP=0
   LINE$(0)="Clear Sprite"
   LINE$(1)="Are you sure?"
   BUTTON$(0)="Clear"
   BUTTON$(1)="Cancel"
   ALERT[26,7,1,0,2,2]
   If Q=1
      Gosub STORE
      Screen 1
      Set Paint 0
      Set Pattern FP
      Ink RIGHTC,LEFTC
      Bar 160*XS,7 To 160*XS+XSIZE-1,6+YSIZE
      Set Pattern 0
      FASTZOOM
      Screen 0
   End If
End If
Return
ROW3:
If C=9 and MDE<>13 and SPDISP=0
   Gosub UNDO
End If
If C=0
   HILITE[Z]
   MDE=0
   DRG=0
End If
If C=1 Then MDE=3 : MOF=1
If C=2 Then MDE=1 : DRG=1
If C=3 Then MDE=5 : DRG=1
If C>0 and C<4
   HILITE[Z]
End If
If C=8
   Dec FP
   FP=(FP+35) mod 35
   SHWFILL[FP]
End If
If C=7
   Gosub SELREZ
   SCRN=1
   NREZ=1
End If
If C=4 and MDE<>13 and SPDISP=0
   HILITE[Z]
   MDE=13
   Screen 1
   Ink BC,FC,BC
   Text 10,150,"Right Button Fixes,Change Mode to exit"
   Ink 0
   Bar 0,0 To 158*XS,138
   Screen 0
   Screen Copy 1,160*XS-1,6,160*XS+97,138 To 1,15,6
   SC4=1
End If
If C=5 and MDE<>13 and SPDISP=0
   Gosub HFLIP
End If
If C=6 and MDE<>13 and SPDISP=0
   Gosub ROTATE
End If
Return
ROW2:
If C=9 and MDE<>13 and SPDISP=0
   Gosub STORE
   Gosub SCRUNCH1
End If
If C=8 and MDE<>13 and SPDISP=0
   Gosub STORE
   Gosub SCRUNCH2
End If
If C>=0 and C<8 and MDE<>13 and SPDISP=0
   On C+1 Gosub HSTL,HSTR,HSBM,HSTM,HSBR,HSBL,HSC,HSUSER
End If
Return
HSTL:
HX=0 : HY=0 : Return
HSTR:
HX=XSIZE-1 : HY=0 : Return
HSBM:
HX=XSIZE/2 : HY=YSIZE-1 : Return
HSTM:
HX=XSIZE/2 : HY=0 : Return
HSBR:
HX=XSIZE-1 : HY=YSIZE-1 : Return
HSBL:
HX=0 : HY=YSIZE-1 : Return
HSC:
HX=XSIZE/2 : HY=YSIZE/2 : Return
HSUSER:
DRG=0
MDE=12
HILITE[Z]
Return
ROW5:
If C=0
   Gosub GTBACK
   CHANGERGB
   NREZ=1
End If
If C=2 and MDE<>13
   Gosub GEDIT
   SHWSPRITES[IN]
End If
If C=1 and MDE<>13
   Gosub INSIT
   SHWSPRITES[IN]
End If
If C=3 and IN<=Length(1) and MDE<>13
   Gosub SPGRAB
End If
If C=4 and IN<=Length(1)
   Del Bob IN
   SHWSPRITES[IN]
   INO=-1
End If
If C=5 and Length(1)>0
   LINE$(0)="Do you really want"
   LINE$(1)="to erase all your"
   LINE$(2)="Images ?"
   BUTTON$(0)="ERASE"
   BUTTON$(1)="CANCEL"
   ALERT[30,8,6,1,2,3]
   If Q=1
      If SMDE<2
         Erase 1
         IN=1
         SHWSPRITES[IN]
      Else
         Erase 2
      End If
   End If
End If
If C=6
   IN=1
   SHWSPRITES[IN]
End If
If C=8 and IN<=Length(1)
   Inc IN
   SHWSPRITES[IN]
   TICK=Max(1,TICK)
End If
If C=7
   If SREDO=1
      SREDO=0
      If SHWSP=1
         Screen 1
         Put Block 5,160*XS,7
         SHWSP=0
         SHWSPO=0
         Screen 0
      End If
      DISPSPRITES
      Auto View On
      SPDISP=1
   End If
   Clip
   SHWSPRITES[IN]
End If
If C=10
   Inc FP
   FP=FP mod 35
   SHWFILL[FP]
End If
If C=11
   Gosub NICENESS
End If
If C=9
   LINE$(0)="Are you sure you"
   LINE$(1)="Want to quit"
   BUTTON$(0)="Quit"
   BUTTON$(1)="Cancel"
   ALERT[20,7,1,2,2,2]
   If Q=1
      Default
      End
   End If
End If
Return
SPGRAB:
If IN<=Length(1)
   S=Screen
   Screen 1
   If SPDISP=1
      Put Block 5,160*XS,7
   End If
   SB=Sprite Base(IN)
   XSIZE=Min(96,Deek(SB)*16)
   YSIZE=Min(128,Deek(SB+2))
   If XSIZE>32 or YSIZE>32
      BIGSPR=1
   End If
   HX=Min(95,Deek(SB+6))
   HY=Min(127,Deek(SB+8))
   If SPDISP=0
      BXES
   End If
   Ink 0 : Bar 160*XS,7 To 160*XS+XSIZE-1,6+YSIZE
   Paste Bob 160*XS,7,IN
   If SPDISP=0
      FASTZOOM
      NREZ=1
   Else
      DISPSPRITES
      Auto View On
   End If
   Clip
   SHWSPRITES[IN]
   Screen S
Else
   Bell
End If
Return
HFLIP:
Screen Copy 1,160*XS,7,160*XS+XSIZE,7+YSIZE To 1,0,0
A=0 : Repeat
   Screen Copy 1,XSIZE-A-1,0,XSIZE-A,YSIZE To 1,160*XS+A,7
   Inc A
Until A=XSIZE
NREZ=1
Return
VFLIP:
Screen Copy 1,160*XS,7,160*XS+XSIZE,7+YSIZE To 1,0,0
A=0 : Repeat
   Screen Copy 1,0,YSIZE-A-1,XSIZE,YSIZE-A To 1,160*XS,7+A
Inc A : Until A=YSIZE
NREZ=1
Return
ROTATE:
Autoback 0
Screen 1
Screen Copy 1,160*XS,7,160*XS+XSIZE,7+YSIZE To 1,0,0
Cls 0,160*XS,7 To 160*XS+XSIZE,7+YSIZE
A=0 : Repeat : Ink FC : Plot 160*XS+96,6+A : Plot 159*XS,6+A
   Ink BC : Plot 160*XS+96,7+A : Plot 159*XS,7+A
   B=0 : Repeat : If A<YSIZE and B<XSIZE
         Ink Point(A,B) : Plot 160*XS+XSIZE-B-1,7+A
      End If
   Inc B : Until B=YSIZE
Inc A : Until A=XSIZE
Ink FC : Box 159*XS,6 To 160*XS+96,136
NREZ=1
Return
SHWCURS:
Gosub GTBACK
X2=(X-16)/MP : Y2=(Y-7)/MP
CLPIT
Paste Bob X2+160*XS,Y2+7,Length(1)
FASTZOOM
Clip
Put Block 1,160*XS,7
Return
Rem Plot point general draw routine
Rem lftwin & Tpwin are used when sprite is >64x64 to determine window area
PLTPNT:
X=(X-16)/MP+LFTWIN : Y=(Y-7)/MP+TPWIN
Y=Min(YSIZE-1,Y) : X=Min(XSIZE-1,X)
Set Paint 0
Set Pattern FP
If K=1 or REAL=0
   Ink LEFTC,RIGHTC,LEFTC
   If REAL=0 and TIM mod 20<=4
      Ink RIGHTC,LEFTC,RIGHTC
   End If
Else
   If K=2 or Rnd(1)=0
      Ink RIGHTC,LEFTC,RIGHTC
   Else
      Ink LEFTC,RIGHTC,LEFTC
   End If
End If
If K<>2 or MDE=0 or MDE=3 or MDE=6 or MDE=10 or MDE=12
   On MDE+1 Gosub PLT,BX,BR,DRW,AIR,ELLPS,FELLPS,LINE,FLL,CUT,PSTE,HTSPOT,HTSPOT
End If
Set Pattern 0
FASTZOOM
Return
HTSPOT:
If K>0
   HX=X : HY=Y
End If
Return
PLT:
Plot 160*XS+X,7+Y
Return
DRW:
If MOF=1
   LPX=X : LPY=Y
   MOF=0
End If
Draw 160*XS+LPX,7+LPY To 160*XS+X,7+Y : If REAL=1 Then LPX=X : LPY=Y
Return
DAIR:
A=0 : Repeat
   Plot 160*XS+X+Rnd(XW)-Rnd(XW),7+Y+Rnd(XW)-Rnd(XW)
Inc A : Until A>AIR
Return
BX:
If DRG
   Gosub STRETCH
Else
   CLPIT
   Box 160*XS+X-HNX,7+Y-HNY To 160*XS+X+XW-HNX,7+Y+YH-HNY
   Clip
End If
Return
STRETCH:
STX=X Mouse : STY=Y Mouse
CLPIT
Gosub GTBACK
OK=0
XO=-1 : YO=-1
LX=X+160*XS : LY=Y+7
Set Pattern FP
While OK=0
   K=Mouse Key : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
   X=(X-16)/MP+LFTWIN : Y=(Y-7)/MP+TPWIN
   If K=0
      OK=1
   End If
   If XO<>X or YO<>Y
      XO=X : YO=Y
      X=X+160*XS : Y=Y+7
      X1=Max(LX,160*XS) : X2=Max(160*XS,Min(X,160*XS+XSIZE))
      Y1=Max(LY,7) : Y2=Max(7,Min(7+YSIZE,Y))
      TX=Min(X1,X2) : BX=Max(X1,X2)
      TY=Min(Y1,Y2) : BY=Max(Y1,Y2)
      BX=Max(TX+1,BX) : BY=Max(TY+1,BY)
      Put Block 1,160*XS,7
      Ink LEFTC,RIGHTC
      On MDE Gosub SBX,SBR,SBR,SAIR,SELLPS,SELLPS,SLINE,SLINE,SBX
      FASTZOOM
   End If
Wend
Ink 0
Put Block 1,160*XS,7
XW=BX-TX : YH=BY-TY
DRG=0
Set Pattern 0
Clip
X Mouse=STX : Y Mouse=STY
Return
SBX:
Box TX,TY To BX,BY
Return
SBR:
Bar TX,TY To BX,BY
Return
SAIR:
D=Max((BX-TX)/2,1)
Circle TX+D,TY+D,D
Return
SELLPS:
DX=Max((BX-TX)/2,1) : DY=Max((BY-TY)/2,1)
Ellipse TX+DX,TY+DY,DX,DY
Return
SLINE:
Draw LX,LY To X,Y
Return
BR:
If DRG=1
   Gosub STRETCH
Else
   CLPIT
   Bar 160*XS+X-HNX,7+Y-HNY To 160*XS+X+XW-HNX,7+Y+YH-HNY
   Clip
End If
Return
AIR:
If DRG=1
   Gosub STRETCH
   XW=Max(1,Max(XW,YH)/2)
Else
   CLPIT
   Gosub DAIR
   Clip
End If
Return
ELLPS:
If DRG=1
   Gosub STRETCH
   XW=Max(1,XW/2) : YH=Max(1,YH/2)
HNX=XW : HNY=YH
Else
   CLPIT
   Ellipse 160*XS+X+XW-HNX,7+Y-HNY+YH,XW,YH
   Clip
End If
Return
FELLPS:
If DRG=1
   DRG=0
   TXT$=""
Else
   CLPIT
   Autoback 0
   Gr Writing 0
   Text 160*XS+X,7+Y,TXT$
   Gr Writing 1
   Clip
End If
Return
LINE:
If DRG=1
   Gosub STRETCH
   XW=X2-LX : YH=Y2-LY
Else
   CLPIT
   Draw 160*XS+X-HNX,7+Y-HNY To 160*XS+X+XW-HNX,7+Y+YH-HNY
   Clip
End If
Return
FLL:
Screen 1
Get Block 1,158*XS,5,100,135
Set Pattern FP
Set Paint 0
If K=2
   M=0
Else
   M=1
End If
Ink FC
Box 158*XS,5 To 160*XS+XSIZE+1,8+YSIZE
Ink BC
Box 159*XS,6 To 160*XS+XSIZE,7+YSIZE
Ink LEFTC,RIGHTC,LEFTC
Paint 160*XS+X,7+Y,M
Get Block 2,160*XS,7,XSIZE,YSIZE
Clip
Put Block 1,158*XS,5 : Put Block 2,160*XS,7
Return
CUT:
If K=1
   Gosub STRETCH
   Get Block 4,LX,LY,XW,YH,1
   HNX=0 : HNY=0
   MDE=10
   Screen 0
   HILITE[2]
   Screen 1
   BLK4=1
End If
Return
PSTE:
CLPIT
If PSTMDE=1 or K=2
   Ink 0
   Bar 160*XS+X-HNX,7+Y-HNY To 160*XS+X-HNX+XW-1,6+Y-HNY+YH
End If
If K<>2
   Put Block 4,160*XS+X-HNX,7+Y-HNY
End If
Clip
Return
GTTXT:
A$=KEYIN$
KEYIN$=""
If A$<>""
   If A$=Chr$(8)
      TXT$=Left$(TXT$,Len(TXT$)-1)
   End If
   If A$>=" "
      TXT$=TXT$+A$
   End If
End If
Return
SCRUNCH1:
Screen 1
SCY=-1
A=0 : Repeat : B=0 : Repeat : If Point(160*XS+B,7+A)>0 Then SCY=A : B=XSIZE : A=YSIZE
Inc B : Until B>=XSIZE : Inc A : Until A>=YSIZE
SCX=-1
A=0 : Repeat : B=0 : Repeat : If Point(160*XS+A,7+B)>0 Then SCX=A : B=YSIZE : A=XSIZE
Inc B : Until B>=YSIZE : Inc A : Until A>=XSIZE
If SCY>=0 and SCX>=0
   Screen Copy 1,160*XS+SCX,7+SCY,160*XS+XSIZE,7+YSIZE To 1,160*XS,7
   CLPIT
   Ink 0 : Bar 160*XS,7+YSIZE-SCY To 160*XS+XSIZE+1,7+YSIZE+1
   Bar 160*XS+XSIZE-SCX,7 To 160*XS+XSIZE+1,7+YSIZE+1
   FASTZOOM
   Clip
End If
Screen 0
SREDO=1
Return
SCRUNCH2:
Gosub SCRUNCH1
Screen 1
SCX=XSIZE
A=XSIZE-1 : Repeat : B=YSIZE-1 : Repeat : If Point(160*XS+A,7+B)>0 Then SCX=A : B=0 : A=0
Dec B : Until B<0 : Dec A : Until A<0
A=YSIZE-1 : Repeat : B=XSIZE-1 : Repeat : If Point(160*XS+B,7+A)>0 Then SCY=A : B=0 : A=0
Dec B : Until B<0 : Dec A : Until A<0
XSIZE=Max(16,SCX+1) : YSIZE=Max(1,SCY+1)
NREZ=1
Screen 0
Return
Rem this routine grabs the data as a sprite,bob or icon
Rem IN = image number to grab to
Rem HX & HY contain the Hot Spot location
INSIT:
SC=Screen
Screen 1
If IN<=Length(1)
   Ins Sprite IN
End If
Gosub GEDITBOB
If IN=Length(1) and OK=1
   Inc IN
End If
Screen SC
Return
GEDIT:
SC=Screen
Screen 1
Gosub GEDITBOB
If IN=Length(1) and OK=1
   Inc IN
End If
Screen SC
Return
GEDITBOB:
On Error Goto FAIL
OK=1
If SPDISP=1 and Screen=0 and SREDO=1
   Put Block 5,160*XS,7
End If
Get Bob IN,160*XS,7 To 160*XS+XSIZE,7+YSIZE
Hot Spot IN,HX,HY
If SPDISP=1
   DISPSPRITES
   Auto View On
End If
FAILSAFE:
On Error Goto GENERALERROR
Return
FAIL:
SC=Screen
Screen 0
LINE$(0)="Not Enough Memory"
LINE$(1)="to store image..."
BUTTON$(0)="O.K"
ALERT[30,7,6,1,1,2]
Screen SC
NREZ=1
OK=0
Resume FAILSAFE
GTBACK:
Del Block 1
SC=Screen
Screen 1
Get Block 1,160*XS,7,Max(16,XSIZE),Max(16,YSIZE)
Screen SC
Return
STORE:
XSIZE=Max(16,XSIZE) : YSIZE=Max(1,YSIZE)
S=Screen
Screen 1
Del Block 2
Get Block 2,160*XS,7,XSIZE,YSIZE
A=0 : Repeat : RGB(A)=Colour(A) : Inc A : Until A=Min(31,NCOLS)
STNCOLS=NCOLS : STXSIZE=XSIZE : STYSIZE=YSIZE
STBIG=BIGSPR : STTL=LFTWIN : STTP=TPWIN
Screen S
Return
UNDO:
S=Screen
Screen 1
XSIZE=STXSIZE : YSIZE=STYSIZE : NCOLS=STNCOLS
BIGSPR=STBIG : LFTWIN=STTL : TPWIN=STTP
A=0 : Repeat : Colour A,RGB(A) : Inc A : Until A=Min(31,NCOLS)
BXES
Put Block 2,160*XS,7
FASTZOOM
BIGBARS
PALDRAW
Screen S
Return
SCRLLER:
TS=Screen
Screen 0
Del Block 1
Get Block 1,208,10,80,64
Ink 0
Bar 209,11 To 274,60
Bar 214,16 To 279,65
Screen Copy 0,0,96,64,144 To 0,210,12
Reset Zone
Reserve Zone 4
Set Zone 1,234,20 To 250,36
Set Zone 2,234,36 To 250,52
Set Zone 3,218,28 To 234,44
Set Zone 4,250,28 To 266,44
If SMDE=1
   Screen 1
   Get Block 3,160*XS,7,XSIZE,YSIZE
   Screen 0
End If
OK=0
TMR=0
While OK=0
   K=Mouse Key : Z=Mouse Zone
   If K=0
      TMR=0
   End If
   If K=2
      OK=1
   Else
      If K=1
         On Z Gosub SUP,SDOWN,SLEFT,SRIGHT
         If SMDE=1
            Gosub SIZEREDO
            NREZ=1
         Else
            FASTZOOM
         End If
         While Mouse Key<>0 and TMR<500 : Inc TMR : Wend
      End If
   End If
Wend
Put Block 1,208,10
SETBUTZONE
Return
SUP:
If SMDE=0
   Screen 1
   Get Block 3,160*XS,7,XSIZE,1
   Screen Copy 1,160*XS,8,160*XS+XSIZE,7+YSIZE To 1,160*XS,7
   Put Block 3,160*XS,6+YSIZE
   Del Block 3
   Screen 0
Else
   If YSIZE>1
      Dec YSIZE
   End If
End If
Return
SDOWN:
If SMDE=0
   Screen 1
   Get Block 3,160*XS,6+YSIZE,XSIZE,1
   Screen Copy 1,160*XS,7,160*XS+XSIZE,6+YSIZE To 1,160*XS,8
   Put Block 3,160*XS,7
   Del Block 3
   Screen 0
Else
   If YSIZE<128
      Inc YSIZE
   End If
End If
Return
SLEFT:
If SMDE=0
   Screen 1
   Get Block 3,160*XS,7,1,7+YSIZE
   Screen Copy 1,160*XS+1,7,160*XS+XSIZE,7+YSIZE To 1,160*XS,7
   Put Block 3,160*XS+XSIZE-1,7
   Del Block 3
   BXES2
   Screen 0
Else
   If XSIZE>16
      Add XSIZE,-16
   End If
End If
Return
SRIGHT:
If SMDE=0
   Screen 1
   Get Block 3,160*XS+XSIZE-1,7,1,YSIZE,1
   Screen Copy 1,160*XS,7,160*XS+XSIZE-1,7+YSIZE To 1,160*XS+1,7
   Ink 0
   Draw 160*XS,7 To 160*XS,6+YSIZE
   Put Block 3,160*XS,7
   Del Block 3
   BXES2
   Screen 0
Else
   If XSIZE<96
      Add XSIZE,16
   End If
End If
Return
SIZEREDO:
Screen 1
Cls 0,159*XS,7 To 160*XS+96,136
Put Block 3,160*XS,7
Ink FC,BC
Box 159*XS,6 To 160*XS+96,136
Box 159*XS,6 To 160*XS+XSIZE,7+YSIZE
Ink BC,FC,BC
Text 120*XS-(XS=2)*100,150,"Size X:"+Right$(" "+Str$(XSIZE),2)+" Y:"+Right$("  "+Str$(YSIZE),3)
Screen 0
Return
NICENESS:
Screen 0
Reset Zone
Reserve Zone 20
Del Block 1
Get Block 1,48,0,240,96
Ink 0 : Bar 52,4 To 274,94
Ink 2 : Bar 48,0 To 270,90
Ink 1 : Polyline 48,90 To 48,0 To 270,0
Ink 7 : Polyline 49,90 To 270,90 To 270,1
Ink 6 : Bar 49,55 To 180,89
Set Paint 1
Ink 0,0,1 : Bar 80,80 To 114,88
Set Zone 1,81,81 To 113,87
Bar 230,16 To 264,25
Set Zone 8,231,17 To 263,24
Set Paint 0
Ink 1,6
Text 54,87,"Vol"
CX=CVOL/2
AX=AIR
Gosub VOLSLIDE
Gosub AIRSLIDE
SMALLBUTTON[2,"O.K",224,70]
QUADBUTTON[3,"Niceness Page",52,4]
QUADBUTTON[3,"Background Col",52,22]
QUADBUTTON[4,"Foreground Col",52,38]
Ink 1,6
Text 52,66,"Button"
Text 52,76,"Click"
Ink 1,2
Text 185,12,"Airbrush"
Text 185,22,"Power"
TWINBUTTON[5,"Tone "+OK$(1-BLEEP),116,56]
TWINBUTTON[6,"Bell "+OK$(BLEEP),116,72]
TWINBUTTON[7,"Credits",192,52]
Ink 3,2
Text 185,36,"Free Mem"
Text 185,46,Str$(Int(((Fast Free+Chip Free)*100)/1024.0)/100.0)+" K"
OK=0
While OK=0
   While Mouse Key=0 : Wend : Z=Mouse Zone
   If Z=5
      BLEEP=0
      TWINBUTTON[5,"Tone *",116,56]
      TWINBUTTON[6,"Bell  ",116,72]
   End If
   If Z=6
      BLEEP=1
      TWINBUTTON[5,"Tone  ",116,56]
      TWINBUTTON[6,"Bell *",116,72]
   End If
   If Z=1
      CX=(X Screen(X Mouse)-81)
      Gosub VOLSLIDE
   End If
   If Z=8
      AX=(X Screen(X Mouse)-231)
      Gosub AIRSLIDE
   End If
   If Z=2
      OK=1
   End If
   If Z=7
      CREDITS
   End If
   If Z=3
      Inc BC
      BC=BC mod NCOLS
      If BC=FC
         Inc BC
         BC=BC mod NCOLS
      End If
      BXES3
      PALDRAW
      Screen 0
   End If
   If Z=4
      Inc FC
      FC=FC mod NCOLS
      If FC=BC
         Inc FC
         FC=FC mod NCOLS
      End If
      BXES3
      PALDRAW
      Screen 0
   End If
Wend
Put Block 1,48,0
SETBUTZONE
Screen 0
Return
VOLSLIDE:
Ink 0 : Bar 81+CVOL/2,81 To 82+CVOL/2,87
Bar 81,82 To 82+CVOL/2,86
CVOL=Max(0,Min(CX,31))*2
Ink 2 : Bar 81,82 To 82+CVOL/2,86
Ink 3 : Bar 81+CVOL/2,81 To 82+CVOL/2,87
Return
AIRSLIDE:
Ink 0 : Bar 231+AIR,18 To 232+AIR,24
Bar 231,19 To 232+AIR,23
AIR=Max(0,Min(AX,31))
Ink 5 : Bar 231,19 To 232+AIR,23
Ink 3 : Bar 231+AIR,18 To 232+AIR,24
Return
SELREZ:
Screen 0
Reset Zone
Reserve Zone 8
Del Block 1
Get Block 1,48,0,240,96
Ink 0 : Bar 52,4 To 274,94
Ink 6 : Bar 48,0 To 270,90
Ink 1 : Polyline 48,90 To 48,0 To 270,0
Ink 7 : Polyline 49,90 To 270,90 To 270,1
Ink 1,2
A=0 : Repeat : B=0 : Repeat
      TRIBUTTON[1+B*4+A,REZ$(B*4+A),64+B*96,A*16+20]
Inc B : Until B=2 : Inc A : Until A=4
Screen Copy 0,128,96,256,112 To 0,96,4
Ink 0,3
Text 100,14,"Select Mode"
REZ=-1
While REZ=-1
   While Mouse Key=0 : Wend : Z=Mouse Zone : While Mouse Key<>0 : Wend
   If Z>0
      REZ=Z-1
   Else
      Bell
   End If
Wend
Put Block 1,48,0
Screen 1
Get Block 1,160*XS,7,96,128
Screen Close 1
CHANGEREZ
SETBUTZONE
Screen 1
Put Block 1,160*XS,7
Screen 0
Return
Procedure SMALLBUTTON[BN,T$,BX,BY]
   Screen Copy 0,96,96,128,112 To 0,BX,BY
   Set Zone BN,BX,BY To BX+32,BY+16
   Ink 1,5 : Text BX+4,BY+10,T$
End Proc
Procedure TWINBUTTON[BN,T$,BX,BY]
   Screen Copy 0,96,112,160,128 To 0,BX,BY
   Set Zone BN,BX,BY To BX+64,BY+16
   Ink 1,6 : Text BX+4,BY+10,T$
End Proc
Procedure TRIBUTTON[BN,T$,BX,BY]
   Screen Copy 0,160,112,256,128 To 0,BX,BY
   Set Zone BN,BX,BY To BX+96,BY+16
   Ink 1,2 : Text BX+4,BY+10,T$
End Proc
Procedure QUADBUTTON[BN,T$,BX,BY]
   Screen Copy 0,128,96,256,112 To 0,BX,BY
   Set Zone BN,BX,BY To BX+128,BY+16
   Ink 0,3 : Text BX+4,BY+10,T$
End Proc
Procedure CHANGERGB
   Shared FC,BC,REZ,NCOLS,XS
   Dim RGB(31)
   SC=Screen
   Screen 1
   Del Block 1
   Get Block 1,8,3,256,112
   Limit Mouse
   Reset Zone
   Reserve Zone 40
   Ink 0,0
   Bar 13,8 To 217,112
   Ink FC,BC
   Bar 8,3 To 212,107
   Ink BC,FC
   Box 9,4 To 211,106
   Ink BC,FC
   A=0 : Repeat
      Bar 15+A*20,6 To 30+A*20,104
      Set Zone A+1,15+A*20,6 To 30+A*20,104
      Inc A
   Until A=3
   A=0 : Repeat
      Draw 10,6+A*6 To 75,6+A*6
      Inc A
   Until A=17
   A=0 : Repeat
      Ink A,A : X=A mod 8 : Y=A/8
      Bar X*16+80,Y*16+8 To X*16+95,Y*16+23
      Set Zone A+4,X*16+80,Y*16+8 To X*16+95,Y*16+23
      RGB(A)=Colour(A)
   Inc A : Until A>=Min(32,NCOLS)
   Ink BC,FC
   Box 79,7 To 96+16*X,24+16*Y
   Box 80,90 To 140,100
   Text 86,98,"Cancel"
   Box 152,90 To 202,100
   Text 165,98,"O.K"
   Set Zone 36,80,90 To 140,100
   Set Zone 37,152,90 To 202,100
   Ink SELCOL
   Bar 195,78 To 201,87
   Ink BC : Box 194,77 To 202,88
  SFADERS[SELCOL]
   OK=0 : While OK=0
      While Mouse Key=0 : Wend : YM=Y Screen(Y Mouse) : Z=Mouse Zone
      If Z>0 and Z<4
         CFADERS[SELCOL,Z-1,YM]
         SFADERS[SELCOL]
      End If
      If Z>3 and Z<36
         SELCOL=Z-4
Ink SELCOL
Bar 195,78 To 201,87
         SFADERS[SELCOL]
         Ink SELCOL
      End If
      If Z=37
         OK=1
      End If
      If Z=36
         A=0 : Repeat
            Colour A,RGB(A) : SPCOL[A,RGB(A)]
         Inc A : Until A>=Min(32,NCOLS)
         OK=1
      End If
   Wend
   Put Block 1,8,3
   Screen SC
End Proc
Procedure CFADERS[S,F,YM]
   Dim R(2)
   C=Colour(S)
   R(0)=C/256
   R(1)=(C/16) mod 16
   R(2)=C mod 16
   V=Max(0,Min(15,15-(YM-7)/6))
   R(F)=V
   Colour S,(R(0)*256+R(1)*16+R(2))
   SPCOL[S,Colour(S)]
End Proc
Procedure SFADERS[S]
   Shared RGBO,BC,FC
   Dim R(2)
   C=RGBO
   R(0)=C/256
   R(1)=(C/16) mod 16
   R(2)=C mod 16
   Ink BC,BC
   A=0 : Repeat
      V=(15-R(A))*6 : Bar 17+20*A,7+V To 28+20*A,12+V
      Inc A
   Until A=3
   C=Colour(S)
   RGBO=C
   R(0)=C/256
   R(1)=(C/16) mod 16
   R(2)=C mod 16
Ink BC,FC
Text 80,85,"Col"+Right$(" "+Str$(S),2)+" Val:$"+Right$("000"+Mid$(Hex$(RGBO),2),3)
   Ink FC,FC
   A=0 : Repeat
      Ink FC,FC
      V=(15-R(A))*6 : Box 17+20*A,7+V To 28+20*A,12+V
      Ink S
      Bar 18+20*A,8+V To 27+20*A,11+V
      Inc A
   Until A=3
End Proc
Procedure SPCOL[A,B]
   If Length(1)>0
      Doke Start(1)+2+8*Length(1)+2*A,B
   End If
End Proc
Procedure CHANGEREZ
   Shared SREDO,FC,BC,REZ,NCOLS,XS,NC(),SX(),ST()
   Auto View Off
   Screen Open 1,SX(REZ),160,NC(REZ),ST(REZ)
   Flash Off
   NCOLS=NC(REZ) : XS=SX(REZ)/320
   Screen Display 1,,140,,160
   Curs Off
   FC=NCOLS-1 : BC=0 : A=0 : Repeat : If Colour(FC)=0 and Colour(A)>0 Then FC=A
      If Colour(BC)>Colour(A) Then BC=A
   Inc A : Until A=NCOLS
   Ink 0 : Bar 0,0 To 320*XS,160
   Auto View On
   SREDO=1
   If Length(1)>0
      Get Sprite Palette
   End If
End Proc
Procedure SCRNUP
   If Ntsc=-1
      Screen Display 1,,80,,160
   Else
      Screen Display 1,,140,,160
   End If
End Proc
Procedure SCRNDOWN
   Screen Display 1,,140,,160
End Proc
Rem alert box routine without using the window commands
Rem uses the arrays line$() and button$()
Procedure ALERT[W,H,C1,C2,NB,NL]
   Shared Q,LINE$(),BUTTON$()
   Reset Zone
   Reserve Zone 3
   W=W*8
   H=H*8
   X=160-W/2
   Y=50-H/2
   Get Block 1,X,Y,W+16,H+16
   Ink 0
   Bar X+5,Y+5 To X+W+5,Y+H+5
   Ink C1
   Bar X,Y To X+W,Y+H
   Ink C2
   Box X+1,Y+1 To X+W-1,Y+H-1
   S=W/8/(NB+1)+1
   Paper C1
   Pen C2
   Curs Off
   A=0 : While A<NB
      Locate X Text(X)+S/2+S*A,Y Text(Y+H)-2
      Print Border$(Zone$(BUTTON$(A),1+A),2);
   Inc A : Wend
   A=0 : While A<NL
      Locate 0,Y Text(Y)+1+A
      Centre LINE$(A)
      Inc A
   Wend
   Q=0
   While Q=0
      While Mouse Key=0 : Wend
      Z=Mouse Zone
      If Z<1 or Z>1+NB
         Bell
      Else
         Q=Z
      End If
   Wend
   Put Block 1,X,Y
   SETBUTZONE
End Proc
Procedure SETBUTZONE
   Screen 0
   Reset Zone
   Reserve Zone 60
   A=0
   Repeat
      B=0
      Repeat
         Set Zone A*10+B+1,B*32,A*16+16 To B*32+32,A*16+32
         Inc B
      Until B=10
      Inc A
   Until A=5
   Set Zone 29,256,48 To 272,64
   Set Zone 51,272,48 To 288,64 : Set Zone 52,288,64 To 320,80
   Set Zone 47,192,80 To 208,96 : Set Zone 39,208,80 To 224,96
   Set Zone 49,256,80 To 272,96 : Set Zone 40,272,80 To 288,96
   Set Zone 30,288,48 To 320,64
End Proc
Procedure CLPIT
   Shared XS,XSIZE,YSIZE
   Clip 160*XS,7 To 160*XS+XSIZE,7+YSIZE
End Proc
Procedure TITLEBAR
   Shared C(),C2()
   Change Mouse 3
   Auto View Off
   Flash Off
   Curs Off
   Hide On
   Unpack 6 To 2
   Screen Display 2,,40,,16
   A=0 : Repeat : C(A)=Colour(A) : C2(A)=0 : Colour A,0 : Inc A : Until A=8
   CPAUSE[1,0]
   Auto View On
   Screen To Front 2
   B=0 : T=0
   While B<>999
      Read B,B2
      If B<>999
         C2(B)=$FFF : C2(B2)=$FFF
         OT=T
         While T<OT+2
            NEATFADE
            Inc T
         Wend
      End If
   Wend
   OT=T : D=6
   While T<OT+D
      NEATFADE
      Inc T
   Wend
   Colour 1,$FFF
   Screen 0
   Show On
   Screen Display 0,,40,,96
   Screen Copy 2,0,0,320,144 To 0,0,0
   Fade 3 To 2
   Wait 15
   Screen Close 2
   Auto View On
   Data 4,4,3,5,2,6,7,7,999,999
End Proc
Procedure CPAUSE[C,C2]
   While Colour(C)<>C2 : Wend
End Proc
Procedure NEATFADE
   Shared C(),C2(),C3(),GTG
   Dim R(5)
   A=0 : Repeat
      CO=Colour(A)
      R(0)=CO/256
      R(1)=(CO mod 256)/16
      R(2)=CO mod 16
      R(3)=C2(A)/256
      R(4)=(C2(A) mod 256)/16
      R(5)=C2(A) mod 16
      R=0 : Repeat
         If R(R)<R(R+3)
            R(R)=R(R)+3 : R(R)=Min(R(R),R(R+3))
         End If
         If R(R)>R(R+3)
            R(R)=R(R)-3 : R(R)=Max(R(R),R(R+3))
         End If
         Inc R
      Until R=3
      CO=R(0)*256+R(1)*16+R(2)
      Colour A,CO
      If CO=$FFF
         C2(A)=C(A)
         C3(A)=1
      End If
      Inc A
   Until A=8
End Proc
Procedure FXSCRN
   Shared SCRN
   Y=Y Mouse
   If Y>141
      SCRN=1
      Screen 1
      SCRNUP
      Screen To Front 1
      Change Mouse 2
   Else
      SCRN=0
      Screen 0
      SCRNUP
      Screen To Front 0
      Change Mouse 1
   End If
   View
   Limit Mouse
End Proc
Procedure SCRNCHK[X,Y]
   Shared SREDO,NREZ,SPDISP,SCRN,SCRNO
   If SCRN=0 and Y>98
      SCRN=1
      Screen 1
      SCRNUP
      If SPDISP=1
         NREZ=1
         SREDO=1
         Put Block 5,160*XS,7
      End If
      Screen To Front 1
      Change Mouse 2
      Y=Y Hard(1,3)
   End If
   If SCRN=1 and Y<=1
      SCRN=0
      Screen 0
      SCRNDOWN
      Screen To Front 0
      Change Mouse 1
      Y=Y Hard(0,95)
   End If
   If SCRN<>SCRNO
      SCRNO=SCRN
      View
      Limit Mouse
      Y Mouse=Y
   End If
End Proc
Procedure REDUCEZOOM[X,Y,K]
   Shared NREZ,BC,FC,XS,XSIZE,YSIZE
   Screen 1
   Zoom 1,16,7,16+XSIZE,7+YSIZE To 1,160*XS,7,Max(X,160*XS+1),Max(Y,8)
   Ink 0
   If X<160*XS+95
      Bar X,7 To 160*XS+95,135
   End If
   If Y<135
      Bar 160*XS,Y To 160*XS+95,135
   End If
   If K=2
      XSIZE=X-160*XS : YSIZE=Y-7
      Screen Copy 1,160*XS,7,160*XS+96,135 To 1,16,7
   Else
      If K=0
         Screen Copy 1,16,7,112,135 To 1,160*XS,7
      End If
   End If
End Proc
Procedure RESIZE[X,Y,K]
   Shared NREZ,BC,FC,XS,XSIZE,YSIZE
   Screen 1
   Get Block 1,160*XS,7,XSIZE,YSIZE
   OK=0
   Ink BC,FC,BC
   Text 10,150," Press Right Button when done "
   While OK=0
      K=0
      While K=0
         Z=Mouse Zone
         K=Mouse Key
         X=X Screen(X Mouse)
         Y=Y Screen(Y Mouse)
      Wend
      If K=1 and Z=3
         X=(X-160*XS)
         Y=(Y-7)
         X=Max(16,X)
         Y=Max(1,Y)
         XSIZE=X : YSIZE=Y
         X=X mod 16
         If X>0
            XSIZE=(XSIZE/16)*16+16
         End If
         Cls 0,159*XS,7 To 160*XS+96,136
         Ink FC,BC
         Box 159*XS,6 To 160*XS+96,136
         Put Block 1,160*XS,7
         Ink FC,BC : Box 159*XS,6 To 160*XS+XSIZE,7+YSIZE
      Else
         OK=1
      End If
   Wend
   NREZ=1
End Proc
Procedure PICKCOL[X,Y,K]
   Shared NCOLS,REZ,XS,BC,FC,LEFTC,RIGHTC
   If K=1
      LEFTC=Point(X,Y)
   Else
      RIGHTC=Point(X,Y)
   End If
   PALDRAW2
End Proc
Procedure PALDRAW
   Shared NCOLS,REZ,XS,BC,FC,LEFTC,RIGHTC,XSIZE,YSIZE
   If Colour(BC)/2=Colour(FC)/2
      FC=1
      BC=0
      Set Pattern 2
   End If
   REZ$=" Low"
   If XS>1 Then REZ$="High"
   Auto View Off
   Screen 1
   X=NCOLS/8
   If X<1 Then X=1
   Y=8 : If NCOLS<8 Then Y=NCOLS
   S=32/X*XS
   Set Paint 1
   Ink FC,BC,FC
   Bar 269*XS,2 To 319*XS,142
   Bar 0,142 To 320*XS,152
   Ink BC,FC,BC
   Text 269*XS,150,REZ$
   Set Paint 0
   Ink 0,0,0
   Bar 277*XS,6 To 279*XS+X*S-1,23+(Y-1)*16
   A=0 : Repeat : B=0 : Repeat
         Ink A*8+B
         Bar 278*XS+A*S,7+B*16 To 278*XS+(A+1)*S-1,22+B*16
      Inc B : Until B>=Y
   Inc A : Until A=X
   Ink BC,FC,BC
   Text 120*XS-(XS=2)*100,150,"Size X:"+Right$(" "+Str$(XSIZE),2)+" Y:"+Right$("  "+Str$(YSIZE),3)
   PALDRAW2
End Proc
Procedure PALDRAW2
   Shared FC,BC,LEFTC,RIGHTC,XS,NCOLS
   Set Paint 1
   Y=8 : If NCOLS<8 Then Y=NCOLS
   Ink LEFTC,BC,BC
   Bar 272*XS,7 To 275*XS,7+Y*16
   Ink RIGHTC,BC,BC
   Bar 313*XS,7 To 316*XS,7+Y*16
   Set Paint 0
End Proc
Procedure HILITE[B]
   Shared BO,SC4,NREZ,HNX,HNY
HNX=0 : HNY=0
   If SC4=1
      SC4=0
      NREZ=1
   End If
   Screen 0
   If B<>0
      Ink 0 : BX=(BO-1) mod 10 : BY=(BO-1)/10 : Box BX*32,BY*16+16 To BX*32+31,BY*16+31
      Ink 1 : BX=(B-1) mod 10 : BY=(B-1)/10 : Box BX*32,BY*16+16 To BX*32+31,BY*16+31
      BO=B
   End If
End Proc
Procedure SHWFILL[F]
   Set Paint 1
   Set Pattern F
   Ink 1,0
   Bar 260,68 To 284,76
   Set Paint 0
   Set Pattern 0
End Proc
Procedure SHWSPRITES[B]
   Shared SPDISP,XS,FC,BC
   SC=Screen
   Screen 0
   Ink 0,3
   Text 228,91,Right$("000"+Mid$(Str$(B),2),3)
   If SPDISP=1
      Screen 1
      A=-1 : Repeat : S=B+A
         If S>0 and S<=Length(1)+1
            Ink FC : Box 8*XS-1+(A+1)*104*XS,15 To 104*XS+1+(A+1)*104*XS,145
            If S<=Length(1)
               SB=Sprite Base(S)
               X=Deek(SB)*16 : Y=Deek(SB+2)
               HX=Deek(SB+6) : HY=Deek(SB+8)
               XV=(52*XS)-X/2
               YV=64-Y/2
               Bob A+1,(A+1)*104*XS+8*XS+HX+XV,16+HY+YV,S
               Ink BC,FC,BC : Text(A+1)*104*XS+8*XS,8,Right$("  "+Str$(S),3)+" Plns"+Str$(Deek(SB+4))
               Text(A+1)*104*XS+8*XS,154," X:"+Right$(" "+Str$(X),2)+" Y:"+Right$("  "+Str$(Y),3)+" "
            Else
               Bob Off A+1
               Ink BC,FC,BC : Text(A+1)*104*XS+8*XS,8,Right$("   "+Str$(S),3)+" Empty "
               Text(A+1)*104*XS+8*XS,154,"Blank Sprite"
            End If
         Else
            Bob Off A+1
            Ink 0 : Bar 8*XS-1+(A+1)*104*XS,0 To 104*XS+1+(A+1)*104*XS,160
         End If
         Inc A
      Until A=2
   End If
   Screen SC
End Proc
Procedure DISPSPRITES
   Shared SPDISP,XS,NC(),SX(),ST(),FC,REZ,XSIZE,YSIZE
   SC=Screen
   Screen 1
   Clip
   Get Block 5,160*XS,7,XSIZE,YSIZE
   Ink 0 : Bar 0,0 To 320*XS,160
   If Length(1)>0
      Get Sprite Palette
   End If
   Screen SC
   Screen To Front SC
End Proc
Procedure BXES
   Shared BIGSPR,LFTO,TPWO,LFTWIN,TPWIN,NCOLS,FC,BC,XS,XSIZE,YSIZE,MP
   TXS=XSIZE : TYS=YSIZE
      XSIZE=Min(32*XS,XSIZE) : YSIZE=Min(32,YSIZE)
   FC=FC mod NCOLS
   BC=BC mod NCOLS
   If FC=BC
      FC=1
      BC=0
   End If
   Get Block 1,160*XS,7,TXS,TYS
   Screen 1
   Ink 0
   Bar 0,0 To XS*320,160
   Ink FC,BC
   Put Block 1,160*XS,7
   Box 14,5 To 17+XSIZE*MP,8+YSIZE*MP
   Box 159*XS,6 To 160*XS+96,136
   Box 159*XS,6 To 160*XS+TXS,7+TYS
   Ink BC,FC
   Text 120*XS-(XS=2)*100,150,"Size X:"+Str$(TXS)+" Y:"+Str$(TYS)
   LFTO=-1
      XSIZE=TXS : YSIZE=TYS
End Proc
Procedure BXES2
   Shared BIGSPR,LFTO,TPWO,TPWIN,LFTWIN,FC,BC,XS,XSIZE,YSIZE,MP
   TXS=XSIZE : TYS=YSIZE
      XSIZE=Min(32*XS,XSIZE) : YSIZE=Min(32,YSIZE)
   BIGBARS
   Screen 1
   Ink FC,BC
   Draw 17+XSIZE*MP,5 To 17+XSIZE*MP,8+YSIZE*MP
   Draw 160*XS+TXS,6 To 160*XS+TXS,7+TYS
   XSIZE=TXS : YSIZE=TYS
End Proc
Procedure BXES3
   Shared BIGSPR,FC,BC,XS,XSIZE,YSIZE,MP
   TXS=XSIZE : TYS=YSIZE
   If BIGSPR
      XSIZE=Min(32*XS,XSIZE) : YSIZE=Min(32,YSIZE)
   End If
   Screen 1
   Ink FC,BC
   Box 14,5 To 17+XSIZE*MP,8+YSIZE*MP
   Box 159*XS,6 To 160*XS+96,136
   Box 159*XS,6 To 160*XS+TXS,7+TYS
   Ink BC,FC
   Text 120*XS-(XS=2)*100,150,"Size X:"+Str$(TXS)+" Y:"+Str$(TYS)
   XSIZE=TXS : YSIZE=TYS
End Proc
Procedure BIGBARS
   Shared FC,BC,XSIZE,YSIZE,BIGSPR,TPWO,TPWIN,LFTO,LFTWIN,XS
X=Min(32*XS,XSIZE) : Y=Min(32,YSIZE)
 SC=Screen
   Screen 1
   If TPWO<>TPWIN or LFTO<>LFTWIN
      Ink 0
      Bar 154*XS,6 To 158*XS,135
      Bar 160*XS,1 To 160*XS+96,5
   End If
   Ink FC,BC
   If BIGSPR and(TPWO<>TPWIN or LFTO<>LFTWIN)
      Draw 154*XS,6+TPWIN To 158*XS,6+TPWIN : Draw 154*XS,6+Y+TPWIN To 158*XS,6+Y+TPWIN
      Draw 160*XS+LFTWIN,1 To 160*XS+LFTWIN,5 : Draw 160*XS+LFTWIN+X,1 To 160*XS+LFTWIN+X,5
      Draw 156*XS,6+TPWIN To 156*XS,Y+6+TPWIN : Draw 160*XS+LFTWIN,3 To 160*XS+LFTWIN+X,3
      LFTO=LFTWIN : TPWO=TPWIN
   End If
   Screen SC
End Proc
Procedure FASTZOOM
   Shared TPWIN,LFTWIN,BIGSPR,FC,BC,XS,M,XSIZE,YSIZE,MP,ST(),SX(),NC()
   SC=Screen
   Screen 1
   TXS=XSIZE
   TYS=YSIZE
      XSIZE=Min(32*XS,XSIZE)
      YSIZE=Min(32,YSIZE)
MP=4
      If BIGSPR
         Get Block 6,160*XS,7,96,128
      End If
      Dreg(1)=MP
      Dreg(2)=160*XS+LFTWIN : Dreg(3)=7+TPWIN
      Dreg(4)=16 : Dreg(5)=7
      Dreg(6)=XSIZE : Dreg(7)=YSIZE
      Areg(0)=Screen Base
      Call 10
      If BIGSPR
         Put Block 6,160*XS,7
         Del Block 6
      End If
   Set Zone 2,16,7 To 16+XSIZE*MP,7+YSIZE*MP
   Set Zone 3,160*XS,7 To 160*XS+96,135
      XSIZE=TXS : YSIZE=TYS
   Screen SC
End Proc
Procedure CREDITS
   Get Block 5,48,0,224,96
   Ink 2
   Bar 49,1 To 269,89
   Screen Copy 0,256,96,320,144 To 0,50,2
   Ink 1,2
   Text 120,12,"AMOS Sprite Editor"
   Text 120,22,"Copyright"
   Ink 3,2
   Text 120,32,"Mandarin/Jawx 1990"
   Text 120,42,"Written by"
   Text 120,52,"Shadow Software"
   Ink 1,2
   Text 52,62,"Program:Aaron Fothergill"
   Text 52,72,"Graphics:Adam Fothergill"
   Text 52,82,"Fast Zoom:Francois Lionet"
   While Mouse Key<>0 : Wend
   While Mouse Key=0 and Asc(Inkey$)=0 : Wend : While Mouse Key<>0 : Wend
   Put Block 5,48,0 : Del Block 5
End Proc
DISKERROR:
SC=Screen
Screen 0
Limit Mouse
LSTERRN=Errn
LINE$(0)="Disk Error "+Str$(Errn)
BUTTON$(0)="O.K"
ALERT[30,5,6,1,1,1]
Screen SC
Limit Mouse
Resume Next
GENERALERROR:
LSTERRN=Errn
Resume Next