'programme Othello3"

'this program is intented to run under compiled form
'this requires a file called bas.rl to be in the L drawer of
'the system disk
'the bas.rl file is provided on this diskette in the L drawer

'the program was initially written in French
'only the comments were translated
'sorry for the french labels and variable names

'this listing is ASCII
'the best way to modify the program, if you want to, 
'is to edit the listing with Ed, and then to recompile
'with ABSOFT's ac-basic

'it is not recommended to run this program from Amigabasic because
'   the mouse control by AmigaBasic is rather defective
'       you have to find out which values Mouse(0) does really return
'       under given circumstances        
'   the program gets awfully slow




GOSUB Initialisation
Nouvellepartie:                         ' new game
GOSUB Damier
GOSUB Premierspions
GOSUB Tour
END

Initialisation:

  SCREEN 1,320,220,3,1
  WINDOW 1,"Othello 3",,15,1
  PALETTE 0,.25,.4,.25
  PALETTE 7,0,0,.25
  DIM pionblanc%(135), pionnoir%(135), pionrouge%(135)
  DIM s%(120,8,8) : DIM trait%(81) : DIM p%(9)
  FOR couleur = 1 TO 3
    CIRCLE (11,11),8,couleur,,,1 : PAINT (11,11),couleur,couleur
    IF couleur=1 THEN GET (1,1)-(22,22), pionblanc%
    IF couleur=2 THEN GET (1,1)-(22,22), pionnoir%
    GET (1,1)-(22,22), pionrouge%
  NEXT couleur
  
Instructions:

  CLS
  LOCATE 3,5  
  PRINT " OTHELLO 3 "
  LOCATE 10,1    
  PRINT " To play click in a square " : PRINT
  PRINT " To pass: press space bar ": PRINT
  PRINT " To go back to a previous pass: r": PRINT
  PRINT " For a new game: n": PRINT
  PRINT " To quit: e": PRINT
  PRINT : PRINT
  PRINT " To start: press space bar "
  Bouclette:
    i$=INKEY$
    IF i$=" " THEN CLS : RETURN     ' press space bar to exit
    SLEEP
  GOTO Bouclette  
    
  
RETURN


Damier:

  h=22                              ' board size 198 x 198
  FOR i=0 TO 9
    LINE (h*i,1)-(h*i,198),7,b
  NEXT i  
  FOR j=0 TO 9
    LINE (1,h*j)-(198,h*j),7,b
  NEXT j  

  x= 44 : y= 44 : GOSUB Repere      ' strategically critical spots
  x= 44 : y=154 : GOSUB Repere
  x=154 : y= 44 : GOSUB Repere
  x=154 : y=154 : GOSUB Repere
  x= 66 : y= 66 : GOSUB Repere
  x= 66 : y=132 : GOSUB Repere
  x=132 : y= 66 : GOSUB Repere
  x=132 : y=132 : GOSUB Repere
  
RETURN

Repere:  
 
  CIRCLE (x,y),2,6,,,1
  PAINT (x,y),6,6
  CIRCLE (x,y),2,7,,,1
  PAINT (x,y),7,7

RETURN

Premierspions:

' there are three startup situations, selected at random
' to alternatively give each player a chance of occupying a
' diagonal line
' it is obviously imoossible to have a startup situation 
' which is symmetrical for the three players, beit only for
' the fact that the reds play last

  
  cas1: DATA 1,3,2,3,2,1,2,1,3
  cas2: DATA 2,1,3,1,3,2,3,2,1
  cas3: DATA 3,2,1,2,1,3,1,3,2 
  n=0 : joueur=0
  RANDOMIZE TIMER 
  alea: k=INT((RND*30)/10)+1        ' k=1, 2 or 3
  IF k=1 THEN RESTORE cas1 
  IF k=2 THEN RESTORE cas2
  IF k=3 THEN RESTORE cas3
  FOR i=1 TO 9
    READ p%(i)
  NEXT  
  q=0

  FOR xx=3 TO 5                      ' place nine pawns with a color
    FOR yy=3 TO 5                    ' sequence contained in p%
      GOSUB Placepremierspions
    NEXT
  NEXT

RETURN

Placepremierspions:

   q=q+1 : coulr=p%(q) 
   IF coulr=1 THEN PUT(xx*22+1,yy*22+1), pionblanc%
   IF coulr=2 THEN PUT(xx*22+1,yy*22+1), pionnoir%
   IF coulr=3 THEN PUT(xx*22+1,yy*22+1), pionrouge%
   
RETURN   

Tour:                                   ' next player 
  
  n=n+1 
  GOSUB Record                          ' save the full board
  
' the board configurations corresponding to all passes are saved
' in an array
' each configuration is accessible at anytime by striking r

  
CasRevue:

' in case a situation has to be reviewed
' first score the board 
' then increment player's number
' then record whose turn's it was
  
  GOSUB Score
  joueur=joueur+1
  IF joueur=4 THEN joueur=1
  IF joueur=0 THEN joueur=3
  trait%(n)=joueur                     
                                       
                                       
Invitation: 
  
  LOCATE 5,29 : PRINT"It's the "
  IF joueur=1 THEN couleur$="WHITE's"
  IF joueur=2 THEN couleur$="BLACK's"
  IF joueur=3 THEN couleur$="RED's  "
  LOCATE 7,29 : COLOR joueur : PRINT couleur$
  LOCATE 9,29 : COLOR 1 : PRINT "turn."
  SOUND 1000,1,255,0                         ' ready to accept input 
  GOSUB Joue
  IF flag=0 THEN BEEP : GOTO Invitation      ' illegal move
  
    
RETURN  

Joue:
 e$=INKEY$
 IF e$=" " THEN GOTO Tour                    ' player passes
 IF e$="r" THEN GOSUB Revue                  ' review a pass
 IF e$="n" THEN CLS : GOTO Nouvellepartie
 IF e$="e" THEN END
 IF MOUSE(0)=0  THEN Joue ELSE Place         ' if mouse was clicked
                                             ' move on

' there are two cases where a player must pass
'    he has no more pawns
'    he can make no legal move

Place:                                       ' put a pawn on the board

  FOR hold=1 TO 1000 : NEXT
  xm=MOUSE(1) : ym=MOUSE(2)                  ' pointer's coordinates
  xxm=INT(xm/22) : yym=INT(ym/22)            ' boxe's x and y positions
  IF xxm>8 OR yym>8 THEN BEEP : GOTO Joue    ' out of the board
  xcc=xxm*22+11 : ycc=yym*22+11              ' coordinates of the
                                             ' center of the selected box
  IF POINT(xcc,ycc)<>0 THEN BEEP : GOTO Joue ' box occupied
  xp=22*xxm+1 : yp=22*yym+1                  ' pawn's coordinates
  IF joueur=1 THEN PUT(xp,yp), pionblanc% 
  IF joueur=2 THEN PUT(xp,yp), pionnoir%
  IF joueur=3 THEN PUT(xp,yp), pionrouge%
  GOTO Explore
  
RETURN

Explore:
  d=0 : flag1=0
  
' assuming the selected box was free, the condition for a legal move
' is the possibility of catching enemies, i.e.
'     there is an "enemy" pawn on an adjacent box
'         followed or not by such pawns in the same direction 
'     there is a "friend" pawn after the enemy (enemies)
' the eight directions are explored sequentially
                           

Direction:
  flag=0                              'line flag
  d=d+1                               'next direction 
  IF d=1 THEN dx= 0 : dy=-1           'north
  IF d=2 THEN dx= 1 : dy=-1           'north-east
  IF d=3 THEN dx= 1 : dy= 0           'east
  IF d=4 THEN dx= 1 : dy= 1           'south-east
  IF d=5 THEN dx= 0 : dy= 1           'south
  IF d=6 THEN dx=-1 : dy= 1           'south-west
  IF d=7 THEN dx=-1 : dy= 0           'west
  IF d=8 THEN dx=-1 : dy=-1           'north-west
  IF d=9 THEN                         'exploration done
     IF flag1=0 THEN                  'no enemy pawn met
        BEEP 
        PAINT (xm,ym),0,7             'cancel pawn placement
        joueur =joueur-1              'cancel player's number increment
        n=n-1                         'cancel passe's number
        GOTO Tour                     'redo
      END IF
      flag1=0                         'reset flag1 for next player     
      GOTO Tour
  END IF
        
  
  xex=xxm : yex=yym                   'starting point coordinates
  
Ligne:                                'exploring a line

  flag=0
  
Mouvement:  

  xex=xex+dx : yex=yex+dy                    'one step in direction d
  xcex=22*xex+11 : ycex=22*yex+11            'boxe's center's coord
  IF POINT(xcex,ycex)=0 THEN Direction       'empty box
  IF xex<0 THEN Direction                    'border, explore next dir
  IF xex>8 THEN Direction                    
  IF yex<0 THEN Direction                    
  IF yex>8 THEN Direction                   
  IF POINT(xcex,ycex)<>0 THEN                'box occupied
     IF POINT(xcex,ycex)<>joueur THEN        'enemy pawn
           flag=1                            'line worth exploring
           GOTO Mouvement                    'make another step
     END IF                     
     IF POINT(xcex,ycex)=joueur THEN         'friendly pawn
           IF flag=1 THEN  Prise             'there were enemy pawns
                                             '  on the line
                                             '  so catch them
     END IF
  END IF   
  GOTO Direction                             'next line
  
   
Prise:
  flag1=1
 'this flag will tell us  in due time that the move was valid
  
  xex=xxm : yex=yym                          ' this is where we are
  
Pas:
  
  xex=xex+dx : yex=yex+dy
  xcex=22*xex+11 : ycex=22*yex+11
  IF POINT(xcex,ycex)=joueur THEN Direction  'friendly pawn met
                                             ' job done
  FOR i=1 TO 2000 : NEXT i
  PAINT(xcex,ycex),0,0                       'enemy, erase him
  xp=22*xex+1 : yp=22*yex+1
  IF joueur=1 THEN  PUT(xp,yp), pionblanc%   'put a friendly pawn 
  IF joueur=2 THEN  PUT(xp,yp), pionnoir%    '  instead
  IF joueur=3 THEN  PUT(xp,yp), pionrouge%
  GOTO Pas

Score:

  blanc=0 : noir=0 : rouge =0  
  IF e$="r" THEN n=nr                        'in case of review, n=number 
  LOCATE 23,31 : PRINT "   "                 'of requested board
  LOCATE 23,31 : PRINT n
  FOR i=0 TO 8                               'scroll whole board
    FOR j=0 TO 8
      xcompte=i*22+11 : ycompte=j*22+11
      credit%=POINT(xcompte,ycompte)         'color at center of box
      IF credit%=1 THEN blanc=blanc+1        'player's counter
      IF credit%=2 THEN noir=noir+1
      IF credit%=3 THEN rouge=rouge+1
    NEXT j
  NEXT i
  LOCATE 15,27 : PRINT "            "        'clean space
  LOCATE 17,27 : PRINT "            "
  LOCATE 19,27 : PRINT "            "
     
  LOCATE 15,27 : PRINT "Whites : ";blanc
  COLOR 2
  LOCATE 17,27 : PRINT "Blacks : ";noir
  COLOR 3
  LOCATE 19,27 : PRINT "Reds   : ";rouge
  COLOR 1
  
  
RETURN

Record:                                     'saving a board

  FOR i=0 TO 8
    FOR j=0 TO 8
      xr=i*22+11 : yr=j*22+11
      rec%=POINT(xr,yr)                     'color at box center
      s%(n,i,j)=rec%                        'save in array
    NEXT j
    NEXT i
    
RETURN

Revue:                                       'review asked

  LOCATE 1,1 : PRINT "Board #  ";n           'remind where we are
  INPUT "Board to review ";nr                'which board ?
    CLS: GOSUB Damier                        'clear board
    FOR i=0 TO 8
      FOR j=0 TO 8  
        coul=s%(nr,i,j)                      'read array
        xr=i*22+1 : yr=j*22+1
        IF coul=1 THEN PUT(xr,yr),pionblanc% 'repaint pawns on board
        IF coul=2 THEN PUT(xr,yr),pionnoir%
        IF coul=3 THEN PUT(xr,yr),pionrouge%
      NEXT j
    NEXT i
      joueur=trait%(nr)-1
    GOTO CasRevue   
        
RETURN
        


