AmigActive 26/AACD 26.iso/AACD/Programming/AllPlaton/LOM/NewMapEditor.AMOS/NewMapEditor.amosSourceCode

AMOS Source Code | 1995-11-03 | 70.7 KB | 2,751 lines

' *************************************
' *                                   *
' *     LOM Level Map Editor V0.6     *
' *      Written by Chris Hodges      *
' *                                   *
' *************************************
'
Set Buffer 40
If Screen<>-1 Then Screen Close 0
MXFILES=200
Dim FIL$(MXFILES)
Dim BOOL$(1),TIAR$(7,1),INVO$(7,1),ACTI$(7,1)
Dim FB(60,4),FB$(60)
Global FB(),FB$()
TH=8
Global TH
If Exist("EditorDats/LastSession.Abk") Then Load "EditorDats/LastSession.Abk"
Break Off
Gosub INIT
TILRAN1=0 : TILRAN2=0
Gosub MAIN
If Param=0 Then Save "EditorDats/LastSession.Abk"
Fade 1 : Wait 16 : Screen Close 0
Fade 1 : Wait 16 : Screen Close 1
Erase All
End
EVENTLOOP:
  OMK=MK
  Screen 0
  If Key Shift and 32 Then X Mouse=X Hard(XM)
  If Key Shift and 16 Then Y Mouse=Y Hard(YM)
  XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
  If MO>-1
    If MK=0
      Limit Mouse 128,40 To 447,300
    Else
      If YM>84
        Limit Mouse 128,40+85 To 447,300
      Else
        Limit Mouse 128,40 To 447,300
      End If
    End If
  End If
  If I$="" Then Multi Wait
  BT=0
  If YM=0 : I$=Cup$ : End If
  If YM>84
    If XM=0 : I$=Cleft$ : End If
    If XM=638 : I$=Cright$ : End If
    If MK<>0 and YM=85 : I$=Cup$ : End If
    If YM=260 : I$=Cdown$ : End If
    If MO=0
      XB=XM/32+MAPX
      YB=Y Screen(1,Y Mouse)/16+MAPY
    End If
    If MO=1
      X=XM/32
      Y=Y Screen(1,Y Mouse)/16+YOF
      XB=Min(X+Y*20,NI-1) : YB=0
    End If
    If MO=2
      XB=(XM/320)*8+Min(Y Screen(1,Y Mouse)/22,7) : YB=0
    End If
    If MO=3
      XB=(XM/320)*10+Min(Y Screen(1,Y Mouse)/17,9)+AROF : YB=0
    End If
    If MO=4
      XB=(XM/160)*10+Min(Y Screen(1,Y Mouse)/17,9)+ANOF : YB=(XM mod 160)/80
    End If
    If MK
      If XB<>OXB or YB<>OYB
        Gosub BUTPRESS
        OXB=XB : OYB=YB
      End If
    Else
      OXB=-1 : OYB=-1
    End If
  Else
    If MK=1 and OMK<>1
      CHKMOUSE[XM,YM,25,59]
      BT=Param
    End If
  End If
  Gosub UPDATINFO
  If BT=31 and MO<>0 Then Gosub VIEMAP
  If BT=36 and MO<>1 Then Gosub VIETILES
  If BT=51 Then UNDO
  If BT=52 Then REDO
  If BT>38 and BT<44 and VIMO<>BT-39
    FB(39+VIMO,4)=1 : RELEGAD[39+VIMO]
    VIMO=BT-39
    FB(39+VIMO,4)=5 : PUSHGAD[39+VIMO]
  End If
  If BT=47
    If BOMO=0
      FB(47,4)=5 : PUSHGAD[47]
      BOMO=1
    Else
      FB(47,4)=1 : RELEGAD[47]
      BOMO=0
    End If
  End If
  If BT=49
    If AUMO=0
      If Length(30)=0
        REQUEST["Please define one autowall first!","Ok"]
        Gosub AUTOWALL
      End If
      FB(49,4)=5 : PUSHGAD[49]
      AUMO=1
    Else
      FB(49,4)=1 : RELEGAD[49]
      AUMO=0
    End If
  End If
  If I$<>""
    Gosub CONTROLS
    Screen 1
    If MO=0 : Gosub VIEMAPCONTROLS : End If
    If MO=1 : Gosub VIETILECONTROLS : End If
    If MO=2 : Gosub VIEAUTOWALLCONTROLS : End If
    If MO=3 : Gosub VIEATTRCONTROLS : End If
  End If
  If BT=26 Then Amos To Back
Return
BUTPRESS:
' Map
  If MO=0 and VIMO>-1
    If MK=1
      If BOMO=0
        If VIMO<2
          If TILRAN1<>TILRAN2
            TIL=TILRAN1+Rnd(TILRAN2-TILRAN1)
          Else
            TIL=TILRAN1
          End If
          Screen 1
          If OMK=0
            NEWUNDO
          End If
          If AUMO=0
            PLT[XB,YB,TIL]
          Else
            PLTAUMO[XB,YB,TIL]
          End If
        End If
      Else
        If OMK=0
          XB1=XB : YB1=YB
        Else
          UNDO
        End If
        NEWUNDO
        Screen 1
        If TILRAN1=TILRAN2
          For Y=YB1 To YB Step(YB<YB1)*2+1
            For X=XB1 To XB Step(XB<XB1)*2+1
              If AUMO=0
                PLT[X,Y,TILRAN1]
              Else
                PLTAUMO[X,Y,TILRAN1]
              End If
            Next
          Next
        Else
          For Y=YB1 To YB Step(YB<YB1)*2+1
            For X=XB1 To XB Step(XB<XB1)*2+1
              If AUMO=0
                PLT[X,Y,TILRAN1+Rnd(TILRAN2-TILRAN1)]
              Else
                PLTAUMO[X,Y,TILRAN1+Rnd(TILRAN2-TILRAN1)]
              End If
            Next
          Next
        End If
      End If
    Else
      If VIMO=0
        TILRAN1=Min(Deek(MAPST+(XB+YB*MAPMAXX)*4),NI-1)
        TILRAN2=TILRAN1
      End If
      If VIMO=1
        If BOMO
          If OMK=0
            XB1=XB : YB1=YB
          Else
            UNDO
          End If
          NEWUNDO
          Screen 1
          For Y=YB1 To YB Step(YB<YB1)*2+1
            For X=XB1 To XB Step(XB<XB1)*2+1
              PLT[X,Y,NULTIL]
            Next
          Next
        Else
          Screen 1
          PLT[XB,YB,NULTIL]
        End If
      End If
    End If
  End If
' Map + Attr-Edit
  If MO=0 and VIMO=-1 and MK<>0
    If MK=1
      A=TIAR or $8000
    Else
      A=0
    End If
    If BOMO=0
      Screen 1
      If OMK=0
        NEWUNDO
      End If
      PATTR[XB,YB,A]
    Else
      If OMK=0
        XB1=XB : YB1=YB
      Else
        UNDO
      End If
      NEWUNDO
      Screen 1
      For Y=YB1 To YB Step(YB<YB1)*2+1
        For X=XB1 To XB Step(XB<XB1)*2+1
          PATTR[X,Y,A]
        Next
      Next
    End If
  End If
' Tiles-Selector
  If MO=1
    If MK=1
      If OMK=0
        TILRAN1=XB : TILRAN2=XB
      Else
        TILRAN2=Min(Max(TILRAN1,XB),TILRAN1+6)
      End If
      Gosub UPDATSELLINE
    Else
      NULTIL=XB
    End If
  End If
' Autowall Editor
  If MO=2
    If OMK=0
      If MK=1
        Doke AWST+CUAW*64+XB*4,TILRAN1
        Doke AWST+CUAW*64+XB*4+2,TILRAN2
      Else
        Doke AWST+CUAW*64+XB*4,0
        Doke AWST+CUAW*64+XB*4+2,0
      End If
      Screen 1
      Gosub UPDATAUTOWALL
    End If
  End If
' Attributes Editor
  If MO=3
    If OMK=0
      If MK=1
        Doke ARST+XB*4,TIAR
        Gosub VIEATTRIBUTES
      Else
        Doke ARST+XB*4,0
        Gosub VIEATTRIBUTES
      End If
    End If
  End If
' Animation Editor
  If MO=4
    If OMK=0
      If MK=1
        Doke ANST+XB*4+YB*2,TILRAN1
        Gosub VIETILEANIM
      Else
        Doke ANST+XB*4+YB*2,0
        Gosub VIETILEANIM
      End If
    End If
  End If
Return
INIT:
  BOOL$(0)="no "
  BOOL$(1)="yes"
  TIAR$(0,0)="sld"
  TIAR$(1,0)="wtr"
  TIAR$(2,0)="lth"
  TIAR$(3,0)="anm"
  TIAR$(0,1)="solid"
  TIAR$(1,1)="water"
  TIAR$(2,1)="lethal"
  TIAR$(3,1)="sp.anim"
  INVO$(0,0)="noinv"
  INVO$(1,0)="inv ^"
  INVO$(2,0)="inv >"
  INVO$(3,0)="inv v"
  INVO$(4,0)="inv <"
  INVO$(5,0)="inv +"
  INVO$(6,0)="inv X"
  INVO$(7,0)="inv *"
  INVO$(0,1)="no invoke"
  INVO$(1,1)="invoke ^"
  INVO$(2,1)="invoke >"
  INVO$(3,1)="invoke v"
  INVO$(4,1)="invoke <"
  INVO$(5,1)="invoke +"
  INVO$(6,1)="invoke X"
  INVO$(7,1)="invoke *"
  ACTI$(0,0)="n/a"
  ACTI$(1,0)="spc"
  ACTI$(2,0)="exit"
  ACTI$(3,0)="door"
  ACTI$(4,0)="lddr"
  ACTI$(0,1)="no action"
  ACTI$(1,1)="special"
  ACTI$(2,1)="map exit"
  ACTI$(3,1)="door"
  ACTI$(4,1)="ladder"
  NI=Length(2)
  MO=-1 : VIMO=0 : BOMO=1 : CUAW=0 : AUMO=0
  FAUW$="EditorDats/Default.auw"
  FAWD$="EditorDats/Default.awd"
  FARD$="Maps/Attributes.dat"
  FAND$="Maps/Animations.tan"
  FMAP$="Maps/TestMap.map"
  FPIC$="RAM:Test.iff"
  FICO$="EditorDats/Default.abk"
  FPTL$="Graphics/AllGfx.ptl"
  Screen Open 1,320,176,32,0
  Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  Screen Display 1,128,40+85,320,176
  If NI
    Get Icon Palette
  Else
    Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  End If
  Screen Open 0,640,84,16,$8000
  Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  Get Palette 1
  Palette 0,$FFF,$AAA,$666
  Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  Screen Display 0,128,40,320,84
  Wait Vbl
  Limit Mouse
  Gosub CREATEMAINSCREEN
  If Length(9)
    ST=Start(9)
    MAPST=Start(9)+256
    MAPMAXX=Deek(ST+4)
    MAPMAXY=Deek(ST+6)
    MAPSCRX=Deek(ST+8)
    MAPSCRY=Deek(ST+10)
  End If
  If Length(30) Then AWST=Start(30)
  If Length(2) and Length(9)
    FB(31,4)=5 : PUSHGAD[31]
    Screen 1 : MO=0 : Gosub UPDATWHOLEMAP
  End If
  CLRUNDO
  TILSUM=-1 : OLDSUM=-1
  If MO=1 Then Screen 1 : Gosub UPDATSELLINE
  Screen 0
  Gosub UPDATINFO
Return
CREATEMAINSCREEN:
  Screen 0
  Gr Writing 0
  Cls 0
  DEFCLOWIN[25,0,0]
  TEXBOX[19,0,616,10,0,"Land Of Magic - Map Editor V0.6"]
  DEFSCRTBK[26,617,0]
  FILBOX[0,11,639,83,0]
  DEFTEX[27,4,13,84,23,"Load Map",1]
  DEFTEX[28,4,25,84,35,"Save Map",1]
  DEFTEX[29,4,37,84,47,"Set Size",1]
  DEFTEX[30,4,49,84,59,"Clear Map",1]
  DEFTEX[31,4,61,84,71,"View Map",1]
  DEFTEX[32,87,13,174,23,"Load Ptile",1]
  DEFTEX[33,87,25,174,35,"Save Ptile",1]
  DEFTEX[34,87,37,174,47,"Load Icons",1]
  DEFTEX[35,87,49,174,59,"Save Icons",1]
  DEFTEX[36,87,61,174,71,"View Tiles",1]
  DEFTEX[37,177,13,264,23,"Grab Icons",1]
  DEFTEX[38,177,25,264,35,"Save Iff",1]
  DEFTEX[39,267,13,354,23,"Sel. Tile",1]
  DEFTEX[40,267,25,354,35,"Draw Tile",1]
  DEFTEX[41,267,37,354,47,"Set Enemy",1]
  DEFTEX[42,267,49,354,59,"Set Items",1]
  DEFTEX[43,267,61,354,71,"Info",1]
  DEFTEX[44,177,37,264,47,"Editors",1]
  ' Anim Editor, Block Editor, Autowall Editor, Enemy Editor
  DEFTEX[46,177,61,264,71,"View En/It",1]
  DEFTEX[47,357,13,444,23,"Box mode",1+BOMO*4]
  DEFTEX[48,357,25,444,35,"Block mode",1]
  DEFTEX[49,357,37,444,47,"Autowall",1+AUMO*4]
  DEFTEX[51,357,61,399,71,"Undo",1]
  DEFTEX[52,402,61,444,71,"Redo",1]
  DEFBOX[60,4,73,635,81,0]
  DRAPROCBAR[60,1,1]
  DRABOX[500,13,635,71,0]
  DEAGAD[41] : DEAGAD[42] : DEAGAD[43]
  DEAGAD[46] : DEAGAD[48]
  FB(39+VIMO,4)=5 : PUSHGAD[39+VIMO]
  If MO=0 Then Gosub VIEMAP
  If MO=1 Then Gosub VIETILES
  If MO>-1 Then Gosub UPDATSELLINE
Return
CREATEAUTOWALLSCREEN:
  Screen 0
  Gr Writing 0
  Cls 0
  DEFCLOWIN[25,0,0]
  TEXBOX[19,0,616,10,0,"Land Of Magic - Autowall Editor V1.0"]
  DEFSCRTBK[26,617,0]
  FILBOX[0,11,639,83,0]
  DEFBOX[60,4,73,635,81,0]
  DRAPROCBAR[60,1,1]
  DRABOX[500,13,635,71,0]
  DEFTEX[27,4,13,84,23,"Load Def",1]
  DEFTEX[28,4,25,84,35,"Save Def",1]
  DEFTEX[29,4,37,84,47,"Load All",1]
  DEFTEX[30,4,49,84,59,"Save All",1]
  DEFTEX[31,4,61,84,71,"View Map",1]
  DEFTEX[32,87,13,174,59,"<",1]
  DEFTEX[33,177,13,264,59,">",1]
  DEFTEX[36,87,61,174,71,"View Tiles",1]
  DEFTEX[39,267,13,354,23,"Sel. Tile",1]
  DEFTEX[40,267,25,354,35,"Draw Tile",1]
  DEFTEX[41,267,37,354,47,"Set Enemy",1]
  DEFTEX[42,267,49,354,59,"Set Items",1]
  DEFTEX[43,267,61,354,71,"Info",1]
  DEFTEX[46,177,61,264,71,"View Auto",5]
  DEFTEX[47,357,13,444,23,"Box mode",1+BO*4]
  DEFTEX[48,357,25,444,35,"Block mode",1]
  DEFTEX[49,357,37,444,47,"Autowall",1+AUMO*4]
  DEFTEX[51,357,61,399,71,"Undo",1]
  DEFTEX[52,402,61,444,71,"Redo",1]
  DEAGAD[31]
  DEAGAD[41] : DEAGAD[42] : DEAGAD[43]
  DEAGAD[47] : DEAGAD[48] : DEAGAD[49] : DEAGAD[51] : DEAGAD[52]
  FB(39+VIMO,4)=5 : PUSHGAD[39+VIMO]
  Gosub VIEAUTOWALL
Return
CREATEATTRIBUTESSCREEN:
  Screen 0
  Gr Writing 0
  Cls 0
  DEFCLOWIN[25,0,0]
  TEXBOX[19,0,616,10,0,"Land Of Magic - Attributes Editor V0.8"]
  DEFSCRTBK[26,617,0]
  FILBOX[0,11,639,83,0]
  DEFBOX[60,4,73,635,81,0]
  DRAPROCBAR[60,1,1]
  DRABOX[500,13,635,71,0]
  DEFTEX[27,4,13,84,35,"Load Att",1]
  DEFTEX[28,4,37,84,59,"Save Att",1]
  DEFTEX[31,4,61,84,71,"View Map",1]
  DEFTEX[32,87,13,174,23,"<",1]
  DEFTEX[33,177,13,264,23,">",1]
  DEFTEX[53,87,25,174,35,"Solid",1+(TIAR and 1)*4]
  DEFTEX[54,87,37,174,47,"Water",1+(TIAR and 2)*2]
  DEFTEX[55,87,49,174,59,"Lethal",1+(TIAR and 4)]
  DEFTEX[56,177,25,264,35,"S-Anim",1+((TIAR and 8)/2)]
  DEFTEX[57,177,37,264,47,"@"+INVO$((TIAR/16) and 7,1),1]
  DEFTEX[58,177,49,264,59,"@"+ACTI$((TIAR/128) and 7,1),1]
  DEFTEX[36,87,61,174,71,"View Tiles",1]
  DEFTEX[39,267,13,354,23,"Set Attr.",4]
  DEFTEX[40,267,25,354,35,"Draw Tile",1]
  DEFTEX[41,267,37,354,47,"Set Enemy",1]
  DEFTEX[42,267,49,354,59,"Set Items",1]
  DEFTEX[43,267,61,354,71,"Info",1]
  DEFTEX[46,177,61,264,71,"View Attr",5]
  DEFTEX[47,357,13,444,23,"Box mode",1+BOMO*4]
  DEFTEX[48,357,25,444,35,"Block mode",1]
  DEFTEX[49,357,37,444,47,"Autowall",1+AUMO*4]
  DEFTEX[51,357,61,399,71,"Undo",1]
  DEFTEX[52,402,61,444,71,"Redo",1]
'  DEAGAD[31]
  DEAGAD[40]
  DEAGAD[41] : DEAGAD[42] : DEAGAD[43]
'  DEAGAD[47]
  DEAGAD[48]
'  DEAGAD[49] : DEAGAD[51] : DEAGAD[52]
  Gosub VIEATTRIBUTES
Return
CREATETILEANIMSCREEN:
  Screen 0
  Gr Writing 0
  Cls 0
  DEFCLOWIN[25,0,0]
  TEXBOX[19,0,616,10,0,"Land Of Magic - Tile Animation Editor V0.0"]
  DEFSCRTBK[26,617,0]
  FILBOX[0,11,639,83,0]
  DEFBOX[60,4,73,635,81,0]
  DRAPROCBAR[60,1,1]
  DRABOX[500,13,635,71,0]
  DEFTEX[27,4,13,84,35,"Load Ani",1]
  DEFTEX[28,4,37,84,59,"Save Ani",1]
  DEFTEX[31,4,61,84,71,"View Map",1]
  DEFTEX[32,87,13,174,59,"<",1]
  DEFTEX[33,177,13,264,59,">",1]
  DEFTEX[36,87,61,174,71,"View Tiles",1]
  DEFTEX[39,267,13,354,23,"Sel. Tile",1]
  DEFTEX[40,267,25,354,35,"Draw Tile",1]
  DEFTEX[41,267,37,354,47,"Set Enemy",1]
  DEFTEX[42,267,49,354,59,"Set Items",1]
  DEFTEX[43,267,61,354,71,"Info",1]
  DEFTEX[46,177,61,264,71,"View Anim",5]
  DEFTEX[47,357,13,444,23,"Box mode",1+BO*4]
  DEFTEX[48,357,25,444,35,"Block mode",1]
  DEFTEX[49,357,37,444,47,"Autowall",1+AUMO*4]
  DEFTEX[51,357,61,399,71,"Undo",1]
  DEFTEX[52,402,61,444,71,"Redo",1]
  DEAGAD[31]
  DEAGAD[41] : DEAGAD[42] : DEAGAD[43]
  DEAGAD[47] : DEAGAD[48] : DEAGAD[49] : DEAGAD[51] : DEAGAD[52]
  FB(39+VIMO,4)=5 : PUSHGAD[39+VIMO]
  Gosub VIETILEANIM
Return
CONTROLS:
  If I$="i"
    A$="System Information:�CPU: "+ Extension_8_0EB8( Extension_8_060E ,5)+"�FPU: "+ Extension_8_0EB8( Extension_8_0618 ,5)
    A$=A$+"��Chip Free: "+ Extension_8_0EC8(Chip Free/1024,6)+"KB�"
    A$=A$+"Fast Free: "+ Extension_8_0EC8(Fast Free/1024,6)+"KB�"
    A$=A$+"�Time: "+ Extension_8_0F1A( Extension_8_07E0 )+" Date: "+ Extension_8_0F0A( Extension_8_07CE )
    A$=A$+"��Map size: "+ Extension_8_0EC8(Length(9),6)+" ("+ Extension_8_0EB8(MAPMAXX,3)+"*"+ Extension_8_0EB8(MAPMAXY,3)+")"
    A$=A$+"�Screen size: "+ Extension_8_0EB8(MAPSCRX,3)+"*"+ Extension_8_0EB8(MAPSCRY,3)+" Blocks"
    A$=A$+"��Icons:"+Str$(NI)
    A$=A$+"��Undo buffer free: "+ Extension_8_0EC8(Leek(UNDOST-4)-Leek(UNDOST-8),5)
    A$=A$+"�Redo buffer free: "+ Extension_8_0EC8(Leek(REDOST-4)-Leek(REDOST-8),5)
    Screen 0
    REQUEST[A$,"Interesting!"]
    Screen 1
  End If
  If I$="u" and(FB(51,4) and 1) Then UNDO
  If I$="r" and(FB(52,4) and 1) Then REDO
  If Key Shift and 7
    If I$="+" and TILRAN2<NI-1 and TILRAN2-TILRAN1<6
      Inc TILRAN2
      If MO=1
        Gosub UPDATSELLINE
      End If
      Gosub UPDATINFO
    End If
    If I$="-" and TILRAN1<>TILRAN2
      Dec TILRAN2
      If MO=1
        Gosub UPDATSELLINE
      End If
      Gosub UPDATINFO
    End If
  Else
    If I$="+" and TILRAN2<NI-1
      Inc TILRAN1 : Inc TILRAN2
      If MO=1
        Gosub UPDATSELLINE
      End If
      Gosub UPDATINFO
    End If
    If I$="-" and TILRAN1>0
      Dec TILRAN1 : Dec TILRAN2
      If MO=1
        Gosub UPDATSELLINE
      End If
      Gosub UPDATINFO
    End If
  End If
  If I$=" " and MO<>1 and(FB(36,4) and 1) Then Gosub VIETILES : Return
  If I$=" " and MO<>0 and(FB(31,4) and 1) Then Gosub VIEMAP : Return
'  If I$=" " and MO<>2 and(FB(46,4) and 1) Then Gosub VIEAUTOWALL : Return
Return
VIETILECONTROLS:
  If I$=Cdown$ and NI-1-YOF*20>219
    If Key Shift and 7
      YOF=Min(YOF+11,(NI-201)/20)
      Screen 0 : Gosub VIETILES
    Else
      Inc YOF
      Screen Copy 1,0,16,320,176 To 1,0,0
      Cls 0,0,160 To 320,176
      For A=200 To Min(NI-1-YOF*20,219)
        I=A+YOF*20
        Paste Icon(A mod 20)*16,160,I+1
        If I=>TILRAN1 and I<=TILRAN2
          Draw(A mod 20)*16,160 To(A mod 20)*16+15,160
          Draw(A mod 20)*16,175 To(A mod 20)*16+15,175
        End If
      Next
    End If
  End If
  If I$=Cup$ and YOF>0
    If Key Shift and 7
      YOF=Max(YOF-11,0)
      Screen 0 : Gosub VIETILES
    Else
      Dec YOF
      Screen Copy 1,0,0,320,160 To 1,0,16
      For A=0 To Min(NI-1-YOF*20,19)
        I=A+YOF*20
        Paste Icon(A mod 20)*16,0,I+1
        If I=>TILRAN1 and I<=TILRAN2
          Draw(A mod 20)*16,0 To(A mod 20)*16+15,0
          Draw(A mod 20)*16,15 To(A mod 20)*16+15,15
        End If
      Next
    End If
  End If
Return
VIEMAPCONTROLS:
  If I$=Cleft$ and MAPX>0
    If Key Shift and 7
      MAPX=Max(MAPX-20,0) : Gosub UPDATWHOLEMAP
    Else
      Dec MAPX
      PO=MAPST+(MAPX+MAPY*MAPMAXX)*4
      Screen Copy 1,0,0,304,176 To 1,16,0
      For Y=0 To 10
        Paste Icon 0,Y*16,Min(Deek(PO+(Y*MAPMAXX)*4)+1,NI)
        If VIMO=-1 and Deek(PO+(Y*MAPMAXX)*4+2)<>0
          Ink 0 : Box 0,Y*16 To 2,Y*16+2
        End If
      Next
      Gosub UPDATMAPLINES
    End If
  End If
  If I$=Cright$ and MAPX<MAPMAXX-20
    If Key Shift and 7
      MAPX=Min(MAPX+20,MAPMAXX-20) : Gosub UPDATWHOLEMAP
    Else
      Inc MAPX
      PO=MAPST+(MAPX+MAPY*MAPMAXX)*4
      Screen Copy 1,16,0,320,176 To 1,0,0
      For Y=0 To 10
        Paste Icon 304,Y*16,Min(Deek(PO+(19+Y*MAPMAXX)*4)+1,NI)
        If VIMO=-1 and Deek(PO+(19+Y*MAPMAXX)*4+2)<>0
          Ink 0 : Box 304,Y*16 To 306,Y*16+2
        End If
      Next
      Gosub UPDATMAPLINES
    End If
  End If
  If I$=Cup$ and MAPY>0
    If Key Shift and 7
      MAPY=Max(MAPY-11,0) : Gosub UPDATWHOLEMAP
    Else
      Dec MAPY
      PO=MAPST+(MAPX+MAPY*MAPMAXX)*4
      Screen Copy 1,0,0,320,160 To 1,0,16
      For X=0 To 19
        Paste Icon X*16,0,Min(Deek(PO+X*4)+1,NI)
        If VIMO=-1 and Deek(PO+X*4+2)<>0
          Ink 0 : Box X*16,0 To X*16+2,2
        End If
      Next
      Gosub UPDATMAPLINES
    End If
  End If
  If I$=Cdown$ and MAPY<MAPMAXY-11
    If Key Shift and 7
      MAPY=Min(MAPY+11,MAPMAXY-11) : Gosub UPDATWHOLEMAP
    Else
      Inc MAPY
      PO=MAPST+(MAPX+MAPY*MAPMAXX)*4
      Screen Copy 1,0,16,320,176 To 1,0,0
      For X=0 To 19
        Paste Icon X*16,160,Min(Deek(PO+(X+10*MAPMAXX)*4)+1,NI)
        If VIMO=-1 and Deek(PO+(X+10*MAPMAXX)*4+2)<>0
          Ink 0 : Box X*16,160 To X*16+2,162
        End If
      Next
      Gosub UPDATMAPLINES
    End If
  End If
Return
VIEAUTOWALLCONTROLS:
  If I$=Cleft$ and CUAW>0 Then Dec CUAW : Gosub VIEAUTOWALL
  If I$=Cright$ and CUAW<31 Then Inc CUAW : Gosub VIEAUTOWALL
Return
VIEATTRCONTROLS:
  If I$=Cleft$ and AROF>0 Then AROF=Max(AROF-20,0) : Gosub VIEATTRIBUTES
  If I$=Cright$ and AROF<NI-20 Then Add AROF,20 : Gosub VIEATTRIBUTES
Return
MAIN:
  Do
    Gosub EVENTLOOP
    Screen 0
    If BT=25
      REQUEST["Are you sure you want to quit the map editor?","Quit&Save|Quit|Abort"]
      Exit If Param=0
    End If
    If BT=27 Then Gosub LOAMAP
    If BT=28 Then Gosub SAVMAP
    If BT=29 Then Gosub SETSIZE
    If BT=30 Then Gosub CLEARMAP2
    If BT=32 Then Gosub LOAPTILE
    If BT=33 Then Gosub SAVPTILE
    If BT=34 Then Gosub LOAICONS
    If BT=35 Then Gosub SAVICONS
    If BT=37 Then Gosub LOAPIC
    If BT=38 Then Gosub SAVPIC
    If BT=44
      REQUEST["Select editor:","Config|Attributes|Anims|Autowall|Enemies|Cancel"]
      PED=Param
      If PED=1 : Gosub ARIBUTES : End If
      If PED=2 : Gosub TILEANIM : End If
      If PED=3 : Gosub AUTOWALL : End If
    End If
  Loop
Return
ARIBUTES:
  Gosub KILGADS
  OVIMO=VIMO : VIMO=-1
  If Length(31)=0
    Reserve As Data 31,4096
     Extension_8_028C 31,"Attributes"
  End If
  ARST=Start(31)
  AROF=Max(Min(TILRAN1,NI-21),0)
  AROF=AROF-(AROF mod 20)
  Gosub CREATEATTRIBUTESSCREEN
  Do
    Gosub EVENTLOOP
    If BT=27 Then Gosub LOAARDEF
    If BT=28 Then Gosub SAVARDEF
    If BT=32 and AROF>0 Then AROF=Max(AROF-20,0) : Gosub VIEATTRIBUTES
    If BT=33 and AROF<NI-20 Then Add AROF,20 : Gosub VIEATTRIBUTES
    If BT>52 and BT<57
      B=BT-53
      If TIAR and Extension_8_04F8(B)
        FB(BT,4)=1 : RELEGAD[BT]
        TIAR=TIAR and($FFFF- Extension_8_04F8(B))
      Else
        FB(BT,4)=5 : PUSHGAD[BT]
        TIAR=TIAR or Extension_8_04F8(B)
      End If
    End If
    If BT=57
      INVO=(TIAR/16) and 7
      Add INVO,1,0 To 7
      TIAR=(TIAR and $FF8F)+INVO*16
      NEWTEX[BT,"@"+INVO$(INVO,1)]
    End If
    If BT=58
      ACTI=(TIAR/128) and 7
      Add ACTI,1,0 To 4
      TIAR=(TIAR and $FC7F)+ACTI*128
      NEWTEX[BT,"@"+ACTI$(ACTI,1)]
    End If
    If BT=46 and MO<>3 Then Gosub VIEATTRIBUTES
    Exit If BT=25
  Loop
  MO=0
  TILSUM=-1
  VIMO=OVIMO
  Gosub CREATEMAINSCREEN
Return
TILEANIM:
  Gosub KILGADS
  If Length(32)=0
    Reserve As Data 32,4096
     Extension_8_028C 32,"TileAnim"
  End If
  ANST=Start(32)
  ANOF=Max(Min(TILRAN1,NI-41),0)
  ANOF=ANOF-(ANOF mod 40)
  Gosub CREATETILEANIMSCREEN
  Do
    Gosub EVENTLOOP
    If BT=27 Then Gosub LOAANDEF
    If BT=28 Then Gosub SAVANDEF
    If BT=32 and ANOF>0 Then ANOF=Max(ANOF-40,0) : Gosub VIETILEANIM
    If BT=33 and ANOF<NI-40 Then Add ANOF,40 : Gosub VIETILEANIM
    If BT=46 and MO<>2 Then Gosub VIETILEANIM
    Exit If BT=25
  Loop
  MO=0
  Gosub CREATEMAINSCREEN
Return
AUTOWALL:
  Gosub KILGADS
  If Length(30)=0
    Reserve As Data 30,2048
     Extension_8_028C 30,"AutoWall"
  End If
  AWST=Start(30)
  Gosub CREATEAUTOWALLSCREEN
  Do
    Gosub EVENTLOOP
    If BT=27 Then Gosub LOAAWDEF
    If BT=28 Then Gosub SAVAWDEF
    If BT=29 Then Gosub LOAAUTOWALL
    If BT=30 Then Gosub SAVAUTOWALL
    If BT=32 and CUAW>0 Then Dec CUAW : Gosub VIEAUTOWALL
    If BT=33 and CUAW<31 Then Inc CUAW : Gosub VIEAUTOWALL
    If BT=46 and MO<>2 Then Gosub VIEAUTOWALL
    Exit If BT=25
  Loop
  MO=0
  Gosub CREATEMAINSCREEN
Return
SETREFRESH:
  OLDSUM=-1 : TILSUM=-1 : AWSUM=-1 : ARSUM=-1
Return
VIETILES:
  If NI=0 Then REQUEST["There are no tiles to show!","Oooops!"] : Return
  FB(36,4)=5 : PUSHGAD[36]
  If MO=0 Then FB(31,4)=1 : RELEGAD[31]
  If MO=2 or MO=3 or MO=4 Then FB(46,4)=1 : RELEGAD[46]
  Screen 1 : Cls : Ink 1
  For A=0 To Min(NI-1-YOF*20,219)
    I=A+YOF*20
    X=(A mod 20)*16 : Y=(A/20)*16
    Paste Icon X,Y,I+1
    If I=>TILRAN1 and I<=TILRAN2 Then Draw X,Y To X+15,Y : Draw X,Y+15 To X+15,Y+15
  Next
  MO=1
  Screen 0
  Gosub SETREFRESH
  XB=0 : Gosub UPDATINFO
Return
VIEMAP:
  If Length(9)=0 Then REQUEST["No map has been defined yet!","Geee!"] : Return
  If Length(2)=0 Then REQUEST["Cannot show map without any icons!","Sorry."] : Return
  If MO=1 Then FB(36,4)=1 : RELEGAD[36]
  If MO=3 Then FB(46,4)=1 : RELEGAD[46]
  FB(31,4)=5 : PUSHGAD[31]
  MO=0
  Screen 1
  XB=0 : YB=0
  Gosub SETREFRESH
  Gosub UPDATWHOLEMAP
  Screen 0 : Gosub UPDATINFO
Return
VIEAUTOWALL:
  FB(46,4)=5 : PUSHGAD[46]
  If MO=1 Then FB(36,4)=1 : RELEGAD[36]
  Screen 1 : Cls : Ink 1
  For XB=0 To 15
    Gosub UPDATAUTOWALL
  Next
  XB=0 : MO=2
  Gosub SETREFRESH
Return
VIETILEANIM:
  FB(46,4)=5 : PUSHGAD[46]
  If MO=1 Then FB(36,4)=1 : RELEGAD[36]
  Screen 1 : Cls : Ink 1
  For A=0 To 39
    X=(A/10)*80 : Y=(A mod 10)*17
    If A+ANOF<NI
      Ink 1,0 : Box X,Y To X+17,Y+17
      Paste Icon X+1,Y+1,A+ANOF+1
      Ink 1,0 : Box X+23,Y To X+40,Y+17
      Paste Icon X+24,Y+1,Deek(ANST+((A+ANOF)*4))+1
      Ink Extension_8_1504((Colour(1) and $EEE)/2),0 : Box X+47,Y To X+64,Y+17
      Paste Icon X+48,Y+1,Deek(ANST+((A+ANOF)*4)+2)+1
    End If
  Next
  XB=0 : MO=4
  Gosub SETREFRESH
Return
VIEATTRIBUTES:
  FB(46,4)=5 : PUSHGAD[46]
  If MO=1 Then FB(36,4)=1 : RELEGAD[36]
  Screen 1 : Cls : Ink 1
  For A=0 To 19
    X=(A/10)*160 : Y=(A mod 10)*17
    If A+AROF<NI
      V=Deek(ARST+(A+AROF)*4)
      Gosub CREATTRSTRING
      Ink 1,0 : Box X,Y To X+17,Y+17
      Paste Icon X+1,Y+1,A+AROF+1
      Text X+20,Y+Text Base+5,T$
    End If
  Next
  XB=0 : MO=3
  Gosub SETREFRESH
Return
CREATTRSTRING:
  If(V and 15)=0
    T$="--- "
  Else
    T$=""
    If V and 1 : T$=TIAR$(0,0)+" " : End If
    If V and 2 : T$=T$+TIAR$(1,0)+" " : End If
    If V and 4 : T$=T$+TIAR$(2,0)+" " : End If
    If V and 8 : T$=T$+TIAR$(3,0)+" " : End If
  End If
  T$=T$+INVO$((V/16) and 7,0)+" "+ACTI$((V/128) and 7,0)
Return
UPDATWHOLEMAP:
  If Length(2)=0 Then Return
  PO=MAPST+(MAPX+MAPY*MAPMAXX)*4
  For Y=0 To 10
    For X=0 To 19
      Paste Icon X*16,Y*16,Min(Deek(PO+(X+Y*MAPMAXX)*4)+1,NI)
      If VIMO=-1 and Deek(PO+(X+Y*MAPMAXX)*4+2)<>0
        Ink 0 : Box X*16,Y*16 To X*16+2,Y*16+2
      End If
    Next
  Next
  Gosub UPDATMAPLINES
Return
UPDATAUTOWALL:
  X=(XB/8)*160
  Y=(XB mod 8)*22
  Ink 1 : Box X,Y To X+17,Y+17
  If XB and 1 Then Bar X+6,Y+2 To X+11,Y+5
  If XB and 2 Then Bar X+2,Y+6 To X+5,Y+11
  If XB and 4 Then Bar X+12,Y+6 To X+15,Y+11
  If XB and 8 Then Bar X+6,Y+12 To X+11,Y+15
  T1=Deek(AWST+CUAW*64+XB*4) : T2=Deek(AWST+CUAW*64+XB*4+2)
  For B=0 To 6
    Box X+24+B*17,Y To X+41+B*17,Y+17
    If T1+B<=T2
      Paste Icon X+25+B*17,Y+1,Min(T1+B+1,NI)
    Else
      Ink 0 : Bar X+25+B*17,Y+1 To X+40+B*17,Y+16
      Ink 1 : Draw X+25+B*17,Y+1 To X+40+B*17,Y+16
      Draw X+25+B*17,Y+16 To X+40+B*17,Y+1
    End If
  Next
Return
UPDATMAPLINES:
  Ink 1
  X1=(((100*MAPSCRX)-MAPX) mod MAPSCRX)*16 : Y1=(((100*MAPSCRY)-MAPY) mod MAPSCRY)*16
  X2=(((100*MAPSCRX-1)-MAPX) mod MAPSCRX)*16 : Y2=(((100*MAPSCRY-1)-MAPY) mod MAPSCRY)*16
  Draw X1,0 To X1,176 : Draw 0,Y1 To 320,Y1
  Draw X2+15,0 To X2+15,176 : Draw 0,Y2+15 To 320,Y2+15
Return
UPDATINFO:
  If MO=-1 Then Return
  If MO=3
    SUM=AROF+XB+YB+TIAR
    If SUM<>ARSUM
      FILBOX[500,13,635,71,0]
      TEX[505,14,630,22,"T1:"+ Extension_8_0EB8(AROF+1,4)+" T2:"+ Extension_8_0EB8(Min(AROF+20,NI),4)]
      TEX[505,22,630,30,"Cur. Icon: "+ Extension_8_0EB8(XB,4)]
      TEX[505,30,630,39,"Solid : "+BOOL$(TIAR and 1)]
      TEX[505,38,630,47,"Water : "+BOOL$((TIAR and 2)/2)]
      TEX[505,46,630,55,"Lethal: "+BOOL$((TIAR and 4)/4)]
      TEX[505,54,630,63,"SpAnim: "+BOOL$((TIAR and 8)/8)]
      ARSUM=SUM
    End If
  End If
  If MO=0 or MO=1
    SUM=AROF+XB+YB+TIAR
    If VIMO=-1 and ARSUM<>TIAR
      V=Deek(MAPST+(XB+YB*MAPMAXX)*4+2) : Gosub CREATTRSTRING
      TEX[505,46,630,55,T$]
      V=TIAR : Gosub CREATTRSTRING
      TEX[505,54,630,63,T$]
      ARSUM=SUM
    End If
    SUM=MAPMAXX+MAPMAXY+MAPX+MAPY+XB+YB
    If SUM<>OLDSUM
'      FILBOX[500,13,635,71,0]
      If VIMO>-1
        Ink 2 : Bar 505,38 To 630,51
      End If
      TEX[505,14,630,22,"MX: "+ Extension_8_0EB8(MAPMAXX,3)+" MY: "+ Extension_8_0EB8(MAPMAXY,3)]
      TEX[505,22,630,30,"X1: "+ Extension_8_0EB8(MAPX,3)+" Y1: "+ Extension_8_0EB8(MAPY,3)]
      TEX[505,30,630,38,"X2: "+ Extension_8_0EB8(MAPX+19,3)+" Y2: "+ Extension_8_0EB8(MAPY+10,3)]
      If MO=0
        TEX[505,38,630,46,"CX: "+ Extension_8_0EB8(XB,3)+" CY: "+ Extension_8_0EB8(YB,3)]
      Else
        TEX[505,38,630,46,"Cur. Icon: "+ Extension_8_0EB8(XB,4)]
      End If
      OLDSUM=SUM
    End If
  End If
  If MO=2
    T1=Deek(AWST+CUAW*64+XB*4) : T2=Deek(AWST+CUAW*64+XB*4+2)
    SUM=CUAW+XB+T1+T2
    If SUM<>AWSUM
      TEX[505,14,630,22,"AutoWall Editor"]
      TEX[505,22,630,30,"Current Def: "+ Extension_8_0EB8(CUAW,2)]
      TEX[505,30,630,38,"Current Pos: "+ Extension_8_0EB8(XB,2)]
      TEX[505,38,630,46,"T1: "+ Extension_8_0EB8(T1,3)+" T2: "+ Extension_8_0EB8(T2,3)]
      AWSUM=SUM
    End If
  End If
  If(MO=0 or MO=1 or MO=2 or MO=4) and VIMO>-1
    If TILRAN1+TILRAN2<>TILSUM
      If Length(2)=0 : Return : End If
      FILBOX[510,52,529+16*(TILRAN2-TILRAN1),69,0]
      Ink 2 : Bar 530+16*(TILRAN2-TILRAN1),52 To 630,69
      For A=0 To TILRAN2-TILRAN1
        Paste Icon 512+A*16,53,A+TILRAN1+1
      Next
      TILSUM=TILRAN1+TILRAN2
      OTILRAN1=TILRAN1 : OTILRAN2=TILRAN2
    End If
  End If
Return
UPDATSELLINE:
  If TILRAN1=OTILRAN1 and TILRAN2=OTILRAN2 Then Return
  Screen 1 : Ink 1
  For A=Max(Min(TILRAN1-YOF*20,OTILRAN1-YOF*20),0) To Max(TILRAN2-YOF*20,OTILRAN2-YOF*20)
    I=A+YOF*20
    X=(A mod 20)*16 : Y=(A/20)*16
    Paste Icon X,Y,I+1
    If I=>TILRAN1 and I<=TILRAN2 Then Draw X,Y To X+15,Y : Draw X,Y+15 To X+15,Y+15
  Next
  OTILRAN1=TILRAN1 : OTILRAN2=TILRAN2
  Screen 0
Return
LOAAWDEF:
  FILEREQ[-1,480,160,-1,"Select an autowall definition", Extension_8_02F0(FAWD$), Extension_8_03E0(FAWD$),"#?.awd","Load","Abort","","P"]
  If Param$="" Then Return
  FAWD$=Param$
  If Exist(FAWD$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Trap Bload FAWD$,AWST+CUAW*64
  If Errtrap
    REQUEST["Error while loading definition!","What a pity :-("]
    Return
  End If
  Gosub VIEAUTOWALL
Return
SAVAWDEF:
  FILEREQ[-1,480,160,-1,"Select an autowall definiton", Extension_8_02F0(FAWD$), Extension_8_03E0(FAWD$),"#?.awd","Save","Abort","","PS"]
  If Param$="" Then Return
  FAWD$=Param$
  If Exist(FAWD$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  Trap Bsave FAWD$,AWST+CUAW*64 To AWST+CUAW*64+64
  If Errtrap
    REQUEST["Error while saving definiton!","Oh No!"]
  Else
    REQUEST["Definition saved successfully!","Yeah!"]
  End If
  FILEREQNOTIFY
Return
LOAANDEF:
  FILEREQ[-1,480,160,-1,"Select a tileanim definition", Extension_8_02F0(FAND$), Extension_8_03E0(FAND$),"#?.tan","Load","Abort","","P"]
  If Param$="" Then Return
  FAND$=Param$
  If Exist(FAND$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Trap Extension_8_0464 FAND$,32
  If Errtrap
    REQUEST["Error while loading definition!","What a pity :-("]
    Return
  End If
  Gosub VIETILEANIM
Return
SAVANDEF:
  FILEREQ[-1,480,160,-1,"Select a tileanim definiton", Extension_8_02F0(FAND$), Extension_8_03E0(FAND$),"#?.tan","Save","Abort","","PS"]
  If Param$="" Then Return
  FAND$=Param$
  If Exist(FAND$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  Trap Extension_8_0472 FAND$,32
  If Errtrap
    REQUEST["Error while saving definiton!","Oh No!"]
  Else
    REQUEST["Definition saved successfully!","Yeah!"]
  End If
  FILEREQNOTIFY
Return
LOAARDEF:
  FILEREQ[-1,480,160,-1,"Select an attributes definition", Extension_8_02F0(FARD$), Extension_8_03E0(FARD$),"#?.dat","Load","Abort","","P"]
  If Param$="" Then Return
  FARD$=Param$
  If Exist(FARD$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Trap Extension_8_0464 FARD$,31
  If Errtrap
    REQUEST["Error while loading definition!","What a pity :-("]
    Erase 31
    Return
  End If
  Gosub VIEATTRIBUTES
Return
SAVARDEF:
  FILEREQ[-1,480,160,-1,"Select an attributes definiton", Extension_8_02F0(FARD$), Extension_8_03E0(FARD$),"#?.dat","Save","Abort","","PS"]
  If Param$="" Then Return
  FARD$=Param$
  If Exist(FARD$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  Trap Extension_8_0472 FARD$,31
  If Errtrap
    REQUEST["Error while saving definiton!","Oh No!"]
  Else
    REQUEST["Definition saved successfully!","Yeah!"]
  End If
  FILEREQNOTIFY
Return
LOAAUTOWALL:
  FILEREQ[-1,480,160,-1,"Select an autowall file", Extension_8_02F0(FAUW$), Extension_8_03E0(FAUW$),"#?.auw","Load","Abort","","P"]
  If Param$="" Then Return
  FAUW$=Param$
  If Exist(FAUW$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Trap Bload FAUW$,AWST
  If Errtrap
    REQUEST["Error while loading autowall file!","What a pity :-("]
    Return
  End If
  Gosub VIEAUTOWALL
Return
SAVAUTOWALL:
  FILEREQ[-1,480,160,-1,"Select an autowall file", Extension_8_02F0(FAUW$), Extension_8_03E0(FAUW$),"#?.auw","Save","Abort","","PS"]
  If Param$="" Then Return
  FAUW$=Param$
  If Exist(FAUW$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  Trap Extension_8_0472 FAUW$,30
  If Errtrap
    REQUEST["Error while saving autowall file!","Oh No!"]
  Else
    REQUEST["All autowall definitions saved successfully!","Yeah!"]
  End If
  FILEREQNOTIFY
Return
LOAPTILE:
  FILEREQ[-1,480,160,-1,"Select a ptile file", Extension_8_02F0(FPTL$), Extension_8_03E0(FPTL$),"#?.ptl","Load","Abort","","P"]
  If Param$="" Then Return
  FPTL$=Param$
  If Exist(FPTL$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Trap Extension_8_0456 FPTL$-".ptl"+".pal",20
  If Errtrap=0
    Screen 1
    For A=0 To 31
      Colour A,Deek(Start(20)+A*2)
    Next
    Screen 0
  End If
  Trap Extension_8_0456 FPTL$,20
  If Errtrap
    Erase 20
    REQUEST["Error while loading ptiles!","What a pity :-("]
    Return
  End If
  ST=Start(20) : NI=Deek(ST)
   Extension_8_0A24 20
  Screen 1
  Erase 2
  For A=0 To NI-1
     Extension_8_0A36 0,0,A
    Get Icon A+1,0,0 To 16,16
  Next
  Erase 20
  If MO=0 Then Gosub VIEMAP
  If MO=1 Then Gosub VIETILES
  Screen 0
Return
SAVPTILE:
  FILEREQ[-1,480,160,-1,"Select a ptile file", Extension_8_02F0(FPTL$), Extension_8_03E0(FPTL$),"#?.ptl","Save","Abort","","PS"]
  If Param$="" Then Return
  FPTL$=Param$
  If Exist(FPTL$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  Reserve As Work 20,64
  Screen 1
  For A=0 To 31
    Doke Start(20)+A*2,Colour(A)
  Next
   Extension_8_0472 FPTL$-".ptl"+".pal",20
  Reserve As Work 20,4+32*5*NI
  ST=Start(20)
  Doke ST,NI
  Doke ST+2,4
  Add ST,4
  For A=0 To NI-1
    Paste Icon 0,0,A+1
    For P=0 To 4
      For Y=0 To 15
        Doke ST,Deek(Logbase(P)+Y*40) : Add ST,2
      Next
    Next
  Next
  If MO=0 Then Gosub VIEMAP
  If MO=1 Then Gosub VIETILES
  Screen 0
  Trap Extension_8_0472 FPTL$,20
  If Errtrap
    REQUEST["Error while saving ptiles!","Oh No!"]
  Else
    REQUEST["Ptiles saved successfully!","Yeah!"]
  End If
  Erase 20
  FILEREQNOTIFY
Return
LOAMAP:
  FILEREQ[-1,480,160,-1,"Select a map file", Extension_8_02F0(FMAP$), Extension_8_03E0(FMAP$),"#?.map","Load","Abort","","P"]
  If Param$="" Then Return
  FMAP$=Param$
  If Exist(FMAP$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Trap Extension_8_0464 FMAP$,20
  If Errtrap
    Erase 20
    REQUEST["Error while loading map!","What a pity :-("]
    Return
  End If
  ST=Start(20)
  If Leek(ST)= Extension_8_0998("GMAP")
    Erase 9
    Bank Swap 9,20
    ST=Start(9)
    MAPST=Start(9)+256
    MAPX=0 : MAPY=0
    MAPMAXX=Deek(ST+4)
    MAPMAXY=Deek(ST+6)
    MAPSCRX=Deek(ST+8)
    MAPSCRY=Deek(ST+10)
    If MAPSCRX=0 or MAPSCRY=0
      MAPSCRX=20
      MAPSCRY=11
    End If
    Gosub VIEMAP
  Else
    Gosub CONVOLDMAP
  End If
  CLRUNDO
Return
SAVMAP:
  FILEREQ[-1,480,160,-1,"Select a map file", Extension_8_02F0(FMAP$), Extension_8_03E0(FMAP$),"#?.map","Save","Abort","","PS"]
  If Param$="" Then Return
  FMAP$=Param$
  If Exist(FMAP$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  Trap Extension_8_0472 FMAP$,9
  If Errtrap
    REQUEST["Error while saving map!","Oh No!"]
  Else
    REQUEST["Map saved successfully!","Yeah!"]
  End If
  FILEREQNOTIFY
Return
CONVOLDMAP:
  REQUEST["This seems to be an old map file. Attempt to convert the map?","Convert|Cancel"]
  If Param=1 Then Erase 20 : Return
  LE=Length(20)/2
  MX=LE/220
  NUMENT["Enter the width (in screens) of the map","Ok|Abort",6,0,MX]
  P=Val(Left$(Param$,1))
  NEWMAXX=Val(Mid$(Param$,2))*20
  If P=1 or NEWMAXX=0 Then Return
  MY=(LE-(MX*220))/11
  NUMENT["Enter the height (in screens) of the map","Ok|Abort",MY,0,MY]
  P=Val(Left$(Param$,1))
  NEWMAXY=Val(Mid$(Param$,2))*11
  If P=1 or NEWMAXY=0 Then Return
  LE=256+4*NEWMAXX*NEWMAXY
  REQUEST["The new map will take about"+Str$(LE)+" Bytes of memory.","Continue|Cancel"]
  If Param=1 Then Return
  Reserve As Data 9,LE
  ST=Start(9)+256 : STO=Start(20)
  For Y=0 To NEWMAXY-1
    DRAPROCBAR[60,Y+1,NEWMAXY]
    For X=0 To NEWMAXX-1
      Doke ST+(X+Y*NEWMAXX)*4,Peek(STO+(X+Y*NEWMAXX)*2)-1
      Poke ST+(X+Y*NEWMAXX)*4+2,Peek(STO+X+(Y*NEWMAXX)*2+1)
    Next
  Next
  Erase 20
  ST=Start(9) : MAPST=Start(9)+256
  MAPMAXX=NEWMAXX : MAPMAXY=NEWMAXY
  Loke ST, Extension_8_0998("GMAP")
  Doke ST+4,MAPMAXX
  Doke ST+6,MAPMAXY
  Doke ST+8,20
  Doke ST+10,11
  MAPX=0 : MAPY=0 : If MO=0 Then Gosub VIEMAP
  CLRUNDO
Return
LOAICONS:
  FILEREQ[-1,480,160,-1,"Select an icon bank", Extension_8_02F0(FICO$), Extension_8_03E0(FICO$),"#?.abk","Load","Abort","","P"]
  If Param$="" Then Return
  FICO$=Param$
  If Exist(FICO$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Erase 2
  Trap Load FICO$,2
  If Errtrap
    MO=-1 : Screen 1 : Cls : Screen 0
    Erase 2
    REQUEST["Error while loading icon bank!","What a pity :-("]
    Return
  End If
  Screen 1 : YOF=0 : NI=Length(2)
  Get Icon Palette
  If MO=1 Then Gosub VIETILES
  If MO=0 Then Gosub VIEMAP
  Screen 0
Return
SAVICONS:
  FILEREQ[-1,480,160,-1,"Select an icon bank", Extension_8_02F0(FICO$), Extension_8_03E0(FICO$),"#?.abk","Save","Abort","","PS"]
  If Param$="" Then Return
  FICO$=Param$
  If Exist(FICO$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  Trap Save FICO$,2
  If Errtrap
    REQUEST["Error while saving icon bank!","Argl :("]
    Return
  End If
Return
LOAPIC:
  FILEREQ[-1,480,160,-1,"Select an IFF picture", Extension_8_02F0(FPIC$), Extension_8_03E0(FPIC$),"","Load","Abort","","P"]
  If Param$="" Then Return
  FPIC$=Param$
  If Exist(FPIC$)=0
    REQUEST["File does not exist!","Sorry."]
    Return
  End If
  Trap Load Iff FPIC$,2
  If Errtrap
    Trap Screen Close 2
    REQUEST["Error while loading picture!","What a pity :-("]
    Return
  End If
  Screen Display 2,128,40+85,320,176
  Screen 0
  REQUEST["Do you want to add the icons from this picture?","Append|Overwrite|Cancel"]
  P=Param
  If P=2 Then Screen Close 2 : Return
  NI=Length(2) : LI=0
  If P=1 Then NI=0 : Erase 2
  Screen 2
  BX=Screen Width/17 : BY=Screen Height/17
  EL=0
  For Y=0 To BY-1
    For X=0 To BX-1
      Screen 0
      DRAPROCBAR[60,Y*BX+X+1,BX*BY]
      Screen 2
      For YY=1 To 16
        For XX=1 To 16
          Exit If Extension_8_039E(X*17+XX,Y*17+YY),2
        Next
      Next
      If XX=17 and YY=17 and EL=0
        Screen 0
        REQUEST["Keep empty tiles?","Yes|No"]
        If Param=0
          EL=1
        Else
          EL=-1
        End If
        Screen 2
      End If
      If XX<>17 or YY<>17 Then LI=NI
      If XX=17 and YY=17 and EL=-1
        Ink 1 : Draw X*17+1,Y*17+1 To X*17+16,Y*17+16
        Draw X*17+16,Y*17+1 To X*17+1,Y*17+16
      Else
        Inc NI
        Get Icon NI,X*17+1,Y*17+1 To X*17+17,Y*17+17
      End If
    Next
  Next
  For A=LI+2 To NI
    Del Icon A
  Next
  NI=LI+1
  Screen Close 2
  Screen 1 : YOF=0
  Get Icon Palette : If MO=1 Then Gosub VIETILES
  Screen 0
Return
SAVPIC:
  FILEREQ[-1,480,160,-1,"Select an IFF picture", Extension_8_02F0(FPIC$), Extension_8_03E0(FPIC$),"","Save","Abort","","PS"]
  If Param$="" Then Return
  FPIC$=Param$
  If Exist(FPIC$)
    REQUEST["File already exists, overwrite?","Overwrite|Cancel"]
    If Param=1 : Return : End If
  End If
  RX=20
  Screen Open 2,((RX*17)+15 and $FFF0),((NI+RX-1)/RX)*17,32,0
  Curs Off : Flash Off : Paper 0 : Pen 1 : Cls
  Screen Display 2,128,40+85,320,176
  Screen 2 : View
  Get Icon Palette
  For A=0 To NI-1
    Paste Icon(A mod RX)*17+1,(A/RX)*17+1,A+1
  Next
  Wait Vbl
  Trap Save Iff FPIC$
  If Errtrap
    Screen Close 2
    REQUEST["Error while saving picture!","What a pity :-("]
    FILEREQNOTIFY
    Return
  End If
  Screen Close 2
  REQUEST["Picture saved successfully.","Great"]
  FILEREQNOTIFY
Return
CLEARMAP2:
  If Length(9)=0 Then REQUEST["Define a map first!","Eh?"] : Return
  REQUEST["Are you sure you want to clear the map?","Clear it!|Cancel"]
  If Param=1 Then Return
  Gosub CLEARMAP
  If MO=0 Then Gosub VIEMAP
  CLRUNDO
Return
CLEARMAP:
  MAPST=Start(9)+256
  If TILRAN1<>TILRAN2
    For Y=0 To MAPMAXY-1
      DRAPROCBAR[60,Y+1,MAPMAXY]
      For X=0 To MAPMAXX-1
        Doke MAPST+(X+Y*MAPMAXX)*4,TILRAN1+Rnd(TILRAN2-TILRAN1)
      Next
    Next
  Else
    For Y=0 To MAPMAXY-1
      DRAPROCBAR[60,Y+1,MAPMAXY]
      For X=0 To MAPMAXX-1
        Doke MAPST+(X+Y*MAPMAXX)*4,TILRAN1
      Next
    Next
  End If
  CLRUNDO
Return
SETSIZE:
  NUMENT["Enter the width of one screen","Ok|Abort",20,0,40]
  P=Val(Left$(Param$,1))
  NEWSCRX=Val(Mid$(Param$,2))
  If P=1 or NEWSCRX<20 Then Return
  NUMENT["Enter the height of one screen","Ok|Abort",11,0,22]
  P=Val(Left$(Param$,1))
  NEWSCRY=Val(Mid$(Param$,2))
  If P=1 or NEWSCRY<11 Then Return
  NUMENT["Enter the width (in screens) of the map","Ok|Abort",10,0,100]
  P=Val(Left$(Param$,1))
  NEWMAXX=Val(Mid$(Param$,2))*NEWSCRX
  If P=1 or NEWMAXX=0 Then Return
  NUMENT["Enter the height (in screens) of the map","Ok|Abort",10,0,100]
  P=Val(Left$(Param$,1))
  NEWMAXY=Val(Mid$(Param$,2))*NEWSCRY
  If P=1 or NEWMAXY=0 Then Return
  If Length(9)
    REQUEST["Keep old map?","Yes|No"]
    If Param=1
      Erase 9 : Erase 20
    Else
      Erase 20
      Bank Swap 9,20
    End If
  Else
    Erase 20
  End If
  LE=256+4*NEWMAXX*NEWMAXY
  REQUEST["The new map will take about"+Str$(LE)+" Bytes of memory.","Continue|Cancel"]
  If Param=1
    If Length(20)
      Bank Swap 9,20
    End If
    Return
  End If
  Reserve As Data 9,LE
  REQUEST["Use current tile(s) to fill the map?","Current|Back-Tile"]
  If Param=1
    TILRAN1=NULTIL : TILRAN2=NULTIL
  End If
  Swap MAPMAXX,NEWMAXX
  Swap MAPMAXY,NEWMAXY
  Gosub CLEARMAP
  Swap MAPMAXX,NEWMAXX
  Swap MAPMAXY,NEWMAXY
  If Length(20)
    If MAPMAXX>NEWMAXX or MAPMAXY>NEWMAXY
      REQUEST["This will cut some parts of the old map. Are you sure you want this?","Ok|Cancel"]
      If Param=1
        Bank Swap 9,20
        Erase 20
        Return
      End If
    End If
    ST=Start(9)+256 : STO=Start(20)+256
    For Y=0 To Min(MAPMAXY-1,NEWMAXY-1)
      DRAPROCBAR[60,Y+1,Min(MAPMAXY,NEWMAXY)]
      For X=0 To Min(MAPMAXX-1,NEWMAXX-1)
        Loke ST+(X+Y*NEWMAXX)*4,Leek(STO+(X+Y*MAPMAXX)*4)
      Next
    Next
    Erase 20
  End If
  ST=Start(9) : MAPST=Start(9)+256
  MAPMAXX=NEWMAXX : MAPMAXY=NEWMAXY
  MAPSCRX=NEWSCRX : MAPSCRY=NEWSCRY
  Loke ST, Extension_8_0998("GMAP")
  Doke ST+4,MAPMAXX
  Doke ST+6,MAPMAXY
  Doke ST+8,MAPSCRX
  Doke ST+10,MAPSCRY
  If MO-1 Then MO=0
  MAPX=0 : MAPY=0 : If MO=0 Then Gosub VIEMAP
  CLRUNDO
Return
KILGADS:
  For A=25 To 60
    DISGAD[A]
  Next
Return
Procedure CLRUNDO
  Shared UNDOST,REDOST
  Reserve As Work 14,20480
  UNDOST=Start(14)+8
  Loke UNDOST-8,UNDOST+8
  Loke UNDOST-4,Start(14)+Length(14)-256
  Doke UNDOST,-2 : Doke UNDOST+2,-2 : Doke UNDOST+4,-2 : Doke UNDOST+6,-2
  Reserve As Work 13,20480
  REDOST=Start(13)+8
  Loke REDOST-8,REDOST+8
  Loke REDOST-4,Start(13)+Length(13)-256
  Doke REDOST,-2 : Doke REDOST+2,-2 : Doke REDOST+4,-2 : Doke REDOST+6,-2
End Proc
Procedure NEWUNDO
  Shared UNDOST,REDOST
  UNDO=Leek(UNDOST-8)
  If Extension_8_0BE4(UNDO-2)<>-1
    Loke UNDO,-1 : Loke UNDO+4,-1
    Add UNDO,8
  End If
  If UNDO=>Leek(UNDOST-4)
    Copy UNDOST+520,UNDO To UNDOST+8
    Loke UNDOST+8,-1 : Loke UNDOST+12,-1
    Add UNDO,-512
  End If
  Loke UNDOST-8,UNDO
  Loke REDOST-8,REDOST+8
End Proc
Procedure PLTAUMO[X,Y,T]
  Shared AWST,MAPST,MAPMAXX,MAPMAXY
  For CW=0 To 31
    AD=AWST+CW*64
    For A=1 To 14
      T1=Deek(AD) : T2=Deek(AD+2) : Add AD,4
      Exit If T=>T1 and T<=T2 and T1<>0,2
    Next
  Next
  If CW=32 Then PLT[X,Y,T] : Pop Proc
  XB=X : YB=Y
  Gosub PUWALL : Gosub ENVMOD
Pop Proc
PUWALL:
  Gosub CHKWALL
  TYP=F10+F01*2+F21*4+F12*8
  T1=Deek(AWST+CW*64+TYP*4) : T2=Deek(AWST+CW*64+TYP*4+2)
  If T1=T2
    PLT[XB,YB,T1]
  Else
    PLT[XB,YB,T1+Rnd(T2-T1)]
  End If
Return
CHKWALL:
  If YB>0
    AD=XB+(YB-1)*MAPMAXX : Gosub CHKEX
    F10=RE
  Else
    F10=0
  End If
  If XB>0
    AD=(XB-1)+YB*MAPMAXX : Gosub CHKEX
    F01=RE
  Else
    F01=0
  End If
  If XB<MAPMAXX-1
    AD=(XB+1)+YB*MAPMAXX : Gosub CHKEX
    F21=RE
  Else
    F21=0
  End If
  If YB<MAPMAXY-1
    AD=XB+(YB+1)*MAPMAXX : Gosub CHKEX
    F12=RE
  Else
    F12=0
  End If
Return
CHKEX:
  T=Deek(MAPST+AD*4)
  For A=0 To 15
    T1=Deek(AWST+CW*64+A*4) : T2=Deek(AWST+CW*64+A*4+2)
    If T=>T1 and T<=T2 Then RE=1 : Return
  Next
  RE=0
Return
ENVMOD:
  XG=XB : YG=YB
  G10=F10 : G01=F01 : G21=F21 : G12=F12
  If G10 Then XB=XG : YB=YG-1 : Gosub PUWALL
  If G01 Then XB=XG-1 : YB=YG : Gosub PUWALL
  If G21 Then XB=XG+1 : YB=YG : Gosub PUWALL
  If G12 Then XB=XG : YB=YG+1 : Gosub PUWALL
  XB=XG : YB=YG
Return
End Proc
Procedure PLT[X,Y,T]
  Shared MAPST,MAPMAXX,UNDOST,MAPX,MAPY
  AD=MAPST+(X+Y*MAPMAXX)*4
  OT=Deek(AD)
  If OT=T and Deek(AD+2)=0 Then Pop Proc
  UNDO=Leek(UNDOST-8)
  Doke UNDO,X : Doke UNDO+2,Y : Doke UNDO+4,OT : Doke UNDO+6,Deek(AD+2)
  Add UNDO,8
  If UNDO=>Leek(UNDOST-4)
    Copy UNDOST+520,UNDO To UNDOST+8
    Loke UNDOST+8,-1 : Loke UNDOST+12,-1
    Add UNDO,-512
  End If
  Loke UNDOST-8,UNDO
  Doke AD,T : Doke AD+2,0
  Paste Icon(X-MAPX)*16,(Y-MAPY)*16,T+1
End Proc
Procedure PATTR[X,Y,T]
  Shared MAPST,MAPMAXX,UNDOST,MAPX,MAPY
  AD=MAPST+(X+Y*MAPMAXX)*4
  OT=Deek(AD+2)
'  If OT=T Then Pop Proc
  UNDO=Leek(UNDOST-8)
  Doke UNDO,X : Doke UNDO+2,Y : Doke UNDO+4,Deek(AD) : Doke UNDO+6,OT
  Add UNDO,8
  If UNDO=>Leek(UNDOST-4)
    Copy UNDOST+520,UNDO To UNDOST+8
    Loke UNDOST+8,-1 : Loke UNDOST+12,-1
    Add UNDO,-512
  End If
  Loke UNDOST-8,UNDO
  Doke AD+2,T
  If T Then Ink 1 : Box(X-MAPX)*16,(Y-MAPY)*16 To(X-MAPX)*16+2,(Y-MAPY)*16+2
End Proc
Procedure UNDO
  Shared MAPST,MAPMAXX,UNDOST,MAPX,MAPY,MO,REDOST
  UNDO=Leek(UNDOST-8)
  REDO=Leek(REDOST-8)
  If Extension_8_0BE4(UNDO-2)=-2 Then REQUEST["No more undo.","Ok"] : Pop Proc
  Screen 1
  Loke REDO,-1 : Loke REDO+4,-1
  Add REDO,8
  While Extension_8_0BE4(UNDO-2)<>-2 and Extension_8_0BE4(UNDO-2)<>-1
    Add UNDO,-8
    X=Deek(UNDO) : Y=Deek(UNDO+2) : T=Deek(UNDO+4) : TT=Deek(UNDO+6)
    AD=MAPST+(X+Y*MAPMAXX)*4
    Loke REDO,Leek(UNDO) : Loke REDO+4,Leek(AD)
    Add REDO,8
    Doke AD,T : Doke AD+2,TT
    If MO=0
      Paste Icon(X-MAPX)*16,(Y-MAPY)*16,T+1
      If TT
        Ink 0 : Box(X-MAPX)*16,(Y-MAPY)*16 To(X-MAPX)*16+2,(Y-MAPY)*16+2
      End If
    End If
  Wend
  Add UNDO,-8
  Loke UNDOST-8,UNDO
  Loke REDOST-8,REDO
  Screen 0
End Proc
Procedure REDO
  Shared MAPST,MAPMAXX,UNDOST,MAPX,MAPY,MO,REDOST
  UNDO=Leek(UNDOST-8)
  REDO=Leek(REDOST-8)
  If Extension_8_0BE4(REDO-2)=-2 Then REQUEST["No more redo.","Ok"] : Pop Proc
  Screen 1
  Loke UNDO,-1 : Loke UNDO+4,-1
  Add UNDO,8
  While Extension_8_0BE4(REDO-2)<>-2 and Extension_8_0BE4(REDO-2)<>-1
    Add REDO,-8
    X=Deek(REDO) : Y=Deek(REDO+2) : T=Deek(REDO+4) : TT=Deek(REDO+6)
    AD=MAPST+(X+Y*MAPMAXX)*4
    Loke UNDO,Leek(REDO) : Loke UNDO+4,Leek(AD)
    Add UNDO,8
    Doke AD,T : Doke AD+2,TT
    If MO=0
      Paste Icon(X-MAPX)*16,(Y-MAPY)*16,T+1
      If TT
        Ink 0 : Box(X-MAPX)*16,(Y-MAPY)*16 To(X-MAPX)*16+2,(Y-MAPY)*16+2
      End If
    End If
  Wend
  Add REDO,-8
  Loke REDOST-8,REDO
  Loke UNDOST-8,UNDO
  Screen 0
End Proc
Procedure FILEREQNOTIFY
  Shared FIL$()
  FIL$(0)=""
End Proc
Procedure FILEREQ[SN,SX,SY,YP,T$,F$,D$,PAT$,OK$,FAIL$,FON$,OP$]
  Shared FIL$(),MXFILES
  OTH=TH
  Gosub INIT
  Gosub SETUPSCREEN
  Gosub REFRESH
  Multi Wait : Limit Mouse
  OMK=0 : EXA=0 : ENT=0
  Do
    If Timer>25 and RDIR=1
      Sort FIL$(0)
      Gosub REFRESH
      Timer=0
    End If
    Repeat
      If RDIR Then Gosub EXAMINDIR Else Multi Wait
    Until Amos Here
    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
    If MK=2 Then Gosub DEVLIST
    If I$<>"" and ENT>0
      STRGAD[ENT,I$]
      If Param=-1
        If ENT=6
          F$=Mid$(FB$(6),2) : BT=4
          FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
          Exit
        End If
        If ENT=7
          DD$=D$
          D$=Mid$(FB$(7),2)
          If Exist(D$)
            Gosub NEWREAD
          Else
            REQUEST["Directory "+D$+" not found!","Oh sorry!"]
            D$=DD$
            NEWTEX[7,"{"+D$]
          End If
        End If
        If ENT=8
          PAT$=Mid$(FB$(8),2)
          Gosub NEWREAD
        End If
        ENT=0
      End If
    End If
    BT=0
    If MK=1 and OMK<>1
      CHKMOUSE[XM,YM,1,15]
      BT=Param
    End If
    If BT and ENT Then NEWTEX[ENT,FB$(ENT)] : ENT=0
    If BT=1 Then Gosub DRAGSCREEN
    If BT=11 Then Gosub SELECT
    If BT=2 or BT=4 or BT=5
      If RDIR
        FIL$(0)=""
      Else
        FIL$(0)= Extension_8_08C4(FILOFF)+ Extension_8_08C4(MXNAMLEN)+RDIR$
      End If
      Exit
    End If
    If BT=3 Then Amos To Back
    If BT>5 and BT<9 Then ENT=BT : STRGAD[BT,""]
    If BT=9 Then Gosub DEVLIST
    If BT=10 Then Gosub PARDIR
    If BT=12 Then Gosub DRAGSLIDER
    If BT=13 Then Gosub ARROWUP
    If BT=14 Then Gosub ARROWDOWN
    If BT=15 Then Gosub FLIPPAGE
    OMK=MK
  Loop
  Screen Close SN
  For A=1 To 15
    DISGAD[A]
  Next
  If BT=4 Then A$= Extension_8_03EC(D$)+F$ Else A$=""
  TH=OTH
  Trap Limit Mouse
Pop Proc[A$]
INIT:
  If SN<0
    For A=0 To 7
      Trap Screen A
      If Errtrap : SN=A : Exit : End If
    Next
  End If
  If T$="" Then T$="AMCAF File Selector"
  If D$="" Then D$= Extension_8_03E0(Dir$)
  If Instr(OP$,"P") Then PAT=1 Else PAT=0
  If Instr(OP$,"R") Then FIL$(0)=""
  If Instr(OP$,"D") Then DIONLY=1 Else DIONLY=0
  If Instr(OP$,"Q") Then QUICK=1 Else QUICK=0
  If Instr(OP$,"S") Then SAVREQ=1 Else SAVREQ=0
  KICK=Deek(Leek(4)+20)
  If KICK<37 Then PAT=0
  SX=Max(Min((SX+15) and $FFE0,640),160)
  SY=Max(Min(SY,256),96)
  If YP<40 Then YP=168-SY/2
  If FIL$(0)<>""
    RDIR$=Mid$(FIL$(0),5)
    If D$<>RDIR$
      FIL$(0)=""
      RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
      Return
    Else
      SELFIL=-1
      FILOFF= Extension_8_098C(FIL$(0))
    End If
    For A=1 To MXFILES
      Exit If FIL$(A)=Chr$(255)
    Next
    NUMFIL=A-1
    MXNAMLEN= Extension_8_098C(Mid$(FIL$(0),3))
    RDIR=0
  Else
    RDIR=1 : NUMFIL=0 : FILOFF=0 : SELFIL=-1
    MXNAMLEN=0
  End If
Return
SETUPSCREEN:
  Screen Open SN,SX,SY,4,$8000
  Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
  Palette 0,$FFF,$AAA,$666
  Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
  Screen Display SN,288-SX/4,YP,SX,SY
  If FON$<>""
    A=Val(Left$(FON$,2))
    If A>0
      Trap Extension_8_05B0 Mid$(FON$,3),A
      If Errtrap=0
        TH=A
      End If
    End If
  End If
  Gr Writing 0
  DEFCLOWIN[2,0,0]
  FILBOX[0,TH+3,SX-1,SY-1,0]
  DEFTEX[1,19,0,SX-24,TH+2,"{"+T$,3]
  DEFSCRTBK[3,SX-23,0]
  A=Text Length("Pattern:")+8
  If DIONLY=0
    DEFTEX[6,A,SY-TH*2-9,SX-5,SY-TH-7,"{"+F$,7]
    TEX[4,FB(6,1),FB(6,0),FB(6,3),"}File:"]
    FY2=SY-TH*3-13
  Else
    FY2=SY-TH*2-9
  End If
  DEFTEX[7,A,FY2,SX-5,FY2+TH+2,"{"+D$,7]
  TEX[4,FB(7,1),FB(7,0),FB(7,3),"}Dir:"]
  If PAT
    DEFTEX[8,A,FY2-TH-4,SX-5,FY2-2,"{"+PAT$,7]
    TEX[4,FB(8,1),FB(8,0),FB(8,3),"}Pattern:"]
    FY2=FB(8,1)-2
  Else
    FY2=FB(7,1)-2
  End If
  DEFTEX[4,4,SY-TH-5,SX/4-2,SY-3,OK$,1]
  DEFTEX[9,SX/4+1,SY-TH-5,SX/2-3,SY-3,"Devices",1]
  DEFTEX[10,SX/2,SY-TH-5,SX/2+SX/4-4,SY-3,"Parent",1]
  If Right$(D$,1)=":" Then DEAGAD[10]
  DEFTEX[5,SX/2+SX/4-1,SY-TH-5,SX-5,SY-3,FAIL$,1]
  DEFARROWU[13,SX-22,FY2-17]
  DEFARROWD[14,SX-22,FY2-8]
  D=(FY2-TH-9)
  MXLIN=D/TH
  FY1=TH+7+(D-TH*MXLIN)/2
  DEFBOX[15,SX-22,TH+5,SX-5,FY2-18,3]
  DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
Return
PARDIR:
  If Right$(D$,1)=":" Then Return
  If RDIR Then Extension_8_0660
  D$= Extension_8_03E0(D$)
  Gosub NEWREAD
Return
NEWREAD:
  If RDIR Then Extension_8_0660
  NEWTEX[7,"{"+D$]
  EXA=0 : RDIR=1 : Gosub EXAMINDIR
  If Right$(D$,1)=":" Then DEAGAD[10] Else ACTGAD[10]
  ACTGAD[9]
Return
DEVLIST:
  If RDIR=1 or Left$(FIL$(NUMFIL),1)=>"A" Then Return
  FILOFF=NUMFIL
  F$=Dev First$("")
  While NUMFIL<MXFILES and(F$<>"")
    F$=Mid$(F$,2,Instr(F$,":")-1)
    TYP= Extension_8_02D0(F$)
    If TYP=0
      MXNAMLEN=Max(MXNAMLEN,Len(F$))
      Request Off
      Trap Extension_8_0672 F$
      A=Errtrap
      Request On
      If A=0
        NAM$= Extension_8_06D8
        SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" ("+NAM$+") "
      Else
        SOR$="A"+Upper$(F$)+Chr$(0)+"  <Dev> "+F$+Chr$(0)+" "+ Extension_8_0522( Extension_8_0532 )
      End If
      Inc NUMFIL
      FIL$(NUMFIL)=SOR$
    End If
    If TYP=1
      MXNAMLEN=Max(MXNAMLEN,Len(F$))
      Inc NUMFIL
      FIL$(NUMFIL)="B"+Upper$(F$)+Chr$(0)+"  <Dir> "+F$+Chr$(0)+" Assign"
    End If
    F$=Dev Next$
  Wend
  Sort FIL$(0)
  FILOFF=Min(FILOFF,NUMFIL-MXLIN)
  Gosub REFRESH
  DEAGAD[9]
Return
SELECT:
  Y=YM-FY1
  If Y<0 or Y>=FY1+MXLIN*TH Then Return
  F=Y/TH+FILOFF+1
  If F>NUMFIL Then Return
  TYP=Asc(FIL$(F))
  A$=Peek$(Varptr(FIL$(F))+Instr(FIL$(F),Chr$(0))+8,40,Chr$(0))
  If TYP=32
    D$= Extension_8_03EC(D$)+A$
    Gosub NEWREAD
  End If
  If TYP=45
    F$=A$
    NEWTEX[6,"{"+F$]
    If SELFIL<>F
      If SELFIL-FILOFF=>0 and SELFIL-FILOFF<=MXLIN
        A=SELFIL-FILOFF-1 : SELFIL=-1
        Gosub LISTFILE
      End If
      SELFIL=F : A=SELFIL-FILOFF-1 : Timer=0
      Gosub LISTFILE
    Else
      If Timer<50 and SAVREQ=0
        BT=4
      End If
    End If
  End If
  If TYP=65 or TYP=66
    D$=A$ : Gosub NEWREAD
  End If
Return
DRAGSCREEN:
  PUSHGAD[BT]
  A=YM
  Limit Mouse X Hard(0),40+A To X Hard(SX-1),296-SY+A
  Repeat
    If RDIR : Gosub EXAMINDIR : Else Multi Wait : End If
    YM=Y Screen(Y Mouse)-A : MK=Mouse Key : I$=Inkey$
    Add YP,YM
    Screen Display SN,,YP,,
  Until MK<>1
  Multi Wait : Limit Mouse
  OMK=1
  RELEGAD[BT]
Return
ARROWUP:
  PUSHGAD[BT]
  Repeat
    Multi Wait
    MK=Mouse Key : I$=Inkey$
    If FILOFF>0
      Dec FILOFF
      Gosub SCROLFILES
    End If
  Until MK<>1
  RELEGAD[BT]
Return
ARROWDOWN:
  PUSHGAD[BT]
  Repeat
    Multi Wait
    MK=Mouse Key : I$=Inkey$
    If FILOFF<NUMFIL-MXLIN
      Inc FILOFF
      Gosub SCROLFILES
    End If
  Until MK<>1
  RELEGAD[BT]
Return
DRAGSLIDER:
  DISGAD[12]
  O=YM-FB(12,1)
  Repeat
    Multi Wait
    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
    DRAGSLIDER[15,YM-O,MXLIN,NUMFIL,12]
    If NUMFIL>MXLIN
      FILOFF=Param
      Gosub SCROLFILES
    End If
  Until MK<>1
  ENAGAD[12]
  DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
  OMK=1
Return
REFRESH:
  DEFBOX[11,4,TH+5,SX-25,FY2,7]
  If NUMFIL>0
    For A=0 To Min(MXLIN-1,NUMFIL-1)
      Gosub LISTFILE
    Next
    OLDOFF=FILOFF
  End If
  If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
Return
SCROLFILES:
  If OLDOFF=FILOFF Then Return
  X1=FB(11,0)+2 : X2=FB(11,2)-2 : Y1=FY1+1 : Y2=FY1+TH*MXLIN+1
  D=FILOFF-OLDOFF
  If Abs(D)>MXLIN-2 Then Gosub REFRESH : Return
  If D>0
    Screen Copy SN,X1,Y1+D*TH,X2,Y2 To SN,X1,Y1
    For A=MXLIN-D To MXLIN-1
      Gosub LISTFILE
    Next
  Else
    Screen Copy SN,X1,Y1,X2,Y2+D*TH To SN,X1,Y1-D*TH
    For A=0 To -D-1
      Gosub LISTFILE
    Next
  End If
  OLDOFF=FILOFF
  If FB(12,4) and 1 Then DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
Return
FLIPPAGE:
  If NUMFIL<MXLIN Then Return
  If YM>(FB(12,1)+FB(12,3))/2
    FILOFF=Min(FILOFF+MXLIN,NUMFIL-MXLIN)
  Else
    FILOFF=Max(FILOFF-MXLIN,0)
  End If
  Gosub REFRESH
  DRASLIDER[15,FILOFF,MXLIN,NUMFIL,12]
Return
LISTFILE:
  If QUICK
    A$=FIL$(A+FILOFF+1)
    A$=Peek$(Varptr(A$)+Instr(A$,Chr$(0)),40,Chr$(0))
  Else
    A$=FIL$(A+FILOFF+1)
    B$=Mid$(A$,Instr(A$,Chr$(0))+1)
    FIL$=Left$(B$,Instr(B$,Chr$(0))-1)
    RES$=Mid$(B$,Len(FIL$)+2)
    A$=FIL$+Space$(MXNAMLEN-(Len(FIL$)-8))+RES$
  End If
  If Asc(FIL$(A+FILOFF+1))<>45
    TEX2[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  Else
    TEX[6,FY1+A*TH,SX-28,FY1+(A+1)*TH+1,"{"+A$]
  End If
  If A+FILOFF+1=SELFIL
    Gr Writing 2
    Ink 2 : Bar 8,FY1+A*TH+1 To SX-29,FY1+(A+1)*TH
    Gr Writing 0
  End If
Return
EXAMINDIR:
  If EXA=0
    FILOFF=0 : NUMFIL=0 : MXNAMLEN=5 : RDIR$=D$
    SELFIL=-1
    For A=1 To MXFILES
      FIL$(A)=Chr$(255)
    Next
    Trap Extension_8_063A D$
    If Errtrap=0
      EXA=1 : Timer=0
    Else
      Gosub REFRESH
      REQUEST[ Extension_8_0522( Extension_8_0532 )+"!","Cancel"]
      RDIR=0 : Return
    End If
  End If
  If NUMFIL=MXFILES
     Extension_8_0660
    Sort FIL$(0)
    RDIR=0
    Gosub REFRESH
    Return
  End If
  FIL$= Extension_8_064C
  If FIL$=""
    Sort FIL$(0)
    Timer=0 : RDIR=0 : Gosub REFRESH
    Return
  End If
  TYP= Extension_8_0688
  If QUICK=0
    DATE$=Mid$( Extension_8_0F0A( Extension_8_06F4 ),4)+" "+ Extension_8_0F1A( Extension_8_070E )
    COM$= Extension_8_0762
    FLAG$= Extension_8_0728( Extension_8_0742 )
  End If
  If TYP<0
    If DIONLY=0
      If KICK>36
        A= Extension_8_0300(FIL$,PAT$)
      Else
        A=-1
      End If
    Else
      A=0
    End If
    If A
      MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
      SIZE$= Extension_8_0EC8( Extension_8_06A2 ,7)
      Inc NUMFIL
      If QUICK
        FIL$(NUMFIL)="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)
      Else
        SOR$="-"+Upper$(FIL$)+Chr$(0)+SIZE$+" "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
        FIL$(NUMFIL)=SOR$
      End If
    End If
  Else
    MXNAMLEN=Max(MXNAMLEN,Len(FIL$))
    Inc NUMFIL
    If QUICK
      FIL$(NUMFIL)=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)
    Else
      SOR$=" "+Upper$(FIL$)+Chr$(0)+"  <Dir> "+FIL$+Chr$(0)+DATE$+" "+FLAG$+" "+COM$
      FIL$(NUMFIL)=SOR$
    End If
  End If
Return
End Proc
Procedure REQUEST[T$,OP$]
  Dim LIN$(20)
  OPT=1 : OTH=TH
  For A=1 To Len(OP$)
    If Mid$(OP$,A,1)="|" Then Inc OPT
  Next
  If Screen=-1
    TH=8
    SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
    LPR=SX/8-2
  Else
    SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
    LPR=SX/Text Length("M")-2
  End If
  LI=0 : LP=1 : LILE=0
  For A=1 To Len(T$)
    P=Asc(Mid$(T$,A,1))
    Inc LILE
    If LILE>LPR
      LIN$(LI)=Mid$(T$,LP,SP-LP+1)
      LP=SP+2 : LILE=A-LP
      Inc LI
    End If
    If P=32 Then SP=A-1
    If P=167 Then LILE=LPR+2 : SP=A-1
  Next
  LIN$(LI)=Mid$(T$,LP) : Inc LI
  NBLI=LI-1
  SY=32+LI*TH
  If Screen=-1
    SN=0
    Screen Open SN,SX,SY,4,$8000
    Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
    Palette 0,$FFF,$AAA,$666
    Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
    Screen Display SN,288-SX/4,168-SY/2,SX,SY
    Gr Writing 0
    Wait Vbl : Limit Mouse
    OLDSCR=-1
    XP=0 : YP=0
  Else
    If Screen Height<SY or Screen Width<SX or Screen Colour<4
      OLDSCR=Screen
      For A=0 To 7
        Trap Screen A
        If Errtrap : SN=A : Exit : End If
      Next
      Screen Open SN,SX,SY,4,$8000
      Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
      Get Palette OLDSCR
      Screen Display SN,288-SX/4,168-SY/2,SX,SY
      Gr Writing 0
      Wait Vbl : Limit Mouse
      XP=0 : YP=0
    Else
      XP=(Screen Width-SX)/2
      YP=(Screen Height-SY)/2
      SN=-1
      Get Cblock 9,XP-4,YP-2,SX+16,SY+4
      DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
      DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
      Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
    End If
  End If
  FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  For A=0 To NBLI
    TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  Next
  OP=0
  For A=1 To OPT
    NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
    T$=Mid$(OP$,OP+1,NP-OP-1)
    X1=XP+4+((A-1)*(SX-6))/OPT
    X2=XP+1+(A*(SX-6))/OPT
    DEFTEX[15+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
    OP=NP
  Next
  OMK=0
  Do
    Repeat : Multi Wait : Until Amos Here
    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
    BT=0
    If MK=1 and OMK<>1
      CHKMOUSE[XM,YM,16,15+OPT]
      BT=Param
    End If
    Exit If BT
    OMK=MK
  Loop
  For A=1 To OPT
    DISGAD[15+A]
  Next
  Limit Mouse
  If SN>-1
    Screen Close SN
    If OLDSCR>-1
      Screen OLDSCR
    End If
  Else
    Put Cblock 9
    Del Cblock 9
  End If
  TH=OTH
End Proc[BT-16]
Procedure NUMENT[T$,OP$,DEFNUM,LOWER,UPPER]
  Dim LIN$(10)
  OPT=1 : OTH=TH
  For A=1 To Len(OP$)
    If Mid$(OP$,A,1)="|" Then Inc OPT
  Next
  If Screen=-1
    TH=8
    SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
    LPR=SX/8-2
  Else
    SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
    LPR=SX/Text Length("M")-2
  End If
  LI=0 : LP=1 : LILE=0
  For A=1 To Len(T$)
    P=Asc(Mid$(T$,A,1))
    Inc LILE
    If LILE>LPR
      LIN$(LI)=Mid$(T$,LP,SP-LP+1)
      LP=SP+2 : LILE=A-LP
      Inc LI
    End If
    If P=32 Then SP=A-1
    If P=167 Then LILE=LPR+2 : SP=A-1
  Next
  LIN$(LI)=Mid$(T$,LP) : Inc LI
  NBLI=LI-1
  SY=48+LI*TH
  If Screen=-1
    SN=0
    Screen Open SN,SX,SY,4,$8000
    Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
    Palette 0,$FFF,$AAA,$666
    Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
    Screen Display SN,288-SX/4,168-SY/2,SX,SY
    Gr Writing 0
    Wait Vbl : Limit Mouse
    OLDSCR=-1
    XP=0 : YP=0
  Else
    If Screen Height<SY or Screen Width<SX or Screen Colour<4
      For A=0 To 7
        Trap Screen A
        If Errtrap : SN=A : Exit : End If
      Next
      OLDSCR=Screen
      Screen Open SN,SX,SY,4,$8000
      Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
      Get Palette OLDSCR
      Screen Display SN,288-SX/4,168-SY/2,SX,SY
      Gr Writing 0
      Wait Vbl : Limit Mouse
      XP=0 : YP=0
    Else
      XP=(Screen Width-SX)/2
      YP=(Screen Height-SY)/2
      SN=-1
      Get Cblock 9,XP-4,YP-2,SX+16,SY+4
      DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
      DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
      Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
    End If
  End If
  FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  For A=0 To NBLI
    TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  Next
  DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+Mid$(Str$(DEFNUM),2),7]
  OP=0
  For A=1 To OPT
    NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
    T$=Mid$(OP$,OP+1,NP-OP-1)
    X1=XP+4+((A-1)*(SX-6))/OPT
    X2=XP+1+(A*(SX-6))/OPT
    DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
    OP=NP
  Next
  OMK=0
  STRGAD[16,""]
  Do
    Repeat : Multi Wait : Until Amos Here
    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
    BT=17
    If I$<>""
      If I$<" " or(I$>="0" and I$<="9")
        If Not(I$="0" and NUM=0)
          STRGAD[16,I$]
          Exit If Param=-1
        End If
      End If
    End If
    NUM=Val(Mid$(FB$(16),2))
    If NUM<LOWER
      NUM=LOWER
      NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
      STRGAD[16,""]
    End If
    If NUM>UPPER
      NUM=UPPER
      NEWTEX[16,"{"+Mid$(Str$(NUM),2)]
      STRGAD[16,""]
    End If
    BT=0
    If MK=1 and OMK<>1
      CHKMOUSE[XM,YM,16,16+OPT]
      BT=Param
    End If
    Exit If BT>16
    OMK=MK
  Loop
  For A=1 To OPT+1
    DISGAD[15+A]
  Next
  Limit Mouse
  If SN>-1
    Screen Close SN
    If OLDSCR>-1
      Screen OLDSCR
    End If
  Else
    Put Cblock 9
    Del Cblock 9
  End If
  TH=OTH
  A$= Extension_8_0EB8(BT-17,1)+Mid$(Str$(NUM),2)
End Proc[A$]
Procedure TXTENT[T$,OP$,DEFTXT$,NUMLET]
  Dim LIN$(10)
  OPT=1 : OTH=TH
  For A=1 To Len(OP$)
    If Mid$(OP$,A,1)="|" Then Inc OPT
  Next
  If Screen=-1
    TH=8
    SX=Max(Len(OP$)*8+OPT*32+8+15,320) and $FE0
    LPR=SX/8-2
  Else
    SX=Max(Text Length(OP$)+OPT*32+8+15,320) and $FE0
    LPR=SX/Text Length("M")-2
  End If
  LI=0 : LP=1 : LILE=0
  For A=1 To Len(T$)
    P=Asc(Mid$(T$,A,1))
    Inc LILE
    If LILE>LPR
      LIN$(LI)=Mid$(T$,LP,SP-LP+1)
      LP=SP+2 : LILE=A-LP
      Inc LI
    End If
    If P=32 Then SP=A-1
    If P=167 Then LILE=LPR+2 : SP=A-1
  Next
  LIN$(LI)=Mid$(T$,LP) : Inc LI
  NBLI=LI-1
  SY=48+LI*TH
  If Screen=-1
    SN=0
    Screen Open SN,SX,SY,4,$8000
    Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
    Palette 0,$FFF,$AAA,$666
    Colour 17,$BDF : Colour 18,$6F : Colour 19,$12
    Screen Display SN,288-SX/4,168-SY/2,SX,SY
    Gr Writing 0
    Wait Vbl : Limit Mouse
    OLDSCR=-1
    XP=0 : YP=0
  Else
    If Screen Height<SY or Screen Width<SX or Screen Colour<4
      For A=0 To 7
        Trap Screen A
        If Errtrap : SN=A : Exit : End If
      Next
      OLDSCR=Screen
      Screen Open SN,SX,SY,4,$8000
      Curs Off : Flash Off : Paper 2 : Pen 1 : Cls 0
      Get Palette OLDSCR
      Screen Display SN,288-SX/4,168-SY/2,SX,SY
      Gr Writing 0
      Wait Vbl : Limit Mouse
      XP=0 : YP=0
    Else
      XP=(Screen Width-SX)/2
      YP=(Screen Height-SY)/2
      SN=-1
      Get Cblock 9,XP-4,YP-2,SX+16,SY+4
      DRABOX[XP-4,YP-2,XP+SX+3,YP+SY+1,0]
      DRABOX[XP-2,YP-1,XP+SX+1,YP+SY,1]
      Limit Mouse X Hard(XP),Y Hard(YP) To X Hard(XP+SX-1),Y Hard(YP+SY-1)
    End If
  End If
  FILBOX[XP,YP,XP+SX-1,YP+SY-1,0]
  For A=0 To NBLI
    TEX[XP+4,YP+4+A*TH,XP+SX-5,YP+12+A*TH,LIN$(A)]
  Next
  DEFTEX[16,XP+4,YP+SY-TH*2-18,XP+SX-5,YP+SY-TH-16,"{"+DEFTXT$,7]
  OP=0
  For A=1 To OPT
    NP=Instr(OP$,"|",OP+1) : If NP=0 Then NP=Len(OP$)+1
    T$=Mid$(OP$,OP+1,NP-OP-1)
    X1=XP+4+((A-1)*(SX-6))/OPT
    X2=XP+1+(A*(SX-6))/OPT
    DEFTEX[16+A,X1,YP+SY-TH-14,X2,YP+SY-3,T$,1]
    OP=NP
  Next
  OMK=0
  STRGAD[16,""]
  Do
    Repeat : Multi Wait : Until Amos Here
    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
    BT=17
    If I$<>""
      STRGAD[16,I$]
      Exit If Param=-1
    End If
    TXT$=Mid$(FB$(16),2)
    If Len(TXT$)>NUMLET
      NEWTEX[16,"{"+Left$(TXT$,NUMLET)]
      STRGAD[16,""]
    End If
    BT=0
    If MK=1 and OMK<>1
      CHKMOUSE[XM,YM,16,16+OPT]
      BT=Param
    End If
    Exit If BT>16
    OMK=MK
  Loop
  For A=1 To OPT+1
    DISGAD[15+A]
  Next
  Limit Mouse
  If SN>-1
    Screen Close SN
    If OLDSCR>-1
      Screen OLDSCR
    End If
  Else
    Put Cblock 9
    Del Cblock 9
  End If
  TH=OTH
  A$= Extension_8_0EB8(BT-17,1)+TXT$
End Proc[A$]
Procedure CHKMOUSE[XM,YM,LL,UL]
  For BT=LL To UL
    If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) and(FB(BT,4) and 1) Then Exit
  Next
  If BT>UL Then Pop Proc[0]
  If FB(BT,4) and 2 Then Pop Proc[BT]
  OST=-1 : AA=0
  ST= Extension_8_093A(FB(BT,4) and 4,2)
  Repeat
    Multi Wait
    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse) : MK=Mouse Key : I$=Inkey$
    If XM=>FB(BT,0) and XM<=FB(BT,2) and YM=>FB(BT,1) and YM<=FB(BT,3) Then A=1 Else A=0
    If AA<>A Then AA=A : ST=1-ST
    If OST<>ST
      If ST
        PUSHGAD[BT]
      Else
        RELEGAD[BT]
      End If
      OST=ST
    End If
  Until MK<>1
  If A=0 Then Pop Proc[0]
  If ST
    RELEGAD[BT]
  Else
    PUSHGAD[BT]
  End If
End Proc[BT]
Procedure DEFTEX[BT,X1,Y1,X2,Y2,T$,FL]
  TEXBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2),T$]
  DEFGAD[BT,X1,Y1,X2,Y2,FL]
  FB$(BT)=T$
End Proc
Procedure DEFBOX[BT,X1,Y1,X2,Y2,FL]
  FILBOX[X1,Y1,X2,Y2, Extension_8_093A(FL and 4,2)]
  DEFGAD[BT,X1,Y1,X2,Y2,FL]
End Proc
Procedure DEFGAD[BT,X1,Y1,X2,Y2,FL]
  FB(BT,0)=X1 : FB(BT,1)=Y1
  FB(BT,2)=X2 : FB(BT,3)=Y2
  FB(BT,4)=FL
  FB$(BT)=""
End Proc
Procedure DEAGAD[BT]
  If(FB(BT,4) and 1)=0 Then Pop Proc
  FB(BT,4)=FB(BT,4) and $FE
  Set Pattern 2
  Ink 3 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
  Set Pattern 0
End Proc
Procedure ACTGAD[BT]
  If FB(BT,4) and 1 Then Pop Proc
  CLRGAD[BT]
  FB(BT,4)=FB(BT,4) or 1
  If FB$(BT)<>""
    TEXBOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2),FB$(BT)]
  Else
    DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3), Extension_8_093A(FB(BT,4) and 4,2)]
  End If
End Proc
Procedure DISGAD[BT]
  FB(BT,4)=FB(BT,4) and $FE
End Proc
Procedure ENAGAD[BT]
  FB(BT,4)=FB(BT,4) or 1
End Proc
Procedure CLRGAD[BT]
  FB(BT,4)=FB(BT,4) and $FE
  Ink 2 : Bar FB(BT,0),FB(BT,1) To FB(BT,2),FB(BT,3)
End Proc
Procedure PUSHGAD[BT]
  DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),1]
End Proc
Procedure RELEGAD[BT]
  DRABOX[FB(BT,0),FB(BT,1),FB(BT,2),FB(BT,3),0]
End Proc
Procedure FILBOX[X1,Y1,X2,Y2,SE]
  Ink 2 : Bar X1+2,Y1+1 To X2-2,Y2-1
   Extension_8_0388 X1,Y2,2
   Extension_8_0388 X2,Y1,2
  Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
End Proc
Procedure NEWTEX[BT,T$]
  FB$(BT)=T$
  TEX[FB(BT,0)+1,FB(BT,1),FB(BT,2)-1,FB(BT,3),T$]
End Proc
Procedure TEXBOX[X1,Y1,X2,Y2,SE,T$]
  TEX[X1+1,Y1,X2-1,Y2,T$]
   Extension_8_0388 X1,Y2,2 : Extension_8_0388 X2,Y1,2
  Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
End Proc
Procedure TEX[X1,Y1,X2,Y2,T$]
  If Asc(T$)=123
    M=1 : T$=Mid$(T$,2)
  Else
    If Asc(T$)=125
      M=2 : T$=Mid$(T$,2)
    Else
      M=0
    End If
  End If
  TL=Text Length(T$)
  While TL>(X2-X1)-4
    T$=Left$(T$,Len(T$)-1)
    TL=Text Length(T$)
  Wend
  If M=1
    X=X1+4 : Y=Y1+1
  Else
    If M=2
      X=X2-Text Length(T$)-2 : Y=Y1+1
    Else
      X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+2)/2
    End If
  End If
  If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  Ink 0 : Text X,Y+Text Base,T$
End Proc
Procedure TEX2[X1,Y1,X2,Y2,T$]
  If Asc(T$)=123
    M=1 : T$=Mid$(T$,2)
  Else
    If Asc(T$)=125
      M=2 : T$=Mid$(T$,2)
    Else
      M=0
    End If
  End If
  TL=Text Length(T$)
  While TL>(X2-X1)-4
    T$=Left$(T$,Len(T$)-1)
    TL=Text Length(T$)
  Wend
  If M=1
    X=X1+4 : Y=Y1+1
  Else
    If M=2
      X=X2-Text Length(T$)-2 : Y=Y1+1
    Else
      X=(X1+X2-TL)/2 : Y=(Y1+Y2-TH+1)/2
    End If
  End If
  If Y2>0 Then Ink 2 : Bar X1+1,Y1+1 To X2-1,Y2-1
  Ink 1 : Text X,Y+Text Base,T$
End Proc
Procedure DRABOX[X1,Y1,X2,Y2,SE]
  Ink 1+SE*2 : Draw X1,Y2-1 To X1,Y1 : Draw To X2-1,Y1 : Draw X1+1,Y2-1 To X1+1,Y1
  Ink 3-SE*2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1 : Draw X2-1,Y2 To X2-1,Y1+1
End Proc
Procedure STRGAD[BT,I$]
  Shared POS
  A$=FB$(BT)
  If I$=""
    POS=Len(A$)-1
  End If
  If I$>Chr$(31) Then A$=Left$(A$,POS+1)+I$+Mid$(A$,POS+2) : Inc POS
  If I$=Chr$(8) and POS>0 Then A$=Left$(A$,POS)+Mid$(A$,POS+2) : Dec POS
  If I$=Cleft$ and POS>0 Then Dec POS
  If I$=Cright$ and POS<Len(A$)-1 Then Inc POS
  If I$=Chr$(13)
    NEWTEX[BT,A$]
    Pop Proc[-1]
  End If
  NEWTEX[BT,A$]
  X1=FB(BT,0)+5+Text Length(Mid$(A$,2,POS)) : Y1=FB(BT,1)+1
  X2=X1+Max(Text Length(Mid$(A$,POS+2,1)),4)
  If X2<FB(BT,2)-4
    Gr Writing 2
    Ink 3 : Bar X1,Y1 To X2-1,Y1+TH-1
    Gr Writing 0
  End If
End Proc[0]
Procedure DEFCLOWIN[BT,X,Y]
  DRACLOWIN[X,Y]
  DEFGAD[BT,X,Y,X+18,Y+TH+2,1]
End Proc
Procedure DRACLOWIN[X,Y]
  FILBOX[X,Y,X+18,Y+TH+2,0]
  Ink 0 : Box 7+X,3+Y To 11+X,Y+TH-1
End Proc
Procedure DEFSCRTBK[BT,X,Y]
  DRASCRTBK[X,Y]
  DEFGAD[BT,X,Y,X+22,Y+TH+2,1]
End Proc
Procedure DRASCRTBK[X,Y]
  FILBOX[X,Y,X+22,Y+TH+2,0]
  Ink 0 : Box 4+X,2+Y To 14+X,Y+TH/2+2
  Ink 2 : Bar 8+X,Y+TH/2 To 18+X,Y+TH
  Ink 0 : Box 8+X,Y+TH/2 To 18+X,Y+TH
End Proc
Procedure DEFARROWU[BT,X,Y]
  DRAARROWU[X,Y]
  DEFGAD[BT,X,Y,X+17,Y+8,3]
End Proc
Procedure DRAARROWU[X,Y]
  DRABOX[X,Y,X+17,Y+8,0]
   Extension_8_1016 X+4,Y+6 To X+8,Y+2,0
   Extension_8_1016 X+5,Y+6 To X+8,Y+3,0
   Extension_8_1016 X+9,Y+2 To X+13,Y+6,0
   Extension_8_1016 X+9,Y+3 To X+12,Y+6,0
End Proc
Procedure DEFARROWD[BT,X,Y]
  DRAARROWD[X,Y]
  DEFGAD[BT,X,Y,X+17,Y+8,3]
End Proc
Procedure DRAARROWD[X,Y]
  DRABOX[X,Y,X+17,Y+8,0]
   Extension_8_1016 X+4,Y+2 To X+8,Y+6,0
   Extension_8_1016 X+5,Y+2 To X+8,Y+5,0
   Extension_8_1016 X+9,Y+6 To X+13,Y+2,0
   Extension_8_1016 X+9,Y+5 To X+12,Y+2,0
End Proc
Procedure DRAPROCBAR[BT,POS,MX]
  X1=FB(BT,0)+2 : X2=FB(BT,2)-2 : Y1=FB(BT,1)+1 : Y2=FB(BT,3)-1
  DX=X2-X1
  PX=X1+(POS*DX)/MX
  If PX>X1 and PX<X2
    Ink 0 : Bar X1,Y1 To PX,Y2
    Ink 2 : Bar PX,Y1 To X2,Y2
  End If
  If PX=X1 Then Ink 2 : Bar X1,Y1 To X2,Y2
  If PX=X2 Then Ink 0 : Bar X1,Y1 To X2,Y2
End Proc
Procedure DRASLIDER[BT,LINOFF,PAG,NUMLIN,NB]
  D=(FB(BT,3)-FB(BT,1))-4
  Y1=(LINOFF*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  Y2=((LINOFF+PAG)*D)/Max(NUMLIN,PAG)+FB(BT,1)+2
  DEFGAD[NB,FB(BT,0)+4,Y1,FB(BT,2)-4,Y2,3]
  Ink 2
  If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  If Y2-Y1>0
    Ink 0 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  Else
     Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,0
  End If
End Proc
Procedure DRAGSLIDER[BT,Y,PAG,NUMLIN,NB]
  Y1=FB(NB,1) : Y2=FB(NB,3) : D=Y2-Y1
  Y1=Min(Max(FB(BT,1)+2,Y),FB(BT,3)-2-D)
  Y2=Y1+D : FB(NB,1)=Y1 : FB(NB,3)=Y2
  Ink 2
  If Y1>FB(BT,1)+2 Then Bar FB(BT,0)+4,FB(BT,1)+1 To FB(BT,2)-4,Y1-1
  If Y2<FB(BT,3)-2 Then Bar FB(BT,0)+4,Y2+1 To FB(BT,2)-4,FB(BT,3)-1
  If Y2-Y1>0
    Ink 1 : Bar FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2
  Else
     Extension_8_1016 FB(BT,0)+4,Y1 To FB(BT,2)-4,Y2,1
  End If
  D=FB(BT,3)-FB(BT,1)-4
  L=Min(((Y1-FB(BT,1)-2)*Max(NUMLIN,PAG)+D/2)/D,NUMLIN-PAG)
End Proc[L]