'------------------------------------------------------
' PARAGON by Volker Stepprath ©1991 by Depeche Software
'------------------------------------------------------
Set Buffer 110
Dim MAB(10),RAB(8),HF$(14,14,1),KF$(38),SCHALTER(16),FILE$(50)
Global FILE$(),MAB(),KF$(),HF$(),FIN,DISK
Global MA,SPMO_A,STONE_A,ZM_A,ZS_A,TIME_A,PUN_A
Global MB,SPMO_B,STONE_B,ZM_B,ZS_B,TIME_B,PUN_B
Global SWP_AB,SPIELER,SPIELART
Global RAB(),STEINANZAHL,ABXY$,ABXY2$,XALT,YALT,CX,CY,NOCROWN
SOUND=1
GAMES_GFX_TO_RAM
MAINLOOP:
EINSTELLUNG[SOUND]
If STATUS=13 Then INFO : Goto MAINLOOP
FIN=0 : NOCROWN=0 : Clear Key 
If MAB(10)>1 and SOUND=1
  For I=50 To 0 Step -1
    Mvolume I : Wait 2
  Next I
  Music Off 
End If 
If MAB(10)=1 and SOUND>1
  Music 1
  For I=1 To 50
    Mvolume I : Wait 3
  Next I
End If 
SOUND=MAB(10)
If STATUS=11 Then SPIELFELD : STEUERUNG : Goto MAINLOOP
If STATUS=14 Then SPIELFELD : REPLAY : Goto MAINLOOP
If STATUS=15
  LADE_SPIELFELD
  If STATUS=13
    SPIELFELD
    STEUERUNG
    Goto MAINLOOP
  End If 
  If STATUS=16
    Goto MAINLOOP
  End If 
End If 
Procedure EINSTELLUNG[SOUND]
  Shared SCHALTER(),STATUS
  OPTION_MAIN:
    Unpack 13 To 0 : Screen Hide : Limit Mouse 0,0 To 450,320
    Reserve Zone 16 : Reset Zone : Restore 
    For I=1 To 16
      Read SCHALTER(I)
      If I>13 Then I2=127
      Set Zone I,45+I2,SCHALTER(I) To 54+I2,SCHALTER(I)+9
    Next I
    Ink 0,5 : STATUS=-1
  OPTION_1:
    For Y=1 To 10
      Gosub OPTION_2
    Next Y
    If STATUS Then Proc BLEND
    Ink 0,5 : STATUS=0
    Do 
      Repeat : Until Mouse Key
      Y=Hzone(X Mouse,Y Mouse)
      Gosub OPTION_2
    Loop 
  OPTION_2:
    If Y<1 Then Return 
    If Y>13 Then I2=172 Else I2=45
    Put Block 14,I2,SCHALTER(Y)
    Repeat 
      If Y=1
        Add MAB(1),1,1 To 4
        If MAB(1)=1 : N$="Mouse     " : End If 
        If MAB(1)=2 : N$="Cpu-Easy" : End If 
        If MAB(1)=3 : N$="Cpu-Medium" : End If 
        If MAB(1)=4 : N$="Cpu-Hard  " : End If 
        SPMO_A=MAB(1) : Text 188,40,N$
      End If 
      If Y=2
        If Mouse Key=1
          Add MAB(2),1,5 To 196
        Else 
          Add MAB(2),-1,5 To 196
        End If 
        N$="0000" : N2$=Str$(MAB(2))-" " : Right$(N$,Len(N2$))=N2$
        STONE_A=MAB(2) : Text 188,50,Right$(N$,3)
      End If 
      If Y=3
        If Mouse Key=1
          Add MAB(3),1,1 To 100
        Else 
          Add MAB(3),-1,1 To 100
        End If 
        N$="0000" : N2$=Str$(MAB(3))-" " : Right$(N$,Len(N2$))=N2$
        If MAB(3)>99 : N$="Off    " : MAB(3)=0 : TIME_A=0 : Else TIME_A=-1 : End If 
        ZM_A=MAB(3) : 
        If MAB(3)>0
          Text 188,60,Right$(N$,2)+" min."
        Else 
          Text 188,60,N$
        End If 
      End If 
      If Y=4
        Add MAB(4),1,1 To 4
        If MAB(4)=1 : N$="Joystick  " : End If 
        If MAB(4)=2 : N$="Cpu-Easy" : End If 
        If MAB(4)=3 : N$="Cpu-Medium" : End If 
        If MAB(4)=4 : N$="Cpu-Hard  " : End If 
        SPMO_B=MAB(4) : Text 188,89,N$
      End If 
      If Y=5
        If Mouse Key=1
          Add MAB(5),1,5 To 196
        Else 
          Add MAB(5),-1,5 To 196
        End If 
        N$="0000" : N2$=Str$(MAB(5))-" " : Right$(N$,Len(N2$))=N2$
        STONE_B=MAB(5) : Text 188,99,Right$(N$,3)
      End If 
      If Y=6
        If Mouse Key=1
          Add MAB(6),1,1 To 100
        Else 
          Add MAB(6),-1,1 To 100
        End If 
        N$="0000" : N2$=Str$(MAB(6))-" " : Right$(N$,Len(N2$))=N2$
        If MAB(6)>99 : N$="Off    " : MAB(6)=0 : TIME_B=0 : Else TIME_B=-1 : End If 
        ZM_B=MAB(6) : 
        If MAB(6)>0
          Text 188,109,Right$(N$,2)+" min."
        Else 
          Text 188,109,N$
        End If 
      End If 
      If Y=7
        If Mouse Key=1
          Add MAB(7),1,1 To 197
        Else 
          Add MAB(7),-1,1 To 197
        End If 
        N$="0000" : N2$=Str$(MAB(7))-" " : Right$(N$,Len(N2$))=N2$
        If MAB(7)>196 : N$="Off" : MAB(7)=0 : End If 
        SWP_AB=MAB(7) : Text 188,139,Right$(N$,3)
      End If 
      If Y=8
        Add MAB(8),1,1 To 2
        If MAB(8)=1 : N$="Tradition" Else N$="Marathon " : End If 
        SPIELART=MAB(8) : Text 188,149,N$
      End If 
      If Y=9
        Add MAB(9),1,1 To 2
        If MAB(9)=1 : N$="One" Else N$="Two" : End If 
        SPIELER=MAB(9) : Text 188,159,N$
      End If 
      If Y=10
        Add MAB(10),1,1 To 3
        If MAB(10)=1 : N$="Music" : End If 
        If MAB(10)=2 : N$="Sfx  " : End If 
        If MAB(10)=3 : N$="Off" : End If 
        Text 188,169,N$
      End If 
      If Y=11
        MA=Rnd(37) : MB=Rnd(37) : PUN_A=0 : PUN_B=0
        ZS_A=0 : ZS_B=0 : ABXY2$="" : ABXY$=""
        For I=1 To 14
          For I2=1 To 14
            HF$(I,I2,1)="O"
          Next I2
        Next I
        STATUS=Y : Fade 2 : Wait 32 : Pop Proc
      End If 
      If Y=12
        MAB(1)=0 : MAB(2)=4 : MAB(3)=101
        MAB(4)=0 : MAB(5)=4 : MAB(6)=101
        MAB(7)=198 : MAB(8)=2 : MAB(9)=2 : MAB(10)=3
        Repeat : Until Mouse Key=0
        Put Block 15,I2,SCHALTER(Y)
        Goto OPTION_1
      End If 
      If Y=13
        STATUS=Y : Fade 2 : Wait 32 : Pop Proc
      End If 
      If Y=14
        TIME_A=0 : TIME_B=0
        STONE_A=RAB(0) : STONE_B=RAB(1) : ZM_A=0 : ZM_B=0 : ZS_A=0 : ZS_B=0
        SWP_AB=RAB(2) : MAB(7)=RAB(2) : SPIELART=RAB(3) : SPIELER=RAB(4) : SPMO_A=0
        PUN_A=RAB(7) : PUN_B=RAB(8) : MA=RAB(5)-1 : MB=RAB(6)-1 : STEINANZAHL=0
        ABXY$="" : STATUS=Y : Fade 2 : Wait 32 : Pop Proc
      End If 
      If Y=15
        STATUS=Y : DISK=0 : Fade 2 : Wait 32 : Pop Proc
      End If 
      If Y=16
        If SOUND=1
          For I=50 To 0 Step -1 : Mvolume I : Wait 3 : Next I
          Music Off 
        End If 
        Fade 3 : Wait 50 : Erase 3 : Erase 5 : Erase 15 : Erase 16 : System 
      End If 
      If Not STATUS Then Wait 6
    Until Mouse Key=0
    Put Block 15,I2,SCHALTER(Y)
  Return 
  Data 32,42,52,81,91,101,131,141,151,161,190,200,210,190,200,210
End Proc
Procedure STEUERUNG
  RAB(0)=MAB(2) : RAB(1)=MAB(5) : RAB(2)=MAB(7) : RAB(3)=MAB(8)
  RAB(4)=MAB(9) : RAB(5)=MA : RAB(6)=MB
  If TIME_A or TIME_B Then Every 40 Proc ZEIT : Every On 
  Do 
    If SPMO_A=1 and SPIELER=1
      Repeat 
        A$=Inkey$
        If Asc(A$)>0
          If Asc(A$)=27 or Asc(A$)=115 : FIN=-1 : End If 
          If Asc(A$)=104 : Proc HELFE_MIR : X=CX*16 : Y=CY*16 : Exit : End If 
          If A$=Chr$(112) : Proc PAUSE : End If 
        End If 
        Exit If FIN,2
        X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
      Until Mouse Key
      X=X/16*16/16 : Y=Y/16*16/16
      XALT=X*16 : YALT=Y*16
      Proc SETZE_STEIN[X,Y]
    End If 
    If SPMO_A>1 and SPIELER=1
      A$=Inkey$
      If A$<>""
        If A$=Chr$(27) or Asc(A$)=115 : FIN=-1 : End If 
        If A$=Chr$(112) : Proc PAUSE : End If 
      End If 
      Exit If FIN
      Proc CPU_THINK
      Proc MAUSMOVE[CX*16,CY*16]
      Proc SETZE_STEIN[CX,CY]
    End If 
    If SPMO_B=1 and SPIELER=2
      X=XALT/16 : Y=YALT/16
      Repeat 
        A$=Inkey$
        If Asc(A$)>0
          If A$=Chr$(27) or Asc(A$)=115 : FIN=-1 : End If 
          If Asc(A$)=104 : Proc HELFE_MIR : X=CX : Y=CY : Exit : End If 
          If A$=Chr$(112) : Proc PAUSE : End If 
        End If 
        Exit If FIN,2
        If Jleft(1) and X>1 : Dec X : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If 
        If Jright(1) and X<14 : Inc X : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If 
        If Jup(1) and Y>1 : Dec Y : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If 
        If Jdown(1) and Y<14 : Inc Y : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If 
      Until Fire(1)=-1
      Proc SETZE_STEIN[X,Y]
    End If 
    If SPMO_B>1 and SPIELER=2
      A$=Inkey$
      If A$<>""
        If A$=Chr$(27) or Asc(A$)=115 : FIN=-1 : End If 
        If A$=Chr$(112) : Proc PAUSE : End If 
      End If 
      Exit If FIN
      Proc CPU_THINK
      Proc MAUSMOVE[CX*16,CY*16]
      Proc SETZE_STEIN[CX,CY]
    End If 
  Loop 
  Every Off 
  Clear Key 
  ABXY$=ABXY$+"*" : ABXY2$=ABXY$ : RAB(7)=PUN_A : RAB(8)=PUN_B
  If Asc(A$)=0
    Proc FINITO
    Proc STATISTIK
  End If 
  If Asc(A$)=27
    Proc FINITO
  End If 
  If Asc(A$)=115
    Proc TILES[98,2,259,35,45]
    Wait Key : Del Cblock 
    Screen Close 1
    Fade 2 : Wait 32
    DISK=-1
    Proc LADE_SPIELFELD
    Fade 2 : Wait 32
    Pop Proc
  End If 
  Proc URSPRUNG
End Proc
Procedure SPIELFELD
  Unpack 15 To 0 : Screen Hide 
  Limit Mouse 149,63 To 358,271
  Proc KLEIN_A : Proc KLEIN_B
  N$="000" : Right$(N$,Len(Str$(ZM_A)-" "))=Str$(ZM_A)-" "
  A$="000" : Right$(A$,Len(Str$(ZM_B)-" "))=Str$(ZM_B)-" "
  For I=2 To 3
    If ZM_A or ZS_A : Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,76 : End If 
    If ZM_B or ZS_B : Put Block 1+Val(Mid$(A$,I,1)),281+(I-1)*5,172 : End If 
  Next I
  N$="000" : Right$(N$,Len(Str$(ZS_A)-" "))=Str$(ZS_A)-" "
  A$="000" : Right$(A$,Len(Str$(ZS_B)-" "))=Str$(ZS_B)-" "
  For I=2 To 3
    If ZS_A or ZM_A : Put Block 1+Val(Mid$(N$,I,1)),296+(I-1)*5,76 : End If 
    If ZS_B or ZM_B : Put Block 1+Val(Mid$(A$,I,1)),296+(I-1)*5,172 : End If 
  Next I
  N$="00000" : Right$(N$,Len(Str$(STONE_A)-" "))=Str$(STONE_A)-" "
  A$="00000" : Right$(A$,Len(Str$(STONE_B)-" "))=Str$(STONE_B)-" "
  For I=1 To 5
    Put Block 1+Val(Mid$(N$,I,1)),281+I*5,83
    Put Block 1+Val(Mid$(A$,I,1)),281+I*5,179
  Next I
  N$="000000" : Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
  A$="000000" : Right$(A$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
  For I=2 To 6
    Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,90
    Put Block 1+Val(Mid$(A$,I,1)),281+(I-1)*5,186
  Next I
  STEINANZAHL=0
  For I=1 To 14
    For I2=1 To 14
      HF$(I,I2,0)=HF$(I,I2,1)
      If HF$(I,I2,0)<>"O"
        If HF$(I,I2,0)="A" : Put Block 11,I*16+1,I2*16+1 : Inc STEINANZAHL : End If 
        If HF$(I,I2,0)="B" : Put Block 12,I*16+1,I2*16+1 : Inc STEINANZAHL : End If 
        If HF$(I,I2,0)="V" : Put Block 16,I*16-1,I2*16-1 : Inc STEINANZAHL : End If 
      Else 
        HF$(I,I2,0)="O"
      End If 
    Next I2
  Next I
  If SPIELER=1 Then Put Block 11,278,217 Else Put Block 12,278,217
  X Mouse=X Hard(21) : Y Mouse=Y Hard(21) : XALT=16 : YALT=16
  Proc BLEND
  Unpack 16 To 1
  Screen To Front 0 : Screen 0
  If SPMO_A>0 Then Proc TILES[0,70,161,103,45] Else Proc TILES[162,36,290,69,62]
  Colour 16,$FFF : Colour 17,$FFF : Colour 18,$FFF
  Wait Key 
  If MAB(10)=2 Then Sam Play 3,3,8300 : Wait 40
  Put Cblock 1,45,109 : Del Cblock 
End Proc
Procedure KLEIN_A
  Add MA,1,1 To 38 : Ink 0
  For I=1 To 3
    For I2=1 To 3
       Inc L
       If Mid$(KF$(MA),L,1)="S"
         Put Block 11,245+I2*16,1+I*16
       Else 
         Bar 245+I2*16,1+I*16 To 253+I2*16,10+I*16
       End If 
     Next I2
   Next I
End Proc
Procedure KLEIN_B
  Add MB,1,1 To 38 : Ink 0
  For I=1 To 3
    For I2=1 To 3
       Inc L
       If Mid$(KF$(MB),L,1)="S"
         Put Block 12,245+I2*16,97+I*16
       Else 
         Bar 245+I2*16,97+I*16 To 253+I2*16,106+I*16
       End If 
     Next I2
   Next I
End Proc
Procedure SETZE_STEIN[X,Y]
  If X>14 or X<1 or Y>14 or Y<1 Then Pop Proc
  If HF$(X,Y,0)<>"O" and Asc(HF$(X,Y,0))<>0 Then Pop Proc
  If MAB(10)=2 Then Sam Play 2,2,28000
  N$="00000"
  If SPIELER=1
    Put Block 11,X*16+1,Y*16+1
    HF$(X,Y,0)="A"
    Dec STONE_A : Right$(N$,Len(Str$(STONE_A)-" "))=Str$(STONE_A)-" "
    For I=1 To 5
      Put Block 1+Val(Mid$(N$,I,1)),281+I*5,83
    Next I
    Proc TESTFELD
    Put Block 12,278,217
    If STONE_B=0 : FIN=-1 : End If 
    SPIELER=2
  Else 
    Put Block 12,X*16+1,Y*16+1
    HF$(X,Y,0)="B"
    Dec STONE_B : Right$(N$,Len(Str$(STONE_B)-" "))=Str$(STONE_B)-" "
    For I=1 To 5
      Put Block 1+Val(Mid$(N$,I,1)),281+I*5,179
    Next I
    Proc TESTFELD
    Put Block 11,278,217
    If STONE_A=0 : FIN=-1 : End If 
    SPIELER=1
  End If 
  Inc STEINANZAHL
  If SWP_AB Then Proc TAUSCHE_AB
  If STEINANZAHL=196 Then FIN=-1
  If STEINANZAHL>140 Then Proc CHANCE_CROWN
  ABXY$=ABXY$+Chr$(X+64)+Chr$(Y+64)
End Proc
Procedure TESTFELD
Every Off 
Repeat 
  If SPIELER=1 Then A$="A" : N$=KF$(MA) Else A$="B" : N$=KF$(MB)
  STATUS=0
  For I=1 To 12
    For I2=1 To 12
      W=Asc(HF$(I2,I,0))
      If W=Asc(A$) or W=80
        A=0
        For L=0 To 2
          For L2=0 To 2
            Inc A : W=Asc(HF$(I2+L2,I+L,0))
            If Mid$(N$,A,1)="S" and W=Asc(A$) or W=80
              N2$=N2$+"S"
            Else 
              N2$=N2$+"O"
            End If 
          Next L2
        Next L
        A=0
        If N2$=N$
          For L=0 To 2
            For L2=0 To 2
              Inc A
              If Mid$(N$,A,1)="S"
                Put Block 13,(I2+L2)*16+1,(I+L)*16+1
                HF$(I2+L2,I+L,0)="P" : STATUS=-1
              End If 
            Next L2
          Next L
          A=0
        End If 
        N2$=""
      End If 
    Next I2
  Next I
  If STATUS
    For I=1 To 14
      For I2=1 To 14
        If HF$(I,I2,0)="P"
          If SPIELART=1 : L2=10 : HF$(I,I2,0)="V" Else L2=5 : HF$(I,I2,0)="O" : Dec STEINANZAHL : End If 
          If MAB(10)=2 : Sam Play 1,1,9800 : End If 
          For L=0 To L2
            Wait 3
            Screen Copy 1,162+L*13,70,175+L*13,82 To 0,I*16-1,I2*16-1
          Next L
          If L2=5 : Wait 5 : Plot I*16+5,I2*16+5,0 : End If 
          N$="00000" : A$=N$
          If SPIELER=1
            Inc STONE_A
            For A=1 To 5
              Right$(A$,Len(Str$(STONE_A)-" "))=Str$(STONE_A)-" "
              Put Block 1+Val(Mid$(A$,A,1)),281+A*5,83
            Next A
            If ABXY2$=""
              Add PUN_A,25 : N$="000000" : A$=N$
              For A=2 To 6
                Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
                Put Block 1+Val(Mid$(N$,A,1)),281+(A-1)*5,90
              Next A
            End If 
          Else 
            Inc STONE_B
            For A=1 To 5
              Right$(A$,Len(Str$(STONE_B)-" "))=Str$(STONE_B)-" "
              Put Block 1+Val(Mid$(A$,A,1)),281+A*5,179
            Next A
            If ABXY2$=""
              Add PUN_B,25 : N$="000000" : A$=N$
              For A=2 To 6
                Right$(N$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
                Put Block 1+Val(Mid$(N$,A,1)),281+(A-1)*5,186
              Next A
            End If 
          End If 
        End If 
      Next I2
    Next I
    If SPIELER=1 : Proc KLEIN_A Else KLEIN_B : End If 
  End If 
Until STATUS=0
Repeat : Until Mouse Key=0
If TIME_A or TIME_B Then Every 40 Proc ZEIT
End Proc
Procedure TAUSCHE_AB
  Dec SWP_AB
  If SWP_AB Then Pop Proc
  For I=1 To 14
    For I2=1 To 14
      If HF$(I,I2,0)<"C"
        If HF$(I,I2,0)="A"
          Put Block 12,I*16+1,I2*16+1
          HF$(I,I2,0)="B"
        Else 
          If HF$(I,I2,0)="B"
            Put Block 11,I*16+1,I2*16+1
            HF$(I,I2,0)="A"
          End If 
        End If 
      End If 
    Next I2
  Next I
  SWP_AB=MAB(7)
  SPIELER_ALT=SPIELER
  SPIELER=1 : Proc TESTFELD
  SPIELER=2 : Proc TESTFELD
  SPIELER=SPIELER_ALT
End Proc
Procedure CHANCE_CROWN
For I=1 To 12
  For I2=1 To 12
    For L=0 To 2
      For L2=0 To 2
        Inc A : X=Asc(HF$(I+L2,I2+L,0))
        If Mid$(KF$(MA),A,1)="S" and(X=65 or X=79) Then Inc W
        If Mid$(KF$(MB),A,1)="S" and(X=66 or X=79) Then Inc Z
      Next L2
    Next L
    If W=5 or Z=5 Then Pop Proc
    W=0 : Z=0 : A=0
  Next I2
Next I
NOCROWN=-1 : FIN=-1
End Proc
Procedure ZEIT
  N$="000" : A$="000"
  If SPIELER=1 and TIME_A
    Add ZS_A,-1,-1 To 59
    If ZS_A=-1 and ZM_A>0
      Dec ZM_A : ZS_A=59
    End If 
    Right$(N$,Len(Str$(ZM_A)-" "))=Str$(ZM_A)-" "
    Right$(A$,Len(Str$(ZS_A)-" "))=Str$(ZS_A)-" "
    For I=2 To 3
      Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,76
      Put Block 1+Val(Mid$(A$,I,1)),296+(I-1)*5,76
    Next I
    If PUN_A>0
      Dec PUN_A : N$="000000"
      Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
      For I=2 To 6
        Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,90
      Next I
    End If 
    If ZM_A=0 and ZS_A=0 : TIME_A=0 : FIN=-1 : End If 
  End If 
  If SPIELER=2 and TIME_B
    Add ZS_B,-1,-1 To 59
    If ZS_B=-1 and ZM_B>0
      Dec ZM_B : ZS_B=59
    End If 
    Right$(N$,Len(Str$(ZM_B)-" "))=Str$(ZM_B)-" "
    Right$(A$,Len(Str$(ZS_B)-" "))=Str$(ZS_B)-" "
    For I=2 To 3
      Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,172
      Put Block 1+Val(Mid$(A$,I,1)),296+(I-1)*5,172
    Next I
    If PUN_B>0
      Dec PUN_B : N$="000000"
      Right$(N$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
      For I=2 To 6
        Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,186
      Next I
    End If 
    If ZM_B=0 and ZS_B=0 : TIME_B=0 : FIN=-1 : End If 
  End If 
  Every On 
End Proc
Procedure PAUSE
  Every Off 
  Proc TILES[0,2,97,35,77]
  Wait Key : Clear Key 
  If MAB(10)=2 Then Sam Play 3,3,8300 : Wait 40
  Put Cblock 1,45,109 : Del Cblock 
  Colour 16,$FFF : Colour 17,$FFF : Colour 18,$FFF
  If TIME_A or TIME_B Then Every 40 Proc ZEIT
End Proc
Procedure FINITO
  Proc TILES[0,36,161,69,45]
  Wait Key 
  Fade 2 : Wait 32
  Del Cblock : Screen Close 1
End Proc
Procedure STATISTIK
  Unpack 14 To 0 : Screen Hide : Hide 
  Ink 5 : Bar 45,45 To 275,200
  Def Scroll 1,0,0 To 320,100,0,28 : Scroll 1
  Def Scroll 1,0,100 To 320,220,0,-28 : Scroll 1
  Ink 0,5 : Bar 0,191 To 320,220
  Text 122,85,"Statistics"
  Text 78,115,"Player 1  -  Player 2"
  N$="000000" : A$="000000"
  Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
  Right$(A$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
  Text 158,133,":" : Text 86,133,N$ : Text 190,133,A$
  If PUN_A>PUN_B Then Text 65,165,"The winner is Player 1 !"
  If PUN_B>PUN_A Then Text 65,165,"The winner is Player 2 !"
  If PUN_A=PUN_B Then Text 112,165,"A full draw !"
  Proc BLEND
  Repeat : Until Mouse Key or Fire(1)
  Fade 2 : Wait 32 : Show 
End Proc
Procedure CPU_THINK
Randomize Timer
If SPIELER=1 and MAB(1)>1 and MAB(1)<4
  Z=Rnd(10)
  If MAB(1)=2
    If Z>7 : Goto LETZTE_HILFE : End If 
    If Z>3 : Goto SPIELER_MUSTER : End If 
  End If 
  If MAB(1)=3
    If Z>5 : Goto SPIELER_MUSTER : End If 
  End If 
End If 
If SPIELER=2 and MAB(4)>1 and MAB(4)<4
  Z=Rnd(10)
  If MAB(4)=2
    If Z>7 : Goto LETZTE_HILFE : End If 
    If Z>3 : Goto SPIELER_MUSTER : End If 
  End If 
  If MAB(4)=3
    If Z>5 : Goto SPIELER_MUSTER : End If 
  End If 
End If 
GEGNER_MUSTER:
  Z2=-1
  If SPIELER=1
    If PUN_A-PUN_B>125 : Goto SPIELER_MUSTER : End If 
  Else 
    If PUN_B-PUN_A>125 : Goto SPIELER_MUSTER : End If 
  End If 
GEGNER_MUSTER_II:
  If SPIELER=1 Then A$="B" : N$=KF$(MB) Else A$="A" : N$=KF$(MA)
  For I=1 To 12
    For I2=1 To 12
      A=0 : Z=0 : W=0
      For L=0 To 2
        For L2=0 To 2
          Inc A
          If Mid$(N$,A,1)="S"
            If HF$(I+L2,I2+L,0)=A$ : Inc Z : End If 
            If HF$(I+L2,I2+L,0)="O" : W=-1 : End If 
          End If 
        Next L2
      Next L
      If Z>3 and W
        Repeat 
          Z=Rnd(8)+1
          If Mid$(N$,Z,1)="S"
            A=0
            For L=0 To 2
              For L2=0 To 2
                Inc A
                If Mid$(N$,A,1)="S" and Asc(HF$(I+L2,I2+L,0))=79
                  CX=I+L2 : CY=I2+L
                End If 
              Next L2
            Next L
          End If 
        Until CX
        Pop Proc
      End If 
    Next I2
  Next I
  If Z2=0 Then Goto LETZTE_HILFE
SPIELER_MUSTER:
  If SPIELER=1 Then A$="A" : N$=KF$(MA) Else A$="B" : N$=KF$(MB)
  W_ALT=0 : CX=0 : CY=0 : A=0 : W=0 : TEST=0
  For I=1 To 12
    For I2=1 To 12
      For L=0 To 2
        For L2=0 To 2
          If HF$(I+L2,I2+L,0)=A$ Then TEST=-1 : L=2 : L2=2
        Next L2
      Next L
      If TEST
        TEST=0
        For L=0 To 2
          For L2=0 To 2
            Inc A
            If Mid$(N$,A,1)="S"
              If HF$(I+L2,I2+L,0)=A$ : Inc Z : Inc W : End If 
              If HF$(I+L2,I2+L,0)="O" : Inc Z : End If 
            End If 
          Next L2
        Next L
        If Z=5 and W>W_ALT
          W_ALT=W : I_ALT=I : I2_ALT=I2
        End If 
        A=0 : W=0 : Z=0
      End If 
    Next I2
  Next I
  If W_ALT
    W=0
    Repeat 
      Z=Rnd(8)+1
      If Mid$(N$,Z,1)="S"
        For L=0 To 2
          For L2=0 To 2
            Inc A : Inc W : If W>1764 : Z2=0 : Goto LETZTE_HILFE : End If 
            If A=Z and Asc(HF$(I_ALT+L2,I2_ALT+L,0))=79
              CX=I_ALT+L2 : CY=I2_ALT+L
            End If 
          Next L2
        Next L
        A=0
      End If 
    Until CX
    Pop Proc
  End If 
LETZTE_HILFE:
  If Z2
    Z2=0
    If MAB(1)=1 or MAB(1)=4 and SPIELER=1 : Goto GEGNER_MUSTER_II : End If 
    If MAB(4)=1 or MAB(4)=4 and SPIELER=2 : Goto GEGNER_MUSTER_II : End If 
  End If 
  If SPIELER=1 Then X=65 : N$=KF$(MA) Else X=66 : N$=KF$(MB)
  Z=Rnd(1) : If Z=0 Then Z2=12 : Z3=1 : W=-1 Else Z2=1 : Z3=12 : W=1
  For I=Z2 To Z3 Step W
    For I2=Z2 To Z3 Step W
      A=0 : Z=0
      For L=0 To 2
        For L2=0 To 2
          Inc A
          Y=Asc(HF$(I+L2,I2+L,0))
          If Mid$(N$,A,1)="S" and(Y=X or Y=79) : Inc Z : End If 
        Next L2
      Next L
      If Z=5
        Repeat 
          Z=Rnd(8)+1
          If Mid$(N$,Z,1)="S"
            For L=0 To 2
              For L2=0 To 2
                If HF$(I+L2,I2+L,0)="O"
                  CX=I+L2 : CY=I2+L : Pop Proc
                End If 
              Next L2
            Next L
          End If 
        Until True=0
      End If 
    Next I2
  Next I
  Repeat 
    CX=Rnd(13)+1 : CY=Rnd(13)+1
  Until HF$(CX,CY,0)="O"
End Proc
Procedure HELFE_MIR
  Proc CPU_THINK
  Proc MAUSMOVE[CX*16,CY*16]
  Clear Key 
End Proc
Procedure REPLAY
  Do 
    A$=Inkey$
    If A$<>""
      If Asc(A$)=27 : Exit : End If 
      If Asc(A$)=112 : Proc PAUSE : End If 
    End If 
    Inc I : X=Asc(Mid$(ABXY2$,I,1))-64
    Inc I : Y=Asc(Mid$(ABXY2$,I,1))-64
    Exit If X<1 or Y<1
    Proc MAUSMOVE[X*16,Y*16]
    Proc SETZE_STEIN[X,Y]
  Loop 
  Clear Key 
  ABXY$=ABXY2$
  MAB(2)=RAB(0) : MAB(5)=RAB(1) : MAB(7)=RAB(2)
  MAB(8)=RAB(3) : MAB(9)=RAB(4)
  Proc FINITO
  Proc URSPRUNG
End Proc
Procedure MAUSMOVE[L,L2]
  If L<XALT Then I2=-1 Else I2=1
  For I=XALT To L Step I2
    X Mouse=X Hard(I)+5 : For A=1 To 100 : Next A
  Next I
  If L2<YALT Then I2=-1 Else I2=1
  For I=YALT To L2 Step I2
    Y Mouse=Y Hard(I)+5 : For A=1 To 100 : Next A
  Next I
  XALT=L : YALT=L2
End Proc
Procedure LADE_SPIELFELD
  Shared SCHALTER(),FILE$(),STATUS
  Unpack 14 To 0 : Screen Hide : Limit Mouse 0,0 To 450,300
  Reserve Zone 16 : Reset Zone : Restore 
  Ink 4,5
  Gosub LESEN
  For I=1 To 9
    Set Zone I,71,43+I*10 To 271,49+I*10
  Next I
  Set Zone 10,46,50 To 60,96
  Set Zone 11,46,97 To 60,143
  Set Zone 12,67,155 To 272,169
  For I=1 To 4
    Read SCHALTER(I)
    Set Zone I+12,SCHALTER(I),189 To SCHALTER(I)+9,198
  Next I
  Def Scroll 1,70,52 To 272,142,0,-1
  Def Scroll 2,70,52 To 272,142,0,1
  Ink 4,5
  If DISK Then Text 59,197,"Load" Else Text 114,197,"Save"
  Z=1
  Proc BLEND
  Do 
    Repeat : Until Mouse Key
    Y=Hzone(X Mouse,Y Mouse)
    If Y=13 and DISK or Y=14 and DISK=0 Then Y=0
    If Y>12 Then Put Block 14,SCHALTER(Y-12),189
    Ink 4,5
    If Y>0 and Y<10 and Instr(FILE$(Y+Z-1),Chr$(160))=0
      N$=FILE$(Y+Z-1)-".dat"
      Ink 0,1 : Text 71,49+Y*10,N$+Space$(25-Len(N$))
      Ink 4,5 : Text 71,165,N$+Space$(25-Len(N$))
      Repeat : Until Mouse Key=0
      Text 71,49+Y*10,N$+Space$(25-Len(N$))
    End If 
    If Y=10 and Z+8<Z2
      For I=1 To 10 : Scroll 1 : Wait Vbl : Next I
      Text 71,139,FILE$(Z+9)-".dat" : Inc Z
    End If 
    If Y=11 and Z>1
      For I=1 To 10 : Scroll 2 : Wait Vbl : Next I
      Dec Z : Text 71,59,FILE$(Z)-".dat"
    End If 
    If Y=12
      Text 71,165,String$("_",25)
      N$="" : Clear Key 
      Repeat 
        A$=""
        While A$="" : A$=Inkey$ : Wend 
        If Asc(A$)<33 and Asc(A$)<>8 and Asc(A$)<>13 : A$="_" : End If 
        If Len(N$)<25 and Asc(A$)<>8 and Asc(A$)<>13 and Asc(A$)<160 : N$=N$+A$ : End If 
        If Asc(A$)=8 and Len(N$)>0 : N$=Left$(N$,Len(N$)-1) : End If 
        Text 71,165,N$+String$("_",25-Len(N$))
      Until Asc(A$)=13
      Text 71,165,N$+Space$(25-Len(N$)) : Clear Key 
    End If 
    If Y=13 and DISK=0 and Mouse Key
      If Exist(N$+".dat")=True
        Open In 1,N$+".dat"
          For I=1 To 9
            Input #1,MAB(I)
          Next I
          Input #1,MA
          Input #1,MB
          Input #1,ZM_A
          Input #1,ZS_A
          Input #1,PUN_A
          Input #1,ZM_B
          Input #1,ZS_B
          Input #1,PUN_B
          I=0
          While Not Eof(1)
            Input #1,N$
            Inc I
            For I2=1 To 14
              HF$(I,I2,1)=Mid$(N$,I2,1)
            Next I2
          Wend 
        Close 1
        RAB(0)=MAB(2) : RAB(1)=MAB(5) : RAB(2)=MAB(7) : RAB(3)=MAB(8)
        RAB(4)=MAB(9) : RAB(5)=MA : RAB(6)=MB
        SPMO_A=MAB(1) : SPMO_B=MAB(4) : STONE_A=MAB(2) : ZM_A=MAB(3)
        STONE_B=MAB(5) : ZM_B=MAB(6) : SWP_AB=MAB(7) : SPIELART=MAB(8) : SPIELER=MAB(9)
        If ZM_A or ZS_A : TIME_A=-1 Else TIME_A=0 : End If 
        If ZM_B or ZS_B : TIME_B=-1 Else TIME_B=0 : End If 
        ABXY$="" : ABXY2$="" : STATUS=Y : Fade 2 : Wait 32 : Pop Proc
      Else 
        If DISK=0 : A$=" File not found...."+Space$(14) : Proc LAUFSCHRIFT[A$,228] : End If 
      End If 
    End If 
    If Y=14 and DISK and Len(N$)>0 and Z2<50
      If Exist(N$+".dat")=0 : Inc Z2 : FILE$(Z2)=N$ : Gosub LESEN : End If 
      Open Out 1,N$+".dat"
        Print #1,MAB(1)
        Print #1,STONE_A
        Print #1,ZM_A
        Print #1,MAB(4)
        Print #1,STONE_B
        Print #1,ZM_B
        Print #1,MAB(7)
        Print #1,MAB(8)
        Print #1,SPIELER
        Print #1,MA-1
        Print #1,MB-1
        Print #1,ZM_A
        Print #1,ZS_A
        Print #1,PUN_A
        Print #1,ZM_B
        Print #1,ZS_B
        Print #1,PUN_B
        For I=1 To 14
          N$=""
          For I2=1 To 14
            N$=N$+HF$(I,I2,0)
          Next I2
          Print #1,N$
        Next I
      Close 1
    Else 
      If Y=14 and DISK
        A$=" No File selected...."+Space$(10) : Proc LAUFSCHRIFT[A$,236]
      End If 
    End If 
    If Y=15
      If Exist(N$+".dat")
        Kill N$+".dat"
        I=Match(FILE$(0),N$+".dat")
        FILE$(I)=Chr$(160)
        Gosub LESEN
      Else 
        A$=" File not found...."+Space$(14) : Proc LAUFSCHRIFT[A$,228]
      End If 
    End If 
    If Y=16 Then Fade 2 : Wait 32 : Proc URSPRUNG : STATUS=Y : Pop Proc
    If Y>12 Then Put Block 15,SCHALTER(Y-12),189
  Loop 
  LESEN:
    Z2=0 : Z=1
    Sort FILE$(0)
    Repeat : Inc Z2 : Until FILE$(Z2)=Chr$(160) or Z2>49 : Dec Z2
    For I=1 To 9 : Text 71,49+I*10,FILE$(I)-".dat"+Space$(25-Len(FILE$(I)-".dat")) : Next I
  Return 
  Data 46,102,158,230
End Proc
Procedure INFO
  Unpack 14 To 0 : Screen Hide : Hide 
  Proc URSPRUNG
  Ink 5 : Bar 45,45 To 275,200
  Ink 0,5
  Text 138,60,"Paragon"
  Text 41,90,"Amos by.....: Fran"+Chr$(231)+"ois Lionet"
  Text 41,105,"Tested by...: Karsten Blank"
  Text 41,120,"Idea by.....: Volker Stepprath"
  Text 41,135,"Written by..: Volker Stepprath"
  Text 161,157,"*"
  Text 53,178,"Amos © 1990 Mandarin / Jawx"
  Text 37,193,"Paragon © 1991 Depeche Software"
  Proc BLEND
  Repeat : Until Mouse Key
  Fade 2 : Wait 32 : Show 
End Proc
Procedure BLEND
  Screen Clone 1 : Screen To Front 0 : Auto View Off 
  For I=1 To 16 : Colour I,0 : Next I : Screen Show 
  View : Auto View On : Fade 2 To 1 : Wait 32 : Screen Close 1
End Proc
Procedure URSPRUNG
  Dec MAB(1) : Inc MAB(2) : Inc MAB(3)
  Dec MAB(4) : Inc MAB(5) : Inc MAB(6)
  Inc MAB(7) : Dec MAB(8) : Dec MAB(9) : Dec MAB(10)
End Proc
Procedure TILES[X,Y,X2,Y2,Z]
  Get Cblock 1,45,109,170,33
  For I=1 To 4 : Colour I+7,$FFF : Next I
  Screen Copy 1,X,Y,X2,Y2 To 0,Z,109
  If NOCROWN
    Ink 10 : Bar 52,115 To 197,132
    Ink 8,10 : Text 79,123,"NO CHANCE TO"
    Text 63,133,"COMPLETE A CROWN"
  End If 
  Wait 10
  Fade 3 To 1 : Wait 64
End Proc
Procedure LAUFSCHRIFT[A$,L]
  Def Scroll 3,1,230 To 320,242,-1,0 : Ink 1,0
  Repeat : Until Mouse Key=0
  For X=1 To L
    If I2=0
      Text 311,239,Mid$(A$,I,1)
      Add I,1,1 To Len(A$)
    End If 
    If Mouse Key=0 Then Wait Vbl 
    Scroll 3 : Add I2,1,0 To 7
  Next X
  Repeat : Until Mouse Key
  For X=1 To 320 : Scroll 3 : Next X
End Proc
Procedure GAMES_GFX_TO_RAM
  Unpack 16 To 0 : Screen Hide 
  Colour 2,$B9B : Colour 3,$979 : Colour 4,$868
  For I=0 To 9
    Get Block 1+I,162+I*3,84,3,5,1
  Next I
  For I=0 To 2
    Get Block 11+I,162+I*9,90,9,9,1
  Next I
  Get Block 14,189,90,11,11,1
  Get Block 15,200,90,11,11,1
  Get Block 16,292,70,13,13,1
  Change Mouse 2
  Hide : Music 1
  Screen Open 1,320,200,8,Lowres
  Flash Off : Curs Off : Change Mouse 2
  For I=1 To 4 : Colour I,$0 : Next I
  Cls 0 : Screen Copy 0,0,104,181,231 To 1,68,26
  Screen Copy 0,183,104,280,130 To 1,58,154 : Screen Copy 0,183,130,280,149 To 1,164,154
  Wait 20 : Fade 3 To 0 : Wait 320 : Fade 3 : Wait 70
  Cls 0 : Screen Copy 0,183,150,280,172 To 1,115,100 : Fade 3 To 0 : Wait 180 : Fade 3 : Wait 70
  Cls 0 : Screen Copy 0,183,172,311,192 To 1,100,100 : Fade 3 To 0 : Wait 240 : Fade 3 : Wait 70
  Cls 0 : Ink 1,0 : Text 80,120,"checking for games..." : Fade 3 To 0 : Wait 50
  For I=1 To 50 : FILE$(I)=Chr$(160) : Next I : I=0
  F$=Dir First$("*.*")
  While F$<>"" and I<51
    If Instr(F$,".dat")
      F$=Left$(F$,Len(F$-" ")-2) : F$=Right$(F$,Len(F$)-1)
      Inc I : FILE$(I)=F$
    End If 
    F$=Dir Next$
  Wend 
  For I=1 To 38
    Read KF$(I)
  Next I
  Fade 3 : Wait 50 : Show 
  Screen Close 1 : Screen Close 0
Data "SOOSSSOOS","SOOSOOSSS","SSOSSOOOS","SOSSSOSOO","SOOSSSSOO","SSSSOOSOO"
Data "SSOOSOOSS","SOOOSOSSS","SSOOSOSOS","SSSOOSOOS","SSOOSSOOS","SSOOOSSSO"
Data "SOSSSOOSO","SSOSOSOOS","SOOSSSOSO","SOSSOSOSO","SSOSOSSOO","SSSSOOOSO"
Data "SSOOSSOSO","SOOOSSOSS","SOSOSOSSO","SSSOSOOOS","SOSOSSOSO","SOOOSSSOS"
Data "SOOSOSSSO","SSOSOOOSS","SOOSSOSOS","SOSSSOOOS","SOOSOSOSS","SOOSSOOSS"
Data "SOOOSSSSO","SSSOSOOSO","SSOOOSOSS","SSSOOSOSO","SOSOSOOSS","SOSOSSOOS"
Data "SSOOSSSOO","SOSOSOSOS"
End Proc