Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Amos/AmosCRAFT2Turbo.DMS/in.adf/fontgrabber/TURBOFontGrabber.AMOS/TURBOFontGrabber.amosSourceCode

AMOS Source Code | 1994-03-09 | 41.2 KB | 2,107 lines

' TURBO Font Grabber v1.0
'
' Copyright � 1994 PLAYFIELD!.  All Rights Reserved.

'please do not redistribute this program!
'support your developers and they'll support you with better programs

Set Buffer 16
Break Off
Dim MITEMS(3),MNUMS(3),CB(254),CX(254),CW(254),CH(254),FR(31),FG(31),FB(31)
Global K,SK,MK,X,Y,MPICK,MITEMS(),MNUMS(),QUIT
Global FON,BON,PON,FY,BY,PY,BH,FRES,HRES,PROP
Global PICW,PICH,BITX,BITY
Global DEF_PICNAME$,DEF_FSAVENAME$,_SAVED
Global XOFF,YOFF,XCUT,YCUT
Global GMODE,GSTEP
Global GGTX,GGTY,GGBX,GGBY,GGDX,GGDY
Global GGB
Global DEF$,NC,FW,FH,CB(),CX(),CW(),CH(),FR(),FG(),FB(),FBOX,YVIEW,FBUT
Global CC,PC,PLOP,PLPC
Global _CUT,CUB,CUX,CUW,CUH,CUS,CUD$
Global _MTX,_MTY,_MBX,_MBY
Global _MX,_MY,_MON,XR,YR,_SP
_INIT
_MAIN
_QUIT
Procedure _MAIN
 QUIT=0
 _QUIET
 Repeat
  '                    Get input from mouse and keyboard
  MK=Mouse Key
  _MCHECK
  X=_MX : Y=_MY
  SK=Key Shift
  If SK=0 or SK=1 or SK=2 or SK=128
   If SK=2
    SK=1
   End If
   K=Instr("lsqgpfb"+Chr$(8)+"ssss"+"xcvn",Inkey$)-Key State(70)*32
   Add K,-(Key State(79)*9+Key State(78)*10+Key State(76)*11+Key State(77)*12)
  Else
   _QUIET
   SK=0
   K=0
  End If
  If K
   _DOKEY
  End If
  If MK=2
   If Y/2<12
    Proc _MENU
    If MPICK
     _DOMENU
    End If
   Else
    If BON
     If Y/2>=BY and Y/2<=(BY+BH-1)
      _BRMB
     End If
    End If
   End If
   _QUIET
  Else
   If MK=1
    If Y/2<12 and X>582
     _MLMB
     MC
    End If
    If PON
     If Y/2>=PY and Y/2<=(PY+36)
      _PLMB
      MC
     End If
    End If
    If BON
     If Y/2>=BY and Y/2<=(BY+BH-1)
      _BLMB
      MC
     End If
    End If
    If FON
     If Y/2>=FY and Y/2<=(FY+56)
      _FLMB
      MC
     End If
    End If
    _QUIET
   Else
    If BON
     _FBOX
     If Y/2>=BY and Y/2<=(BY+BH-1)
      _BNONE
     End If
    End If
   End If
  End If
  If Key State(69) Then _DOQUIT
 Until QUIT
End Proc
Procedure _DOQUIT
 If _SAVED=0
  _DOREQUEST[12]
  _SAVED=Param
 End If
 Screen 0
 QUIT=_SAVED
End Proc
Procedure _DOREQUEST[REQ]
 Screen Open 6,640,16,16,Hires
 Screen Display 6,,50+92,640,16
 Curs Off : Flash Off : Cls 0
 Get Icon Palette
 Paste Icon 0,0,REQ
 _QUIET
 DC=0 : OK=0
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX : Y=_MY/2
  A=Instr("yn",Inkey$)
  If Key Shift Then A=0
  If A=2
   DC=1
  Else
   If A=1
    DC=1 : OK=1
   End If
  End If
  If A Then _QUIET
  If MK=1
   If Y>93 and Y<106 and X>516 and X<637
    DC=1
    QBUT=(X-517)/60
    GAD[517+QBUT*60,2,60,12,2,1]
    If QBUT=0
     OK=1
    End If
    _QUIET
    GAD[517+QBUT*60,2,60,12,2,0]
   End If
   _QUIET
  Else
   If MK=2
    DC=1
    _QUIET
   End If
  End If
 Until DC=1
 Screen Close 6
End Proc[OK]
Procedure _DOKEY
 If K=16 and SK=128 Then _NEW
 If K=3 and SK=128 Then _DOQUIT
 If K=1 and SK=0 Then _LOADIFF
 If K=1 and SK=128 Then _LOAD
 If K=2 and SK=128 Then _SAVEAS
 If K=4 and SK=0 Then _GSELNORM
 If K=4 and SK=128 Then _GSELGRID
 If K=7 and SK=128 Then _GSELPROP
 If K=6 and SK=0 Then _FON
 If K=7 and SK=0 Then _BON
 If K=5 and SK=0 Then _PON
 If K=8 and SK=0 Then _BACKSPACE
 If K=9 and SK=0 Then _LEFT
 If K=10 and SK=0 Then _RIGHT
 If K=9 and SK=1 Then _WAYLEFT
 If K=10 and SK=1 Then _WAYRIGHT
 If K=11 and SK=0 Then _MOVEUP
 If K=12 and SK=0 Then _MOVEDOWN
 If K=11 and SK=1 Then _VIEWUP
 If K=12 and SK=1 Then _VIEWDOWN
 If K=13 and SK=128 Then _CUT
 If K=14 and SK=128 Then _COPY
 If K=15 and SK=128 Then _PASTE
 If K=32 and SK=0 Then _DELETE
 _QUIET
End Proc
Procedure _DOMENU
 If MPICK=16
  _ABOUT
 End If
 If MPICK=18
  _NEW
 End If
 If MPICK=19
  _LOAD
 End If
 If MPICK=20
  _SAVE
 End If
 If MPICK=21
  _SAVEAS
 End If
 If MPICK=23
  _DOQUIT
 End If
 If MPICK=32
  _LOADIFF
 End If
 If MPICK=33
  _FLUSHIFF
 End If
 If MPICK=35
  _GETIFFPAL
 End If
 If MPICK=48
  _GSELNORM
 End If
 If MPICK=49
  _GSELGRID
 End If
 If MPICK=50
  _GSELPROP
 End If
 If MPICK=52
  _DELETE
 End If
 If MPICK=54
  _CUT
 End If
 If MPICK=55
  _COPY
 End If
 If MPICK=56
  _PASTE
 End If
 If MPICK=64
  _PON
 End If
 If MPICK=65
  _FON
 End If
 If MPICK=66
  _BON
 End If
 If MPICK=68
  _TESTFONT
 End If
End Proc
Procedure _NEW
 If _SAVED=0
  _DOREQUEST[12]
  _SAVED=Param
 End If
 If _SAVED
  DEF_FSAVENAME$=""
  DEF$="" : NC=0 : FW=0 : FH=0
  For A=0 To 254
   CB(A)=0 : CX(A)=0 : CW(A)=0
  Next
  CC=0 : Erase 1
  _GSELNORM
  _GETIFFPAL
  _SAVED=1
  _FFONT
  _FDEF
 End If
End Proc
Procedure _LOAD
 CANLOAD=1
 GNP=1
 If NC>0
  GNP=0
  _DOREQUEST[13]
  If Param=0
   _NEW
   If NC>0
    CANLOAD=0
   End If
   GNP=1
  End If
 End If
 If CANLOAD
  Show
  SUG$=""
  If DEF_FSAVENAME$<>""
   SUG$=DEF_FSAVENAME$+".abk"
  End If
  A$=Fsel$("*.abk",SUG$,"Select a Font bank","Chip Free ="+Str$(Chip Free))
  Hide
  If Len(A$)>4
   FP$=Left$(A$,Len(A$)-4)
   If Upper$(A$)=Upper$(FP$+".abk")
    If Exist(FP$+".abk") and Exist(FP$+".fin")
     Repeat
      C=Instr(FP$,":")
      If C
       FP$=Mid$(FP$,C+1)
      Else
       C=Instr(FP$,"/")
       If C
        FP$=Mid$(FP$,C+1)
       End If
      End If
     Until C=0
     DEF_FSAVENAME$=FP$
     Load(FP$+".fin"),4
     R=Start(4)
     MC=Deek(R)
     If MC+NC<=255
      Load(FP$+".abk"),1-GNP
      If GNP
       _GETFILEPAL
      End If
      _PEEKSTRING[R+6,MC]
      NEWDEF$=Param$
      DEF$=DEF$+NEWDEF$
      Add R,6+MC-(MC mod 2=1)
      For A=0 To MC-1
       CB(NC+A)=Peek(R+A*8)*256+Peek(R+A*8+1)
       CH(NC+A)=Peek(R+A*8+2)*256+Peek(R+A*8+2+1)
       CX(NC+A)=Peek(R+A*8+4)*256+Peek(R+A*8+4+1)
       CW(NC+A)=Peek(R+A*8+6)*256+Peek(R+A*8+6+1)
      Next A
      Add NC,MC
      _FONTWH
      _FPAL
      _PCOLOR
      _FFONT
      _FDEF
     End If
     Erase 4
    End If
   End If
  End If
 End If
End Proc
Procedure _SAVE
 If NC>0
  If DEF_FSAVENAME$=""
   _GETSAVENAME
  End If
  CANSAVE=1
  If NC<>Len(DEF$)
   CANSAVE=0
   _DOREQUEST[14]
   If Param
    DEF$=String$("�",NC)
    _FDEF
    CANSAVE=1
   End If
  End If
  If CANSAVE
   Repeat
    OK=1
    If DEF_FSAVENAME$<>""
     OK=0
     _PERMPALETTE
     ' Trap Save(DEF_FSAVENAME$+".abk"),1
     Save(DEF_FSAVENAME$+".abk"),1
     If True : RemErrtrap=0
      Reserve As Data 4,6+9*NC-(NC mod 2=1)
      R=Start(4)
      '                 _POKESTRING[R-8,"FontInfo"]
      Doke R,NC
      Doke R+2,FW
      Doke R+4,FH
      If NC<>Len(DEF$)
       DEF$=String$("�",NC)
      End If
      _POKESTRING[R+6,DEF$]
      Add R,6+NC-(NC mod 2=1)
      For A=0 To NC-1
       Poke R+A*8,CB(A)/256 : Poke R+A*8+1,CB(A) and 255
       Poke R+A*8+2,CH(A)/256 : Poke R+A*8+2+1,CH(A) and 255
       Poke R+A*8+4,CX(A)/256 : Poke R+A*8+4+1,CX(A) and 255
       Poke R+A*8+6,CW(A)/256 : Poke R+A*8+6+1,CW(A) and 255
      Next A
      'Trap Save(DEF_FSAVENAME$+".fin"),4
      Save(DEF_FSAVENAME$+".fin"),4
      If True : RemErrtrap=0
       OK=1 : _SAVED=1
      End If
      Erase 4
     End If
     If OK=0
      _DOREQUEST[15]
      If Param=0
       OK=1
      Else
       _GETSAVENAME
      End If
     End If
    End If
   Until OK
  End If
 End If
End Proc
Procedure _GETSAVENAME
 Show
 SUG$=""
 If DEF_FSAVENAME$<>""
  SUG$=DEF_FSAVENAME$+".abk"
 End If
 A$=Fsel$("*.abk",SUG$,"Select a save name (.abk)",Str$(NC)+" characters")
 DEF_FSAVENAME$=""
 Hide
 If Len(A$)>4
  FP$=Left$(A$,Len(A$)-4)
  If Upper$(A$)=Upper$(FP$+".abk")
   Repeat
    C=Instr(FP$,":")
    If C
     FP$=Mid$(FP$,C+1)
    Else
     C=Instr(FP$,"/")
     If C
      FP$=Mid$(FP$,C+1)
     End If
    End If
   Until C=0
   DEF_FSAVENAME$=FP$
  End If
 End If
End Proc
Procedure _SAVEAS
 If NC>0
  _GETSAVENAME
  If DEF_FSAVENAME$<>""
   _SAVE
  End If
 End If
End Proc
Procedure _LOADIFF
 Show
 A$=Fsel$("",DEF_PICNAME$,"Select an IFF-ILBM file","Chip Free ="+Str$(Chip Free))
 Hide
 OP=1
 If Exist(A$)
  PICNAME$=A$
  Repeat
   C=Instr(PICNAME$,":")
   If C
    PICNAME$=Mid$(PICNAME$,C+1)
   Else
    C=Instr(PICNAME$,"/")
    If C
     PICNAME$=Mid$(PICNAME$,C+1)
    End If
   End If
  Until C=0
  DEF_PICNAME$=PICNAME$
  If NC=0
   DEF_FSAVENAME$=PICNAME$-".iff"-".IFF"-".pic"-".PIC"-".ilbm"-".ILBM"-".bru"-".BRU"
  End If
  Open In 1,A$
  If Lof(1)>=36
   If Input$(1,4)="FORM"
    J$=Input$(1,4)
    If Input$(1,4)="ILBM"
     NF$=Input$(1,4)
     If NF$="ANNO"
      J$=Input$(1,4)
      ANL=Asc(Mid$(J$,3,1))*256+Asc(Mid$(J$,4,1))
      J$=Input$(1,ANL+(ANL and 1))
      NF$=Input$(1,4)
     End If
     If NF$="BMHD"
      J$=Input$(1,4)
      J$=Input$(1,20)
      Close 1 : OP=0
      SCW=Asc(Mid$(J$,17,1))*256+Asc(Mid$(J$,18,1))
      SCH=Asc(Mid$(J$,19,1))*256+Asc(Mid$(J$,20,1))
      XRES=-(SCW>=640)
      YRES=-(SCH>=400)
      HRES=Max(0,XRES-YRES)
      BPL=Asc(Mid$(J$,9,1))
      If BPL<=6-2*HRES
       PICW=Max(320+HRES*320,Asc(Mid$(J$,1,1))*256+Asc(Mid$(J$,2,1)))
       PICH=Max(200,Asc(Mid$(J$,3,1))*256+Asc(Mid$(J$,4,1)))
       If Chip Free>=40000+PICW*PICH*6/8
        If BON=0
         _BON
        End If
        Screen Open 3,PICW,PICH,32-16*HRES,HRES*Hires
        Curs Off : Flash Off : Cls 0
        Screen Display 3,128,50+BY,320+HRES*320,BH
        BITX=0 : BITY=0 : Screen Offset 3,BITX,BITY
        Load Iff(A$)
        If NC=0
         _GETFPALETTE
         _FPAL
         _PCOLOR
        End If
       End If
      End If
     End If
    End If
   End If
  End If
  If OP
   Close 1
  End If
 End If
 Screen 0
End Proc
Procedure _FLUSHIFF
 PICW=320 : PICH=200 : HRES=0
 Screen Open 3,PICW,PICH,32-16*HRES,HRES*Hires
 Curs Off : Flash Off : Cls 0
 If BON=0
  Screen Hide 3
 Else
  Screen Display 3,128,50+BY,320+HRES*320,BH
 End If
 BITX=0 : BITY=0 : Screen Offset 3,BITX,BITY
 _PUTFPALETTE
 Screen 0
End Proc
Procedure _GETIFFPAL
 Screen 3
 _GETFPALETTE
 _SAVED=0
 _FPAL
 _PCOLOR
 Screen 0
End Proc
Procedure _BACKSPACE
 If CC>0
  Dec CC
  _DELETE
 End If
End Proc
Procedure _DELETE
 If CC<NC
  If CC=NC-1
   Del Bob CC+1
  Else
   Del Bob CC+1
   For A=CC To NC-2
    CB(A)=CB(A+1) : CX(A)=CX(A+1) : CW(A)=CW(A+1) : CH(A)=CH(A+1)
   Next
  End If
  If Len(DEF$)>=CC+1
   DEF$=Left$(DEF$,CC)+Mid$(DEF$,CC+2)
  End If
  Dec NC
  _SAVED=0
  _FONTWH
  _FFONT
  _FDEF
 End If
End Proc
Procedure _CUT
 If CC<NC
  _COPY
  _DELETE
 End If
End Proc
Procedure _COPY
 If CC<NC
  Screen Open 6,320,Max(8,CH(CC)),32,0
  Screen Hide 6
  Curs Off : Flash Off : Cls 0
  Paste Bob 0,0,CC+1
  CUS=16*Deek(Leek(Start(1)+2+8*CC))
  Get Block 1,0,0,CUS,CH(CC)
  Screen Close 6
  CUD$=""
  If CC<Len(DEF$)
   CUD$=Mid$(DEF$,CC+1,1)
  End If
  _CUT=1 : CUB=CB(CC) : CUX=CX(CC) : CUW=CW(CC) : CUH=CH(CC)
 End If
End Proc
Procedure _PASTE
 If _CUT
  If CC<NC
   Ins Bob CC+1
   For A=NC To CC+1 Step -1
    CB(A)=CB(A-1) : CX(A)=CX(A-1) : CW(A)=CW(A-1) : CH(A)=CH(A-1)
   Next
  End If
  Screen Open 6,320,Max(8,CUH),32,0
  Screen Hide 6
  Curs Off : Flash Off
  Put Block 1,0,0
  Get Bob CC+1,0,0 To CUS,CUH
  Screen Close 6
  If CUD$<>""
   If CC<Len(DEF$)
    DEF$=Left$(DEF$,CC)+CUD$+Mid$(DEF$,CC+1)
   Else
    DEF$=DEF$+CUD$
   End If
  End If
  FW=Max(FW,CUW) : FH=Max(FH,CUH)
  CB(CC)=CUB : CX(CC)=CUX : CW(CC)=CUW : CH(CC)=CUH
  Inc NC
  Inc CC
  _SAVED=0
  _FFONT
  _FDEF
 End If
End Proc
Procedure _LEFT
 If FON
  If CC>0
   Dec CC
   _FFONT
   _FDEF
  End If
 End If
End Proc
Procedure _RIGHT
 If FON
  If CC<NC
   Inc CC
   _FFONT
   _FDEF
  End If
 End If
End Proc
Procedure _WAYLEFT
 If FON
  If CC>0
   CC=0
   _FFONT
   _FDEF
  End If
 End If
End Proc
Procedure _WAYRIGHT
 If FON
  If CC<NC
   CC=NC
   _FFONT
   _FDEF
  End If
 End If
End Proc
Procedure _WIDTHLEFT
 If CC<NC
  Dec CW(CC)
  _SAVED=0
  _FFONT
  _FDEF
 End If
End Proc
Procedure _WIDTHRIGHT
 If CC<NC
  Inc CW(CC)
  _SAVED=0
  _FFONT
  _FDEF
 End If
End Proc
Procedure _XLEFT
 If CC<NC
  Dec CX(CC)
  Dec CW(CC)
  _SAVED=0
  _FFONT
  _FDEF
 End If
End Proc
Procedure _XRIGHT
 If CC<NC
  Inc CX(CC)
  Inc CW(CC)
  _SAVED=0
  _FFONT
  _FDEF
 End If
End Proc
Procedure _MOVEUP
 If FON
  If CC<NC
   Inc CB(CC)
   _SAVED=0
   _FFONT
   _FDEF
  End If
 End If
End Proc
Procedure _MOVEDOWN
 If FON
  If CC<NC
   Dec CB(CC)
   _SAVED=0
   _FFONT
   _FDEF
  End If
 End If
End Proc
Procedure _VIEWUP
 If FON
  Dec YVIEW
  _FFONT
  _FDEF
 End If
End Proc
Procedure _VIEWDOWN
 If FON
  Inc YVIEW
  _FFONT
  _FDEF
 End If
End Proc
Procedure _FONTWH
 FW=0 : FH=0
 If NC>0
  For A=0 To NC-1
   FW=Max(FW,CW(A)) : FH=Max(FH,CH(A))
  Next
 Else
  _SAVED=1
 End If
End Proc
Procedure _FON
 If FON
  Screen Close 1
  Screen Close 2
  FON=0
  If PON*PY>FY
   Add PY,-58
   Screen Display 4,,50+PY,,
   Screen Display 5,,50+PY+29,,
  End If
  If BON*BY
   Add BH,58
   BITX=Max(0,Min(PICW-(320+HRES*320),BITX))
   BITY=Max(0,Min(PICH-BH,BITY))
   Screen Offset 3,BITX,BITY
   If BON*BY>FY
    Add BY,-58
   End If
   If PON*PY>BY
    Add PY,58
    Screen Display 4,,50+PY,,
    Screen Display 5,,50+PY+29,,
   End If
   Screen Display 3,,50+BY,,BH
  End If
  Screen 0
 Else
  '                              Font description
  Screen Open 1,640,16,16,Hires
  FY=13+PON*38+BON*(BH+1-58) : FON=1
  Screen Display 1,128,50+FY,640,16
  Curs Off : Flash Off : Cls 0
  Get Icon Palette
  Paste Icon 0,0,11
  '                              Font display
  Screen Open 2,320+FRES*320,40,32-FRES*16,FRES*Hires
  Screen Display 2,128,50+FY+17,320+FRES*320,40
  Curs Off : Flash Off : Cls 0
  '  Set Bitmap too
  If BON
   Add BH,-58
   If PON*PY>BON*BY
    Add PY,-58
    Screen Display 4,,50+PY,,
    Screen Display 5,,50+PY+29,,
   End If
   Screen Display 3,,50+BY,,BH
  End If
  Screen 0
  YVIEW=29 : FBOX=0
  _FFONT
  _FDEF
  _FPAL
  _PCOLOR
 End If
End Proc
Procedure _FRES
 FRES=1-FRES
 Screen Close 2
 Screen Open 2,320+FRES*320,40,32-FRES*16,FRES*Hires
 Screen Display 2,128,50+FY+17,320+FRES*320,40
 Curs Off : Flash Off : Cls 0
 _FFONT
 _FDEF
 _FPAL
 _PCOLOR
End Proc
Procedure _FFONT
 If FON
  S=Screen
  Screen 2
  Cls 0
  Ink 31
   Extension_12_04CC 0,YVIEW To 319+320*FRES,YVIEW
  If FON=1 and NC>0
   If CC>0
    A=CC-1
    FDX=160+FRES*160
    Repeat
     OF=FDX
     Add FDX,-CW(A)-1
     Dec A
    Until A<0 or OF<0
    Inc A
    Repeat
     Paste Bob FDX+CX(A),YVIEW-CB(A),A+1
     Add FDX,CW(A)+1
     Inc A
    Until A=CC
   End If
   If CC<NC
    A=CC
    FDX=160+FRES*160
    Paste Bob FDX+CX(A),YVIEW-CB(A),A+1
    _BOX[FDX-1,YVIEW-CB(A)-1,FDX+CW(A),YVIEW-CB(A)+CH(A),31]
    Add FDX,CW(A)+1
    Inc A
    If A<NC
     Repeat
      Paste Bob FDX+CX(A),YVIEW-CB(A),A+1
      Add FDX,CW(A)+1
      Inc A
     Until A=NC or FDX>320+FRES*320
    End If
   End If
  End If
  Screen S
 End If
End Proc
Procedure _FBOX
 If FON
  S=Screen
  Screen 2
  If CC<NC
   FDX=160+FRES*160
   _BOX[FDX-1,YVIEW-CB(CC)-1,FDX+CW(CC),YVIEW-CB(CC)+CH(CC),(Timer mod 20)/15*FBOX]
   Add FBOX,1,0 To 31
  Else
   Ink FBOX
   FDX=160+FRES*160
    Extension_12_04CC FDX,20 To FDX+10,20
    Extension_12_04CC FDX+7,17 To FDX+10,20
    Extension_12_04CC FDX+7,23 To FDX+10,20
   Add FBOX,1,0 To 31
  End If
  Screen S
 End If
End Proc
Procedure _FPAL
 S=Screen
 If FON=1
  Screen 2
  _PUTFPALETTE
 End If
 If PON=1
  Screen 5
  _PUTFPALETTE
 End If
 Screen S
End Proc
Procedure _FDEF
 If FON
  S=Screen
  Screen 1
  Ink 2
  Bar 463,3 To 635,12
  Gr Writing 0
  Ink 3
  FTC=Max(Min(NC-20,CC-10),0)
  Text 465,10,Mid$(DEF$,FTC+1,21)
  Ink 10
  PP=Min(CC,Len(DEF$))
  FDS$=Mid$(DEF$+" ",PP+1,1)
  Text 465+8*(PP-FTC),10,FDS$
  Screen S
 End If
End Proc
Procedure _FDEFEDIT
 Sprite Off 0
 N$=DEF$
 S=Screen
 Screen 1
 FTC=Max(Min(NC-20,CC-10),0)
 EC=Min(Max(0,Min(20,(X-465)/8))+FTC,Len(N$))
 OK=0
 Repeat
  Ink 2
  Bar 463,3 To 635,12
  Gr Writing 0
  Ink 4
  FTC=Max(Min(Len(N$)-20,EC-10),0)
  Text 465,10,Mid$(N$,FTC+1,21)
  Gr Writing 1
  Ink 10
  FDS$=Mid$(N$+" ",EC+1,1)
  Text 465+8*(EC-FTC),10,FDS$
  CC=Min(NC,EC)
  _FFONT

  _QUIET
  Repeat
   K=Asc(Inkey$)
   SK=-((Key Shift=1) or(Key Shift=2))
   If SK=1 and Key State(79) Then K=Asc(Cleft$)
   If SK=1 and Key State(78) Then K=Asc(Cright$)
   If Key State(69) Then OK=1 : K=1
   If Key State(70) and SK=0 and EC<Len(N$)
    N$=Left$(N$,EC)+Mid$(N$,EC+2)
    K=1
   End If
   If K=8 and SK=0 and EC>0
    Dec EC
    N$=Left$(N$,EC)+Mid$(N$,EC+2)
   End If
   If K=8 and SK=1
    EC=0
    N$=""
   End If
   If K=13 Then DEF$=N$ : OK=1 : _SAVED=0
   If K=Asc(Cleft$) and SK=0 Then EC=Max(0,EC-1)
   If K=Asc(Cright$) and SK=0 Then EC=Min(Len(N$),EC+1)
   If K=Asc(Cleft$) and SK=1 Then EC=0
   If K=Asc(Cright$) and SK=1 Then EC=Len(N$)
   If K>=32 and EC<255
    N$=Left$(N$,EC)+Chr$(K)+Mid$(N$,EC+1)
    Inc EC
   End If
  Until K
 Until OK
 _FFONT
 _FDEF
 Screen S
End Proc
Procedure _FLMB
 Y=Y/2-FY
 If Y<16
  If Y>1 and Y<15
   If X>4 and X<423
    FBUT=(X-5)/19
    _FBUT
   End If
   If X>462 and X<636
    _FDEFEDIT
   End If
  End If
 Else
  If Y>16
   X=X/(2-FRES)
   FDX=160+FRES*160
   If X<FDX
    _LEFT
   Else
    _RIGHT
   End If
  End If
 End If
End Proc
Procedure _FBUT
 Screen 1
 GG=0
 If Mid$("0 0000 00 000000 000 0",FBUT+1,1)="0" Then GG=1
 If GG Then GAD[5+FBUT*19,2,19,12,2,1]

 If FBUT=0 Then _FRES

 If FBUT=2 Then _WAYLEFT
 If FBUT=3 Then _LEFT
 If FBUT=4 Then _RIGHT
 If FBUT=5 Then _WAYRIGHT

 If FBUT=7 Then _VIEWUP
 If FBUT=8 Then _VIEWDOWN

 If FBUT=10 Then _WIDTHLEFT
 If FBUT=11 Then _WIDTHRIGHT
 If FBUT=12 Then _XLEFT
 If FBUT=13 Then _XRIGHT
 If FBUT=14 Then _MOVEUP
 If FBUT=15 Then _MOVEDOWN

 If FBUT=17 Then _CUT
 If FBUT=18 Then _COPY
 If FBUT=19 Then _PASTE

 If FBUT=21 Then _DELETE

 _QUIET
 Screen 1
 If GG Then GAD[5+FBUT*19,2,19,12,2,0]
 Screen 0
End Proc
Procedure _BON
 If BON
  Screen Hide 3
  BON=0
  If FON*FY>BY
   Add FY,-(BH+1)
   Screen Display 1,,50+FY,,
   Screen Display 2,,50+FY+17,,
  End If
  If PON*PY>BY
   Add PY,-(BH+1)
   Screen Display 4,,50+PY,,
   Screen Display 5,,50+PY+29,,
  End If
  Screen 0
 Else
  '  Bitmap display
  Screen Show 3
  BY=13+FON*58+PON*38 : BON=1 : BH=199-BY
  BITX=0 : BITY=0
  Screen Offset 3,BITX,BITY
  Screen Display 3,128,50+BY,320+HRES*320,BH
  Screen 0
 End If
End Proc
Procedure _BNONE
 Screen 3
 If GMODE=0
  Gr Writing 2
  _MCHECK
  _UNBUG
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
  _MCHECK
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
  Gr Writing 1
 End If
 If GMODE=1
  Gr Writing 2
  _UNBUG
  If GSTEP=0
   _MCHECK
   _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
   _MCHECK
   _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
  Else
   If GSTEP=1
    _MCHECK
    _FLASHBOX[GGTX,GGTY,GGBX,GGBY]
    _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
    _MCHECK
    _FLASHBOX[GGTX,GGTY,GGBX,GGBY]
    _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
   Else
    If GSTEP=2
     _MCHECK
     TEMX=BITX+X/(2-HRES) : TEMY=BITY+Y/2-BY
     GGDX=Max(GGBX-GGTX+1,Max(TEMX-GGTX,GGBX-TEMX))
     GGDY=Max(GGBY-GGTY+1,Max(TEMY-GGTY,GGBY-TEMY))
     _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TEMX,TEMY]
     For TABX=-1 To 1
      For TABY=-1 To 1
       _FLASHBOX[GGTX+GGDX*TABX,GGTY+GGDY*TABY,GGBX+GGDX*TABX,GGBY+GGDY*TABY]
       If GGB<>GGTY and GGB<>GGBY
        _FLASHLINE[GGTX+GGDX*TABX,GGB+GGDY*TABY,GGBX+GGDX*TABX,GGB+GGDY*TABY]
       End If
      Next
     Next
     _MCHECK
     _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TEMX,TEMY]
     For TABX=-1 To 1
      For TABY=-1 To 1
       _FLASHBOX[GGTX+GGDX*TABX,GGTY+GGDY*TABY,GGBX+GGDX*TABX,GGBY+GGDY*TABY]
       If GGB<>GGTY and GGB<>GGBY
        _FLASHLINE[GGTX+GGDX*TABX,GGB+GGDY*TABY,GGBX+GGDX*TABX,GGB+GGDY*TABY]
       End If
      Next
     Next
    Else
     TEMX=BITX+X/(2-HRES) : TEMY=BITY+Y/2-BY
     TSX=(TEMX-GGTX)/GGDX+(TEMX<GGTX) : TSY=(TEMY-GGTY)/GGDY+(TEMY<GGTY)
     STX=GGTX+GGDX*TSX : STY=GGTY+GGDY*TSY
     SBX=GGBX+GGDX*TSX : SBY=GGBY+GGDY*TSY
     SB=GGB+GGDY*TSY
     If TEMX<=SBX and TEMY<=SBY
      If STX>=0 and SBX<PICW and STY>=0 and SBY<PICH
       _FLASHBOX[STX,STY,SBX,SBY]
       If GGB<>GGTY and GGB<>GGBY
        _FLASHLINE[STX,SB,SBX,SB]
       End If
      End If
     End If
     _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TEMX,TEMY]
     _MCHECK
     _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TEMX,TEMY]
     If TEMX<=SBX and TEMY<=SBY
      If STX>=0 and SBX<PICW and STY>=0 and SBY<PICH
       _FLASHBOX[STX,STY,SBX,SBY]
       If GGB<>GGTY and GGB<>GGBY
        _FLASHLINE[STX,SB,SBX,SB]
       End If
      End If
     End If
    End If
   End If
  End If
  Gr Writing 1
 End If
 If GMODE=2
  Gr Writing 2
  _UNBUG
  If GSTEP=0
   _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
   _MCHECK
   _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
  Else
   _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
   _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),GGB]
   _MCHECK
   _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),BITY+Y/2-BY]
   _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,BITX+X/(2-HRES),GGB]
  End If
  Gr Writing 1
 End If
 Screen 0
End Proc
Procedure _BLMB
 If GMODE=0 Then _GRAB
 If GMODE=1
  If GSTEP=0
   _GRABGRID0
  Else
   If GSTEP=1
    _GRABGRID1
   Else
    If GSTEP=2
     _GRABGRID2
    Else
     _GRABGRID3
    End If
   End If
  End If
 End If
 'End If
 If GMODE=2
  If GSTEP=0
   _GRABPROP0
  Else
   _GRABPROP1
  End If
 End If
End Proc
Procedure _GRABGRID0
 HX=X : HY=Y
 TIX=BITX+X/(2-HRES) : TIY=BITY+Y/2-BY
 Screen 3
 Gr Writing 2
 _UNBUG
 X=TIX : Y=TIY
 _MON=0 : Sprite Off 0
 _MLIMIT[-100,BY*2-100,639+100,(BY+BH-1)*2+100]
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX/(2-HRES) : Y=_MY/2-BY
  _MX=Max(0,Min(639,_MX))
  _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
  X=Max(0,Min(PICW-1,X+BITX))
  Y=Max(0,Min(PICH-1,Y+BITY))
  BITX=Max(X-(319+320*HRES),Min(X,BITX))
  BITY=Max(Y-(BH-1),Min(Y,BITY))
  Screen Offset 3,BITX,BITY
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TIX,TIY]
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  _MCHECK
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TIX,TIY]
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
 Until MK<>1
 _MLIMIT[0,0,639,397]
 _MON=1
 Gr Writing 1
 If TIX>X Then Swap TIX,X
 If TIY>Y Then Swap TIY,Y
 If MK=0
  GGTX=TIX : GGTY=TIY
  GGBX=X : GGBY=Y
  GSTEP=1 : _SP=3
 End If
 Screen 0
End Proc
Procedure _GRABGRID1
 HX=X : HY=Y
 TIX=BITX+X/(2-HRES) : TIY=BITY+Y/2-BY
 Screen 3
 Gr Writing 2
 _UNBUG
 X=TIX : Y=TIY
 _MON=0 : Sprite Off 0
 _MLIMIT[-100,BY*2-100,639+100,(BY+BH-1)*2+100]
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX/(2-HRES) : Y=_MY/2-BY
  _MX=Max(0,Min(639,_MX))
  _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
  X=Max(0,Min(PICW-1,X+BITX))
  Y=Max(0,Min(PICH-1,Y+BITY))
  BITX=Max(X-(319+320*HRES),Min(X,BITX))
  BITY=Max(Y-(BH-1),Min(Y,BITY))
  Screen Offset 3,BITX,BITY
  _FLASHBOX[GGTX,GGTY,GGBX,GGBY]
  _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  _MCHECK
  _FLASHBOX[GGTX,GGTY,GGBX,GGBY]
  _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
 Until MK<>1
 _MLIMIT[0,0,639,397]
 _MON=1
 Gr Writing 1
 If TIX>X Then Swap TIX,X
 If TIY>Y Then Swap TIY,Y
 If MK=0
  GGB=Y
  GSTEP=2 : _SP=2
 End If
 Screen 0
End Proc
Procedure _GRABGRID2
 HX=X : HY=Y
 TIX=BITX+X/(2-HRES) : TIY=BITY+Y/2-BY
 Screen 3
 Gr Writing 2
 _UNBUG
 X=TIX : Y=TIY
 _MON=0 : Sprite Off 0
 _MLIMIT[-100,BY*2-100,639+100,(BY+BH-1)*2+100]
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX/(2-HRES) : Y=_MY/2-BY
  _MX=Max(0,Min(639,_MX))
  _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
  X=Max(0,Min(PICW-1,X+BITX))
  Y=Max(0,Min(PICH-1,Y+BITY))
  BITX=Max(X-(319+320*HRES),Min(X,BITX))
  BITY=Max(Y-(BH-1),Min(Y,BITY))
  Screen Offset 3,BITX,BITY
  GGDX=Max(GGBX-GGTX+1,Max(X-GGTX,GGBX-X))
  GGDY=Max(GGBY-GGTY+1,Max(Y-GGTY,GGBY-Y))
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  For TABX=-1 To 1
   For TABY=-1 To 1
    _FLASHBOX[GGTX+GGDX*TABX,GGTY+GGDY*TABY,GGBX+GGDX*TABX,GGBY+GGDY*TABY]
    If GGB<>GGTY and GGB<>GGBY
     _FLASHLINE[GGTX+GGDX*TABX,GGB+GGDY*TABY,GGBX+GGDX*TABX,GGB+GGDY*TABY]
    End If
   Next
  Next
  _MCHECK
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  For TABX=-1 To 1
   For TABY=-1 To 1
    _FLASHBOX[GGTX+GGDX*TABX,GGTY+GGDY*TABY,GGBX+GGDX*TABX,GGBY+GGDY*TABY]
    If GGB<>GGTY and GGB<>GGBY
     _FLASHLINE[GGTX+GGDX*TABX,GGB+GGDY*TABY,GGBX+GGDX*TABX,GGB+GGDY*TABY]
    End If
   Next
  Next
 Until MK<>1
 _MLIMIT[0,0,639,397]
 _MON=1
 Gr Writing 1
 If TIX>X Then Swap TIX,X
 If TIY>Y Then Swap TIY,Y
 If MK=0
  GSTEP=3 : _SP=1
 End If
 Screen 0
End Proc
Procedure _GRABGRID3
 HX=X : HY=Y
 Screen 3
 Gr Writing 2
 _UNBUG
 _MON=0 : Sprite Off 0
 _MLIMIT[-100,BY*2-100,639+100,(BY+BH-1)*2+100]
 ' First test
 MK=Mouse Key
 _MCHECK
 X=_MX/(2-HRES) : Y=_MY/2-BY
 _MX=Max(0,Min(639,_MX))
 _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
 X=Max(0,Min(PICW-1,X+BITX))
 Y=Max(0,Min(PICH-1,Y+BITY))
 BITX=Max(X-(319+320*HRES),Min(X,BITX))
 BITY=Max(Y-(BH-1),Min(Y,BITY))
 Screen Offset 3,BITX,BITY

 TSX=(X-GGTX)/GGDX+(X<GGTX) : TSY=(Y-GGTY)/GGDY+(Y<GGTY)
 STX=GGTX+GGDX*TSX : STY=GGTY+GGDY*TSY
 SBX=GGBX+GGDX*TSX : SBY=GGBY+GGDY*TSY
 SB=GGB+GGDY*TSY
 SCHECK=0
 If X<=SBX and Y<=SBY
  If STX>=0 and SBX<PICW and STY>=0 and SBY<PICH
   SCHECK=1
  End If
 End If
 If SCHECK
  FTSX=TSX : FTSY=TSY
  Repeat
   MK=Mouse Key
   _MCHECK
   X=_MX/(2-HRES) : Y=_MY/2-BY
   _MX=Max(0,Min(639,_MX))
   _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
   X=Max(0,Min(PICW-1,X+BITX))
   Y=Max(0,Min(PICH-1,Y+BITY))
   BITX=Max(X-(319+320*HRES),Min(X,BITX))
   BITY=Max(Y-(BH-1),Min(Y,BITY))
   Screen Offset 3,BITX,BITY

   TSX=(X-GGTX)/GGDX+(X<GGTX) : TSY=(Y-GGTY)/GGDY+(Y<GGTY)
   STX=GGTX+GGDX*TSX : STY=GGTY+GGDY*TSY
   SBX=GGBX+GGDX*TSX : SBY=GGBY+GGDY*TSY
   SB=GGB+GGDY*TSY
   SCHECK=0
   _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
   If X<=SBX and Y<=SBY
    If STX>=0 and SBX<PICW and STY>=0 and SBY<PICH
     For LTSY=FTSY To TSY Step Sgn(TSY-FTSY) or 1
      For LTSX=FTSX To TSX Step Sgn(TSX-FTSX) or 1
       LSTX=GGTX+GGDX*LTSX : LSTY=GGTY+GGDY*LTSY
       LSBX=GGBX+GGDX*LTSX : LSBY=GGBY+GGDY*LTSY
       LSB=GGB+GGDY*LTSY
       SCHECK=1
       _FLASHBOX[LSTX,LSTY,LSBX,LSBY]
       If GGB<>GGTY and GGB<>GGBY
        _FLASHLINE[LSTX,LSB,LSBX,LSB]
       End If
      Next
     Next
    End If
   End If
   _MCHECK
   _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
   If X<=SBX and Y<=SBY
    If STX>=0 and SBX<PICW and STY>=0 and SBY<PICH
     For LTSY=FTSY To TSY Step Sgn(TSY-FTSY) or 1
      For LTSX=FTSX To TSX Step Sgn(TSX-FTSX) or 1
       LSTX=GGTX+GGDX*LTSX : LSTY=GGTY+GGDY*LTSY
       LSBX=GGBX+GGDX*LTSX : LSBY=GGBY+GGDY*LTSY
       LSB=GGB+GGDY*LTSY
       SCHECK=1
       _FLASHBOX[LSTX,LSTY,LSBX,LSBY]
       If GGB<>GGTY and GGB<>GGBY
        _FLASHLINE[LSTX,LSB,LSBX,LSB]
       End If
      Next
     Next
    End If
   End If
  Until MK<>1
  _MLIMIT[0,0,639,397]
  _MON=1
  If MK=0 and SCHECK=1
   If FTSY>TSY
    Swap FTSY,TSY
   End If
   If FTSX>TSX
    Swap FTSX,TSX
   End If
   If NC+((TSY-FTSY)+1)*((TSX-FTSX)+1)<256
    For LTSY=FTSY To TSY Step Sgn(TSY-FTSY) or 1
     For LTSX=FTSX To TSX Step Sgn(TSX-FTSX) or 1
      TIX=GGTX+GGDX*LTSX : TIY=GGTY+GGDY*LTSY
      X=GGBX+GGDX*LTSX : Y=GGBY+GGDY*LTSY
      SB=GGB+GGDY*LTSY
      If CC<NC
       Ins Bob CC+1
       For A=NC To CC+1 Step -1
        CB(A)=CB(A-1) : CX(A)=CX(A-1) : CW(A)=CW(A-1) : CH(A)=CH(A-1)
       Next
      End If
      _GRABCUT[TIX,TIY,X,Y]
      Get Bob CC+1,TIX+XOFF,TIY+YOFF To X-XCUT+1,Y-YCUT+1
      CB(CC)=SB-TIY-YOFF : CX(CC)=XOFF : CW(CC)=X-TIX+1 : CH(CC)=Y-TIY-YCUT-YOFF+1
      FW=Max(FW,CW(CC)) : FH=Max(FH,CH(CC))
      If CC<Len(DEF$)
       DEF$=Left$(DEF$,CC)+"?"+Mid$(DEF$,CC+1)
      Else
       DEF$=DEF$+"?"
      End If
      Inc NC
      Inc CC
      _SAVED=0
     Next
    Next
    _FFONT
    _FDEF
   End If
  End If
 End If
 _MLIMIT[0,0,639,397]
 _MON=1
 Gr Writing 1
 Screen 0
End Proc
Procedure _GRABPROP0
 HX=X : HY=Y
 TIX=BITX+X/(2-HRES) : TIY=BITY+Y/2-BY
 Screen 3
 Gr Writing 2
 _UNBUG
 X=TIX : Y=TIY
 _MON=0 : Sprite Off 0
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX/(2-HRES) : Y=_MY/2-BY
  _MX=Max(0,Min(639,_MX))
  _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
  X=Max(0,Min(PICW-1,X+BITX))
  Y=Max(0,Min(PICH-1,Y+BITY))
  BITX=Max(X-(319+320*HRES),Min(X,BITX))
  BITY=Max(Y-(BH-1),Min(Y,BITY))
  Screen Offset 3,BITX,BITY
  _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  Wait 1
  _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
 Until MK<>1
 _MLIMIT[0,0,639,397]
 _MON=1
 Gr Writing 1
 If MK=0
  GGB=Y
  GSTEP=1
  _SP=1
 End If
 Screen 0
End Proc
Procedure _GRABPROP1
 HX=X : HY=Y
 TIX=BITX+X/(2-HRES) : TIY=BITY+Y/2-BY
 Screen 3
 Gr Writing 2
 _UNBUG
 X=TIX : Y=TIY
 _MON=0 : Sprite Off 0
 _MLIMIT[-100,BY*2-100,639+100,(BY+BH-1)*2+100]
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX/(2-HRES) : Y=_MY/2-BY
  _MX=Max(0,Min(639,_MX))
  _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
  X=Max(0,Min(PICW-1,X+BITX))
  Y=Max(0,Min(PICH-1,Y+BITY))
  BITX=Max(X-(319+320*HRES),Min(X,BITX))
  BITY=Max(Y-(BH-1),Min(Y,BITY))
  Screen Offset 3,BITX,BITY
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TIX,TIY]
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,GGB]
  _MCHECK
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TIX,TIY]
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  _BASELINE[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,GGB]
 Until MK<>1
 _MLIMIT[0,0,639,397]
 _MON=1
 Gr Writing 1
 If TIX>X Then Swap TIX,X
 If TIY>Y Then Swap TIY,Y
 If MK=0 and NC<255
  If CC<NC
   Ins Bob CC+1
   For A=NC To CC+1 Step -1
    CB(A)=CB(A-1) : CX(A)=CX(A-1) : CW(A)=CW(A-1) : CH(A)=CH(A-1)
   Next
  End If
  _GRABCUT[TIX,TIY,X,Y]
  Add TIX,XOFF : Add TIY,YOFF : Add X,-XCUT : Add Y,-YCUT
  Get Bob CC+1,TIX,TIY To X+1,Y+1
  CB(CC)=GGB-TIY : CX(CC)=0 : CW(CC)=X-TIX+1 : CH(CC)=Y-TIY+1
  FW=Max(FW,CW(CC)) : FH=Max(FH,CH(CC))
  If CC<Len(DEF$)
   DEF$=Left$(DEF$,CC)+"?"+Mid$(DEF$,CC+1)
  Else
   DEF$=DEF$+"?"
  End If
  Inc NC
  Inc CC
  _SAVED=0
  _FFONT
  _FDEF
 End If
 Screen 0
End Proc
Procedure _GRAB
 HX=X : HY=Y
 TIX=BITX+X/(2-HRES) : TIY=BITY+Y/2-BY
 Screen 3
 Gr Writing 2
 _UNBUG
 X=TIX : Y=TIY
 _MON=0 : Sprite Off 0
 _MLIMIT[-100,BY*2-100,639+100,(BY+BH-1)*2+100]
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX/(2-HRES) : Y=_MY/2-BY
  _MX=Max(0,Min(639,_MX))
  _MY=Max(BY*2,Min((BY+BH-1)*2,_MY))
  X=Max(0,Min(PICW-1,X+BITX))
  Y=Max(0,Min(PICH-1,Y+BITY))
  BITX=Max(X-(319+320*HRES),Min(X,BITX))
  BITY=Max(Y-(BH-1),Min(Y,BITY))
  Screen Offset 3,BITX,BITY
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TIX,TIY]
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
  _MCHECK
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,TIX,TIY]
  _CROSSHAIR[BITX,BITY,BITX+319+320*HRES,BITY+BH-1,X,Y]
 Until MK<>1
 _MLIMIT[0,0,639,397]
 _MON=1
 Gr Writing 1
 If TIX>X Then Swap TIX,X
 If TIY>Y Then Swap TIY,Y
 If MK=0 and NC<255
  If CC<NC
   Ins Bob CC+1
   For A=NC To CC+1 Step -1
    CB(A)=CB(A-1) : CX(A)=CX(A-1) : CW(A)=CW(A-1) : CH(A)=CH(A-1)
   Next
  End If
  _GRABCUT[TIX,TIY,X,Y]
  Get Bob CC+1,TIX+XOFF,TIY+YOFF To X-XCUT+1,Y-YCUT+1
  CB(CC)=Y-TIY-YOFF : CX(CC)=XOFF : CW(CC)=X-TIX+1 : CH(CC)=Y-TIY-YCUT-YOFF+1
  FW=Max(FW,CW(CC)) : FH=Max(FH,CH(CC))
  If CC<Len(DEF$)
   DEF$=Left$(DEF$,CC)+"?"+Mid$(DEF$,CC+1)
  Else
   DEF$=DEF$+"?"
  End If
  Inc NC
  Inc CC
  _SAVED=0
  _FFONT
  _FDEF
 End If
 Screen 0
End Proc
Procedure _BRMB
 HX=X : HY=Y
 _MLIMIT[0,0,(PICW-(320+HRES*320))*(2-HRES)+1-HRES,(PICH-BH)*2+1]
 _MX=BITX*(2-HRES) : _MY=BITY*2 : _MON=0 : Sprite Off 0
 Repeat
  Wait 1
  MK=Mouse Key
  _MCHECK
  X=_MX : Y=_MY
  BITX=X/(2-HRES)
  BITY=Y/2
  Screen Offset 3,BITX,BITY
 Until MK<2
 _MINIT
 _MX=HX : _MY=HY : _MON=1
End Proc
Procedure _GSELNORM
 _SP=1 : GMODE=0
End Proc
Procedure _GSELGRID
 _SP=2 : GMODE=1 : GSTEP=0
End Proc
Procedure _GSELPROP
 _SP=3 : GMODE=2 : GSTEP=0
End Proc
Procedure _PON
 If PON
  Screen Close 4
  Screen Close 5
  PON=0
  If FON*FY>PY
   Add FY,-38
   Screen Display 1,,50+FY,,
   Screen Display 2,,50+FY+17,,
  End If
  If BON*BY
   Add BH,38
   BITX=Max(0,Min(PICW-(320+HRES*320),BITX))
   BITY=Max(0,Min(PICH-BH,BITY))
   Screen Offset 3,BITX,BITY
   If BON*BY>PY
    Add BY,-38
   End If
   If FON*FY>BY
    Add FY,38
    Screen Display 1,,50+FY,,
    Screen Display 2,,50+FY+17,,
   End If
   Screen Display 3,,50+BY,,BH
  End If
  Screen 0
 Else
  '  Palette Editor
  Screen Open 4,640,28,16,Hires
  PY=13+FON*58+BON*(BH+1-38) : PON=1
  Screen Display 4,128,50+PY,640,28
  Curs Off : Flash Off : Cls 0
  Get Icon Palette
  Paste Icon 0,0,7
  '  Palette
  Screen Open 5,320,8,32,0
  Screen Display 5,128,50+PY+29,320,8
  Curs Off : Flash Off : Cls 0
  Get Palette 3
  '  Set Bitmap too
  If BON
   Add BH,-38
   If FON*FY>BON*BY
    Add FY,-38
    Screen Display 1,,50+FY,,
    Screen Display 2,,50+FY+17,,
   End If
   Screen Display 3,,50+BY,,BH
  End If
  _PCOLOR
  _FPAL
  _PCOLOR
  Screen 0
 End If
End Proc
Procedure _PLMB
 S=Screen
 Screen 4
 Y=Y/2-PY
 If Y>13 and Y<26 and X>2 and X<156
  PBUT=(X-3)/51

  GAD[3+PBUT*51,14,51,12,2,1]
  If PBUT=0
   _PSPREAD
  End If
  If PBUT=1
   _PCOPY
  End If
  If PBUT=2
   _PEX
  End If
  _QUIET
  GAD[3+PBUT*51,14,51,12,2,0]

 Else
  If X>443 and X<636 and Y>1 and Y<26
   _PALTER
  Else
   If Y>28
    _PSELECT
   End If
  End If
 End If
 Screen S
End Proc
Procedure _PSELECT
 PC=X/20
 If PLOP=1 and PC<>PLPC
  For PCS=PC To PLPC Step Sgn(PLPC-PC)
   FR(PCS)=FR(PC)+((FR(PLPC)-FR(PC))*(PCS-PC))/(PLPC-PC)
   FG(PCS)=FG(PC)+((FG(PLPC)-FG(PC))*(PCS-PC))/(PLPC-PC)
   FB(PCS)=FB(PC)+((FB(PLPC)-FB(PC))*(PCS-PC))/(PLPC-PC)
  Next
  _FPAL
 End If
 If PLOP=2
  FR(PC)=FR(PLPC)
  FG(PC)=FG(PLPC)
  FB(PC)=FB(PLPC)
  _FPAL
 End If
 If PLOP=3
  Swap FR(PC),FR(PLPC)
  Swap FG(PC),FG(PLPC)
  Swap FB(PC),FB(PLPC)
  _FPAL
 End If
 _PCOLOR
End Proc
Procedure _PSPREAD
 PLOP=1 : PLPC=PC
End Proc
Procedure _PCOPY
 PLOP=2 : PLPC=PC
End Proc
Procedure _PEX
 PLOP=3 : PLPC=PC
End Proc
Procedure _PALTER
 PSL=(Y-2)/8
 CV=(X-444)/12
 If PSL=0 Then N=FR(PC)
 If PSL=1 Then N=FG(PC)
 If PSL=2 Then N=FB(PC)
 If N=CV
  Repeat
   _MCHECK
   X=_MX : Y=_MY : MK=Mouse Key
   Ink 2
   Gr Locate 444+CV*12,3+PSL*8
    Extension_12_01B0 11,5
   CV=Max(0,Min(15,(X-444)/12))
   Paste Icon 444+CV*12,3+PSL*8,8
  Until MK<>1
  If MK=2
   CV=N
  End If
 Else
  CV=N+Sgn(CV-N)
 End If
 If PSL=0 Then FR(PC)=CV
 If PSL=1 Then FG(PC)=CV
 If PSL=2 Then FB(PC)=CV
 _FPAL
 _PCOLOR
End Proc
Procedure _PCOLOR
 If PON
  S=Screen
  Screen 5
  Paste Icon 0,0,9
  Ink -(PC=0)
  Gr Locate PC*10,0
   Extension_12_01B0 9,7
  Ink PC
   Extension_12_0172 1,1
   Extension_12_01B0 7,5
  Screen 4
  Ink 2
  For SC=0 To 2
   Gr Locate 444,3+SC*8
    Extension_12_01B0 191,5
   SCC=-(SC=0)*FR(PC)-(SC=1)*FG(PC)-(SC=2)*FB(PC)
   Paste Icon 444+SCC*12,3+SC*8,8
  Next
  Screen S
  PLOP=0
 End If
End Proc
Procedure _ABOUT
 Sprite Off 0
 Paste Icon 0,12,10
 Screen Display 0,,,640,63
 Repeat
  _MCHECK
  MK=Mouse Key
 Until MK
 Screen Display 0,,,640,12
 Bar 0,12 To 640,111
End Proc
Procedure _MENU
 MPICK=0 : ACTIVE=0
 Paste Icon 0,0,2
 Screen To Front 0
 Repeat
  MK=Mouse Key
  _MCHECK
  X=_MX : Y=_MY/2
  If Y<12 and X>=7 and X<=426
   NEWACTIVE=(X-7)/105+1
   If ACTIVE<>NEWACTIVE
    If ACTIVE
     GAD[7+(ACTIVE-1)*105,0,105,12,2,1]
    End If
    ACTIVE=NEWACTIVE
    GAD[7+(ACTIVE-1)*105,0,105,12,2,0]
    MPICK=0
    Ink 0 : Bar 0,12 To 640,111
    Paste Icon 7+(ACTIVE-1)*105,12,ACTIVE+2
    Screen Display 0,,,640,16+MNUMS(ACTIVE-1)*12
   Else
    If MPICK/16=ACTIVE
     GAD[AX,14+(MPICK-ACTIVE*16)*12,310,12,2,1]
     MPICK=0
    End If
   End If
  Else
   If ACTIVE
    C=1
    AX=10+(ACTIVE-1)*105
    If X>=AX and X<=AX+309 and Y>=14 and Y<=139
     YCOM=(Y-14)/12
     SYCOM=2^YCOM
     If SYCOM and MITEMS(ACTIVE-1)
      NEWMPICK=ACTIVE*16+YCOM
      C=0
      If MPICK<>NEWMPICK
       If MPICK/16=ACTIVE
        GAD[AX,14+(MPICK-ACTIVE*16)*12,310,12,2,1]
       End If
       MPICK=NEWMPICK
       GAD[AX,14+YCOM*12,310,12,2,0]
      End If
     End If
    End If
    If C=1 and(MPICK/16=ACTIVE)
     GAD[AX,14+(MPICK-ACTIVE*16)*12,310,12,2,1]
     MPICK=0
    End If
   End If
  End If
 Until MK<2
 Screen Display 0,,,640,12
 Ink 0 : Bar 0,12 To 640,111
 Paste Icon 0,0,1
End Proc
Procedure _MLMB
 PFB=(X-583)/19
 GAD[583+PFB*19,0,19,12,2,1]
 If PFB=0
  _PON
 Else
  If PFB=1
   _FON
  Else
   If PFB=2
    _BON
   End If
  End If
 End If
 _QUIET
 GAD[583+PFB*19,0,19,12,2,0]
End Proc
Procedure _QUIT
 If FON Then Screen Close 1 : Screen Close 2
 If PON Then Screen Close 4 : Screen Close 5
 Screen Close 3
 Screen Close 7
 Screen Close 0
 Wait 5
 Show
 Erase 1
 Bank Swap 1,3
 Edit
End Proc
Procedure _INIT
 ' If Leek(Start(1)-20)<>106 Then Bell : Wait 30 : Edit
 Bank Swap 1,3

 No Icon Mask
 Make Icon Mask 8

 For A=0 To 3 : Read MITEMS(A),MNUMS(A) : Next
 Screen Open 7,320,200,2,0
 Curs Off : Flash Off : Cls 0
 Screen Display 7,128,50,320,200
 Screen Open 0,640,124,16,Hires
 Curs Off : Flash Off : Cls 0
 Get Icon Palette
 Screen Display 0,128,50,640,12
 _MINIT
 Hide : _MON=1
 Shift Down 6,4,9,1
 Paste Icon 0,0,1

 PICW=320 : PICH=200 : HRES=0
 DEFPICNAME$=""
 DEF$="" : NC=0 : FW=0 : FH=0
 For A=0 To 254
  CB(A)=0 : CX(A)=0 : CW(A)=0
 Next
 CC=0
 _CUT=0
 _SAVED=1
 _GSELNORM

 Screen Open 3,PICW,PICH,32-HRES*16,HRES*Hires
 Curs Off : Flash Off : Cls 1
 A=$888
 Palette 0,$36,$6A,$9F,A,A,A,A,A,A,A,A,A,A,A,A,A,,,,A,A,A,A,A,A,A,A,A,A,A,A
 _GETFPALETTE
 Screen Hide 3
 Screen 0

 _BON
 _FON

 PC=0 : PLOP=0 : PLPC=0 : GMODE=0 : GSTEP=0

 MENUDATA:
 Data 189,8,11,4,471,9,23,5
End Proc
Procedure GAD[X1,Y1,X2,Y2,C,DN]
 X2=X1+X2-1 : Y2=Y1+Y2-1
 Ink C+1-DN*2
  Extension_12_04CC X1,Y2-1 To X1,Y1 : Extension_12_04CC X1,Y1 To X2-1,Y1
 Ink C-1+DN*2
  Extension_12_04CC X2,Y1+1 To X2,Y2 : Extension_12_04CC X2,Y2 To X1+1,Y2
End Proc
Procedure _QUIET
 TEM=_MON
 _MON=0
 Sprite Off 0
 Repeat
  _MCHECK
  MK=Mouse Key
  K=Asc(Inkey$)-Key State(70)-Key State(65)-Key State(69)
 Until MK=0 and K=0
 _MON=TEM
End Proc
Procedure _CROSSHAIR[X1,Y1,X2,Y2,XI,YI]
 Draw X1,YI To X2,YI
 Draw XI,Y1 To XI,Y2
End Proc
Procedure _BASELINE[X1,Y1,X2,Y2,XI,YI]
 Draw X1,YI To X2,YI
End Proc
Procedure _FLASHBOX[X1,Y1,X2,Y2]
 Draw X1,Y1 To X2,Y1
 Draw To X2,Y2
 Draw To X1,Y2
 Draw To X1,Y1
End Proc
Procedure _FLASHLINE[X1,Y1,X2,Y2]
 Plot X1,Y1
 Draw X1,Y1 To X2,Y2
End Proc
Procedure _UNBUG
 A= Extension_12_044C(0,0)
 Draw 0,0 To 0,0
  Extension_12_036E 0,0,A
End Proc
Procedure _MINIT
 Limit Mouse 128,50 To 128+319,50+199
 XR=Peek($DFF00B) : YR=Peek($DFF00A)
 _MX=320 : _MY=200
 _MLIMIT[0,0,639,397]
End Proc
Procedure _MCHECK
 WX=Peek($DFF00B)-XR
 If WX<-128 Then Add WX,256
 If WX>127 Then Add WX,-256
 WY=Peek($DFF00A)-YR
 If WY<-128 Then Add WY,256
 If WY>127 Then Add WY,-256
 XR=Peek($DFF00B) : YR=Peek($DFF00A)
 DX=WX
 DY=WY
 _MX=Max(_MTX,Min(_MBX,_MX+DX))
 _MY=Max(_MTY,Min(_MBY,_MY+DY))
 Bank Swap 1,3
 Sprite 0,128+_MX/2,50+_MY/2,_MON*_SP
 Multi Wait
 Bank Swap 1,3
End Proc
Procedure _MLIMIT[X1,Y1,X2,Y2]
 _MTX=X1 : _MTY=Y1
 _MBX=X2 : _MBY=Y2
End Proc
Procedure _BOX[X1,Y1,X2,Y2,C]
 Ink C
  Extension_12_04CC X1,Y1 To X2,Y1 : Extension_12_04CC X2,Y1 To X2,Y2
  Extension_12_04CC X2,Y2 To X1,Y2 : Extension_12_04CC X1,Y2 To X1,Y1
End Proc
Procedure _GETFPALETTE
 For A=0 To 31
  CA=Colour(A)
  FR(A)=(CA and $F00)/$100
  FG(A)=(CA and $F0)/$10
  FB(A)=(CA and $F)
 Next
End Proc
Procedure _PUTFPALETTE
 For A=0 To 31
  Colour A,FR(A)*$100+FG(A)*$10+FB(A)*$1
 Next
End Proc
Procedure _POKESTRING[LOC,S$]
 For SL=1 To Len(S$)
  Poke LOC+SL-1,Asc(Mid$(S$,SL,1))
 Next
End Proc
Procedure _PEEKSTRING[LOC,SL]
 S$=""
 For SLC=1 To SL
  S$=S$+Chr$(Peek(LOC+SLC-1))
 Next
End Proc[S$]
Procedure _PERMPALETTE
 PS=Start(1)+2+Length(1)*8
 For A=0 To 31
  Doke PS+A*2,FR(A)*$100+FG(A)*$10+FB(A)*$1
 Next
End Proc
Procedure _GETFILEPAL
 PS=Start(1)+2+Length(1)*8
 For A=0 To 31
  CA=Deek(PS+A*2)
  FR(A)=(CA and $F00)/$100
  FG(A)=(CA and $F0)/$10
  FB(A)=(CA and $F)
 Next
End Proc
Procedure _GRABCUT[X1,Y1,X2,Y2]
 XOFF=0 : YOFF=0 : XCUT=0 : YCUT=0

 ' Left
 T=0 : Repeat
  If X1<X2
   For A=Y1 To Y2
    Add T,-(Point(X1,A)>0)
   Next
   If T=0
    Inc X1
    Inc XOFF
   End If
  Else
   T=1
  End If
 Until T

 ' Top
 T=0 : Repeat
  If Y1<Y2
   For A=X1 To X2
    Add T,-(Point(A,Y1)>0)
   Next
   If T=0
    Inc Y1
    Inc YOFF
   End If
  Else
   T=1
  End If
 Until T

 ' Right
 T=0 : Repeat
  If X1<X2
   For A=Y1 To Y2
    Add T,-(Point(X2,A)>0)
   Next
   If T=0
    Dec X2
    Inc XCUT
   End If
  Else
   T=1
  End If
 Until T

 ' Bottom
 T=0 : Repeat
  If Y1<Y2
   For A=X1 To X2
    Add T,-(Point(A,Y2)>0)
   Next
   If T=0
    Dec Y2
    Inc YCUT
   End If
  Else
   T=1
  End If
 Until T
 Ink Rnd(31)
End Proc
Procedure MC
 X=0 : Y=0 : MK=0
End Proc
Procedure F_TEXT[XO,YO,S$]
 XC=XO
 For A=1 To Len(S$)
  CH=-1
  B=0
  Repeat
   If Mid$(DEF$,B+1,1)=Mid$(S$,A,1) Then CH=B
   Inc B
  Until B=NC or CH>=0
  If CH>=0
   Paste Bob XC+CX(CH),YO-CB(CH),CH+1
   Add XC,CW(CH)+1
  End If
 Next
End Proc
Procedure F_TEXT_WIDTH[S$]
 WIDTH=0
 For A=1 To Len(S$)
  CH=-1
  B=0
  Repeat
   If Mid$(DEF$,B+1,1)=Mid$(S$,A,1) Then CH=B
   Inc B
  Until B=NC or CH>=0
  If CH>=0
   Add WIDTH,CW(CH)+1
  End If
 Next
End Proc[WIDTH]
Procedure F_TEXT_CENTRE[XO,YO,S$]
 F_TEXT_WIDTH[S$]
 F_TEXT[XO-Param/2,YO,S$]
End Proc
Procedure _TESTFONT
 If NC>0
  Sprite Off 0
  Screen Open 6,320+FRES*320,200,32-16*FRES,FRES*Hires
  Screen Display 6,128,50,320+FRES*320,200
  Curs Off : Flash Off : Cls 0
  _PUTFPALETTE
  YYY=100+FH/2
  F_TEXT_CENTRE[160+FRES*160,YYY-FH*2-2,"ABCDEFGHIJKLM"]
  F_TEXT_CENTRE[160+FRES*160,YYY-FH-1,"NOPQRSTUVWXYZ"]
  F_TEXT_CENTRE[160+FRES*160,YYY,"0123456789.!?"]
  F_TEXT_CENTRE[160+FRES*160,YYY+FH+1,"FONT TEST SCREEN"]
  F_TEXT_CENTRE[160+FRES*160,YYY+FH*2+2,"abcdefghijklm"]
  F_TEXT_CENTRE[160+FRES*160,YYY+FH*3+3,"nopqrstuvwxyz"]
  'fh=font height
  '   X=0 : Y=YY+FH*3+3
  'put typing test mode here, although this is ok for now.
  Repeat
   _MCHECK
  Until Mouse Key
  Screen Close 6
  Screen 0
 End If
End Proc