'* -------------------------------------------- *
'* AMOS Professional PowerPacker Projekt V1.00  *
'* -------------------------------------------- *
'* Start: 12:14:41 23-07-95 Sonntag             *
'* Ende : 11:16:10 30-07-95 Sonntag             *
'* -------------------------------------------- *
'* AProPoPa Projekt © 1995 bei Testaware        *
'* Programmiert von Volker Stepprath ® 30-07-95 *
'* -------------------------------------------- *


Set Buffer 30


Close Workbench 
Close Editor 
Request Off 
Erase All 
Lib Close 
Close 
Flush 


Global VER$,XD$,XBK,XDG,XEF,XOP,XPE,XPP,XSB

VER$="1.00"

XBK=8 : Rem * Bank 
XDG=0 : Rem * Dateigröße 
XEF=4 : Rem * Effizienz
XOP=4 : Rem * Optimal
XPP=0 : Rem * Nicht/Gepackt
XPE=4 : Rem * Effizienz für ppWriteDataHeader
XSB=0 : Rem * Speedup Buffer für ppCrunchBuffer


Proc _INSCREEN
Proc _APPPP


Procedure _APPPP

   Do 


      '* HAUPTWARTESCHLEIFE *
      Proc _GLOBAL : X=False : Y=False : Proc _WAIT
      If Param<3
         X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
      Else 
         If Param=76 : X=0 : Y=51
         Else If Param=83 : X=106 : Y=51
         Else If Param=67 : X=2*106 : Y=51
         Else If Param=80 : X=3*106 : Y=51
         Else If Param=69 : X=4*106 : Y=51
         Else If Param=79 : X=5*106 : Y=51
         Else If Param=70 : X=0 : Y=65
         Else If Param=85 : X=106 : Y=65
         Else If Param=78 : X=2*106 : Y=65
         Else If Param=73 : X=3*106 : Y=65
         Else If Param=87 : X=4*106 : Y=65
         Else If Param=90 : X=5*106 : Y=65
         End If 
      End If 


      '* SCHLIEßSYMBOL * 
      If Param=27 or(X>0 and X<24 and Y<13) Then _ENDE


      '* ICONIFY-SYMBOL *
      If Param=8 or(X>611 and X<635 and Y<13) Then _ICONIFY


      '* SCHALTER OBEN GEWÄHLT ? * 
      If Y>50 and Y<64
         X=X/106
         _G[X*106,51,104+X*106,63,True]
         Wait 10
         On X+1 Proc _LADEN,_SPEICHERN,_LöSCHEN,_PACKEN,_ENTPACKEN,_OPTIMALTEST
      End If 


      '* SCHALTER UNTEN GEWÄHLT ? *
      If Y>64 and Y<78
         X=X/106
         _G[X*106,65,104+X*106,77,True]
         Wait 10
         On X+1 Proc _EFFIZIENZ,_PUFFER,_LESEN,_INFORMATION,_WORKBENCH,_ZURüCK
      End If 


   Loop 

End Proc

Procedure _LADEN

   _FREQ["Datei laden..."]

   _T["",False]

   If Param$<>""

      _T["Überprüfe Datei '"+Param$+"'...",1]

      If Exist(Param$)=False
         _T["Nanu, Datei ist nicht auffindbar.",2]
         Pop Proc
      End If 

      Trap Reserve As Work XBK,File Size(Param$)
      If Errtrap
         _FEHLER
      Else 
         _T["Lese Datei in den Speicher...",1]
         Repeat 
            Trap Bload Param$,XBK
            If Errtrap
               Proc _FEHLER
               If Not Param
                  _T["Dann breche ich den Ladeversuch heilt ab.",2]
                  Exit 
               End If 
            End If 
         Until Errtrap=False
      End If 

      If Errtrap
         Erase XBK
      Else 
         XD$=Param$
         _T["Hat alles prima geklappt.",1]
         If Peek$(Start(XBK),4)="PP20"
            _T["Übrigens, Datei ist bereits gepackt.",2]
         Else If Peek$(Start(XBK),4)="PX20"
            _T["Grrr, Datei ist gepackt und verschlüsselt !",2]
            Erase XBK
         End If 
      End If 

      XPP=False
      XDG=Length(XBK)

   Else 

      _T["Na gut, dann eben nicht.",2]

   End If 

End Proc
Procedure _SPEICHERN

   _T["",0]

   If Length(XBK)=False

      _T["Nanu, aber was soll ich denn speichern ?",2]

   Else 

      _FREQ["Puffer speichern..."]

      If Param$<>""

         _T["Schreibe in Datei '"+Param$+"'...",1]

         If Exist(Param$)
            _MREQ["Datei existiert bereits,","Überschreiben ?",True]
            If Not Param
               _T["Dann eben nicht.",2]
               Pop Proc
            End If 
         End If 

         If XPP

            Repeat 
               Trap Open Out 1,Param$
               If Errtrap
                  Proc _FEHLER
                  Exit If Not Param
               Else 
                  _T["Schreibe Packinformationen (8 Bytes)...",1]
                  Dreg(0)=Hof(1)
                  Dreg(1)=XPE
                  Dreg(2)=False
                  Dreg(3)=False
                  XPPWDH=Lib Call(1,-$72)
                  _T["Schreibe komprimierte Daten ("+Str$(Length(XBK))-" "+" Bytes)...",1]
                  Trap Ssave 1,Start(XBK) To Start(XBK)+Length(XBK)
                  If Errtrap : _FEHLER : End If 
                  Exit 
               End If 
            Until Errtrap=False
            Close 

         Else 

            Repeat 
               Trap Bsave Param$,Start(XBK) To Start(XBK)+Length(XBK)
               If Errtrap
                  Proc _FEHLER
                  Exit If Not Param
               End If 
            Until Errtrap=False

         End If 

         If Errtrap
            _T["Na dann muß der Schreibversuch abgebrochen werden.",2]
         Else 
            _T["Ok, hat alles prima geklappt.",1]
         End If 

      Else 

         _T["Na gut, dann eben nicht.",2]

      End If 

   End If 

End Proc
Procedure _LöSCHEN

   _FREQ["Datei löschen..."]

   If Param$<>""

      _MREQ["Wirklich löschen",Param$,True]

      If Param

         _T["",False]
         _T["Lösche '"+Param$+"'...",1]
         Repeat 
            Trap Kill Param$
            If Errtrap
               Proc _FEHLER
               Exit If Not Param
            End If 
         Until Errtrap=False
         If Errtrap
            _T["Tja, der Löschversuch ist leider gescheitert.",2]
         Else 
            _T["Datei hat sich Aufnimmerwiedersehen verabschiedet.",1]
         End If 

      End If 

   End If 

End Proc
Procedure _PACKEN

   Proc _PPTEST : If Param Then Pop Proc

   Dec XSB
   Do 
      Inc XSB
      Dreg(0)=XEF
      Dreg(1)=XSB
      Areg(0)=False
      Areg(1)=False
      XPPACI=Lib Call(1,-$60)
      Exit If XPPACI
      _T["Ui, zu wenig Speicher, verringe Puffer...",2]
   Loop 

   _GLOBAL
   _T["Komprimiere Datei...",1]

   Timer=False

   Areg(0)=XPPACI
   Areg(1)=Start(XBK)
   Dreg(0)=Length(XBK)
   XPPCB=Lib Call(1,-$6C)

   Areg(0)=XPPACI
   XPPFCI=Lib Call(1,-$66)

   Proc _ZEIT

   If XPPCB<4
      _T["Datei ist zu dicht zum Packen, habe den Puffer gelöscht.",2]
      Erase XBK
      XDG=False
   Else 
      Bank Shrink XBK To XPPCB
      _T["Puuuh, fertig.",1]
      _T["Größe orginal:"+Str$(XDG)+" Bytes",1]
      _T["Größe gepackt:"+Str$(XPPCB)+" Bytes",1]
      _T["Packzeit     : "+Param$,1]
      _T["Packergebnis :"+Str$(100-((100.0*XPPCB)/XDG))+"% ("+Str$(XDG-XPPCB)-" "+" Bytes).",2]
      XPP=True
      XPE=XEF
   End If 

End Proc
Procedure _ENTPACKEN

   _T["",False]

   If XPP Then _T["Upsss, Datei ist zwar gepackt, aber noch ohne Packinfos !",2] : Pop Proc

   If Length(XBK)=False
      _T["Hmmm, ich finde keine zu entpackenden Daten.",2]
   Else 
      If Pplength(XBK)=False
         _T["Bäääh, Datei ist kein PowerPacker Datenformat.",2]
      Else 
         _T["Entpacke Datei...",1]
         Timer=False
         Trap Ppdecrunch XBK
         Proc _ZEIT
         If Errtrap=False
            _T["Größe gepackt :"+Str$(XDG)+" Bytes",1]
            _T["Größe entpackt:"+Str$(Length(XBK))+" Bytes",1]
            _T["Entpackzeit   : "+Param$,1]
            _T["Na, das ging doch relativ flott.",1]
            XDG=Length(XBK)
         Else 
            _FEHLER
         End If 
      End If 
   End If 

End Proc
Procedure _OPTIMALTEST

   Proc _PPTEST : If Param Then Pop Proc

   _T["Ermittele die beste Packeffizienz...",1]

   Trap Reserve As Work XBK+1,Length(XBK)
   If Errtrap Then _FEHLER : Pop Proc

   N=XDG

   For I=0 To 4

      Dec XSB
      Do 
         Inc XSB
         Dreg(0)=I
         Dreg(1)=XSB
         Areg(0)=False
         Areg(1)=False
         XPPACI=Lib Call(1,-$60)
         Exit If XPPACI
         _T["Ui, zu wenig Speicher, verringe Puffer...",2]
      Loop 

      Proc _GLOBAL

      Copy Start(XBK),Start(XBK)+Length(XBK) To Start(XBK+1)

      Timer=False

      Areg(0)=XPPACI
      Areg(1)=Start(XBK+1)
      Dreg(0)=Length(XBK+1)
      XPPCB=Lib Call(1,-$6C)

      Areg(0)=XPPACI
      XPPFCI=Lib Call(1,-$66)

      Proc _ZEIT

      If XPPCB<4
         _T["Schade, aber Datei ist zu dicht zum Packen.",2]
         Exit 
      Else 
         _T["Resultat "+Chr$(65+I)+":"+Str$(XPPCB)+" Bytes ("+Str$(100-((100.0*XPPCB)/XDG))-" "+"%), Zeit: "+Param$+"...",1]
      End If 

      If N>XPPCB Then N=XPPCB : XOP=I

   Next 

   If XOP=0 : N$="Schnell"
   Else If XOP=1 : N$="Mittel"
   Else If XOP=2 : N$="Gut"
   Else If XOP=3 : N$="Sehr gut"
   Else If XOP=4 : N$="Super"
   End If 
   If XPPCB>4 Then _T["Oki, doki, beste Packeffizienz: "+N$+" (Resultat "+Chr$(65+XOP)+").",2]

End Proc
Procedure _EFFIZIENZ

   Cls 0,0,51 To 640,78
   For X=0 To 5
      Read N$,T$
      _G[X*106,51,104+X*106,63,False]
      Ink 1,0 : Text X*106+52-Len(N$)*4,60,N$
      N=Instr(N$,T$) : Draw X*106+52-Len(N$)*4+N*8-8,61 To X*106+51-Len(N$)*4+N*8,61
   Next 

   Do 

      X=False : Y=False : Proc _WAIT
      If Param<3
         X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
      Else 
         If Param=83 : X=0 : Y=51
         Else If Param=77 : X=106 : Y=51
         Else If Param=71 : X=2*106 : Y=51
         Else If Param=69 : X=3*106 : Y=51
         Else If Param=85 : X=4*106 : Y=51
         Else If Param=72 or Param=32 : X=5*106 : Y=51
         End If 
      End If 

      '* Schalter oben angewählt ? * 
      If Y>50 and Y<64
         X=X/106
         _G[X*106,51,104+X*106,63,True]
         Wait 10
         Exit If X>4
         XEF=X
         Restore "E"+Chr$(65+X)
         Read N$
         Ink 1,0 : Text 238,25,N$+String$(" ",8-Len(N$))
         _G[X*106,51,104+X*106,63,False]
      End If 

   Loop 

   Cls 0,0,51 To 640,78

EA: Data "Schnell","S"
EB: Data "Mittel","M"
EC: Data "Gut","G"
ED: Data "Sehr gut","e"
EE: Data "Super","u"
    Data "Hauptmenü","H"

End Proc
Procedure _PUFFER

   Cls 0,0,51 To 640,78
   For X=0 To 3
      Read N$,T$
      _G[X*106,51,104+X*106,63,False]
      Ink 1,0 : Text X*106+52-Len(N$)*4,60,N$
      N=Instr(N$,T$) : Draw X*106+52-Len(N$)*4+N*8-8,61 To X*106+51-Len(N$)*4+N*8,61
   Next 

   Do 

      X=False : Y=False : Proc _WAIT
      If Param<3
         X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
      Else 
         If Param=71 : X=0 : Y=51
         Else If Param=77 : X=1*106 : Y=51
         Else If Param=75 : X=2*106 : Y=51
         Else If Param=72 or Param=32 : X=3*106 : Y=51
         End If 
      End If 

      '* SCHALTER BIS MAX. POS. 3 ANGEWÄHLT ? *
      If Y>50 and Y<64 and X<423
         X=X/106
         _G[X*106,51,104+X*106,63,True]
         Wait 10
         Exit If X>2
         XSB=X
         Restore "P"+Chr$(65+X)
         Read N$
         Ink 1,0 : Text 238,43,N$+String$(" ",8-Len(N$))
         _G[X*106,51,104+X*106,63,False]
      End If 

   Loop 

   Cls 0,0,51 To 640,78

PA: Data "Groß","G"
PB: Data "Mittel","M"
PC: Data "Klein","K"
    Data "Hauptmenü","H"

End Proc
Procedure _LESEN
   Proc _APT[""]
End Proc
Procedure _INFORMATION

   Repeat 
      Read N$,N
      _T[N$,N]
   Until N$=""

   Data " ",0
   Data "AMOS Professional PowerPacker Projekt V"+VER$,2
   Data "Programmiert in AMOSPro V2.00 von Volker Stepprath",1
   Data " ",0
   Data "Dieses Programm dient zum Packen & Entpacken im Datenformat",1
   Data "des PowerPackers (PP20). Das Komprimieren geschieht unter",1
   Data "zuhilfenahme der »powerpacker.library«. Sie muß sich im",1
   Data "Verzeichnis »LIBS« auf der Startdiskette befinden !",1
   Data "Das Entpacken wird programmintern mittels der AMOSPro",1
   Data "Extension »AMOSPro_Explode.Lib« erledigt.",1
   Data " ",0
   Data "Rechtliche Anmerkung...",1
   Data "powerpacker.library © by Nico François, PowerPeak",1
   Data "AMOS Professional © by François Lionet, Europress Software",1
   Data "AMOSPro_Explode.Lib © by Volker Stepprath, Testaware",1
   Data " ",0
   Data "AProPoPa Projekt V"+VER$+" ® 30.Juli,1995 von Volker Stepprath",2
   Data "",0

End Proc
Procedure _WORKBENCH

   If Workbench
      Close Workbench 
      N=False
   Else 
      Open Workbench 
      N=True
   End If 

   If N=False and Workbench=True
      _MREQ["Workbench nicht schließbar,","CLI/Shell Task aktiv !",False]
   Else If N=False and Workbench=False
      _T["",False] : _T["Jiipiee, Workbench geschlossen !",2]
   Else If N=True and Workbench=False
      _MREQ["Workbench nicht zu öffnen,","Zu wenig Speicher verfügbar !",True]
   Else If N=True and Workbench=True
      _T["",False] : _T["Juuchuu, Workbench geöffnet !",2]
   End If 

End Proc
Procedure _ZURüCK

   _MREQ["Alle Einstellungen zurücksetzen !","Pufferdaten ebenfalls löschen ?",True]
   If Param Then Erase XBK : XDG=0 : XPP=0

   Erase 98
   Erase 99
   Flush 
   XEF=4
   XSB=0

End Proc

Procedure _ENDE

   _G[0,0,23,12,True]
   _MREQ["AProPoPa Projekt V"+VER$,"wirklich beenden ?",True]
   If Not Param Then _G[0,0,23,12,False] : Pop Proc

   Erase All 
   Lib Close 
   Wait 15
   Request On 
   If Prg State<False
      Amos To Back 
      Screen Close 0
      Flush 
      System 
   End If 
   Edit 

End Proc
Procedure _ICONIFY

   _G[611,0,634,12,True]

   Open Workbench 

   Erase 98
   Erase 99

   Reserve As Chip Work 98,52
   Wait 30

   N$="APPPP"+Chr$(0)
   N=Start(98)

   Doke N+4,Len(N$)*8+77
   Doke N+6,10
   Poke N+8,2
   Poke N+9,3
   Loke N+10,$200
   Loke N+14,14
   Loke N+26,Varptr(N$)
   Doke N+46,1

   Amos Lock 
   Amos To Back 
   Screen Close 0

   Areg(0)=N
   N=Intcall(-204)

   Areg(0)=Leek(N+86)
   A=Execall(-384)
   Areg(0)=N
   N=Intcall(-72)

   Amos Unlock 
   Amos To Front 
   Erase 98
   Close Workbench 

   Proc _INSCREEN

End Proc

Procedure _INSCREEN

   Fix(2)

   Screen Open 0,640,256,4,Hires
   Flash Off 
   Curs Off 
   Palette $789,$0,$FFF,$34A,,,,,,,,,,,,,,$FFF,$C12,$0
   Colour Back Colour(0)
   Cls 0

   Cls 3,0,0 To 634,12
   Cls 3,0,84 To 634,255
   Cls 1,616,3 To 624,5
   Cls 1,616,6 To 629,11
   Cls 2,618,7 To 627,10

   _G[0,0,23,12,False]
   _G[10,5,14,8,False]
   _G[24,0,610,12,False]
   _G[611,0,634,12,False]
   _G[0,84,634,255,True]

   N$="AProPoPa Projekt V"+VER$+" (c) 1995 von Volker Stepprath"
   Ink 2,3 : Text 317-Len(N$)*4,9,N$

   _ST[0,19,"Chip  :            Effizienz:           Datei      :",2,1]
   _ST[0,28,"Fast  :            Optimal  :           Größe      :",2,1]
   _ST[0,37,"Gesamt:            Puffer   :           Ge/Entpackt:",2,1]

   Proc _GLOBAL

   Amos To Front 

   Proc _INFORMATION

End Proc
Procedure _GLOBAL

   For Y=0 To 1
      For X=0 To 5
         Read N$,T$
         _G[X*106,51+Y*14,104+X*106,63+Y*14,False]
         Ink 1,0 : Text X*106+52-Len(N$)*4,60+Y*14,N$
         N=Instr(N$,T$)
         Draw X*106+44-Len(N$)*4+N*8,61+Y*14 To X*106+51-Len(N$)*4+N*8,61+Y*14
      Next 
   Next 

   Ink 1,0
   Text 62,25,Str$(Chip Free)-" "+"  "
   Text 62,34,Str$(Fast Free)-" "+"  "
   Text 62,43,Str$(Chip Free+Fast Free)-" "+"  "

   If XEF=0 : N$="Schnell "
   Else If XEF=1 : N$="Mittel  "
   Else If XEF=2 : N$="Gut     "
   Else If XEF=3 : N$="Sehr gut"
   Else If XEF=4 : N$="Super   "
   End If 
   Text 238,25,N$

   If XOP=0 : N$="Schnell "
   Else If XOP=1 : N$="Mittel  "
   Else If XOP=2 : N$="Gut     "
   Else If XOP=3 : N$="Sehr gut"
   Else If XOP=4 : N$="Super   "
   End If 
   Text 238,34,N$

   If XSB=0 : N$="Groß  "
   Else If XSB=1 : N$="Mittel"
   Else If XSB=2 : N$="Klein "
   End If 
   Text 238,43,N$

   N=False
   If Length(XBK)=False Then XD$="Keine Angabe"
   Text 422,25,Right$(XD$,26)+String$(" ",26)
   Text 422,34,Str$(XDG)-" "+String$(" ",26)
   If Length(XBK)
      If Pplength(XBK)
         N=Pplength(XBK)
      Else 
         N=Length(XBK)
      End If 
   End If 
   Text 422,43,Str$(N)-" "+String$(" ",26)

   Data "Laden","L"
   Data "Speichern","S"
   Data "Löschen","c"
   Data "Packen","P"
   Data "Entpacken","E"
   Data "Optimaltest","O"
   Data "Effizienz","f"
   Data "Puffer","u"
   Data "Lesen","n"
   Data "Information","I"
   Data "Workbench","W"
   Data "Zurück","Z"

End Proc

Procedure _PPTEST

   If Lib Base(1)=False
      Trap Lib Open 1,"powerpacker.library",0
      If Errtrap
         _MREQ["SYS:LIBS/powerpacker.library V35+","konnte nicht geöffnet werden !",False]
         Goto A
      End If 
   End If 

   _T["",0]

   If Length(XBK)=False Then _T["Ooops, da ist nichts zum Packen.",2] : Goto A

   If Pplength(XBK) Then _T["Wie bereits erwehnt, Datei ist schon gepackt.",2] : Goto A

   If XPP Then _T["Ähm, Datei wurde doch schon gepackt.",2] : Goto A

   Goto B
   A: N=True
   B:

End Proc[N]
Procedure _FEHLER

   N=Errtrap
   If N=24 : A$="Zu wenig Speicher verfügbar," : B$="Versuch vorzeitig beendet !" : N=False
   Else If N=81 : A$="Datei nicht aufgefunden," : B$="Versuch vorzeitig beendet !" : N=False
   Else If N=84 : A$="Diskette ist schreibgeschützt," : B$="Zugriff auf Datenträger wiederholen ?" : N=True
   Else If N=86 or N=93 : A$="Datenträger nicht verfügbar," : B$="erneuten Versuch starten ?" : N=True
   Else If N=88 : A$="Diskette ist überfüllt," : B$="Schreibversuch vorzeitig beendet !" : N=False
   Else If N=94 or N=101 : A$="Ein- bzw. Ausgabefehler," : B$="Versuch vorzeitig beendet !" : N=False
   End If 

   If A$="" and B$=""
      _T["Ooops, folgende Fehlernummer ist aufgetreten:"+Str$(Errtrap),2]
   Else 
      _MREQ[A$,B$,N]
   End If 

End Proc
Procedure _WAIT

   Wait 10
   Repeat : Clear Key : Until Mouse Key+Asc(Inkey$)=False
   Do 
      N=Asc(Inkey$)
      Exit If N
      N=Mouse Key
      Exit If N
      Multi Wait 
   Loop 
   If N>32 Then Bclr 5,N
   Clear Key 

End Proc[N]
Procedure _ZEIT
   S=Timer/50
   M=S/60
   H=M/60
   S=S mod 60
   H$=Str$(H)-" " : H$=String$("0",2-Len(H$))+H$
   M$=Str$(M)-" " : M$=String$("0",2-Len(M$))+M$
   S$=Str$(S)-" " : S$=String$("0",2-Len(S$))+S$
End Proc[H$+":"+M$+":"+S$]

Procedure _APT[N$]

'* APT (AMOS Professional Textreader) V2.05
'* Programming ® July, 8th 1995 by Volker Stepprath  


'* N$ = Name der zu lesenden Datei 


'* FENSTER FÜR TEXTAUSGABE BEREITSTELLEN * 
   Wait 15
   Screen Hide 
   XX=Screen Width/8
   XY=Min(33,(Screen Height/8))
   XSU=Screen Height/4
   XSD=XSU*3
   Wind Save 
   Wait 20
   Wind Open 1,0,0,XX,XY
   Dec XX
   Dec XY
   Curs Off 
   Pen 1
   Paper 0
   Clw 
   Ink ,1
   Scroll Off 
   Screen Show 


'* SPEICHER FÜR TEXT (XB) UND TEXTZEIGER (XZ) RESERVIEREN *
   For XB=16 To $FFFE
      Exit If Length(XB)+Length(XB+1)=False
   Next 
   XZ=XB+1


'* TEXTDATEI EINLADEN *
A: If N$="" Then _FREQ["Zu lesende Datei wählen..."] : N$=Param$
   Trap Reserve As Work XB,File Size(N$)
   Trap Bload N$,XB
   If Errtrap Then Goto B
   Pen 1
   Paper 0
   Clw 
   If Pplength(XB)
      Inverse On 
      Locate ,14 : Centre "...decrunching, please wait..."
      Ppdecrunch XB
      Inverse Off 
   End If 
   If Hunt(Start(XB) To Start(XB)+Length(XB),Chr$(0))
      Inverse On 
      Locate ,14 : Centre "...file contains binary, can`t load..."
      Inverse Off 
      Stop Loop 
      Clw 
      N$=""
      Goto A
   End If 
   N$=Right$(N$,50)
   N$=N$+String$(" ",50-Len(N$))

E: XL=Length(XB)

'* SPEICHER FÜR TEXTZEIGER MAX. 4000 × 4 (LONG) *  
   Reserve As Work XZ,4000*4


'* ADRESSENSTART DER ZEILEN INSTALLIEREN * 
   A=Start(XB)
   XA=False
   Loke Start(XZ),A
   Repeat 
      A=Hunt(A To Start(XB)+XL,Chr$(10))
      Exit If A=False
      Inc A
      Inc XA
      Loke Start(XZ)+XA*4,A
   Until XA>3998 or A>Start(XB)+XL


   A=False
   Gosub C


   Do 

'* AUSGABE DER INFOLEISTE *
      If XI=False
         N=(100.0/XA)*Min(XA,A+30)
         T$=String$(" ",3-Len(Str$(N)-" "))+Str$(N)+"%"
         T$=T$+" Lines:"+String$(" ",4-Len(Str$(A)-" "))+Str$(A)-" "+"-"
         N=Min(A+30,XA)
         T$=T$+Str$(N)-" "+String$(" ",4-Len(Str$(N)-" "))+" of"
         Ink 2,1 : Text 0,XY*8+6,N$+T$+String$(" ",4-Len(Str$(XA)-" "))+Str$(XA)+" "
      End If 

      Trap Curs Off 
      Clear Key 
      Do 
         N=Mouse Key
         Exit If N
         N=Asc(Inkey$)
         Exit If N
         If Y Screen(Y Mouse)<XSU
            If A>0 : N=33 : End If 
         Else If Y Screen(Y Mouse)>XSD
            If A+XY<XA : N=34 : End If 
         End If 
         Exit If N
         Multi Wait 
      Loop 
      If N>64 Then Bclr 5,N

'* LMB+RMB/ESC/SPACE/Q = APT BEENDEN * 
      If Btst(6,$BFE001)+Btst(10,$DF0016)=0 or N=27 or N=32 or N=81
         Exit 

'* CSR/LMB = SEITE VOR * 
      Else If N=28 or N=1
         Add A,XY
         Gosub C
         While Mouse Key : Wend 

'* CSL/RMB = SEITE ZURÜCK *  
      Else If N=29 or N=2
         A=A-XY
         Gosub C
         While Mouse Key : Wend 

'* CSD/BS = EINE ZEILE ZURÜCK *    
      Else If N=30 or N=8
         Y Mouse=XSU*2+42
         Ink 0
         Repeat 
            Clear Key 
            Exit If A<1
            Home 
            Dec A
            Screen Copy Screen,0,0,Screen Width,XY*8-8 To Screen,0,8
            Bar 0,0 To Screen Width,7
            Print Peek$(Leek(Start(XZ)+A*4),255,Chr$(10))
         Until Inkey$=""

'* CSU/RT = EINE ZEILE VOR *     
      Else If N=31 or N=13
         Y Mouse=XSU*2+42
         Ink 0
         Repeat 
            Clear Key 
            Exit If A+XY>XA
            Locate 0,XY-1
            Inc A
            Screen Copy Screen,0,8,Screen Width,XY*8 To Screen,0,0
            Bar 0,XY*8-8 To Screen Width,XY*8-1
            Print Peek$(Leek(Start(XZ)+(A+XY-1)*4),255,Chr$(10))
         Until Inkey$=""

'* 33 = Y MOUSE < 2/4 SCROLL ZURÜCK *  
      Else If N=33
         Ink 0
         Repeat 
            Exit If A<1
            Home 
            Dec A
            Screen Copy Screen,0,0,Screen Width,XY*8-8 To Screen,0,8
            Bar 0,0 To Screen Width,7
            Print Peek$(Leek(Start(XZ)+A*4),255,Chr$(10))
         Until Y Screen(Y Mouse)>XSU

'* 34 = Y MOUSE > 3/4 SCROLL VORWÄRTS *  
      Else If N=34
         Ink 0
         Repeat 
            Exit If A+XY>XA
            Locate 0,XY-1
            Inc A
            Screen Copy Screen,0,8,Screen Width,XY*8 To Screen,0,0
            Bar 0,XY*8-8 To Screen Width,XY*8-1
            Print Peek$(Leek(Start(XZ)+(A+XY-1)*4),255,Chr$(10))
         Until Y Screen(Y Mouse)<XSD

'* A = TEXT AUSSPRECHEN *
      Else If N=65
         Locate 0,XY
         Pen 2
         Paper 1
         Put Key "Y"
         Input "Sure to speak out (Y/N): ";T$
         Curs Off 
         Pen 1
         Paper 0
         If T$="Y"
            For I=0 To XA-1
               T$=Peek$(Leek(Start(XZ)+I*4),255,Chr$(10))
               Text 0,XY*8+6,T$+Space$(80)
               If T$<>""
                  Trap Say T$
               End If 
               Exit If Errtrap+Asc(Inkey$)
            Next 
            Clear Key 
            Wait 100
         Else 
            Trap Error 23
         End If 

'* B = TEXTENDE (BOTTOM) * 
      Else If N=66
         A=XA
         Gosub C

'* C = WORKBENCH- BZW. DEFAULTFARBEN * 
      Else If N=67
         Add XC,1,0 To 1
         If XC
            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)
            Palette ,,,,,,,,,,,,,,,,,Deek(I+106),Deek(I+102),Deek(I+104)
         Else 
            Palette $789,$0,$FFF,$34A,,,,,,,,,,,,,,$FFF,$C12,$0
         End If 
         Colour Back Colour(0)
         Screen Show 

'* F = SUCHE NACH ZEICHENKETTE * 
      Else If N=70
         Locate 0,XY
         Pen 2
         Paper 1
         Put Key XF$
         Input "Find string: ";XF$
         Curs Off 
         Pen 1
         Paper 0
         N=False
         If XF$<>""
            For I=A+1 To XA-1
               T$=Peek$(Leek(Start(XZ)+I*4),255,Chr$(10))
               N=Instr(T$,XF$)
               Exit If N
            Next 
         End If 
         If N
            A=I
            Gosub C
         Else 
            Trap Error 23
         End If 

'* G = SPRINGE ZU ZEILE *  
      Else If N=71
         Locate 0,XY
         Pen 2
         Paper 1
         Input "Goto line: ";T$
         A=Val(T$)
         A=Abs(A)
         Pen 1
         Paper 0
         Gosub C

'* H = INFO *
      Else If N=72
         Paper 0
         Clw 
         Restore D
         Read T$
         Under On 
         Locate ,4 : Print T$
         Under Off 
         For I=0 To 18
            Trap Read T$
            Print T$
         Next 
         Stop Loop 
         Gosub C

'* I = INFOLEISTE ABSCHALTEN * 
      Else If N=73
         Add XI,1,0 To 1
         If XI
            Ink ,0 : Text 0,XY*8+6,Space$(90)
         Else 
            Ink ,1
         End If 

'* L = LADE NEUE TEXTDATEI * 
      Else If N=76
         N$=""
         XA=False
         Goto A

'* M = ENTFERNT ALLE AMOSPRO STEUERCODES * 
      Else If N=77
         If Hunt(Start(XB) To Start(XB)+XL,Chr$(27))=False
            Trap Error 23
         Else 
            Paper 0
            Pen 1
            Clw 
            Inverse On 
            Locate ,14 : Centre "...removing AMOS ctrl sequences, please wait..."
            Inverse Off 
            A=Start(XB)
            N=A
            Do 
               A=Hunt(A To Start(XB)+XL,Chr$(27))
               Exit If A=False
               Poke$ A,String$(Chr$(0),3)
               Inc A
            Loop 
            A=N
            Repeat 
               If Peek(A) : Poke N,Peek(A) : Inc N : End If 
               Inc A
            Until A=>Start(XB)+XL
            Bank Shrink XB To(N-Start(XB))+1
            Poke Start(XB)+Length(XB)-1,10
            Goto E
         End If 

'* N = SUCHE NÄCHSTE ZEICHENKETTE VORWÄRTS * 
      Else If N=78
         N=False
         If XF$<>""
            For I=A+1 To XA-1
               T$=Peek$(Leek(Start(XZ)+I*4),255,Chr$(10))
               N=Instr(T$,XF$)
               Exit If N
            Next 
         End If 
         If N
            A=I
            Gosub C
         Else 
            Trap Error 23
         End If 

'* P = DRUCKE TEXT AUS * 
      Else If N=80
         Locate 0,XY
         Pen 2
         Paper 1
         Put Key "Y"
         Input "Sure to make a print out (Y/N): ";T$
         Curs Off 
         Pen 1
         Paper 0
         If T$="Y"
            Trap Open Port 1,"PRT:"
            If Errtrap=False
               For I=0 To XA-1
                  T$=Peek$(Leek(Start(XZ)+I*4),255,Chr$(10))
                  Text 0,XY*8+6,T$+Space$(80)
                  Trap Print #1,T$
                  Exit If Errtrap+Asc(Inkey$)
                  Wait 15
               Next 
               Close 
               Clear Key 
               Flush 
               Wait 100
            End If 
         Else 
            Trap Error 23
         End If 

'* R = SUCHE VORHERIGE ZEICHENKETTE *
      Else If N=82
         N=False
         If XF$<>""
            For I=A-1 To 0 Step -1
               T$=Peek$(Leek(Start(XZ)+I*4),255,Chr$(10))
               N=Instr(T$,XF$)
               Exit If N
            Next 
         End If 
         If N
            A=I
            Gosub C
         Else 
            Trap Error 23
         End If 

'* S = SICHERN ALS ASCII DATEI * 
      Else If N=83
         _FREQ["Datei speichern..."] : T$=Param$
         Trap Bsave T$,Start(XB) To Start(XB)+XL

'* T = TEXTANFANG (TOP) *
      Else If N=84
         A=False
         Gosub C

      End If 


'* DISPLAYBEEP BEI FEHLER *  
      If Errtrap
         N=Colour(0)
         Colour 0,$FFF
         Wait 6
         Colour 0,N
      End If 

   Loop 


'* SPEICHERBEREICHE FREIGEBEN *
B: Erase XZ
   Erase XB
   Palette $789,$0,$FFF,$34A,,,,,,,,,,,,,,$FFF,$C12,$0
   Colour Back Colour(0)
   Screen Show 
   Wind Close 
   Ink 1,0
   While Asc(Inkey$)+Mouse Key
   Wend 
   Clear Key 
   Wait 20
   Pop Proc


'* AUSGABE EINER KOMPLETTEN SEITE *
C: A=Max(0,Min(XA-XY+1,A))
   Y Mouse=XSU*2+42
   Home 
   Curs Off 
   Ink 0 : Bar 0,0 To Screen Width,XY*8-1
   For I=A To A+XY
      Exit If I=XA or Y Curs>XY-1
      Print Peek$(Leek(Start(XZ)+I*4),255,Chr$(10))
   Next 
   Curs Off 
   Return 


'* INFORMATIONSDATEN * 
D: Data Pen$(1)+" The AMOSPro Textreader replacement project V2.05 "
   Data ""
   Data Pen$(2)+"Right arrow, Left mouse - Left, Right"+Pen$(1)+": Page forward - Backward"
   Data Pen$(2)+"   Down arrow, Return - Up, Backspace"+Pen$(1)+": Line down - Line up"
   Data Pen$(2)+Space$(19)+"Mouse top - buttom"+Pen$(1)+": Scroll up - Scroll down"
   Data Pen$(2)+Space$(28)+"T - B - G"+Pen$(1)+": Top - Bottom - Goto line"
   Data Pen$(2)+Space$(28)+"F - N - R"+Pen$(1)+": Find string - Next - Previous"
   Data Pen$(2)+Space$(32)+"P - A"+Pen$(1)+": Print out - Speak out"
   Data Pen$(2)+Space$(32)+"S - L"+Pen$(1)+": Save to - Load new file"
   Data Pen$(2)+Space$(36)+"M"+Pen$(1)+": Removes AMOS ctrl sequences"
   Data Pen$(2)+Space$(36)+"I"+Pen$(1)+": Hide & show infoline"
   Data Pen$(2)+Space$(36)+"C"+Pen$(1)+": Switch Workbench & Defaultcolor"
   Data Pen$(2)+Space$(23)+"Left Amiga + A"+Pen$(1)+": Switch Workbench & Textreader"
   Data Pen$(2)+Space$(36)+"H"+Pen$(1)+": This help and infopage"
   Data Pen$(2)+"        Esc, Space, Q, Both mousekeys"+Pen$(1)+": Quits textreader"
   Data ""
   Data "PowerPacker decrunch support by the AMOSPro Explode Extension V1.03"
   Data "APT © 95 by Volker Stepprath, Tegeler Str.7, 40789 Monheim, Germany"
   Data ""
   Data "Chip:"+Str$(Chip Free)-" "+"  Fast:"+Str$(Fast Free)-" "+"  Total:"+Str$(Chip Free+Fast Free)-" "+"  Buffer:"+Str$(Free)-" "+"  Text:"+Str$(XL)-" "

End Proc
Procedure _FREQ[N$]

'* FReq (AMOSPro Filerequest Replacement) V1.0b  
'* Programming ® May, 30th 1995 by Volker Stepprath  


   '* N$ = Requesttitel 


   '* X  = Request X Position 
   '* Y  = Request Y Position 
   '* XM = X Maus relativ zu X
   '* YM = Y Maus relativ zu Y
   '* XA = Anzahl der Dateien 
   '* XP = Scrollposition 
   '* D$ = Selektierter Pfadname  
   '* F$ = Selektierter Dateiname   
   '* P$ = Alter Pfad (s. Dir$) 

   '* Bnk 98 = Variablenspeicher    
   '* Bnk 99 = Verzeichniseintragungen max. 500 

   '* Param$ = Pfad + Dateiname 


'* ALTER ZUGRIFFSPFAD SICHERN *
   P$=Dir$


'* X/Y POSITION = MITTIG & VIELFACHES VON 16 * 
   X=(Screen Width/2-130)/16*16
   Y=(Screen Height/2-70)/16*16


'* HINTERGRUND SICHERN * 
   Get Cblock 1,X,Y,288,160


'* FILEREQUEST ERSTELLEN *   
   Gr Writing 0
   Set Pattern 2
   Ink 1,0 : Bar X+18,Y+9 To X+284,Y+159
   Gr Writing 1
   Set Pattern 0
   Ink 0 : Bar X,Y To X+269,Y+151
   Ink 3 : Bar X,Y To X+269,Y+12
   For I=0 To 13
      Read A,B,C,D,N
      _G[X+A,Y+B,X+C,Y+D,N]
   Next 
   Draw X+252,Y+118 To X+255,Y+115
   Draw X+255,Y+115 To X+258,Y+118
   Bar X+254,Y+116 To X+256,Y+120
   Draw X+252,Y+129 To X+255,Y+132
   Draw X+255,Y+132 To X+258,Y+129
   Bar X+254,Y+127 To X+256,Y+131
   Gr Writing 0
   Ink 2 : Text X+30,Y+9,Left$(N$,29)
   Gr Writing 1
   Ink 1
   Text X+82,Y+146,"DISKS"
   Text X+144,Y+146,"PARENT"
   Text X+226,Y+146,"OK"


'* TEST OB BEREITS VERZEICHNIS EINGELESEN (BANK 98 & 99) * 
   If Length(98)
      XA=Deek(Start(98)+200)
      XP=Deek(Start(98)+202)
      F$=Peek$(Start(98),100,Chr$(0))
      D$=Peek$(Start(98)+100,100,Chr$(0))
      Text X+10,Y+132,Left$(F$,29)
      Text X+10,Y+120,Right$(D$,29)
      Gosub C
      If Exist(D$)
         Dir$=D$
      End If 
   Else 
      Trap Reserve As Work 98,204
      Trap Reserve As Work 99,9300
      If Errtrap : Goto Z : End If 
      Gosub A
   End If 


'* HAUPTSCHLEIFE * 
   Do 

      N=Wait Loop
      Bclr 5,N
      XM=X Screen(X Mouse)-X
      YM=Y Screen(Y Mouse)-Y

'* CLOSE GADGET *
      If N=27 or XM>0 and XM<24 and YM>0 and YM<13
         _G[X,Y,X+23,Y+12,True]
         Poke$ Start(98),F$+Chr$(0)
         Poke$ Start(98)+100,D$+Chr$(0)
         D$=""
         F$=""
         Goto Z

'* D = DISKS * 
      Else If N=68 or XM>71 and XM<132 and YM>137 and YM<148
         _G[X+72,Y+138,X+131,Y+148,True]
         Wait 10
         Gosub A
         _G[X+72,Y+138,X+131,Y+148,False]

'* P = PARENT *
      Else If N=80 or XM>137 and XM<198 and YM>137 and YM<148
         _G[X+138,Y+138,X+197,Y+148,True]
         Parent 
         D$=Dir$
         Gosub B
         _G[X+138,Y+138,X+197,Y+148,False]

'* RETURN = OK * 
      Else If N=13 or XM>203 and XM<264 and YM>137 and YM<148
         _G[X+204,Y+138,X+263,Y+148,True]
         Poke$ Start(98),F$+Chr$(0)
         Poke$ Start(98)+100,D$+Chr$(0)
         If F$="" : D$="" : End If 
         Goto Z

'* CSR = ZEILENWEISE HOCH *  
      Else If N=30 or XM>248 and XM<264 and YM>111 and YM<124
         _G[X+249,Y+112,X+263,Y+123,True]
         Ink 1
         Repeat 
            If XP>0
               Screen Copy Screen,X+7,Y+17,X+245,Y+100 To Screen,X+7,Y+25
               Dec XP
               Text X+10,Y+26,Peek$(Start(99)+XP*31,29,Chr$(0))
               Gosub E
            End If 
         Until Mouse Key=False
         _G[X+249,Y+112,X+263,Y+123,False]

'* CSR = ZEILENWEISE RUNTER *  
      Else If N=31 or XM>248 and XM<264 and YM>123 and YM<136
         _G[X+249,Y+124,X+263,Y+135,True]
         Ink 1
         Repeat 
            If XP<XA-11
               Screen Copy Screen,X+7,Y+28,X+245,Y+110 To Screen,X+7,Y+20
               Inc XP
               Text X+10,Y+106,Peek$(Start(99)+(10+XP)*31,29,Chr$(0))
               Gosub E
            End If 
         Until Mouse Key=False
         _G[X+249,Y+124,X+263,Y+135,False]

'* DEVICE / DATEI SELEKTIEREN *
      Else If XM>5 and XM<247 and YM>19 and YM<108
         A=(YM-20)/8
         N$=Peek$(Start(99)+(A+XP)*31,29,Chr$(0))
         Ink 2,1 : Text X+10,Y+A*8+26,N$
         If Instr(N$,":")
            Gosub D
            If Exist(N$)
               D$=N$
               Gosub B
            Else 
               Gosub A
            End If 
         Else If Peek(Varptr(N$))=42
            N$=Right$(N$,Len(N$)-1)
            Gosub D
            If Exist(N$)
               D$=D$+N$
               Gosub B
            Else 
               Gosub C
            End If 
         Else 
            Ink 1,0 : Text X+10,Y+132,N$
            While Mouse Key : Wend 
            Text X+10,Y+A*8+26,N$
            Gosub D
            If F$=N$ and Timer-T<30
               Poke$ Start(98),F$+Chr$(0)
               Poke$ Start(98)+100,D$+Chr$(0)
               Goto Z
            Else 
               F$=N$
               T=Timer
            End If 
         End If 

'* DIRECTORY EINTRAGEN * 
      Else If XM>5 and XM<247 and YM>111 and YM<124
         A$=D$
         YM=Y+120
         Gosub F
         If A$<>""
            If Exist(A$)
               D$=A$
               Gosub B
            End If 
         End If 
         Ink 0 : Bar X+7,Y+113 To X+245,Y+122
         Ink 1 : Text X+10,Y+120,Right$(D$,29)

'* FILE EINTRAGEN *
      Else If XM>5 and XM<247 and YM>123 and YM<136
         A$=F$
         YM=Y+132
         Gosub F
         F$=A$

      End If 

   Loop 


'* AUSGABE DER VERFÜGBAREN DEVICES (DISKS) * 
A: N=Start(99)
   Fill N To N+Length(99),0
   XA=False
   XP=False
   N$=Dev First$("")
   Do 
      N$=Left$(N$,30)
      N$=Right$(N$,Len(N$)-1)
      Poke$ N,Left$(N$,29)+Chr$(0)
      Add N,31
      N$=Dev Next$
      Inc XA
      Exit If N$=""
   Loop 
   Goto C


'* FILEEINTRAGUNGEN ERMITTELN ( MAX. 300 ) * 
B: N=Start(99)
   Fill N To N+Length(99),0
   XA=False
   XP=False
   Dir$=D$
   D$=Dir$
   N$=Dir First$("")
   Do 
      Exit If N$=""
      If Left$(N$,1)<>"*"
         N$=Right$(N$,Len(N$)-1)
      End If 
      Poke$ N,Left$(N$,29)+Chr$(0)
      N$=Dir Next$
      Add N,31
      Inc XA
      Exit If XA>299
   Loop 
   Ink 0 : Bar X+7,Y+113 To X+245,Y+122
   Ink 1,0 : Text X+10,Y+120,Right$(D$,29)
   Goto C


'* AUSGABE DER EINTRAGUNGEN *
C: N=Start(99)
   Ink 0 : Bar X+7,Y+17 To X+245,Y+110
   Ink 1,0
   For I=0 To 10
      N$=Peek$(N+(I+XP)*31,29,Chr$(0))
      Exit If N$=""
      Text X+10,Y+26+I*8,N$
   Next 
   Ink 3 : Bar X+7,Y+139 To X+64,Y+147
   N$=Str$(XA)-" " : N$=String$("0",3-Len(N$))+N$
   Ink 2,3 : Text X+24,Y+146,N$
   Ink 1,0
   Goto E


'* NAMEN ERMITTELN * 
D: A=Varptr(N$)+Len(N$)-1
   Repeat 
      N=Peek(A)
      If N=32 Then Poke A,0 : Dec A
   Until N<>32
   N$=Peek$(Varptr(N$),29,Chr$(0))
   Return 


'* SCROLLBALKEN *
E: N=Max(1,XA)
   If N>10 Then N#=(91.0/N)*(N-11) Else N#=0
   Ink 0 : Bar X+252,Y+18 To X+260,Y+109
   Ink 3 : Bar X+253,Y+18+XP*(91.0/N) To X+259,Y+109-N#+XP*(91.0/N)
   _G[X+252,Y+18+XP*(91.0/N),X+260,Y+109-N#+XP*(91.0/N),False]
   Return 


'* DEVICE & DATEI EINGEBEN * 
F: Do 
      Ink ,0 : Text X+10,YM,Right$(A$,28)
      Ink ,3 : Text X+10+Min(Len(A$)*8,28*8),YM," "
      N=Wait Loop
      Exit If N=13
      If N>31 and Len(A$)<100
         A$=A$+Chr$(N)
      Else If N=8 and Len(A$)>0
         Ink ,0
         Text X+10+Min(Len(A$)*8,28*8),YM," "
         A$=Left$(A$,Len(A$)-1)
      End If 
   Loop 
   Ink ,0 : Text X+10+Min(Len(A$)*8,28*8),YM," "
   Return 


'* HINTERGRUND RESTAURIEREN & BEENDEN *
Z: Doke Start(98)+200,XA
   Doke Start(98)+202,XP
   If Mouse Key=2 Then Erase 98 : Erase 99
   If Exist(P$) Then Dir$=P$
   Wait 10
   Put Cblock 1,X,Y
   Del Cblock 1


'* DATAS FÜR REQUESTGRAFIK * 
   Data 0,0,23,12,0
   Data 10,5,14,8,0
   Data 24,0,269,12,0

   Data 0,13,269,151,0
   Data 6,16,246,111,1
   Data 6,112,246,123,1
   Data 6,124,246,135,1

   Data 249,16,263,111,0
   Data 249,112,263,123,0
   Data 249,124,263,135,0

   Data 6,138,65,148,0
   Data 72,138,131,148,0
   Data 138,138,197,148,0
   Data 204,138,263,148,0

End Proc[D$+F$]
Procedure _MREQ[A$,B$,N]

'* MReq (AMOSPro Messagerequest) V1.0a   
'* Programming ® July, 30th 1995 by Volker Stepprath   

   '* 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=(Screen Width/2-10*16)/16*16
   Y=(Screen Height/2-5*16)/16*16


'* HINTERGRUND SICHERN * 
   Get Cblock 1,X,Y,352,80


'* REQUESTGRAFIK ERSTELLEN * 
   Gr Writing 0 : Set Pattern 2
   Ink 1,0 : Bar X+18,Y+9 To X+338,Y+79
   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
   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$
   Ink 2,3
   N$="» REQUESTMESSAGE «" : Text X+160-Len(N$)*4,Y+9,N$
   If N
      Cls 3,X+6,Y+55 To X+101,Y+67
      Cls 3,X+218,Y+55 To X+313,Y+67
      N$="Cancel" : Text X+56-Len(N$)*4,Y+64,N$
      N$="Retry" : 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+208,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 

      T=Wait Loop

'* MAUSTASTE BETÄTIGT *
      If T<False
         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
'* CANCEL ANGEWÄHLT *
         If A>5 and A<103 and N
            _G[X+6,Y+55,X+102,Y+67,True]
            T=False
            Exit 
'* RETRY 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 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 _T[N$,N]

   '* N$ = Text 
   '* N  = Farbe

   Screen Copy 0,1,98,633,255 To 0,1,89
   N$=Space$(8)+N$ : N$=Left$(N$,77)
   Ink N,3 : Text 8,249,N$+String$(" ",77-Len(N$))

End Proc
Procedure _ST[X,Y,N$,A,B]
   
'* SCHATTIERTE TEXTAUSGABE * 
   
   '* X = X Pos 
   '* Y = Y Pos 
   '* N$= Textstring
   '* A = Vordergrundfarbe
   '* B = Hintergrundfarbe  
   
   Gr Writing 0
   Add Y,6
   
   Ink B,0 : Text X+1,Y+1,N$
   
   Ink A : Text X,Y,N$
   
   Gr Writing 1
   
End Proc
Procedure _G[X,Y,X2,Y2,N]

'* SCHALTER ZEICHNEN * 

   '* X  = X Startpos 
   '* Y  = Y Startpos 
   '* X2 = X Endpos 
   '* Y2 = Y Endpos 
   '* N  = False >> Schalter aus - True >> Schalter an

   If N Then A=1 : B=2 Else A=2 : B=1
   Ink A : Draw X,Y To X2,Y : Draw X,Y To X,Y2
   Ink B : Draw X2,Y2 To X,Y2 : Draw X2,Y2 To X2,Y

End Proc