'* -----------------------------------------------------
'* ChessBase V1.00
'* Copyrigth © 1996 by Volker Stepprath & Testaware
'* AMOSPro V2.00 by François Lionet & Europress Software
'* Last change: 30-07-96 / 10:04:06
'* -----------------------------------------------------

Set Buffer 15

Request Off
Close Workbench

Dim XF(7,7),XA$(5)
Global XF(),XA$(),XPLY,XROCHADE,XREL,YREL,XWAIT,XCSR,XGAM,XT0$,XT1$

Proc _CHESSBASE

Erase 1
Erase 2
Erase Temp
Lib Close
Request On

Procedure _CHESSBASE

   Proc _CBGETGFX

   Do

      Proc _WINDOW[0,15,319,230,"Main Menu","please make your choice"]

      If XWAIT Then XB$=Str$(XWAIT) Else XB$=" key"
      If XCSR=1 Then XC$="on" Else XC$="off"

      Amos To Front
      Proc _FADEIN

      A=True

      Do

         If A=True
            Cls 0,22,82 To 299,179
            Cls 12,1,16 To 319,25
            Proc _B[5,18,"Main Menu"]
            A=False
            Restore
            Do
               Inc A
               Read A$
               Exit If A$=""
               A$="F"+Str$(A)-" "+":"+String$(".",32-Len(A$))+A$
               Proc _T[160-(Len(A$)*5)/2,85+A*8,A$]
            Loop
            Read A$
            A$="Esc:"+String$(".",31-Len(A$))+A$
            Proc _T[160-(Len(A$)*5)/2,92+A*8,A$]
            A=False
         End If

         Proc _STOPLOOP
         Exit If Param=27,2

         If Param=80
            Proc _CBLOAD

         Else If Param=81
            If Length(8)
               Proc _CBREPLAY
               Exit If Param
               A=True
            Else
               A$="You must first load a"
               B$="recorded game of chess,"
               C$="then you can analyse"
               D$="by replaying it !"
               Proc _R[A$,B$,C$,D$,False]
            End If

         Else If Param=82
            A=XWAIT
            XWAIT=1
            Proc _CBRECORD
            XWAIT=A
            Exit

         Else If Param=83
            Add XWAIT,10,0 To 100
            If XWAIT=0
               XB$=" key"
            Else
               XB$=Str$(XWAIT)
            End If
            B=Param-79
            A$="Wait between moves by"+XB$
            A$="F"+Str$(B)-" "+":"+String$(".",32-Len(A$))+A$
            Proc _T[160-(Len(A$)*5)/2,85+B*8,A$]

         Else If Param=84
            Add XCSR,7,1 To 8
            If XCSR=1
               XC$="on"
            Else
               XC$="off"
            End If
            B=Param-79
            A$="Curser is "+XC$
            A$="F"+Str$(B)-" "+":"+String$(".",32-Len(A$))+A$
            Proc _T[160-(Len(A$)*5)/2,85+B*8,A$]

         Else If Param=85
            If Length(8)
               Proc _CBINFO
               A=True
            Else
               A$="You must first load a"
               B$="recorded game of chess,"
               C$="then you can get"
               D$="information about it !"
               Proc _R[A$,B$,C$,D$,False]
            End If

         Else If Param=86
            If Length(8)
               Proc _CBPRINT
               A=True
            Else
               A$="You must first load a"
               B$="recorded game of chess,"
               C$="then you can make a"
               D$="print out of it !"
               Proc _R[A$,B$,C$,D$,False]
            End If

         Else If Param=87
            Proc _CBABOUT
            A=True

         End If

      Loop

   Loop

   Proc _FADEOUT
   Wait 50

   Data "Load a recorded game of chess"
   Data "Analyse game of chess"
   Data "Record a new game of chess"
   Data "Wait between moves by"+XB$
   Data "Curser is "+XC$
   Data "Info of game"
   Data "Print out game"
   Data "About ChessBase"
   Data ""
   Data "Exit to workbench"

End Proc

Procedure _CBREPLAY

   Proc _CBNUMBER
   If Param=False Then Pop Proc
   A=Param
   B=Start(8)+Length(8)
   Proc _FADEOUT

   XPLY=False

   For C=0 To 5
      D=Hunt(A To B,Chr$(65+C)+"=")
      If D Then XA$(C)=Peek$(D+2,80,Chr$(10))
   Next
   C=Hunt(A To B,"G=") : If C Then Add C,2

   Proc _CBFIELD
   A$="R E P L A Y - C H E S S"
   Proc _T[160-(Len(A$)*5)/2,220,A$]

   Proc _FADEIN

   Do

      Exit If C=>B

      C$=Upper$(Peek$(C,4))
      Exit If Instr(C$,"Z!")
      Add C,4

      A$=Left$(C$,2)
      B$=Right$(C$,2)

      'Ausgabe der Züge
      If XPLY=0
         Inc Z0
         If Z0>26
            Screen Copy 1,0,45,43,219 To 1,0,38
         End If
         C$=Str$(Z0)-" "+"."+A$+"-"+B$
         X=XREL-Len(C$)*5-8
         Y=YREL-2+Min(25,Z0-1)*7
      Else If XPLY=1
         Inc Z1
         If Z1>26
            Screen Copy 1,277,45,320,219 To 1,277,38
         End If
         C$=Str$(Z1)-" "+"."+A$+"-"+B$
         X=320-Len(C$)*5
         Y=YREL-2+Min(25,Z1-1)*7
      End If
      Proc _T[X,Y,C$]

      'Figurumrandung
      X=Asc(Left$(A$,1))-65
      Y=Asc(Right$(A$,1))-49
      Bob 1,XREL+X*28,YREL+(7-Y)*22,8
      Proc _PAWNFRAME

      'Curser für Zielfeld
      X=Asc(Left$(B$,1))-65
      Y=Asc(Right$(B$,1))-49
      Bob 1,XREL+X*28,YREL+(7-Y)*22,XCSR

      Proc _CBMOVE[A$,B$]
      Exit If Param=27

   Loop

   Bob Off
   Wait Vbl

   A$=Chr$(1)+" "+XA$(2)+" "+Chr$(1)
   Proc _T[160-(Len(A$)*5)/2,230,A$]

   Proc _STOPLOOP
   Proc _FADEOUT

End Proc[-1]
Procedure _CBRECORD

   Cls 0,22,82 To 299,179
   Cls 12,1,16 To 319,25
   Proc _B[5,18,"Recording A New Game Of Chess"]

   Proc _T[30,103,"Info for title:"+Right$(XA$(0),36)]
   Proc _T[30,113,"Info for game :"+Right$(XA$(1),36)]
   Proc _T[30,123,"Info for end  :"+Right$(XA$(2),36)]
   Proc _T[30,133,"Date of game  :"+Right$(XA$(3),36)]
   Proc _T[30,143,"Name for white:"+Right$(XA$(4),36)]
   Proc _T[30,153,"Name for black:"+Right$(XA$(5),36)]

   Proc _I[30,103,36,"Info for title:",XA$(0)] : XA$(0)=Param$
   Proc _I[30,113,36,"Info for game :",XA$(1)] : XA$(1)=Param$
   Proc _I[30,123,36,"Info for end  :",XA$(2)] : XA$(2)=Param$
   Proc _I[30,133,36,"Date of game  :",XA$(3)] : XA$(3)=Param$
   Proc _I[30,143,36,"Name for white:",XA$(4)] : XA$(4)=Param$
   Proc _I[30,153,36,"Name for black:",XA$(5)] : XA$(5)=Param$

   Proc _FADEOUT

   Proc _CBFIELD
   A$="R E C O R D I N G - C H E S S"
   B$="[Esc] = Abort   [A] = Append to   [S] = Save as   [U] = Undo"
   Proc _T[160-(Len(A$)*5)/2,220,A$]
   Proc _T[160-(Len(B$)*5)/2,230,B$]

   'UnDobuffer (500! mal)
   Reserve As Work 9,500*64

   'True = Installieren für UnDo
   A=True

   Z0=1
   Z1=1
   XPLY=0
   XROCHADE=0

   Proc _FADEIN
   Ink 1,0

   Do

      'Feld für UnDo installieren
      If A=True
         Copy Start(9),Start(9)+Length(9)-64 To Start(9)+64
         For I=0 To 7
            For I2=0 To 7
               Poke Start(9)+I*8+I2,XF(I2,I)
            Next
         Next
         If XU<Length(9) : Add XU,64 : End If
      End If

      Proc _SETMOUSE[X Screen(X Mouse),Y Screen(Y Mouse)]

      A$="??"
      B$="??"

      Gosub C
      Gosub B

      Repeat
         Gosub A
         A$=Param$
         Gosub C
         Exit If A
         Multi Wait
      Until A
      Proc _PAWNFRAME
      Gosub B
      Exit If A=27

      Repeat
         Gosub A
         B$=Param$
         Gosub C
         Exit If A
         Multi Wait
      Until A
      Bob 1,X Bob(1),Y Bob(1),XCSR
      Gosub B
      Exit If A=27

      Proc _CBMOVE[A$,B$]
      A=Param
      If A=True
         D$=D$+A$+B$
         If XPLY=0
            Inc Z1
            If Z0>26
               Screen Copy 1,0,45,43,219 To 1,0,38
            End If
         Else If XPLY=1
            Inc Z0
            If Z1>26
               Screen Copy 1,277,45,320,219 To 1,277,38
            End If
         End If
      End If

   Loop

   Bob Off
   Wait Vbl
   Proc _FADEOUT
   Pop Proc

   A:
   X=X Mouse : Y=Y Mouse
   Repeat
      A=Mouse Key+Asc(Inkey$) : Exit If A
      Multi Wait
   Until X<>X Mouse or Y<>Y Mouse
   Bclr 5,A

   If A=27 : Rem * [Esc]
      Proc _R["","Really quit ?","All moves will be lost !","",True]
      If Param=False
         A=False
      End If
   Else If A=65 or A=83 : Rem * [A][S]
      If A=65
         A=True
      Else If A=83
         A=False
      End If
      Proc _CBSAVE[A,D$]
      A=False
   Else If A=85 : Rem * [U]
      Gosub D
      A=False
   End If
   Proc _SETMOUSE[X Screen(X Mouse),Y Screen(Y Mouse)]
   Return

   B:
   Clear Key
   Wait 10
   While Mouse Key<>False
      Multi Wait
   Wend
   Clear Key
   Return

   C:
   If XPLY=0
      C$=Str$(Z0)-" "+"."+A$+"-"+B$
      X=XREL-Len(C$)*5-8
      Y=YREL-2+Min(25,Z0-1)*7
   Else If XPLY=1
      C$=Str$(Z1)-" "+"."+A$+"-"+B$
      X=320-Len(C$)*5
      Y=YREL-2+Min(25,Z1-1)*7
   End If
   Proc _T[X,Y,C$]
   Text 140,33,Right$(C$,5)
   Return

   D:
   If XU>0 and Len(D$)>0
      Bob Off
      Wait Vbl
      N=False
      Copy Start(9)+64,Start(9)+Length(9) To Start(9)
      For I=0 To 7
         For I2=0 To 7
            XF(I2,I)=False
            Proc _SETPAWN[I2,I,15+N]
            Add N,1,0 To 1
            A=Peek(Start(9)+I*8+I2)
            If A
               If A>247
                  A=(255 xor A)+1
                  XF(I2,I)=-A
               Else
                  XF(I2,I)=A
                  Add A,6
               End If
               Proc _SETPAWN[I2,I,A]
            End If
         Next
         Add N,1,0 To 1
      Next
      Add XU,-64
      Add XPLY,1,0 To 1
      If XPLY=0
         Dec Z0
      Else
         Dec Z1
      End If
      D$=Left$(D$,Len(D$)-4)
   End If
   Return

End Proc
Procedure _CBPRINT

   On Error Goto B

   Do

      Proc _CBNUMBER
      Exit If Param=False
      A=Param
      B=Start(8)+Length(8)

      Cls 0,22,82 To 299,179
      Cls 12,1,16 To 319,25
      Proc _B[5,18,"Print Out Game Of Chess"]

      For C=0 To 5
         D=Hunt(A To B,Chr$(65+C)+"=")
         XA$(C)=Peek$(D+2,80,Chr$(10))
      Next
      C=Hunt(A To B,"G=")+2

      A$="Print out game #"+Str$(XGAM)-" "
      A$="F1:"+String$(".",32-Len(A$))+A$
      Proc _T[160-(Len(A$)*5)/2,119,A$]

      A$="Choose other number of game"
      A$="F2:"+String$(".",32-Len(A$))+A$
      Proc _T[160-(Len(A$)*5)/2,127,A$]

      Do
         Proc _STOPLOOP
         If Param=80
            Open Out 1,"PRT:"
            A=40-(Len(XA$(0)))/2
            Print #1,Space$(A)+XA$(0)
            A=40-(Len(XA$(1)))/2
            Print #1,Space$(A)+XA$(1)
            A=40-(Len(XA$(3)))/2
            Print #1,Space$(A)+XA$(3)
            A=38-Len(XA$(4))
            Print #1,Space$(A)+XA$(4)+"    "+XA$(5)
            A=False
            B=C
            Repeat
               A$=Peek$(B,4)
               Exit If Instr(A$,"Z!")
               B$=Peek$(B+4,4)
               If Instr(B$,"Z!")
                  B$=""
               End If
               Add B,8
               Inc A
               A$=Left$(A$,2)+"-"+Right$(A$,2)
               If B$<>""
                  B$=Left$(B$,2)+"-"+Right$(B$,2)
               End If
               A$=Str$(A)+". "+A$
               A$=Space$(38-Len(A$))+A$+"    "+B$
               Print #1,Lower$(A$)
            Until Inkey$=Chr$(27) or B$=""
            A=40-(Len(XA$(2)))/2
            Print #1,Space$(A)+XA$(2)
         Else If Param=81
            Exit
         End If
      Loop

   Loop

   A:
   Close
   Pop Proc

   B:
   A$="Printer trouble,"
   B$="please check all at first !"
   Proc _R["",A$,B$,"",False]
   Resume A

End Proc
Procedure _CBINFO

   Do

      Proc _CBNUMBER
      Exit If Param=False
      A=Param
      B=Start(8)+Length(8)

      Cls 0,22,82 To 299,179
      Cls 12,1,16 To 319,25
      Proc _B[5,18,"Informations About Game Of Chess"]

      For C=0 To 5
         D=Hunt(A To B,Chr$(65+C)+"=")
         If D Then XA$(C)=Peek$(D+2,80,Chr$(10))
      Next

      D=Hunt(A To B,"G=")
      If D
         A=False
         B=False
         C=False
         Add D,2
         Do
            C$=Upper$(Peek$(D,4))
            Exit If Instr(C$,"Z!")
            If A=0
               Inc B
            Else
               Inc C
            End If
            Add D,4
            Add A,1,0 To 1
         Loop
      End If

      Proc _T[30,93,"Info of title :"+Right$(XA$(0),36)]
      Proc _T[30,103,"Info of game  :"+Right$(XA$(1),36)]
      Proc _T[30,113,"Date of game  :"+Right$(XA$(3),36)]
      Proc _T[30,123,"Name of white :"+Right$(XA$(4),36)]
      Proc _T[30,133,"Name of black :"+Right$(XA$(5),36)]
      Proc _T[30,143,"Info of end   :"+Right$(XA$(2),36)]
      Proc _T[30,153,"Moves by white:"+Str$(B)-" "]
      Proc _T[30,163,"Moves by black:"+Str$(C)-" "]

      Proc _STOPLOOP

   Loop

End Proc
Procedure _CBABOUT

   Cls 0,22,82 To 299,179
   Cls 12,1,16 To 319,25
   Proc _B[5,18,"About Chess Base"]

   For I=0 To 10
      Read A$
      Proc _T[160-(Len(A$)*5)/2,87+I*8,A$]
   Next

   Proc _STOPLOOP

   Data "ChessBase V1.00 (Freeware)"
   Data "written in AMOS Professional V2.00 & APCmp V2.00"
   Data ""
   Data "PowerPacker & Xpk support by using (xpksub)libraries"
   Data ""
   Data "For any suggestions or error reports contact:"
   Data ""
   Data "Volker Stepprath"
   Data "Tegeler Straße 7"
   Data "40789 Monheim   "
   Data "Germany         "

End Proc
Procedure _CBLOAD

   On Error Goto B

   Proc _F["Load a new game of chess"]
   N$=Param$

   If N$<>""
      Open In 1,N$
      Reserve As Work 8,Lof(1)
      Sload 1 To Start(8),Length(8)
      Proc _PPDECRUNCH[8,0]
      Proc _XPKUNPACK[8,""]
      If Peek$(Start(8),4)<>"CB10"
         Erase 8
         Proc _R["",N$,"is not a chessbase file !","",False]
      Else
         Proc _R["",N$,"is correct installed !","",False]
      End If
      XGAM=1
   End If

   A:
   Close
   Pop Proc

   B:
   Erase 8
   A$="AMOS error #"+Str$(Errn)-" "+" occured,"
   B$="please check your files !"
   Proc _R["",A$,B$,"",False]
   Resume A

End Proc
Procedure _CBSAVE[A,A$]

   If Len(A$)=0
      A$="Nothing to save,"
      B$="no moves recorded !"
      Proc _R["",A$,B$,"",False]
      Pop Proc
   End If

   On Error Goto C

   If A
      B$="Appending recorded game of chess to an existing file"
      C$="Append game to an existing file"
   Else
      B$="Saving recorded game of chess as a new file"
      C$="Save current game as a new file"
   End If
   Cls 0,0,230 To 320,237
   B$=Chr$(1)+" "+B$+" "+Chr$(1)
   Proc _T[160-(Len(B$)*5)/2,230,B$]

   A:
   Proc _F[C$]
   N$=Param$

   If N$<>""

      If Exist(N$)
         If A=False
            Proc _R["",N$,"already exist, overwrite ?","",True]
            If Param=False
               Goto A
            End If
         Else
            Open In 1,N$
            B$=Input$(1,4)
            Close
            If B$<>"CB10"
               Proc _R[N$,"is no chessbase file","please use correct files","or try to decrunch it !",False]
               Goto A
            End If
         End If
      End If

      If A
         Append 1,N$
      Else
         Open Out 1,N$
      End If
      Print #1,"CB10"+Chr$(10);
      For B=0 To 5
         Print #1,Chr$(65+B)+"="+XA$(B)+Chr$(10);
      Next
      Print #1,"G="+A$+Chr$(10);
      Print #1,"Z!"+Chr$(10);

   End If

   B:
   Close
   Cls 0,0,230 To 320,237
   A$="[Esc] = Abort   [A] = Append to   [S] = Save as   [U] = Undo"
   Proc _T[160-(Len(A$)*5)/2,230,A$]
   Pop Proc

   C:
   A$="AMOS error #"+Str$(Errn)-" "+" occured,"
   B$="please check your drives !"
   Proc _R["",A$,B$,"",False]
   Resume B

End Proc
Procedure _CBNUMBER

   'Anzahl Spiele
   A=Start(8)
   Repeat
      A=Hunt(A To Start(8)+Length(8),"CB10")
      If A
         Inc A
         Inc B
         C=A
      End If
   Until A=False
   A=C

   Cls 0,22,82 To 299,179
   Cls 12,1,16 To 319,25
   Proc _B[5,18,"Set Number of Game"]

   A$="Number of available games ="+Str$(B)+" !"
   Proc _T[160-(Len(A$)*5)/2,100,A$]

   A$="F2:"+String$(".",30)+"Ok"
   Proc _T[160-(Len(A$)*5)/2,85+5*8,A$]
   A$="F3:"+String$(".",16)+"Back to mainmenu"
   Proc _T[160-(Len(A$)*5)/2,85+6*8,A$]

   Gosub A

   Do
      Proc _STOPLOOP
      If Param=80
         Add XGAM,1,1 To B
         Gosub A
      Else If Param=81
         Exit
      Else If Param=82
         Pop Proc[False]
      End If
   Loop

   B=Start(8)-1
   For I=0 To XGAM-1
      B=Hunt(B+1 To Start(8)+Length(8),"CB10")
   Next

   Pop Proc[B]

   A:
   A$="Choose game #"+Str$(XGAM)-" "
   A$="F1:"+String$(".",32-Len(A$))+A$
   Proc _T[160-(Len(A$)*5)/2,85+4*8,A$]
   A=Start(8)-1
   For I=0 To XGAM-1
      A=Hunt(A+1 To Start(8)+Length(8),"CB10")
   Next
   C=Hunt(A To Start(8)+Length(8),"E=")
   If C Then XA$(4)=Peek$(C+2,80,Chr$(10))
   C=Hunt(A To Start(8)+Length(8),"F=")
   If C Then XA$(5)=Peek$(C+2,80,Chr$(10))
   Cls 0,25,150 To 295,160
   A$=Left$(XA$(4),25)+" vs "+Left$(XA$(5),25)
   Proc _T[160-(Len(A$)*5)/2,152,A$]
   Return

End Proc[B]
Procedure _CBGETGFX

   Unpack 16 To 0
   Screen Hide
   Colour 17,$FFF
   Colour 18,$C00
   Colour 19,$0

   If Prg State<False Then Erase 16

   For I=0 To 10
      Get Icon 1+I,1+I*29,1 To I*29+29,23
      If I<5
         Get Icon 12+I,1+I*29,24 To I*29+29,46
      End If
   Next
   Make Icon Mask
   For I=0 To 5
      Get Bob 1+I,146+I*29,24 To 146+I*29+28,46
   Next
   Get Bob 7,1,47 To 29,69
   Get Bob 8,0,0 To 1,1 : Rem Image für Curser off

   Screen Open 1,320,255,16,Lowres
   Screen Hide
   Curs Off
   Cls 0
   Get Icon Palette
   Screen Display 1,,42,,
   Colour Back Colour(0)
   View

   XREL=49
   YREL=40

   XCSR=1
   XGAM=1

   XA$(0)="Schachweltmeisterschaft in Meran"
   XA$(1)="1.Wettkampfpartie"
   XA$(2)="Weiß gibt auf."
   XA$(3)="Donnerstag,1.Oktober 1981"
   XA$(4)="Viktor Kortschnoi"
   XA$(5)="Anatoli Karpow"

   XT0$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-:"
   XT1$="#()<>[].,+*ß"+Chr$(34)+"$%&/=?!^_~`'"+Chr$(0)+Chr$(1)+" "

End Proc
Procedure _CBMOVE[A$,B$]

   'Param->True  = Ok
   'Param->False = Fehler

   'Falls Rochade dann 1 × warten
   C=XWAIT

   A:
   A$=Upper$(A$)
   B$=Upper$(B$)

   'Startfeld
   XA=Peek(Varptr(A$))-65
   YA=Peek(Varptr(A$)+1)-49

   'Zielfeld
   XB=Peek(Varptr(B$))-65
   YB=Peek(Varptr(B$)+1)-49

   YA=7-YA
   YB=7-YB

   'Fehler bei falscher Figur- bzw. Feldwahl
   'oder bei Versuch eigene Figur zu nehmen !
   Proc _CBCHECK[XA,YA,XB,YB]
   If Param=False Then Bob Off : Wait Vbl : Pop Proc

   A=XF(XA,YA)
   B=XF(XB,YB)

   A=Abs(A)+XPLY*6

   'Zugmakierung & Ziehen
   Proc _PAUSE[XWAIT]
   If Param=27 Then Pop Proc

   Channel 1 To Bob 2
   Amreg(23)=X Bob(1)-X Bob(2)
   Amreg(24)=Y Bob(1)-Y Bob(2)
   Bob Off 1
   Wait Vbl
   N=(Abs(XA-XB)+Abs(YA-YB))*11
   Amal 1,"MRX,RY,"+Str$(N)
   Amal On 1
   While Chanmv(1)<>False : Wend
   Amal Off
   Bob Off
   Wait Vbl

   'Feld löschen
   N=((YA mod 2)+XA) mod 2
   Proc _SETPAWN[XA,YA,15+N]
   N=((YB mod 2)+XB) mod 2
   Proc _SETPAWN[XB,YB,15+N]

   'Schachfigur setzen
   XF(XB,YB)=XF(XA,YA)
   XF(XA,YA)=False
   Proc _SETPAWN[XB,YB,A]

   'Rochade?
   If XROCHADE
      A=4+XPLY*6
      If XPLY=0
         If XB=2
            XA=0 : XB=3 : YA=0
         Else If XB=6
            XA=7 : XB=5 : YA=0
         End If
      Else If XPLY=1
         If XB=2
            XA=0 : XB=3 : YA=7
         Else If XB=6
            XA=7 : XB=5 : YA=7
         End If
      End If
      A$=Chr$(65+XA)+Chr$(49+YA)
      B$=Chr$(65+XB)+Chr$(49+YA)
      Bob 1,XREL+XA*28,YREL+(7-YA)*22,XCSR
      Proc _PAWNFRAME
      Bob 1,XREL+XB*28,YREL+(7-YA)*22,XCSR
      XWAIT=1
      Goto A
   End If

   'Nächster Spieler
   Add XPLY,1,0 To 1
   XWAIT=C

End Proc[-1]
Procedure _CBCHECK[XA,YA,XB,YB]

   A=XF(XA,YA)
   B=XF(XB,YB)

   'Zugfeld mit gegnerischen Figur besetzt / unbesetzt
   If XPLY=0 and A>-1 Then Pop Proc[False]
   If XPLY=1 and A<1 Then Pop Proc[False]

   'Zielfeld mit eigener Figur besetzt
   If A<False and B<False or A>False and B>False Then Pop Proc[False]

   C=True
   XROCHADE=False

   If XPLY=0

      'Bauer
      If A=-1

         'Schlagen ohne Gegner
         If Abs(XA-XB)=1 and Abs(YA-YB)=1 and B=0 : C=False : End If

         'Waagerechter Zug
         If XA<>XB and YA=YB : C=False : End If

         'Horizontaler Zug auf besetztes Feld
         If Abs(YA-YB)=1 and Abs(XA-XB)=False and B<>False : C=False : End If

         'Zurück
         If YA<YB : C=False : End If

         '1.Zug mehr als 2 Felder
         If YA=6 and Abs(YA-YB)>2 : C=False : End If

         '1.Zug mehr als 2 Felder und schlagen ohne Gegner
         If YA=6 and Abs(XA-XB)<>False and B=False : C=False : End If

         '2.Zug mehr als 2 Felder
         If YA<>6 and Abs(YA-YB)>1 : C=False : End If

         'Bauer zu Dame wandeln
         If YB=0 and C=True : XF(XA,YA)=-5 : End If

      'Pferd
      Else If A=-2

         'Falscher Pferdsprung (X<>+-1/Y<>+-1)
         If Abs(XA-XB)<>1 and Abs(YA-YB)<>1 : C=False : End If

         'X oder Y Position zu groß/klein
         If Abs(XA-XB)+Abs(YA-YB)<>3 : C=False : End If

      'Läufer
      Else If A=-3

         'Falscher Läuferzug (X&Y<>parallel)
         If(Abs(XA-XB)-Abs(YA-YB)) : C=False : End If

      'Turm
      Else If A=-4

         'Falscher Turmzug (X&Y=differenz)
         If XA-XB<>False and YA-YB<>False : C=False : End If

      'Dame
      Else If A=-5

         'Zug waagerecht und/oder horizontal falsch
         If Abs(XA-XB)<>False and YA<>YB
            If Abs(XA-XB)<>Abs(YA-YB)
               C=False
            End If
         End If

      'König
      Else If A=-6

         'Mehr als 2 Felder in Y Richtung
         If Abs(YA-YB)>1 : C=False : End If

         'Rochade auf falscher Position
         If Abs(XA-XB)>1 and XB<>2 and XB<>6 : C=False : End If

         'Rochade
         If Abs(XA-XB)>1 and YA=7
            If XB=2 and XF(0,YA)=-4
               If XF(3,YA)=False : XROCHADE=True : End If
            Else If XB=6 and XF(7,YA)=-4
               If XF(5,YA)=False : XROCHADE=True : End If
            End If
            If XROCHADE=False : C=False : End If
         End If

      End If

   Else If XPLY=1

      'Bauer
      If A=1

         'Schlagen ohne Gegner
         If Abs(XA-XB)=1 and Abs(YA-YB)=1 and B=0 : C=False : End If

         'Waagerechter Zug
         If XA<>XB and YA=YB : C=False : End If

         'Horizontaler Zug auf besetztes Feld
         If Abs(YA-YB)=1 and Abs(XA-XB)=False and B<>False : C=False : End If

         'Zurück
         If YA>YB : C=False : End If

         '1.Zug mehr als 2 Felder
         If YA=1 and Abs(YA-YB)>2 : C=False : End If

         '1.Zug mehr als 2 Felder und schlagen ohne Gegner
         If YA=1 and Abs(XA-XB)<>False and B=False : C=False : End If

         '2.Zug mehr als 2 Felder
         If YA<>1 and Abs(YA-YB)>1 : C=False : End If

         'Bauer zu Dame wandeln
         If YB=7 and C=True : XF(XA,YA)=5 : End If

      'Pferd
      Else If A=2

         'Falscher Pferdsprung (X<>+-1/Y<>+-1)
         If Abs(XA-XB)<>1 and Abs(YA-YB)<>1 : C=False : End If

         'X oder Y Position zu groß/klein
         If Abs(XA-XB)+Abs(YA-YB)<>3 : C=False : End If

      'Läufer
      Else If A=3

         'Falscher Läuferzug (X&Y<>parallel)
         If(Abs(XA-XB)-Abs(YA-YB)) : C=False : End If

      'Turm
      Else If A=4

         'Falscher Turmzug (X&Y=differenz)
         If XA-XB<>False and YA-YB<>False : C=False : End If

      'Dame
      Else If A=5

         'Zug waagerecht und/oder horizontal falsch
         If Abs(XA-XB)<>False and YA<>YB
            If Abs(XA-XB)<>Abs(YA-YB)
               C=False
            End If
         End If

      'König
      Else If A=6

         'Mehr als 2 Felder in Y Richtung
         If Abs(YA-YB)>1 : C=False : End If

         'Rochade auf falscher Position
         If Abs(XA-XB)>1 and XB<>2 and XB<>6 : C=False : End If

         'Rochade
         If Abs(XA-XB)>1 and YA=0
            If XB=2 and XF(0,YA)=4
               If XF(3,YA)=False : XROCHADE=True : End If
            Else If XB=6 and XF(7,YA)=4
               If XF(5,YA)=False : XROCHADE=True : End If
            End If
            If XROCHADE=False : C=False : End If
         End If

      End If

   End If

End Proc[C]
Procedure _CBFIELD

   Cls 0

   'Textinformationen
   Proc _T[160-(Len(XA$(0))*5)/2,$0,XA$(0)]
   Proc _T[160-(Len(XA$(1))*5)/2,$9,XA$(1)]
   Proc _T[160-(Len(XA$(3))*5)/2,19,XA$(3)]

   Paste Icon -6,14,13
   Proc _T[20,27,Left$(XA$(4),27)]
   Paste Icon 299,14,14
   A$=Left$(XA$(5),27)
   Proc _T[300-Len(A$)*5,27,A$]

   Proc _COPYRIGHT

   'Schachspielbrett
   For X=0 To 7
      For Y=0 To 7
         XF(X,Y)=False
         Proc _SETPAWN[X,Y,15+N]
         Add N,1,0 To 1
      Next
      Add N,1,0 To 1
   Next
   Proc _G[XREL-2,YREL-2,225+XREL,177+YREL,False]

   'Schachfiguren
   For X=0 To 7
      Read N
      XF(X,0)=N : Proc _SETPAWN[X,7,N]
      XF(X,7)=-N : Proc _SETPAWN[X,0,N+6]
      XF(X,1)=1 : Proc _SETPAWN[X,6,1]
      XF(X,6)=-1 : Proc _SETPAWN[X,1,7]
   Next

   '    T P S D K
   Data 4,2,3,5,6,3,2,4

End Proc

Procedure _SETPAWN[X,Y,A]

   If A Then Paste Icon XREL+X*28,YREL+Y*22,A

End Proc
Procedure _SETMOUSE[A,B]

   A=(A-XREL)/28
   A=Min(7,Max(0,A))
   A$=Chr$(65+A)

   B=8-(B-YREL)/22
   B=Min(8,Max(1,B))
   B$=Chr$(48+B)

   Bob 1,XREL+A*28,YREL+(8-B)*22,XCSR
   Wait Vbl

End Proc[A$+B$]
Procedure _PAWNFRAME

   'Spielfigur umranden

   X=X Bob(1)
   Y=Y Bob(1)

   A=(X-XREL)/28
   B=(Y-YREL)/22

   C=Abs(XF(A,B))

   Bob 2,X,Y,1+C
   Wait Vbl

End Proc
Procedure _STOPLOOP
   Clear Key
   N=Scancode
   Do
      N=Mouse Key : Exit If N
      N=Asc(Inkey$) : Exit If N
      N=Scancode : Exit If N
      Multi Wait
   Loop
End Proc[N]
Procedure _PAUSE[A]
   If A=0 Then Proc _STOPLOOP : Pop Proc
   Clear Key
   N=Scancode
   For I=0 To A
      N=Mouse Key : Exit If N
      N=Asc(Inkey$) : Exit If N
      N=Scancode : Exit If N
      Multi Wait
   Next
End Proc[N]
Procedure _COPYRIGHT

   A$="Copyright (c) ChessBase 1996 by Volker Stepprath & Testaware"
   Proc _T[160-(Len(A$)*5)/2,248,A$]

End Proc

Procedure _FADEIN

   For A=0 To 15
      Colour A,Colour(0)
   Next
   Screen Show
   Show On
   Fade 1 To 0
   Wait 15
   Flash 3,"(000,2)(440,2)(880,2)(BB0,2)(DD0,2)(EE0,2)(FF2,2)(FF8,2)(FFC,2)(FFF,2)(AAF,2)(88C,2)(66A,2)(226,2)(004,2)(001,2)"
   Wait Vbl

End Proc
Procedure _FADEOUT

   Flash Off
   Hide On
   A=Colour(0)
   Fade 1,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A
   Wait 15
   Screen Hide
   Wait Vbl

End Proc
Procedure _WINDOW[X,Y,XW,YW,A$,B$]

   Cls 0

   Cls 12,X,Y To XW,Y+11
   Proc _G[X,Y,XW,Y+11,False]
   Ink 15,14
   Randomize Timer
   Set Pattern 2+Rnd(32)
   Bar X,Y+12 To XW,YW
   Set Pattern 0
   Proc _G[X,Y+12,XW,YW,False]
   Proc _B[X+5,Y+3,A$]

   Screen 0 : Get Block 1,132,46,188,20,1
   Screen 1 : Put Block 1,66,40 : Del Block 1
   Cls 0,20,80 To 300,180
   Proc _G[20,80,300,180,False]
   Proc _G[21,81,299,179,True]

   B$="..."+B$+"..."
   X=(Len(B$)*5)/2
   Cls 12,155-X,200 To 165+X,210
   Proc _G[155-X,200,165+X,210,False]
   Proc _B[160-X,203,B$]

   Proc _COPYRIGHT

End Proc

Procedure _T[X,Y,A$]

   For I=1 To Len(A$)
      A=Instr(XT0$,Mid$(A$,I,1))
      If A
         B=70
      Else
         B=77
         A=Instr(XT1$,Mid$(A$,I,1))
         If A=False : A=Len(XT1$) : End If
      End If
      If A Then Screen Copy 0,(A-1)*5,B,A*5,B+7 To 1,X+(I-1)*5,Y
   Next

End Proc
Procedure _B[X,Y,A$]

   For I=1 To Len(A$)
      A=Instr(XT0$,Mid$(A$,I,1))
      If A
         B=70
      Else
         B=77
         A=Instr(XT1$,Mid$(A$,I,1))
      End If
      If A
         Screen 0
         Get Block 1,(A-1)*5,B,5,7,1
         Screen 1
         Put Block 1,X+(I-1)*5,Y
      End If
   Next

End Proc
Procedure _I[X,Y,A,A$,B$]

   Proc _T[X,Y,A$+Right$(B$,A)+Chr$(0)]
   Add X,Len(A$)*5
   Do
      Proc _STOPLOOP : B=Param
      If B=8 and Len(B$)>0
         B$=Left$(B$,Len(B$)-1)
      Else If B=13
         Exit
      Else If B>31 and Len(B$)<64
         B$=B$+Chr$(B)
      End If
      Proc _T[X,Y,Right$(B$,A)+Chr$(0)+" "]
   Loop
   Proc _T[X,Y,Right$(B$,A)+" "]

End Proc[B$]
Procedure _F[N$]

   'N$     = Requesttitel
   'Param$ = Pfad + Dateiname
   'Bnk 98 = Variablenspeicher
   'Bnk 99 = Verzeichniseintragungen max. 500

   P$=Dir$
   D$=P$

   X=(Screen Width/2)-89
   Y=(Screen Height/2-70)/16*16

   Get Cblock 1,X,Y,Min(208,Screen Width),Min(160,Screen Height)

   Cls 2,X+11,Y+9 To X+186,Y+160
   For I=0 To 12
      Read A,B,C,D,E,N
      Cls A,X+B,Y+C To X+D,Y+E
      _G[X+B,Y+C,X+D,Y+E,N]
   Next
   Draw X+164,Y+118 To X+167,Y+115
   Draw X+167,Y+115 To X+170,Y+118
   Bar X+166,Y+116 To X+168,Y+120
   Draw X+164,Y+129 To X+167,Y+132
   Draw X+167,Y+132 To X+170,Y+129
   Bar X+166,Y+127 To X+168,Y+131
   _B[X+16,Y+3,Left$(N$,37)]
   _B[X+22,Y+141,"DISKS"]
   _B[X+78,Y+141,"PARENT"]
   _B[X+145,Y+141,"OK"]

   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))
      _T[X+10,Y+127,Left$(F$,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
   _T[X+10,Y+115,Right$(D$,29)]

   Do

      Proc _STOPLOOP
      N=Param
      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<12 and YM>0 and YM<12
         _G[X,Y,X+11,Y+11,1]
         Poke$ Start(98),F$+Chr$(0)
         Poke$ Start(98)+100,D$+Chr$(0)
         D$=""
         F$=""
         Goto Z

      'D = DISKS
      Else If N=2 or N=68 or XM>5 and XM<58 and YM>137 and YM<148
         _G[X+6,Y+138,X+57,Y+148,1]
         Wait 10
         Gosub A
         _G[X+6,Y+138,X+57,Y+148,0]

      'P = PARENT
      Else If N=80 or XM>66 and XM<116 and YM>137 and YM<148
         _G[X+67,Y+138,X+115,Y+148,1]
         Parent
         D$=Dir$
         Gosub B
         _G[X+67,Y+138,X+115,Y+148,0]

      'RETURN = OK
      Else If N=13 or XM>124 and XM<173 and YM>137 and YM<148
         _G[X+125,Y+138,X+172,Y+148,1]
         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>162 and XM<173 and YM>111 and YM<124
         _G[X+163,Y+112,X+172,Y+123,True]
         Ink 1
         Repeat
            If XP>0
               Screen Copy Screen,X+7,Y+17,X+159,Y+100 To Screen,X+7,Y+25
               Dec XP
               _T[X+10,Y+21,Peek$(Start(99)+XP*31,29,Chr$(0))]
               Gosub E
            End If
         Until Mouse Key=False
         _G[X+163,Y+112,X+172,Y+123,False]

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

      'DEVICE / DATEI SELEKTIEREN
      Else If XM>5 and XM<160 and YM>19 and YM<108
         A=(YM-20)/8
         N$=Peek$(Start(99)+(A+XP)*31,29,Chr$(0))
         Cls 12,X+7,Y+A*8+20 To X+158,Y+A*8+28
         _G[X+7,Y+A*8+20,X+158,Y+A*8+28,False]
         _B[X+10,Y+A*8+21,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
            _T[X+10,Y+127,N$]
            While Mouse Key : Wend
            Cls 0,X+7,Y+A*8+20 To X+159,Y+A*8+29
            _T[X+10,Y+A*8+21,N$]
            Gosub D
            F$=N$
         End If

      'DIRECTORY EINTRAGEN
      Else If XM>5 and XM<160 and YM>111 and YM<124
         A$=D$
         YM=Y+115
         Gosub F
         If A$<>""
            If Exist(A$)
               D$=A$
               Gosub B
            End If
         End If
         Cls 0,X+7,Y+113 To X+159,Y+123
         _T[X+10,Y+115,Right$(D$,29)]

      'FILE EINTRAGEN
      Else If XM>5 and XM<160 and YM>123 and YM<136
         A$=F$
         YM=Y+127
         Gosub F
         F$=A$
         _T[X+10,Y+127,Right$(F$,29)]

      End If

   Loop

   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

   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
   Cls 0,X+7,Y+113 To X+160,Y+123
   _T[X+10,Y+115,Right$(D$,29)]
   Goto C

   C:
   N=Start(99)
   Cls 0,X+7,Y+17 To X+160,Y+111
   For I=0 To 10
      N$=Peek$(N+(I+XP)*31,29,Chr$(0))
      Exit If N$=""
      _T[X+10,Y+21+I*8,N$]
   Next
   Goto E

   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

   E:
   N=Max(1,XA)
   If N>10 Then N#=(91.0/N)*(N-11) Else N#=0
   Cls 0,X+166,Y+18 To X+171,Y+110
   Cls 2,X+166,Y+18+XP*(91.0/N) To X+170,Y+110-N#+XP*(91.0/N)
   Return

   F:
   _I[X+10,YM,28,"",A$]
   A$=Param$
   Return

   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

   Data 12,0,0,11,11,0
   Data 12,5,5,7,7,0
   Data 12,12,0,179,11,0
   Data 15,0,12,179,152,0
   Data 0,6,16,160,111,1
   Data 0,6,112,160,123,1
   Data 0,6,124,160,135,1
   Data 0,163,16,172,111,0
   Data 15,163,112,172,123,0
   Data 15,163,124,172,135,0
   Data 12,6,138,57,148,0
   Data 12,67,138,115,148,0
   Data 12,125,138,172,148,0

End Proc[D$+F$]
Procedure _R[A$,B$,C$,D$,A]

   X=80
   Y=70

   A$=Right$(A$,29)
   B$=Right$(B$,29)
   C$=Right$(C$,29)
   D$=Right$(D$,29)

   Get Cblock 1,X,Y,176,88
   Cls 2,X+8,Y+8 To X+167,Y+75

   Cls 12,X,Y To X+160,Y+11
   Cls 15,X,Y+12 To X+160,Y+68
   Cls 0,X+5,Y+15 To X+155,Y+50
   Cls 12,X+5,Y+54 To X+55,Y+64
   Cls 12,X+105,Y+54 To X+155,Y+64

   _G[X,Y,X+160,Y+11,False]
   _G[X,Y+12,X+160,Y+68,False]
   _G[X+5,Y+15,X+155,Y+50,True]
   _G[X+5,Y+54,X+55,Y+64,False]
   _G[X+105,Y+54,X+155,Y+64,False]

   N$="MESSAGE REQUEST"
   _B[X+82-(Len(N$)*5)/2,Y+3,N$]
   _T[X+80-(Len(A$)*5)/2,Y+19,A$]
   _T[X+80-(Len(B$)*5)/2,Y+26,B$]
   _T[X+80-(Len(C$)*5)/2,Y+33,C$]
   _T[X+80-(Len(D$)*5)/2,Y+40,D$]

   If A
      A$="Cancel"
      B$="Retry"
   Else
      A$="Ok"
      B$="Ok"
   End If
   _B[X+30-(Len(A$)*5)/2,Y+57,A$]
   _B[X+130-(Len(B$)*5)/2,Y+57,B$]

   Do

      _STOPLOOP
      N=Param
      B=X Screen(X Mouse)
      C=Y Screen(Y Mouse)

      If N=27 or B>X+5 and B<X+55 and C>Y+54 and C<Y+64
         _G[X+5,Y+54,X+55,Y+64,True]
         N=False
         Exit
      Else If N=13 or B>X+105 and B<X+155 and C>Y+54 and C<Y+64
         _G[X+105,Y+54,X+155,Y+64,True]
         N=True
         Exit
      End If

   Loop

   If A=False Then N=True

   Wait 10
   Put Cblock 1,X,Y
   Del Cblock 1

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

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

End Proc

Procedure _PPDECRUNCH[A,B]

   If Leek(Start(A))<>$50503230 Then Pop Proc

   If Lib Base(1)=False
      Trap Lib Open 1,"powerpacker.library",0
      If Errtrap : Pop Proc : End If
   End If

   For C=1 To $FFFF
      Exit If Length(C)=False
   Next

   N=Leek(Start(A)+Length(A)-4)
   Ror.l 8,N
   Poke Varptr(N),0

   Reserve As Work C,N+8
   Copy Start(A),Start(A)+Length(A) To Start(C)

   Areg(0)=Start(C)+Length(A)
   Areg(1)=Start(C)+8
   Areg(2)=Start(C)+4
   Dreg(0)=B
   N=Lib Call(1,-$24)

   Copy Start(C)+8,Start(C)+Length(C) To Start(C)
   Bank Shrink C To Length(C)-8
   Doke Start(C)-12,Deek(Start(A)-12)
   Poke$ Start(C)-8,Peek$(Start(A)-8,8)
   Bank Swap A,C
   Erase C

End Proc
Procedure _XPKUNPACK[A,A$]

   If Leek(Start(A))<>$58504B46 Then Pop Proc

   If Lib Base(2)=False
      Trap Lib Open 2,"xpkmaster.library",0
      If Errtrap : Pop Proc : End If
   End If

   A$=A$+Chr$(0)

   Gosub A : B=N : Reserve As Work B,256
   Gosub A : C=N : Reserve As Work C,256
   Gosub A : D=N : Reserve As Work D,Leek(Start(A)+12)+256

   N=Start(C)
   Loke N+$0*4,$80005853
   Loke N+$1*4,Start(A)
   Loke N+$2*4,$80005870
   Loke N+$3*4,Length(A)
   Loke N+$4*4,$80005862
   Loke N+$5*4,Start(D)
   Loke N+$6*4,$80005871
   Loke N+$7*4,Length(D)
   Loke N+$8*4,$80005874
   Loke N+$9*4,Varptr(A$)
   Loke N+10*4,$80005875
   Loke N+11*4,Start(B)
   Loke N+12*4,$80005881
   Loke N+13*4,$80005877
   Loke N+14*4,True
   Loke N+15*4,False

   Areg(0)=N
   If Lib Call(2,-48)=False
      Bank Shrink D To Length(D)-256
      Doke Start(D)-12,Deek(Start(A)-12)
      Poke$ Start(D)-8,Peek$(Start(A)-8,8)
      Bank Swap A,D
   End If

   N$=Peek$(Start(B),Length(B),Chr$(0))

   Erase B
   Erase C
   Erase D

   Pop Proc

   A:
   For N=1 To $FFFF
      Exit If Length(N)=False
   Next
   Return

End Proc