' *********************************
' *         Othello V1.01         *
' *  © 11.10.1992 by Henry König  *
' * Bornheide 71, 2000 Hamburg 53 *
' *********************************
init
spielen
PROCEDURE anweisung(text$)
  PRINT AT(4,24);SPACE$(55)
  PRINT AT(4,24);text$
RETURN
PROCEDURE spielen
  label200:
  FOR i=1 TO 10
    FOR j=1 TO 10
      strat%(i,j)=0
    NEXT j
  NEXT i
  label210:
  anweisung("Soll ich mit hoher Spielstärke spielen (JA/NEE)")
  check.ja.nein                 ! JA/NEIN-Abfrage
  IF x$="N" THEN
    GOTO label280
  ENDIF
  IF x$<>"Y" THEN
    GOTO label210
  ENDIF
  label240:
  DATA 4,-1,2,2,2,2,-1,4
  FOR i=2 TO 9 STEP 7
    RESTORE label240
    FOR j=2 TO 9
      READ strat%(i,j)
    NEXT j
  NEXT i
  FOR j=2 TO 9 STEP 7
    RESTORE label240
    FOR i=2 TO 9
      READ strat%(i,j)
    NEXT i
  NEXT j
  FOR i=3 TO 8 STEP 5
    FOR j=3 TO 8 STEP 5
      strat%(i,j)=-1
    NEXT j
  NEXT i
  label280:
  b=-1
  wt=1
  RESTORE label310
  FOR k=2 TO 9
    READ i4(k)
  NEXT k
  label310:
  DATA 0,-1,-1,-1,0,1,1,1
  FOR k=2 TO 9
    READ j4(k)
  NEXT k
  DATA 1,1,0,-1,-1,-1,0,1
  FOR i=1 TO 10
    FOR j=1 TO 10
      a(i,j)=0
    NEXT j
  NEXT i
  a(5,5)=wt
  a(6,6)=wt
  a(5,6)=b
  a(6,5)=b
  c1=2
  h1=2
  z=0
  n1=4
  hu=wt
  c=b
  anweisung("Willst Du mit den weißen Steinen spielen (JA/NEE)")
  spielstart                    ! Strategie und Spielfeld aufbauen
  REM draw board and pieces.
  label410:
  anweisung("Willst Du anfangen (JA/NEE)")
  GOSUB check.ja.nein
  IF x$="N" THEN
    GOTO label460
  ENDIF
  IF x$<>"Y" THEN
    GOTO label410
  ENDIF
  GOTO label790
  label460:
  anweisung("Ich überlege.")
  b1=-1
  j3=0
  i3=0
  t1=c
  t2=hu
  FOR i=2 TO 9
    FOR j=2 TO 9
      IF a(i,j)<>0 THEN
        GOTO label580
      ENDIF
      GOSUB label1340
      IF f1=0 THEN
        GOTO label580
      ENDIF
      u=-1
      GOSUB label1420
      IF s1=0 THEN
        GOTO label580
      ENDIF
      s1=s1+strat%(i,j)
      IF s1<b1 THEN
        GOTO label580
      ENDIF
      IF s1>b1 THEN
        GOTO label570
      ENDIF
      IF RND(100)>50 THEN
        GOTO label580
      ENDIF
      label570:
      b1=s1
      i3=i
      j3=j
      label580:
    NEXT j
  NEXT i
  IF b1>0 THEN
    GOTO label630
  ENDIF
  anweisung("Ich habe den Zug verworfen.")
  IF z=1 THEN
    GOTO label1060
  ENDIF
  z=1
  GOTO label790
  label630:
  z=0
  anweisung("Ich prüfe den nächsten Zug")
  pc=0
  x=i3-2
  y=j3-2
  GOSUB zeichne.stein
  pc=1
  i=i3
  j=j3
  GOSUB label1420
  REM get # captured pieces.
  c1=c1+s1+1
  h1=h1-s1
  n1=n1+1
  text$="Dieser Zug bringt mir "+STR$(s1)+" Steine ein."
  anweisung(text$)
  IF f2=0 THEN
    SLEEP
    GOTO label760
  ENDIF
  anweisung("Drücke linke Maustaste")
  ' PRINT AT(4,28);"you're ready for me to"
  ' PRINT AT(4,28);"complete my play."
  '
  label750:
  b%=MOUSEK
  x%=mouse(1)
  y%=mouse(2)
  IF b%=0 THEN
    GOTO label750
  ENDIF
  WHILE b%<>0
    b%=MOUSEK
    x%=mouse(1)
    y%=mouse(2)
  WEND
  label760:
  i=i3
  j=j3
  u=1
  GOSUB label1420
  REM flip captured pieces
  IF h1=0 THEN
    GOTO label1060
  ENDIF
  IF n1=64 THEN
    GOTO label1060
  ENDIF
  label790:
  t1=hu
  t2=c
  label800:
  anweisung("Wähle Dein Spielfeld aus.")
  mausabfrage
  IF y>7 AND y<10 THEN
    IF x>0 AND x<4 THEN
      pr%=2
    ELSE IF x>3 AND x<7
      pr%=1
    ELSE
      pr%=4
    ENDIF
  ELSE
    IF y>-1 AND y<8 AND x>-1 AND x<8 THEN
      pr%=3
    ELSE
      pr%=4
    ENDIF
  ENDIF
  SELECT pr%
  CASE 1
    GOTO label1280
  CASE 2
    GOTO label840
  CASE 3
    GOTO label880
  CASE 4
    GOTO label800
  ENDSELECT
  label840:
  anweisung("Du verwirfst Deinen Zug.")
  IF z=1 THEN
    GOTO label1060
  ENDIF
  z=1
  GOTO label460
  label880:
  i=x+2
  j=y+2
  IF a(i,j)=0 THEN
    GOTO label910
  ENDIF
  anweisung("Diese Feld ist belegt.")
  GOTO label800
  label910:
  GOSUB label1340
  IF f1=1 THEN
    GOTO label950
  ENDIF
  PRINT AT(4,22);"Sorry; you're not next to "
  ' PRINT AT(4,28);" one of my pieces;"
  ' PRINT AT(4,28);"Try again."
  GOTO label800
  label950:
  u=-1
  GOSUB label1420
  IF s1>0 THEN
    GOTO label990
  ENDIF
  anweisung("Falscher Zug. Bitte neue Wahl")
  GOTO label800
  label990:
  z=0
  text$="Dieser Zug bringt Dir "+STR$(s1)+" Steine ein."
  anweisung(text$)
  u=1
  GOSUB label1420
  h1=h1+s1+1
  c1=c1-s1
  n1=n1+1
  IF c1=0 THEN
    GOTO label1060
  ENDIF
  IF n1=64 THEN
    GOTO label1060
  ENDIF
  GOTO label460
  label1060:                    ! Spiel zu ende
  PRINT AT(4,22);"Du hast ";h1;" Steine,"
  PRINT AT(4,23);"und Ich habe ";c1;" Steine."
  IF h1=c1 THEN
    GOTO label1120
  ENDIF
  IF h1>c1 THEN
    GOTO label1130
  ENDIF
  anweisung("Ich habe gewonnen.")
  GOTO label1140
  label1120:
  anweisung("Unentschieden!")
  GOTO label1270
  label1130:
  anweisung("Du gewinnst!")
  label1140:
  c1=c1-h1
  IF c1>0 THEN
    GOTO label1160
  ENDIF
  c1=-c1
  label1160:
  c1=64*c1/n1                   ! Anzahl der Spielsteine
  PRINT AT(4,22);"Das war ein ";
  IF c1<11 THEN
    PRINT "Squeaker!!"
  ELSE IF c1<25
    PRINT "Heißes Spiel!"
  ELSE IF c1<39
    PRINT "Guter Kampf!"
  ELSE IF c1<53
    PRINT "Walkaway."
  ELSE
    PRINT "Gutes Spiel!"
  ENDIF
  ' PRINT AT(4,23);
  label1280:
  anweisung("Möchtest Du noch ein Spiel (JA/NEE)")
  check.ja.nein
  IF x$="Y" THEN
    RESTORE label310
    GOTO label200
  ELSE
    beenden
  ENDIF
RETURN
PROCEDURE beenden
  anweisung("Danke für das Spiel! Weiter mit Mausklick")
  check.ja.nein
  CLOSEW #2
  CLOSES 1
  END
RETURN
PROCEDURE label1340
  f1=0
  FOR i1=-1 TO 1
    FOR j1=-1 TO 1
      IF a(i+i1,j+j1)=t2 THEN
        f1=1
        i1=1
        j1=1
      ENDIF
    NEXT j1
  NEXT i1
RETURN
PROCEDURE label1420
  s1=0
  FOR k=2 TO 9
    i5=i4(k)
    j5=j4(k)
    i6=i+i5
    j6=j+j5
    s3=0
    IF a(i6,j6)<>t2 THEN
      GOTO label1510
    ENDIF
    label1450:
    s3=s3+1
    i6=i6+i5
    j6=j6+j5
    IF a(i6,j6)=t1 THEN
      GOTO label1480
    ENDIF
    IF a(i6,j6)=0 THEN
      GOTO label1510
    ENDIF
    GOTO label1450
    label1480:
    s1=s1+s3
    IF u<>1 THEN
      GOTO label1510
    ENDIF
    i6=i
    j6=j
    FOR k1=0 TO s3
      a(i6,j6)=t1
      stein                     ! Stein zeichnen (Verzweigung)
      i6=i6+i5
      j6=j6+j5
    NEXT k1
    label1510:
  NEXT k
RETURN
PROCEDURE spielstart            ! Strategie und Spielfeld aufbauen
  init.spielfeld                ! Spielfeld zeichnen
  FOR i=2 TO 9
    FOR j=2 TO 9
      state%=a(i,j)+2
      x=i-2
      y=j-2
      ON state% GOSUB stein.schwarz,nichts,stein.weiß
    NEXT j
  NEXT i
  COLOR 1
RETURN
PROCEDURE stein.weiß
  COLOR 1
  zeichne.stein
RETURN ! eingefügt. Unterprogramm ohne Rücksprung.
PROCEDURE stein.schwarz         ! schwarzen Stein zeichnen
  COLOR 2
  zeichne.stein                 ! Stein zeichnen
RETURN
PROCEDURE nichts                ! leere Prozedur
RETURN
PROCEDURE zeichne.stein
  cx0=x0+INT(w/2)+x*w
  cy0=INT(h/2)+y*h
  PCIRCLE cx0,cy0,12            ! Stein zeichnen
  IF pc<>0 THEN
    DEFFILL red%
  ENDIF
  COLOR 1
RETURN
PROCEDURE mausabfrage           ! Mauskoordinaten feststellen
  b%=MOUSEK
  WHILE b%=0
    b%=MOUSEK
  WEND
  WHILE b%<>0
    b%=MOUSEK
    xm%=MOUSEX
    ym%=MOUSEY
  WEND
  x=INT((xm%-42)/w)
  y=INT(ym%/h)
RETURN
PROCEDURE init
  DIM a(10,10),i4(9),j4(9),strat%(10,10)
  DIM green%(1),red%(1),gblock%(500),square%(1000)
  FOR i=1 TO 10
    FOR j=1 TO 10
      strat%(i,j)=0
    NEXT j
  NEXT i
  OPENS 1,0,0,640,256,3,&H8000
  TITLES #1,"O t h e l l o   © 1992 by Henry König, Bornheide 71, 2 Hamburg 53"
  OPENW #1,100,40,500,200,&H18,&H1800,1
  CLS
  COLOR 1
  green%(0)=0
  red%(0)=&HFFFF
  w=39
  h=17
  pc=1
  COLOR 1
  farben.setzen
  f2=0
  spielstart                    ! Strategie und Spielfeld aufbauen
RETURN
PROCEDURE init.spielfeld        ! Spielfeld zeichnen
  wb=8*w
  hb=8*h
  x0=30
  COLOR 5
  PBOX x0,0,x0+wb-1,hb-1        ! Spielfeld
  COLOR 3                       ! rot
  PBOX x0,0,x0+w-1,h-1
  GET x0,0,x0+w,h,gblock$
  PUT x0+w,h,gblock$
  GET x0,0,x0+2*w,2*h,square$
  FOR i=x0 TO x0+6*w STEP 2*w
    FOR j=0 TO 6*h STEP 2*h
      PUT i,j,square$
    NEXT j
  NEXT i
  COLOR 1,0
  BOX 90,144,170,159
  BOX 202,144,282,159
  BOX 30,144,65,159
  BOX 307,144,342,159
  TEXT 99,154,"KEIN ZUG"
  TEXT 215,154," ENDE "
  TEXT 39,154,"JA "
  TEXT 312,154,"NEE"
  COLOR 1
RETURN
PROCEDURE stein
  x=i6-2
  y=j6-2
  IF t1=hu THEN
    stein.weiß                  ! weißen Stein zeichnen
  ELSE
    stein.schwarz               ! schwarzen Stein zeichnen
  ENDIF
RETURN
PROCEDURE check.ja.nein         ! Ja/Nein-Schalter
  mausabfrage
  IF y>7 AND y<10 THEN
    IF x=0 THEN
      x$="Y"
    ELSE IF x=7
      x$="N"
    ELSE
      x$=""
    ENDIF
  ELSE
    x$=""
  ENDIF
RETURN
PROCEDURE programmfuss1         ! Anweisungsbox ausblenden
  COLOR 0,0                     ! grau
  PBOX 6,(27*8)-5,633,(28*8)+4  ! 1. graue Box
RETURN
PROCEDURE farben.setzen
  SETCOLOR 0,5,5,5              ! grau statt blau
  SETCOLOR 1,15,15,15           ! weiß bleibt
  SETCOLOR 2,0,0,0              ! schwarz erhalten
  SETCOLOR 3,15,5,0             ! rot bleibt
  SETCOLOR 4,10,10,10           ! hellgrau inverse Farbe im Filerequester
  SETCOLOR 5,210,45,0/15*15     ! grün
  '  SETCOLOR 5,15,15,0            ! gelb
  SETCOLOR 6,0,0,0              ! schwarz = Inverse Farbe im Filerequester
RETURN
REM