'* -------------------------------------------------------- *
'*             Amos - Professional - Textreader             *
'* -------------------------------------------------------- *
'* ReadText replacement project for AMOS Professional V2.00 *
'* -------------------------------------------------------- *
'* Released ® by Volker Stepprath 27-07-98/13-07-01         *
'* -------------------------------------------------------- *
'* Apt V3.20, MReq V1.10 © 95-01 by Testaware               *
'* -------------------------------------------------------- *
'* AMOSPro_Explode.Lib V2.00 & AMOSPro_AMCAF.Lib V1.19 used *
'* -------------------------------------------------------- *

N$=Command Line$

Close Editor 
Request Off 
If Screen>True Then Screen Close Screen

Default Palette $789,$0,$FFF,$34A,,,,,,,,,,,,,,$FFF,$C12,$0
Colour Back $789
View 

Proc _APT[N$]

If Prg State<False Then Amos To Back 

Default 
Colour Back Colour(0)
View 
Request On 
Wait Vbl 

Edit 

Procedure _APT[N$]

   '* Apt « AMOS Professional Textreader » V3.20
   '* 27-07-98/13-07-01 ® by Volker Stepprath © by Testaware  

   'N$ = Name der zu lesenden Datei 
   'T$ = Div. 
   'B$ = Div. 
   'F$ = Zu suchende Zeichenkette 
   'P$ = Typ des Datenkomprimierer
   'XN$= Nächste Textdatei
   'A  = Anzahl der gelesenen Zeilen
   'B  = Scancode nach Tastendruck
   'C  = Div. 
   'I  = For/Next Schleifenzähler 
   'H  = Div. 
   'N  = Div. 
   'W  = Div. 
   'XA = Max. Zeilenanzahl
   'XB = BkNb der Textdaten 
   'XC = 2/1/0 Apt/System/Defpalette
   'XD = Unterer Startbereich für Scrollmodus 
   'XF = Bildgröße in Bytes 
   'XG = BkNb für Iconbank
   'XK = PrefsKeyList BitCode 
   'XL = BkLen in Bytes 
   'XM = Moduletest 
   'XN = Tab-Abstand
   'XP = Bk für Def-Farben  
   'XS = BkAd von Textdaten 
   'XT = Bk für Textmarker
   'XU = Oberer Startbereich für Scrollmodus
   'XX = Max. Zeichenanzahl pro Zeile 
   'XY = Max. sichtbare Zeilenanzahl
   'XZ = Bk der Textzeilenzeiger

   'Namensermittlung einer WB.Info-Datei (nur in Kompilat nutzbar)
   If Len(N$)=False and Prg State<False
      Restore W
      For I=0 To 75
         Read N
         N$=N$+Chr$(N)
      Next 
      Call Varptr(N$)
      N$=Peek$(Dreg(4)+12,108,Chr$(0))
      If Upper$(N$)="APT"
         N$=""
      End If 
   End If 

   'Freie Bank ab Pos.255 ermitteln (XB)
   XB=Bank Free(255)

   'Falls Iconbank bereits reserviert - Sichern (XG)
   XG=XB+13 : Bank Swap 2,XG

   'Falls Hintergrund-Screen existiert
   If Screen>True Then Wait 20 : Screen Hide 

   'Def.Tab-Abstand definieren
   XN=8

   'Text-Screen bereitstellen 
   Gosub H

   'Textdatei einladen
   A:
   If N$="" Then _FREQ["Load text"] : N$=Param$
   Amos To Front 
   If N$="" Then Goto B
   Erase 2
   Trap Bank Load N$ To XB
   If Errtrap Then Gosub F : N$="" : Goto A
   Pen 1 : Paper 0
   Cls 

   'Dateiname formatieren 
   N$=Right$(N$,45)+Chr$(0)

   'PP20/XPKF/IMP!/BYTEKILLER/LH18 Format entpacken 
   P$="None"
   If Ppk Length(XB)+Xpk Length(XB)+Ipk Length(XB)+Bpk Length(XB)+Lpk Length(XB)
      T$=" » unpacking « "
      Gosub M
      Proc _PKUNPACK[XB]
      P$=Param$
      If Errtrap : Gosub F : N$="" : Cls : Goto A : End If 
   End If 

   'Binäre Daten werden nicht akzeptiert
   XS=Start(XB)
   Cls 
   If Hunt(XS To Finish(XB),Chr$(0))
      _MREQ["Can`t read,","file contains binary!",False]
      N$="" : Goto A
   End If 

   Curs Pen 2

   'Def.Texteinstellungen aktivieren (PrefsKeyList) 
   Gosub K

   'Speicher fÜr eigene Palette 32 × 2 (Word) (XP)
   XP=XB+12 : Reserve As Work XP,64 : XP=Start(XP)
   For I=0 To 31 : Doke XP+I*2,Colour(I) : Next 

   E:
   XS=Start(XB)
   XL=Length(XB)

   'DOS CSI-Codes ($1B/$9B) Konvertierung 
   A=Hunt(XS To Finish(XB),Chr$(27))
   If A
      If Instr("BCDEFILPRSUWXY",Peek$(A+1,1))
         A=False
      End If 
   Else 
      A=Hunt(XS To Finish(XB),Chr$(155))
   End If 
   If A
      T$=" » convert DOS csi-codes « "
      Gosub M
      F=Finish(XB)
      B=Bank Free(XB)
      Trap Reserve As Work B,XL+5000
      If Errtrap=False
         N=XS
         Do 
            N=Hunt(N To F,Chr$(155))
            Exit If N=False
            Poke N,27
            Inc N
         Loop 
         C=Start(B)
         Do 
            N=Hunt(XS To F,Chr$(27))
            Exit If N=False
            If XS<N
               Copy XS,N To C
               Add C,N-XS
            End If 
            B$=""
            C$=Peek$(N,255,"m")+";"
            For I=0 To 7
               If Instr(C$,"3"+Str$(I)-" ")
                  B$=B$+Pen$(I)
               End If 
               If Instr(C$,"4"+Str$(I)-" ")
                  B$=B$+Paper$(I)
               End If 
            Next 
            If Instr(C$,"0;")
               B$=B$+Pen$(1)+Paper$(0)+Pund$(0)
            End If 
            If Instr(C$,"4;")
               B$=B$+Pund$(1)
            End If 
            If Instr(C$,"7;")
               B$=B$+Pinv$(1)
            End If 
               Poke$ C,B$
               Add C,Len(B$)
            Add N,Len(C$)
            XS=N
         Loop 
         Copy XS,F To C
         N=Hunt(Start(B) To Finish(B),Chr$(0))
         If XS
            Bank Shrink B To N-Start(B)
         End If 
         Erase XB
         Bank Swap XB,B
         XS=Start(XB)
         XL=Length(XB)
      End If 
   End If 

   'Speicher fÜr Textmarker 10 × 2 (Word) (XT)
   XT=XB+11 : Reserve As Work XT,20 : XT=Start(XT)

   'Adressenstart der Zeilen installieren 
   T$=" » counting lines « "
   Gosub M

   A=XS
   B=False
   Do 
      Inc B
      A=Hunt(A To Finish(XB),Chr$(10))
      Exit If A=False
      Inc A
   Loop 
   XZ=XB+10 : Reserve As Work XZ,B*4+40 : XZ=Start(XZ)

   A=XS
   XA=False
   Loke XZ,A
   Repeat 
      A=Hunt(A To Finish(XB),Chr$(10))
      Exit If A=False
      Inc A
      Inc XA
      Loke XZ+XA*4,A
   Until XA>B-2
   Loke XZ+(XA+1)*4,False
   Dec XA

   Pen 1 : Paper 0
   Under Off 
   Set Tab XN
   A=False
   Gosub C

   'Speicher für formatierte Infoleiste   
   Rs Structure False,40

   Do 

      'Ausgabe der Infoleiste
      If Btst(0,XK)
         I=Leek(XZ+(A+Min(XA+1,XY))*4)-XS
         Rs Set False,0
         Rs Long False,Varptr(N$)
         Rs Long False,(100.0/Align(XL,2))*Align(I,2)
         Rs Long False,I
         Rs Long False,A
         Rs Long False,Min(A+30,XA)
         Rs Long False,XA
         Ink 2,3 : Text 0,XY*8+6,Format$("%-45s%4ld%%  B:%-7ldL:%4ld-%-5ld/%5ld ",Rs Start(False))
      Else 
         Cls 0,0,XY*8 To XX*8+8,XY*8+8
      End If 

      Trap Curs Off 
      B=Scancode
      Clear Key 
      Do 
         Multi Wait 
         If Not Amos Here
            Request On 
            Repeat 
               Multi Wait 
            Until Amos Here
            Request Off 
         End If 
         N=Mouse Key
         If N
            Wait Vbl 
            N=Mouse Key
            Exit 
         End If 
         N=Joy(1)
         If N
            If N=1 : N=30
            Else If N=2 : N=31
            Else If N=4 : N=29
            Else If N=8 : N=28
            Else If N=16 : N=27
            End If 
            Exit 
         End If 
         N=Asc(Upper$(Inkey$))
         B=Scancode
         If Key Shift=False
            If Y Screen(Y Mouse)<XU
               If A>0 : N=30 : End If 
            Else If Y Screen(Y Mouse)>XD
               If A+XY<XA : N=31 : End If 
            End If 
         End If 
         Exit If N+B
      Loop 

      '[LMB+RMB/ESC/SPACE/Q] APT Beenden bzw. nÄchste Datei
      If N=3 or N=27 or N=32 or N=81
         If Len(XN$) and N=32
            If Exist(XN$)
               N$=XN$
               Goto A
            End If 
         End If 
         Exit 

      '[DEL] Unbenutzte Speicherbereiche freigeben 
      Else If B=70
         B=Avail Free
         Flush 
         Rs Structure False,40
         _MREQ["Restored memory:"+Str$(Avail Free-B)+" bytes","",False]

      '[CTRL+1-9] Textpuffer installieren
      Else If Key Shift=8 and N>48 and N<58
         N=XB+N-48
         T=True
         If Length(N)
            _MREQ["Buffer in use, install new?","",True]
            T=Param
         End If 
         If T
            Trap Bank Clone XB To N
            If Errtrap
               Gosub F
            Else 
               Trap Error 23
            End If 
         End If 

      '[1-9] Textpuffer installieren 
      Else If Key Shift=False and N>48 and N<58
         N=XB+N-48
         If Length(N)
            Trap Bank Clone N To XB
            XS=Start(XB)
            Goto E
         Else 
            Trap Error 23
         End If 

      '[CTRL+LMB/RMB] Suche selektierten String
      Else If Key Shift=8 and N<3
         B=A+Lsr.l(3,Y Screen(Y Mouse))
         I=Leek(XZ+B*4)+Lsr.l(3,Align(X Screen(X Mouse),8))
         Do 
            Exit If Peek(I)<>27 and Peek(I)<33
            Dec I
         Loop 
         T$=Peek$(I+1,255,Chr$(10))-Chr$(9)
         Gosub S
         F$=Peek$(Varptr(T$),Len(T$)," ")
         F$=Peek$(Varptr(F$),Len(F$),".")
         F$=Peek$(Varptr(F$),Len(F$),",")
         If F$<>""
            If N=1
               For I=B+1 To XA-1
                  T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
                  Gosub S
                  N=Instr(T$,F$)
                  Exit If N
               Next 
            Else 
               For I=A-1 To 0 Step -1
                  T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
                  Gosub S
                  N=Instr(T$,F$)
                  Exit If N
               Next 
            End If 
            Gosub G
         Else 
            Trap Error 23
         End If 

      '[CSR/LMB] Seite vor 
      Else If N=28 or N=1
         Add A,XY
         Gosub C

      '[CSL/RMB] Seite zurÜck
      Else If N=29 or N=2
         A=A-XY
         Gosub C

      '[CSD/BS/Y MOUSE UP] Zeile zurÜck  
      Else If N=30 or N=8
         Repeat 
            Clear Key 
            Exit If A<1
            Home 
            Dec A
            Screen Copy Screen,0,0,Screen Width,XY*8-8 To Screen,0,8
            Cls 0,0,0 To Screen Width,8
            B=A
            Gosub P
         Until Y Screen(Y Mouse)>XU and Inkey$=""

      '[CSU/RT/Y MOUSE DOWN] Zeile vor 
      Else If N=31 or N=13
         Repeat 
            Clear Key 
            Exit If A+XY>XA
            Locate 0,XY-1
            Screen Copy Screen,0,8,Screen Width,XY*8 To Screen,0,0
            Cls 0,0,XY*8-8 To Screen Width,XY*8
            B=A+XY
            Gosub P
            Inc A
         Until Y Screen(Y Mouse)<XD and Inkey$=""

      '[CTRL+TAB] Tab Abstand
      Else If Key Shift=8 and N=9
         Locate 0,XY
         Pen 2 : Paper 3
         Put Key Str$(XN)-" "
         Input "Set tab: ";T$
         Curs Off 
         Pen 1 : Paper 0
         XN=Val(T$)
         Set Tab Min(12,Max(1,XN))
         Gosub C

      '[TAB] Ausgabe APT PrefsKeyList
      Else If N=9
         If Length(100)
            Pen 1 : Paper 0
            Cls 
            Under On 
            Print " PrefsKeyList "
            Under Off 
            T=20
            N=Start(100)
            Ink 1,0
            Repeat 
               T$=Peek$(N,255,Chr$(10))
               Text 0,T,T$
               Add T,8
               Add N,Len(T$)+1
            Until Instr(T$,"#")
            Proc _STOPLOOP
            Gosub C
         Else 
            Trap Error 23
         End If 

      '[#] Ausgabe aktuelle Zeilennummern
      Else If N=35
         Home 
         Pen 2 : Paper 3
         For I=A To Min(XA,A+XY-1)
            Print Str$(I)-" "
         Next 
         Pen 1 : Paper 0

      '[A] AMOSPro Steuercodes entfernen 
      Else If N=65
         If Hunt(XS To Finish(XB),Chr$(27))
            Show On 
            Shift Off 
            Flash Off 
            XC=False
            XF=False
            XK=XK or %11
            Gosub V
            T$=" » remove AMOS csi-codes « "
            Gosub M
            A=XS
            Clear Mouse 
            Repeat 
               A=Hunt(A To XS+XL,Chr$(27))
               Exit If A=False
               Copy A+3,XS+XL To A
               Add XL,-3
            Until Mouse Key
            Bank Shrink XB To XL
            Erase 2
            Erase 100
            Trap Screen Close 6
            Goto E
         Else 
            Trap Error 23
         End If 

      '[B] Textende (Bottom) 
      Else If N=66
         A=XA
         Gosub C

      '[C] Palette setzen
      Else If N=67
         Add XC,1,0 To 2
         Gosub V

      '[E] Anzahl Stringkette ermitteln
      Else If N=69
         Locate 0,XY
         Pen 2 : Paper 3
         Put Key F$
         Input "Count string: ";F$
         Curs Off 
         Pen 1 : Paper 0
         I=False
         N=XS
         Do 
            N=Hunt(N To Finish(XB),F$)
            Exit If N=False
            Inc N
            Inc I
         Loop 
         _MREQ[F$,"Count:"+Str$(I)+" total",False]

      '[F] Suche String
      Else If N=70
         Locate 0,XY
         Pen 2 : Paper 3
         Put Key F$
         Input "Find string: ";F$
         Curs Off 
         Pen 1 : Paper 0
         N=False
         If F$<>""
            For I=A+1 To XA-1
               T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
               Gosub S
               N=Instr(T$,F$)
               Exit If N
            Next 
         End If 
         Gosub G

      '[G] Springe zu Zeile
      Else If N=71
         Locate 0,XY
         Pen 2 : Paper 3
         Input "Goto line: ";T$
         A=Val(T$)
         A=Abs(A)
         Pen 1 : Paper 0
         Gosub C

      '[H/HELP] Info 
      Else If N=72 or B=95
         Pen 1 : Paper 0
         Cls 
         Restore D
         Locate ,2
         Curs Off 
         Repeat 
            Trap Read T$
            Print T$
         Until T$=" "
         Proc _STOPLOOP
         Gosub C

      '[I] Infoleiste abschalten 
      Else If N=73
         Bchg 0,XK

      '[J] Text nochmals einlesen
      Else If N=74
         XA=False
         Goto A

      '[K] Datei löschen 
      Else If N=75
         _FREQ["Kill file"] : T$=Param$
         If T$<>""
            _MREQ["Really kill",T$,True]
            If Param
               Trap Kill T$
               If Errtrap : Gosub F : End If 
            End If 
         End If 

      '[L] Lade neue Textdatei 
      Else If N=76
         Trap Screen Close 6
         N$=""
         XA=False
         Goto A

      '[M] Mauszeiger an/aus 
      Else If N=77
         Bchg 1,XK
         If Btst(1,XK)
            Show On 
         Else 
            Hide On 
         End If 

      '[N] Suche String vorwärts 
      Else If N=78
         N=False
         If F$<>""
            For I=A+1 To XA-1
               T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
               Gosub S
               N=Instr(T$,F$)
               Exit If N
            Next 
         End If 
         Gosub G

      '[O] Text aussprechen
      Else If N=79
         _MREQ["Really speak out?","",True]
         If Param
            For I=0 To XA
               T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
               Gosub S
               Text 0,XY*8+6,T$+Space$(80)
               If T$<>""
                  Trap Say T$
               End If 
               If Errtrap
                  Gosub F
               End If 
               Exit If Errtrap+Asc(Inkey$)
            Next 
            Cls 0,0,XY*8 To XX*8,XY*8+8
            Wait 100
         Else 
            Trap Error 23
         End If 

      '[P] Drucke Text 
      Else If N=80
         _MREQ["Really print out?","",True]
         If Param
            Trap Open Port 1,"PRT:"
            If Errtrap=False
               _MREQ["Print start-endline?","",True]
               If Param
                  Gosub N
               Else 
                  N=False
                  B=XA-1
               End If 
               For I=N To B
                  T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
                  Gosub S
                  Text 0,XY*8+6,T$+Space$(80)
                  Trap Print #1,T$
                  Exit If Errtrap+Asc(Inkey$)
                  Wait 15
               Next 
               Close 
               Wait 100
            Else 
               Gosub F
            End If 
         Else 
            Trap Error 23
         End If 

      '[R] Suche vorherigen String 
      Else If N=82
         N=False
         If F$<>""
            For I=A-1 To 0 Step -1
               T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
               Gosub S
               N=Instr(T$,F$)
               Exit If N
            Next 
         End If 
         Gosub G

      '[S] Sichern als ASCII Datei 
      Else If N=83
         _MREQ["Save start-endline?","",True] : B=Param
         _FREQ["Save as"]
         If Param$<>""
            If Exist(Param$)
               _MREQ[Param$,"already exist, overwrite?",True]
               N=Param
            End If 
            If N
               If B
                  Gosub N
                  Trap Open Out 1,Param$
                  If Errtrap=False
                     For I=N To B
                        T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
                        Gosub S
                        Trap Print #1,T$+Chr$(10);
                        Exit If Errtrap
                     Next 
                  End If 
                  Close 
               Else 
                  Trap Open Out 1,Param$
                  If Errtrap=False
                     If Length(100)
                        Trap Ssave 1,Start(100) To Finish(100)
                     End If 
                     Trap Ssave 1,XS To XS+XL
                  End If 
                  Close 
               End If 
               If Errtrap
                  Gosub F
               End If 
            End If 
         End If 

      '[T] Textanfang (Top)
      Else If N=84
         A=False
         Gosub C

      '[U] Filter an/aus   
      Else If N=85
         Bchg 2,XK
         If Btst(2,XK)
            Led On 
         Else 
            Led Off 
         End If 

      '[V] Musiklautstärke 
      Else If N=86
         Locate 0,XY
         Pen 2 : Paper 3
         Put Key "63"
         Input "Volume of music: ";T$
         Curs Off 
         Pen 1 : Paper 0
         B=Min(63,Abs(Val(T$)))
         Mvolume B
         Pt Volume B

      '[W] Workbench zu/auf
      Else If N=87
         If Workbench
            Close Workbench 
            T=Workbench
         Else 
            Open Workbench 
            T= Not Workbench
         End If 
         If T
            Trap Error 23
         End If 

      '[Z] Musik stop & entfernen
      Else If N=90
         Music Off 
         Pt Stop 
         Erase 3

      '[F1-F10] Setzen/Zeigen Textmarker 
      Else If B>79 and B<90
         N=XT+((B-80)*2)
         If Deek(N)
            A=Deek(N)
            Gosub C
         Else 
            Doke N,A
            Trap Error 23
         End If 

      '[X] Alle Textbuffereinträge löschen 
      Else If N=88
         _MREQ["Really erase all textbuffer`s?","",True]
         If Param
            For I=XB+1 To XB+9
               Erase I
            Next 
         Else 
            Trap Error 23
         End If 

      End If 

      'Displaybeep bei Fehler
      If Errtrap
         For I=0 To 11
            Colour 0, Not Colour(0)
            Colour Back Colour(0)
            View 
            Wait Vbl 
         Next 
      End If 

   Loop 

   'Defaultwerte/Speicherbereiche zurücksetzen
   B:
   Trap Screen Close 6
   Screen Close 7
   If Screen>True
      Colour Back Colour(0)
      Screen Show 
      Clear Key 
      Wait 20
      Show On 
      Wait Vbl 
      Limit Mouse 
   End If 
   For I=XB To XB+14
      Erase I
   Next 
   If XM Then Music Off : Pt Stop : Erase 3
   Erase 2
   Erase 100
   Rs Erase False
   Bank Swap XG,2
   Pop Proc

   'Ausgabe einer kompletten Seite
   C:
   A=Max(0,Min(XA-XY+1,A))
   Y Mouse=Y Hard(Screen Height/2)
   Home 
   Curs Off 
   Cls 0,0,0 To Screen Width,XY*8
   For B=A To A+XY
      Exit If B>XA or Y Curs=>XY
      Gosub P
   Next 
   Trap Curs Off 
   Return 

   'Spezielle Apt-ESC Codes aktivieren (Icon/Pic/Palette) 
   P:
   If Leek(XZ+B*4)=False Then Return 
   T$=Peek$(Leek(XZ+B*4),255,Chr$(10))
   If Length(100)
      If Instr(T$,Chr$(27))
         Gosub S
         Repeat 
            H=False
            T=Instr(T$,Chr$(27)+"D")
            If T
               H=True
               Trap Paste Icon T*8-8,Y Curs*8,Peek(Varptr(T$)+T+1)-48
               Poke$ Varptr(T$)+T-1,String$(Chr$(0),3)
            End If 
            T=Instr(T$,Chr$(27)+"F")
            If T
               H=True
               C=Peek(Varptr(T$)+T+1)-48
               Poke$ Varptr(T$)+T-1,String$(Chr$(0),3)
               Trap Screen Copy 6,0,C*8,Screen Width(6),C*8+8 To 7,T*8-8,Y Curs*8
            End If 
            T=Instr(T$,Chr$(27)+"C")
            If T
               H=True
               B$=Peek$(Varptr(T$)+T+1,1)
               Poke$ Varptr(T$)+T-1,String$(Chr$(0),3)
               N=Hunt(Start(100) To Finish(100),"PLINK"+B$)
               If N
                  N=Hunt(N To Finish(100),"= ")
                  If N
                     Add N,2
                     For C=0 To Screen Colour-1
                        B$=Peek$(N,5,",")
                        Add N,Len(B$)+1
                        If Len(B$)
                           Colour C,Val(B$)
                        End If 
                        Exit If Len(B$)>4
                     Next 
                     Colour Back Colour(0)
                     View 
                  End If 
               End If 
            End If 
            T$=T$-Chr$(0)
         Until H=False
      End If 
   End If 
   Print T$
   Return 

   'Stringlink einsetzen  
   S:
   If Length(100)
      Do 
         T=Instr(T$,Chr$(27)+"L")
         Exit If T=False
         N=Hunt(Start(100) To Finish(100),"SLINK"+Peek$(Varptr(T$)+T+1,1))
         If N
            N=Hunt(N To Finish(100),"= ")
            If N
               T$=Left$(T$,T-1)+Peek$(N+2,255,Chr$(10))+Right$(T$,Len(T$)-(T+2))
            End If 
         End If 
      Loop 
   End If 
   Return 

   'Fehlerrequest anzeigen
   F:
   T$=Err$(Errtrap)
   If T$="" Then T$="AMOSPro Error #"+Str$(Errtrap)-" "+" occurred"
   _MREQ[T$+",","press key [HELP] for informations!",False]
   Return 

   'Gesuchten String invertieren
   G:
   If N
      A=I
      Gosub C
      B=False
      For I=A To XA-1
         T$=Peek$(Leek(XZ+I*4),255,Chr$(10))
         Gosub S
         N=Instr(T$,F$)
         Exit If N
         Inc B
      Next 
      Locate 0,B : Print Left$(T$,N-1)+Pen$(1)+Paper$(2)+F$+Paper$(0);
   Else 
      Trap Error 23
   End If 
   Return 

   'Eingabe von Start (B) - Endzeile (N)
   N:
   Pen 2 : Paper 3
   Locate 0,XY : Put Key "0" : Input "Startline: ";T$
   N=Val(T$) : N=Min(XA,Max(0,N))
   Locate 0,XY : Put Key Str$(XA)-" " : Input "Endline: ";T$
   B=Val(T$) : B=Min(XA,Max(0,B))
   If N>B : Swap N,B : End If 
   Curs Off 
   Pen 1 : Paper 0
   Return 

   'Farbpalette setzen
   V:
   If XC=0
      Palette $789,$0,$FFF,$34A,,,,,,,,,,,,,,$FFF,$C12,$0
   Else If XC=1
      T$=String$(Chr$(0),232)
      Areg(0)=Varptr(T$)
      Dreg(0)=232
      I=Intcall(-132)
      Palette Deek(I+110),Deek(I+112),Deek(I+114),Deek(I+116),,,,,,,,,,,,,,Deek(I+106),Deek(I+102),Deek(I+104)
   Else If XC=2
      Palette Deek(XP),Deek(XP+2),Deek(XP+4),Deek(XP+6),,,,,,,,,,,,,,Deek(XP+34),Deek(XP+36),Deek(XP+32)
   End If 
   Colour Back Colour(0)
   View 
   Return 

   'Screen für Textausgabe bereitstellen  
   H:
   If Screen<>7
      Screen Open 7,640,256,4,Hires
      Colour Back Colour(0)
      Flash Off 
   End If 

   I:
   Screen Hide 
   Wait Vbl 
   Limit Mouse 
   XX=Screen Width/8-1
   XY=Screen Height/8-1
   XU=9
   XD=Screen Height-15
   Curs Off 
   Pen 1 : Paper 0
   Cls 
   Scroll Off 
   Screen Show 
   Return 

   'Statusmeldung ausgeben (T$) 
   M:
   Pen 1
   Paper 0
   Cls 
   Locate ,14
   Inverse On 
   Centre T$
   Inverse Off 
   Return 

   'Auswertung der texteigenen PrefsKeyList 
   K:
   XN$=""
   XK=%11
   XF=False
   Erase 100
   Trap Flash Off 
   Trap Shift Off 

   A=Hunt(XS To Finish(XB),"#")
   If A=False or Leek(XS)<>$4150543A Then Return 

   If Instr(N$,":") Then A$=Peek$(Varptr(N$),Len(N$),":")+":" Else A$=":"

   B$="CODE" : Gosub L
   If T
      Locate 0,Screen Height/8-1
      Pen 2 : Paper 3
      Input "Code: ";B$
      Curs Off 
      Pen 1 : Paper 0
      If B$<>Peek$(T,255,Chr$(10))
         _MREQ["Incorrect code,","choose new textfile!",False]
         Pop 
         N$=""
         Goto A
      End If 
   End If 

   B$="SETDIR" : Gosub L : If T Then A$=Peek$(T,255,Chr$(10))

   B$="WORKBENCH" : Gosub L : If Peek(T)=48 Then Close Workbench 

   B$="SCREEN" : Gosub L
   If T
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : X=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : Y=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : C=Val(B$)
      B$=Peek$(T,5,Chr$(10)) : M=Val(B$)
      If X<>Screen Width or Y<>Screen Height or C<>Screen Colour or M<>Screen Mode
         Screen Open 7,X,Y,C,M
         Flash Off 
         Curs Off 
      End If 
      Cls 0
      Gosub I
   End If 

   B$="DISPLAY" : Gosub L
   If T
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : X=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : Y=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : W=Val(B$)
      B$=Peek$(T,5,",") : H=Val(B$)
      If X=False : X=128 : End If 
      If Y=False : Y=42 : End If 
      If W=False : W=Screen Width : End If 
      If H=False : H=Screen Height : End If 
      Screen Display 7,X,Y,W,H
   End If 

   B$="INFO" : Gosub L : If Peek(T)=48 Then Bclr 0,XK

   B$="MOUSE" : Gosub L : If Peek(T)=48 Then Bclr 1,XK : Hide On Else Show On 

   B$="PICNAME" : Gosub L
   If T
      N=Bank Free(255)
      B$=A$+Peek$(T,255,Chr$(10))
      Trap Bank Load B$ To N
      If Errtrap=False
         Proc _PKUNPACK[N]
         Trap Iff Bank N To 6
         If Errtrap
            Trap Unpack N To 6
         End If 
         Trap Screen Hide 6
         Trap Screen To Back 6
      End If 
      XF=Length(N)
      Erase N
      Screen 7
      Trap Get Palette 6
   End If 

   B$="AICNAME" : Gosub L
   If T
      B$=A$+Peek$(T,255,Chr$(10))
      Trap Open In 1,B$
      If Errtrap=False
         If Input$(1,4)="PPbk"
            Trap Ppload B$,2
         Else 
            Trap Load B$,2
         End If 
         If Length(2)
            Get Icon Palette 
         End If 
      End If 
      Close 
   End If 

   B$="ICONMASK" : Gosub L
   If Length(2) and T>False Then Trap Make Icon Mask 

   B$="PALETTE" : Gosub L
   If T
      I=Peek(T)
      If I=48 or I=49
         XC=I-48
         Gosub V
      Else 
         For I=0 To Screen Colour-1
            B$=Peek$(T,5,",")
            Add T,Len(B$)+1
            If Len(B$)
               Colour I,Val(B$)
            End If 
            Exit If Len(B$)>4
         Next 
         XC=2
      End If 
   End If 

   B$="FLASH" : T=XS
   Do 
      T=Hunt(T To A,B$)
      Exit If T=False
      Inc T
      T=Hunt(T To A,"= ")
      Exit If T=False
      Add T,2
      Flash Abs(Peek(T)-48),Peek$(T+2,255,Chr$(10))
   Loop 

   B$="SHIFTUP" : Gosub L
   If T
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : X=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : Y=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : C=Val(B$)
      Shift Up X,Y,C,1
   End If 

   B$="SHIFTDOWN" : Gosub L
   If T
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : X=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : Y=Val(B$)
      B$=Peek$(T,5,",") : Add T,Len(B$)+1 : C=Val(B$)
      Shift Down X,Y,C,1
   End If 

   B$="MODNAME" : Gosub L
   If T and Length(3)=False
      B$=A$+Peek$(T,255,Chr$(10))
      Trap Open In 1,B$
      If Errtrap=False
         T$=Input$(1,4)
         If T$="PPbk"
            Trap Ppload B$,3
         Else If T$="AmBk"
            Trap Load B$,3
         Else 
            Trap Bank Load B$,3
         End If 
         If Length(3)
            XM=True
            If Instr(Bank Name$(3),"Music")
               Music 1
            Else 
               Bank To Chip 3
               Pt Play 3
            End If 
         End If 
      End If 
      Close 
   End If 

   B$="FILTER" : Gosub L : If Peek(T)=49 Then Bset 2,XK : Led On Else Led Off 

   B$="NEXTFILE" : Gosub L : If T Then XN$=A$+Peek$(T,255,Chr$(10))

   B$="SETTAB" : Gosub L : If T Then XN=Val(Peek$(T,2,Chr$(10)))

   'Extrabank (100) für PrefsKeyList reservieren
   Add A,2
   Reserve As Work 100,A-XS
   Copy XS,A To Start(100)
   Copy A,Finish(XB) To XS
   Bank Shrink XB To Finish(XB)-A

   Colour Back Colour(0)
   View 
   Return 

   'PrefKey (B$) ermitteln
   L:
   T=Hunt(XS To A,B$)
   If T
      Inc T
      T=Hunt(T To A,"= ")
      If T
         Add T,2
      End If 
   End If 
   Return 

   'Informationsdaten 
   D:
   Data Pund$(1)+" The AMOSPro Textreader replacement project V3.20 "+Pund$(0)
   Data ""
   Data Pen$(2)+At(4,)+"CSR/LMB/JR - CSL/RMB/JL"+Pen$(1)+": Page forward - Backward"
   Data Pen$(2)+At(6,)+"CSD/Rt/JD - CSU/Bs/JU"+Pen$(1)+": Line down - Up"
   Data Pen$(2)+At(9,)+"Mouse top - buttom"+Pen$(1)+": Scroll up - Down"
   Data Pen$(2)+At(18,)+"T - B - G"+Pen$(1)+": Top - Bottom - Goto line"
   Data Pen$(2)+"F - N/Ctrl+LMB - R/Ctrl+RMB"+Pen$(1)+": Find - Next - Previous"
   Data Pen$(2)+At(14,)+"S - L - J - K"+Pen$(1)+": Save - Load - Reload - Kill"
   Data Pen$(2)+At(14,)+"P - O - E - A"+Pen$(1)+": Print - Speak - Count - Kill AMOS codes"
   Data Pen$(2)+At(18,)+"I - M - #"+Pen$(1)+": Hide & show info - Mouse - Linenumber"
   Data Pen$(2)+At(18,)+"U - V - Z"+Pen$(1)+": Switch filter - Volume - Stop & erase music"
   Data Pen$(2)+At(22,)+"C - W"+Pen$(1)+": Swap Apt/Wb/Keycolor - Close/Open Wb"
   Data Pen$(2)+At(20,)+"F1..F10"+Pen$(1)+": Set & goto textmark"
   Data Pen$(2)+At(7,)+"Ctrl+1..9 - 1..9 - X"+Pen$(1)+": Install text in - of # - Erase buffer"
   Data Pen$(2)+At(15,)+"Left Amiga+A"+Pen$(1)+": Switch Wb & Apt"
   Data Pen$(2)+At(13,)+"Tab - Ctrl+Tab"+Pen$(1)+": Show prefskeylist - Set tab"
   Data Pen$(2)+At(15,)+"Del - H/Help"+Pen$(1)+": Restore memory - This info"
   Data Pen$(2)+At(22,)+"Space"+Pen$(1)+": Load nextfile or quit"
   Data Pen$(2)+At(11,)+"Esc/Q/LMB+RMB/JF"+Pen$(1)+": Quits Apt"
   Data ""
   Data "PowerPacker-, Xpk-Dataformat: mainlibs (compressors) must be available"
   Data "Apt © 2001 by Volker Stepprath, Tegeler Strasse 7, 40789 Monheim, Germany"
   Data ""
   Data "Mem:"+Str$(Avail Free)-" "+" - Text:"+Str$(XL)-" "+" - Aic:"+Str$(Length(2))-" "+" - Pic:"+Str$(XF)-" "+" - Mod:"+Str$(Length(3))-" "+" - Packer:"+P$
   Data " "

   'Get WB-Name ASM Daten 
   W:
   Data 44,121,0,0,0,4,147,201,78,174,254,218,40,64,74,172,0,172,102
   Data 0,0,50,65,236,0,92,78,174,254,140,35,192,0,0,0,72,32,121
   Data 0,0,0,72,32,104,0,36,103,0,0,22,32,121,0,0,0,72,32
   Data 104,0,36,40,40,0,4,6,132,0,0,0,8,78,117,0,0,0,0

End Proc
Procedure _FREQ[A$]

   Amos To Back 

   If Lib Base(1)=False
      Trap Lib Open 1,"reqtools.library",0
   End If 

   If Lib Base(1)=False Then Goto A

   A$="Apt V3.20: "+A$+Chr$(0)
   B$=String$(Chr$(0),108)

   Areg(0)=False
   Dreg(0)=False
   A=Lib Call(1,-30)

   Loke A,1
   Doke A+4,False
   Doke A+6,False
   Loke A+8,False

   Areg(1)=A
   Areg(2)=Varptr(B$)
   Areg(3)=Varptr(A$)
   Dreg(0)=Lib Call(1,-54)

   If Dreg(0)
      A$=Peek$(Varptr(B$),108,Chr$(0))
      B$=Peek$(Leek(A+16),256,Chr$(0))
      If Instr(B$,":")=False
         B$="SYS:"+B$
      End If 
      B=Peek(Varptr(B$)+Len(B$)-1)
      If B<>47 and B<>58
         B$=B$+"/"
      End If 
      B$=B$+A$
   Else 
      B$=""
   End If 

   Areg(1)=A
   Dreg(0)=Lib Call(1,-36)

   A: Amos To Front 
   Wait Vbl 

End Proc[B$]
Procedure _MREQ[A$,B$,N]

   '* MReq (AMOSPro MessageRequest project) V1.10 
   '* ® 25-05-1998 by Volker Stepprath © by Testaware 

   'A$ = Messagetext oben 
   'B$ = Messagetext unten
   'N  = True > Ja/Nein - False > Abbruch 
   'Param = False ( 0) » Nein / Abbruch 
   'Param = True  (-1) » Ja 

   'X/Y Position = Mittig & Vielfaches von 16 
   X=Min(160,Align(Max(0,Screen Width/2-160),16))
   Y=Min(80,Align(Max(0,Screen Height/2-56),16))

   'Hintergrund sichern 
   Get Cblock 1,X,Y,Min(336,Screen Width),Min(80,Screen Height)

   'Requestgrafik erstellen 
   Gr Writing 0 : Set Pattern 2
   Ink 1,0 : Bar X+18,Y+9 To X+334,Y+77
   Gr Writing 1 : Set Pattern 0
   Cls 0,X,Y To X+320,Y+70
   Cls 3,X,Y To X+320,Y+12
   _G[X,Y,X+320,Y+12,False]
   _G[X,Y+13,X+320,Y+70,False]
   _G[X+6,Y+16,X+314,Y+52,False]
   _G[X+7,Y+17,X+313,Y+51,True]
   Ink 1,0
   If A$="" or B$=""
      If A$=""
         A$=B$
      End If 
      N$=Right$(A$,37) : Text X+160-Len(N$)*4,Y+37,N$
   Else 
      N$=Right$(A$,37) : Text X+160-Len(N$)*4,Y+32,N$
      N$=Right$(B$,37) : Text X+160-Len(N$)*4,Y+41,N$
   End If 
   Ink 2,3
   N$="» Request Message «" : Text X+160-Len(N$)*4,Y+9,N$
   If N
      Cls 3,X+6,Y+55 To X+102,Y+67
      Cls 3,X+218,Y+55 To X+314,Y+67
      N$="Don`t" : Text X+56-Len(N$)*4,Y+64,N$
      N$="Ok" : Text X+268-Len(N$)*4,Y+64,N$
      _G[X+6,Y+55,X+102,Y+67,False]
      _G[X+218,Y+55,X+314,Y+67,False]
   Else 
      Cls 3,X+113,Y+55 To X+209,Y+67
      N$="Ok" : Text X+163-Len(N$)*4,Y+64,N$
      _G[X+113,Y+55,X+209,Y+67,False]
   End If 

   'Hauptschleife 
   Do 

      Proc _WAITLOOP : T=Param

      'Maustaste betätigt
      If T<3
         A=X Screen(X Mouse)-X : B=Y Screen(Y Mouse)-Y

      '[RETURN] Ja 
      Else If T=13
         B=67 : If N : A=254 Else A=113 : End If 

      '[ESC] Nein
      Else If T=27
         B=67 : If N : A=6 Else A=113 : End If 

      End If 

      If B>55 and B<68

         'DON'T Angewählt 
         If A>5 and A<103 and N
            _G[X+6,Y+55,X+102,Y+67,True]
            T=False
            Exit 

         'OK Angewählt
         Else If A>217 and A<315 and N
            _G[X+218,Y+55,X+314,Y+67,True]
            T=True
            Exit 

         'OK (Einzelnd) Angewählt 
         Else If A>112 and A<210 and N=False
            _G[X+113,Y+55,X+209,Y+67,True]
            T=False
            Exit 

         End If 

      End If 

   Loop 

   'Hintergrund restaurieren & beenden
   Wait 10
   Put Cblock 1,X,Y
   Del Cblock 1

End Proc[T]
Procedure _G[X,Y,A,B,N]

   '* Schalter zeichnen 

   'X = X Startpos
   'Y = Y Startpos
   'A = X Endpos
   'B = Y Endpos
   'N = False > Schalter aus - True > Schalter an 

   If N Then C=1 : D=2 Else C=2 : D=1
   Ink C : Polyline X,B To X,Y To A,Y
   Ink D : Polyline To A,B To X,B

End Proc
Procedure _STOPLOOP

   '* Wartestellung mit Scancode

   Clear Key 
   Clear Mouse 

   N=Scancode
   Repeat 
      Multi Wait 
   Until Mouse Key+Fire(0)+Fire(1)+Asc(Inkey$)+Scancode

End Proc
Procedure _WAITLOOP

   '* Wartestellung normal

   Clear Key 
   Clear Mouse 

   Do 
      N=Mouse Key
      Exit If N
      N=Asc(Inkey$)
      Exit If N
      Multi Wait 
   Loop 

End Proc[N]
Procedure _PKUNPACK[A]

   '* Erkennt: PowerPacker,Xpk Packer,Lh-Lib,Imploder,ByteKiller  

   A=Number(A)
   A$=Peek$(Start(A),4)

   If Ppk Length(A)
      Trap Ppk Unpack A
   Else If Xpk Length(A)
      A$=A$+"("+Xpk Name$(A)+")"
      Trap Xpk Unpack A
   Else If Lpk Length(A)
      Trap Lpk Unpack A
   Else If Ipk Length(A)
      B=Bank Free(A)
      Trap Imploder Unpack A To B
      If Errtrap=False
         Bank Swap A,B
         Erase B
      End If 
   Else If Bpk Length(A)
      Trap Bpk Unpack A
      A$="BK20"
   End If 

End Proc[A$]