\|/  :::::::::: * * *  $OTHEL  * * * ::::::::::  \|/
ECH 
REL,%OTHEL::E8
REL,%OTSUB::E8
REL,%VALGT::E8
REL,%SWTCH::E8
REL,%SCAN::E8 
REL,%TRACK::E8
REL,%LKAHD::E8
^^^  :::::::::: * * *  $OTHEL  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &LKAHD  * * * ::::::::::  \|/
ASMB,R
************************************************************* 
*  PROGRAM PERFORMS THE LOOKAHEAD FUNCTION FOR OTHELLO
*  TABS SET AT 7,22 
************************************************************* 
      NAM LKAHD             4/22/77                 GLB 
      ENT LKAHD,MDPOS 
      EXT .ENTR 
      EXT CT.,LT.,M.,T.,CS.,XS.,LS.,P.
      EXT SCAN1 
      EXT TRCK1 
      COM A(500),D(80)
LA.   BSS 1 
ISL.  BSS 1 
CL.   BSS 1 
XL.   BSS 1 
SC.   BSS 1 
LKAHD NOP 
      JSB .ENTR 
      DEF LA. 
* 
      LDA XL.,I 
      STA IX11      SAVE INPUT VALUE
* 
      LDA SC.,I 
      ADA =D-48 
      STA SCORE     SCORE > 48 FLAG 
* 
      LDA A.
      ADA =D299 
      CMA,INA 
      STA ASUB4      SUBTRAHEND TO RECOVER NUMERIC A(C,4) 
* 
      LDA POS.
      STA CT. 
      STA CS.       ADDRESSES OF VALUES FOR SUBROUTINES 
      LDA LEV.
      STA LT. 
      STA LS. 
      LDA PLA.
      STA P.
      LDA MOD.
      STA M.
      LDA TYP.
      STA T.
* 
*2 2 2  EVALUATE LEVEL 2 (HUMAN'S RESPONSE TO COMPUTER'S MOVE)  2 2 2 
* 
      LDA =D1 
      LDB CL.,I 
      ADB A.
      ADB =D-1
      STB IC11
      ADB =D100 
      STB IC112 
      STA 1,I        1 -> A(IC11,2) 
      ADB =D100 
      STB IC113 
      STA 1,I        1 -> A(IC11,3) 
      ADB =D100 
      STB IC114 
      STB POSIT 
      STA 1,I        1 -> A(IC11,4) 
*2
      STA MODE       M.=1 
      LDA =D2 
      STA LEVEL      LT.,LS.=2
      LDA =D514 
      STA IX22       514 -> IX22
      LDA DPOS1 
      STA MDPOS 
*2
      JSB TRCK1 
      LDA =D50
      JSB CHNG
*2
      LDB ALEV2 
      STB IC12       START ADDRESS OF A(X,2)
      LDA =D-8
      STA IH12       -8 -> IH12 
*2
LOOP3 ISZ IC12
      ISZ IC12       IC12+2 -> IC12 
      LDA =D-8
      STA IV12       -8 -> IV12 
*2
LOOP4 ISZ IC12       IC12+1 -> IC12 
      LDA IC12,I
      SZA            A(IC12,2)=0? 
      JMP NXTV2      NO, NEXT IV12
      LDA DPOS2 
      STA MDPOS 
      LDA =D-1
      STA PLAYR 
      LDB IC12       YES, CALL SCAN WITH APOS IN B REG
      LDA IC12
      ADA =D300      AND AVAL IN A REG
*2
      JSB SCAN1 
      ISZ ISL.,I
      NOP 
*2
      LDA XS.,I 
      STA IX12
      SZA,RSS        IX12=0?
      JMP NXTV2      YES, NEXT IV12 
************************************
      LDA LA.,I      LEVEL 3 DESIRED? 
      ADA =D-3
      SSA            IS A>=0? 
      JMP CONT2      NO, CONTINUE WITH LEVEL 2
************************************
* 
*3 3 3  EVALUATE LEVEL 3 (COMPUTER'S COUNTER MOVE)  3 3 3 
* 
      LDA =D-1
      LDB IC12
      ADB =D100 
      STB IC123 
      STA 1,I        -1 -> A(IC12,3)
      ADB =D100 
      STB IC124 
      STB POSIT 
      STA 1,I        -1 -> A(IC12,4)
*3
      LDA =D3 
      STA LEVEL      LS.,LT.=3
      LDA =D1        M.=1 
      STA MODE
*3
      JSB TRCK1 
      LDA =D50
      JSB CHNG
*3
      LDB =D-227
      STB IX23       -227 -> IX23 
      LDB ALEV3 
      STB IC13       START ADDRESS OF A(X,3)
      LDA =D-8
      STA IH13       -8 -> IH13 
*3
LOOP5 ISZ IC13
      ISZ IC13       IC13+2 -> IC13 
      LDA =D-8
      STA IV13       -8 -> IV13 
*3
LOOP6 ISZ IC13       IC13+1 -> IC13 
      LDA IC13,I
      SZA            A(IC13,3)=0? 
      JMP NXTV3      NO, NEXT IV13
      LDA DPOS3 
      STA MDPOS 
      LDA =D1 
      STA PLAYR 
      LDB IC13       YES, CALL SCAN WITH APOS IN B REG
      LDA IC13
      ADA =D200      AND AVAL IN A REG
*3
      JSB SCAN1 
      ISZ ISL.,I
      NOP 
*3
      LDA XS.,I 
      STA IX13
      SZA,RSS        IX13=0?
      JMP NXTV3      YES, NEXT IV13 
************************************
      LDA LA.,I      LEVEL 4 DESIRED? 
      ADA =D-4
      SSA            A>=0?
      JMP CONT3      NO, CONTINUE LEVEL 3 
************************************
* 
*4 4 4  EVALUATE LEVEL 4 (HUMAN'S COUNTER COUNTER MOVE)  4 4 4
* 
      LDB IC13
      ADB =D100 
      STB IC134 
      STB POSIT 
      LDA =D1 
      STA 1,I        1 -> A(IC13,4) 
*4
      STA MODE       M.=1
      CMA,INA 
      STA PLAYR      P.=-1
      LDA =D4 
      STA LEVEL      LS.,LT.=4
*4
      JSB TRCK1 
      LDA =D50
      JSB CHNG
*4
      LDA DPOS4 
      STA MDPOS 
      LDB =D539 
      STB IX24       539 -> IX24
      LDB ALEV4 
      STB IC14       START ADDRESS OF A(X,4)
      LDA =D-8
      STA IH14       -8 -> IH14 
*4
LOOP7 ISZ IC14
      ISZ IC14       IC14+2 -> IC14 
      LDA =D-8
      STA IV14       -8 -> IV14 
*4
LOOP8 ISZ IC14       IC14+1 -> IC14 
      LDA IC14,I
      SZA            A(IC14,4)=0? 
      JMP NXTV4      NO, NEXT IV14
      LDB IC14       YES, CALL SCAN WITH APOS IN B REG
      LDA IC14
      ADA =D100      AVAL IN A REG
*4
      JSB SCAN1 
      ISZ ISL.,I
      NOP 
*4
      LDA XS.,I 
      SZA,RSS        IX14=0?
      JMP NXTV4      YES, NEXT IV14 
      LDB IX24
      CPB =D539      IS IX24=539? 
      JMP NWX24      YES, IX14 -> IX24
      CMB,INB 
      ADB 0 
      SSB,RSS        IX14 >= IX24?
NWX24 STA IX24       YES, IX14 -> IX24
*4
NXTV4 ISZ IV14       DONE WITH IV14?
      JMP LOOP8      NO 
*4
NXTH4 ISZ IH14       YES, DONE WITH IH14? 
      JMP LOOP7      NO 
*4
      CLA            YES, RESET LEVEL 4 
      STA IC134,I    0 -> A(IC13,4) 
      LDA =D2 
      STA MODE       M.=2 
      LDA DPOS3 
      STA MDPOS 
      LDA IC13
      LDB IC134 
*4
      JSB TRCK1 
      LDA =D-803
      JSB CHNG
*4
      LDA IX24
      CMA,INA 
      ADA IX13
      STA IX13       IX13-IX24 -> IX13
* 
*4 4 4   DONE WITH LEVEL 4
* 
**************************************
CONT3 LDA IX13
      LDB IX23
      CPB =D-227     IS IX23=-227?
      JMP NWX23      YES, IX13 -> IX23
      CMB,INB 
      ADB 0 
      SSB,RSS        IX13 >= IX23?
NWX23 STA IX23       YES, IX13 -> IX23
*3
NXTV3 ISZ IV13       DONE WITH IV13?
      JMP LOOP6      NO 
*3
NXTH3 ISZ IH13       YES, DONE WITH IH13? 
      JMP LOOP5      NO 
*3
      CLA            YES, RESET LEVELS 3,4
      STA IC123,I    0 -> A(IC12,3) 
      STA IC124,I    0 -> A(IC12,4) 
      LDA =D2 
      STA MODE
      LDA =D3 
      STA LEVEL 
      LDA DPOS2 
      STA MDPOS 
      LDA IC12
      LDB IC124 
      STB POSIT 
*3
      JSB TRCK1 
      LDA =D-803
      JSB CHNG
*3
      LDA IX23
      CMA,INA 
      ADA IX12
      STA IX12       IX12-IX23 -> IX12
* 
*3 3 3   DONE WITH LEVEL 3
* 
*************************************** 
*33333   DONE WITH LEVEL 3
CONT2 LDA IX12
      LDB IX22
      CPB =D514      IS IX22=514? 
      JMP NWX22      YES, IX12 -> IX22
      CMB,INB 
      ADB 0 
      SSB,RSS        IX12 >= IX22?
NWX22 STA IX22       YES, IX12 -> IX22
*2
NXTV2 ISZ IV12       DONE WITH IV12?
      JMP LOOP4      NO 
*2
NXTH2 ISZ IH12       YES, DONE WITH IH12? 
      JMP LOOP3      NO 
*2
      CLA            YES, RESET LEVELS 2,3,4
      STA IC112,I    0 -> A(IC11,2) 
      STA IC113,I    0 -> A(IC11,3) 
      STA IC114,I    0 -> A(IC11,4) 
      LDA =D2 
      STA MODE
      STA LEVEL 
      LDA DPOS1 
      STA MDPOS 
      LDA IC11
      LDB IC114 
      STB POSIT 
*2
      JSB TRCK1 
      LDA =D-803
      JSB CHNG
*2
      LDA IX22
      CMA,INA 
      ADA IX11
      STA XL.,I      IX11-IX22 -> IX11
* 
*2 2 2   DONE WITH LEVEL 2
* 
*************************************** 
      JMP LKAHD,I    RETURN TO MAIN 
* 
CHNG  NOP 
      LDB SCORE 
      SSB,RSS       IS SCORE >= 0 (.GT.47)
      JMP CHNG,I    YES, RETURN 
      LDB POSIT     NO,CHECK IF VALUE SHOULD BE MODIFIED
* 
      CPB A12.4 
      JMP POS12 
      CPB A23.4 
      JMP POS23 
* 
      CPB A19.4 
      JMP POS19 
      CPB A28.4 
      JMP POS28 
* 
      CPB A82.4 
      JMP POS82 
      CPB A73.4 
      JMP POS73 
* 
      CPB A89.4 
      JMP POS89 
      CPB A78.4 
      JMP POS78 
      JMP CHNG,I
* 
POS12 LDB A23.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A23.5      NO, CHANGE VALUE 
      JMP CHNG,I
POS23 LDB A12.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A23.5      NO, CHANGE VALUE 
      JMP CHNG,I
* 
POS19 LDB A28.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A28.5      NO, CHANGE VALUE 
      JMP CHNG,I
POS28 LDB A19.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A28.5      NO, CHANGE VALUE 
      JMP CHNG,I
* 
POS82 LDB A73.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A73.5      NO, CHANGE VALUE 
      JMP CHNG,I
POS73 LDB A82.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A73.5      NO, CHANGE VALUE 
      JMP CHNG,I
* 
POS89 LDB A78.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A78.5      NO, CHANGE VALUE 
      JMP CHNG,I
POS78 LDB A89.4,I    GET CONTENTS OF COMPLEMENT CELL
      SZB            IS IT OCCUPIED?
      JMP CHNG,I     YES, RETURN TO MAIN
      STA A78.5      NO, CHANGE VALUE 
      JMP CHNG,I
*        VARIABLES AND STORAGE
* 
D.    DEF D          STARTING ADDRESS OF D ARRAY
A.    DEF A          STARTING ADDRESS OF A ARRAY
ALEV2 DEF A+108     START OF LEVEL 2 SCAN 
ALEV3 DEF A+208       "   "    "   3 SCAN 
ALEV4 DEF A+308       "   "    "   4 SCAN 
A12.4 DEF A+311 
A19.4 DEF A+318 
A23.4 DEF A+322 
A28.4 DEF A+327 
A73.4 DEF A+372 
A78.4 DEF A+377 
A82.4 DEF A+381 
A89.4 DEF A+388 
A23.5 DEF A+422 
A28.5 DEF A+427 
A73.5 DEF A+472 
A78.5 DEF A+477 
ASUB4 NOP 
DPOS1 DEF D+8 
DPOS2 DEF D+16
DPOS3 DEF D+24
DPOS4 DEF D+32
MDPOS NOP            TEMPORARY STORAGE FOR DPOS 
SCORE NOP 
IX11  NOP            STORAGE FOR LEVEL 1 IX11 
IC11  NOP 
IC112 NOP            LEVEL 2 VARIABLES
IC113 NOP 
IC114 NOP 
C12   NOP 
IC12  NOP 
IX12  NOP 
IX22  NOP 
IH12  NOP 
IV12  NOP 
IC123 NOP            LEVEL 3 VARIABLES
IC124 NOP 
C13   NOP 
IC13  NOP 
IX13  NOP 
IX23  NOP 
IH13  NOP 
IV13  NOP 
IC134 NOP            LEVEL 4 VARIABLES
IC14  NOP 
IX14  NOP 
IX24  NOP 
IH14  NOP 
IV14  NOP 
POSIT NOP            ARRAY POINT TO BE TRACKED OR SCANNED 
LEVEL NOP            LEVEL TO BE TRACKED OR SCANNED 
PLAYR NOP            PLAYER TO BE SCANNED 
MODE  NOP            MODE FOR TRACKING (1=UPDATE,2=BACKUP)
TYPE  OCT 1         TYPE FOR TRACKING (1=TEMPORARY) 
POS.  DEF POSIT     ADDRESSES OF VALUES FOR CALLED SUBROUTINES
LEV.  DEF LEVEL 
PLA.  DEF PLAYR 
MOD.  DEF MODE
TYP.  DEF TYPE
      END 
      END$
^^^  :::::::::: * * *  &LKAHD  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &OTHEL  * * * ::::::::::  \|/
FTN4
      PROGRAM OTHEL,3,100 
      INTEGER A(100,5),D(8,5,2),C(2,4),W,MOVES(50,4)
      INTEGER WS(2,2),IX24,IS2,H,V,P,ITIME(5),IYEAR(1)
      INTEGER VS(8),B(100),T,IPASS(5),AC(100) 
      COMMON A,D
      DATA VS/-10,-9,1,11,10,9,-1,-11/
      DATA AC/
     14,4,4,4,4,4,4,4,4,4,4,9,9,9,9,9,9,9,9,4,
     24,9,9,9,9,9,9,9,9,4,4,9,9,0,0,0,0,9,9,4,
     34,9,9,0,-1,1,0,9,9,4,4,9,9,0,1,-1,0,9,9,4,
     44,9,9,0,0,0,0,9,9,4,4,9,9,9,9,9,9,9,9,4,
     54,9,9,9,9,9,9,9,9,4,4,4,4,4,4,4,4,4,4,4/
      LU=1
      CALL RMPAR(IPASS) 
      LU=IPASS(1) 
C 
C     SET GAME PARAMETERS 
C 
1     WRITE(LU,47)
47    FORMAT("HJWHAT LEVEL PLAYER ARE YOU ?",/, 
     1"   BEGINNER (NO COMPUTER LOOKAHEAD) =1",/, 
     2"   MODERATE (COMPUTER LOOKS AHEAD ONE MOVE) =2   ",/,
     3"   ADVANCED (COMPUTER LOOKS AHEAD TWO MOVES) =3",/,
     4"   EXPERT (COMPUTER LOOKS AHEAD THREE MOVES) =4")
      READ(LU,48) LA
      LAT=LA
48    FORMAT(I1)
      WRITE(LU,49)
49    FORMAT("HOW FAST WOULD YOU LIKE THE DISPLAY UPDATED ?",/, 
     1"    (0.02 TO 1.00 SECONDS PER CHIP)  ")
      READ(LU,51) DELAY 
51    FORMAT(F3.2)
      IDEL=DELAY/.08
      WRITE(LU,52)
52    FORMAT("WOULD YOU LIKE TO GO FIRST (YES OR NO) ?")
      READ(LU,53) IANS
53    FORMAT(1A2) 
      WRITE(LU,55)
55    FORMAT("ARE THERE ANY CHANGES TO THE STARTING CONFIGUARTION (YES" 
     1" OR NO) ?")
      READ(LU,53) ICHNG 
      WRITE(LU,56)
56    FORMAT("DOES YOUR TERMINAL HAVE A LINE DRAWING CAPABILITY ",
     1"  (YES OR NO ) ?") 
      READ(LU,53) LINE
C 
C     DRAW BOARD -- CALL BORD1 FOR LINE DRAWING SET 
C 
57    IF (LINE.NE.2HYE) CALL BOARD(LU,WS,LA)
      IF (LINE.EQ.2HYE) CALL BORD1(LU,WS,LA)
C 
C     INITIALIZE DATA AND ARRAYS
C 
6     CALL VALGT(B) 
      DO 5 JJ=1,4 
      DO 10 I=1,100 
      A(I,JJ)=AC(I) 
      A(I,5)=B(I) 
10    CONTINUE
      IX21=0
      DO 15 I=1,8 
      D(I,JJ,1)=0 
      D(I,JJ,2)=0 
      D(I,5,1)=VS(I)
      D(I,5,2)=0
15    CONTINUE
5     CONTINUE
      IS1=2 
      IS2=2 
      IF (ICHNG.NE.2HYE) GO TO 70 
C 
C     MODIFY STARTING BOARD IF DESIRED
C 
      WRITE(LU,60)
60    FORMAT("&a23r1CSTARTING CHANGES ? ROW,COL=P" 
     1"   P=(+1=COMPUTER,-1=HUMAN)   R,C=(0,0=DONE)") 
61    WRITE(LU,62)
62    FORMAT("&a24r1C?_")
      READ(LU,63) H,V,P 
63    FORMAT(I1,1X,I1,1X,I2)
      IF (H.EQ.0.AND.V.EQ.0) GO TO 76 
      IF (H.EQ.9.AND.V.EQ.0) GO TO 1
      IF (H.LT.1.OR.H.GT.8.OR.V.LT.1.OR.V.GT.8) GO TO 71
      IF (P.EQ.(-1).OR.P.EQ.(+1)) GO TO 69
71    WRITE(LU,72)
72    FORMAT("INCORRECT PARAMETER") 
69    C=10*H+V+1
      A(C,1)=P
      A(C,2)=P
      A(C,3)=P
      A(C,4)=P
      CALL TRACK(C,1,1,2) 
      H=(H*2)+1 
      V=(V*4)-1 
      W=1 
      IF (P.EQ.(-1)) W=2
      IF (LINE.EQ.2HYE) WRITE(LU,85) H,V,WS(W,1),WS(W,2)
      IF (LINE.NE.2HYE.AND.W.EQ.1) WRITE(LU,85) H,V,WS(W,1),WS(W,2) 
      IF (LINE.NE.2HYE.AND.W.EQ.2) WRITE(LU,87) H,V,WS(W,1),WS(W,2) 
85    FORMAT("&a",I2,"r",I2,"C",A2,A1) 
87    FORMAT("&a",I2,"r",I2,"C&dB",A2,A1,"&d@")
      GO TO 61
76    WRITE(LU,80)
80    FORMAT("WHAT IS THE CORRECT STARTING SCORE (COMPUTER,HUMAN) ?",/, 
     1"             2 DIGITS EACH  _")
      READ(LU,81) IS1,IS2 
81    FORMAT(I2,1X,I2)
      WRITE(LU,204) IS1,IS2 
      WRITE(LU,95)
95    FORMAT("&a23r1CJH")
70    T=0 
      IMOV=1
      DO 13 I=1,4 
      MOVES(IMOV,I)=0 
13    CONTINUE
      SL=0. 
      IS3=IS1+IS2 
C 
C     START GAME  WHO GOES FIRST? 
C 
      IRAND=1 
      IF (IANS.NE.2HNO) GO TO 2700
C 
C     COMPUTER SELECTS MOVE 
C 
2250  WRITE(LU,200) 
200   FORMAT("&a6r62C&dB?        &d@&a+0r-8C_") 
      J=0 
      ISL=0 
      IX11=0
      IX21=2
      IC11=9
      DO 20 IH11=1,8
      IC11=IC11+2 
      DO 30 IV11=1,8
      IF (LAT.EQ.3.AND.IS3.LT.40) LA=2
      IC11=IC11+1 
      IF (A(IC11,1).NE.0) GO TO 30
      CALL SCAN(IC11,IX11,1,1)
      ISL=ISL+1 
      IF (IX11.EQ.0) GO TO 30 
      H=IC11/10 
      V=IC11-1-(H*10) 
      IF ((H.EQ.1.OR.H.EQ.8).AND.LAT.EQ.3) LA=4 
      IF ((V.EQ.1.OR.V.EQ.8).AND.LAT.EQ.3) LA=4 
      CALL TRAP(IC11,H,V,IX11)
      WRITE(LU,1100) H,V
1100  FORMAT("&a21r45CCHECKING CELL ",2I2) 
      IC1M=IC11-1 
      IF (T.EQ.1) WRITE(LUT,1024) IC1M,IX11 
1024  FORMAT("*",2X," IC11=",I2," PRE-IX11=",I5)
      J=1 
      IF (LA.LT.2) GO TO 23 
C 
C     EVALUATE EFFECTS OF COMPUTER'S MOVE UP TO 3 MOVES AHEAD 
C 
      CALL LKAHD(LA,ISL,IC11,IX11,IS3)
      IF (T.EQ.1) WRITE(LUT,989) IX11 
989   FORMAT(29X,"IX11=",I5)
C 
23    XSL=ISL 
      SL=SL+XSL 
      ISL=0 
      IF (IX21.EQ.2) GO TO 24 
      IF (IX11.LT.IX21) GO TO 30
      CALL EXEC(11,ITIME,IYEAR) 
      IF (IX11.EQ.IX21.AND.ITIME(1).GT.50.AND.IRAND.EQ.1) GO TO 30
24    IC21=IC11 
      IX21=IX11 
      X4=0
      DO 25 I=1,8 
      D(I,1,2)=D(I,1,1) 
      X4=X4+D(I,1,2)
25    CONTINUE
30    CONTINUE
20    CONTINUE
      XSL=ISL 
      SL=SL+XSL 
C 
C     MAKE MOVE BASED ON CLEVER DECISION
C 
      IF (J.EQ.1) GO TO 2370
C 
C     CHECK FOR END OF GAME 
C 
      DO 1000 IC11=1,100
      IF (A(IC11,1).NE.0) GO TO 1000
      CALL SCAN(IC11,IX11,1,-1) 
      IF (IX11.EQ.0) GO TO 1000 
      GO TO 2369
1000  CONTINUE
      MRGN=IS1-IS2
      MRGN1=IS2-IS1 
      IF (MRGN.GE.36) WRITE(LU,1111) MRGN 
      IF (MRGN.GE.24.AND.MRGN.LT.36) WRITE(LU,1112) MRGN
      IF (MRGN.GE.12.AND.MRGN.LT.24) WRITE(LU,1113) MRGN
      IF (MRGN.GT.0.AND.MRGN.LT.12) WRITE(LU,1114) MRGN 
      IF (MRGN.EQ.0) WRITE(LU,1115) 
      IF (MRGN.LT.0.AND.MRGN.GE.(-12)) WRITE(LU,1116) MRGN1 
      IF (MRGN.LT.(-12).AND.MRGN.GE.(-24)) WRITE(LU,1117) MRGN1 
      IF (MRGN.LT.(-24).AND.MRGN.GE.(-36)) WRITE(LU,1118) MRGN1 
      IF (MRGN.LT.(-36)) WRITE(LU,1119) MRGN1 
1111  FORMAT("&a7r45CYOU LOSE BY",I3," CHIPS,DUMMY!!") 
1112  FORMAT("&a7r45CYOU LOSE BY",I3," CHIPS,HA!HA!HA!") 
1113  FORMAT("&a7r45CYOU LOSE BY",I3," CHIPS,TOUGH LUCK!") 
1114  FORMAT("&a7r45CYOU LOSE BY",I3," CHIPS,NICE TRY!") 
1116  FORMAT("&a7r45CYOU WIN BY",I3," CHIPS -- NICE GAME!")
1117  FORMAT("&a7r45CYOU WIN BY",I3," CHIPS -- WELL DONE!")
1118  FORMAT("&a7r45CYOU WIN BY",I3," CHIPS, I'M IMPRESSED!")
1119  FORMAT("&a7r45CYOU WIN BY",I3," CHIPS -- SIR!!!!!")
1115  FORMAT("&a7r45CTIE GAME!!! YOU LUCKED OUT !!!")
      IMOV=IMOV+1 
      GO TO 2700
2369  WRITE(LU,292) 
292   FORMAT("&a6r63CNO MOVE") 
      MOVES(IMOV,3)=0 
      MOVES(IMOV,4)=0 
      IMOV=IMOV+1 
      GO TO 2700
2370  H=IC21/10 
      V=IC21-1-(H*10) 
      WRITE(LU,293) H,V 
293   FORMAT("&a6r64C",I1,".",I1)
      IF (T.EQ.1) WRITE(LUT,988) H,V
988   FORMAT(" **********COMPUTER PLAYING AT ",2I3) 
      MOVES(IMOV,3)=H 
      MOVES(IMOV,4)=V 
      IMOV=IMOV+1 
      A(IC21,1)=1 
      A(IC21,2)=1 
      A(IC21,3)=1 
      A(IC21,4)=1 
      CALL TRACK(IC21,1,1,2)
      IF (IS3.GE.47) GO TO 6669 
      IF (IC21.EQ.12.OR.IC21.EQ.23) A(23,5)=50
      IF (IC21.EQ.19.OR.IC21.EQ.28) A(28,5)=50
      IF (IC21.EQ.82.OR.IC21.EQ.73) A(73,5)=50
      IF (IC21.EQ.89.OR.IC21.EQ.78) A(78,5)=50
C     IF (T.EQ.1) CALL PRINT(1,1,1,1) 
6669  IF (LINE.EQ.2HYE) CALL UPDT1(IC21,1,WS,1,2,IDEL,LU) 
      IF (LINE.NE.2HYE) CALL UPDAT(IC21,1,WS,1,2,IDEL,LU) 
      IS1=IS1+1+X4
      IS2=IS2-X4
C 
C     CHANGE WEIGHTS AT INTERVALS TO MAXIMIZE CHANCES FOR WIN 
C 
      IS3=IS1+IS2 
      IF (IS3.EQ.12) CALL SWTCH(1)
      IF (IS3.EQ.24) CALL SWTCH(2)
      IF (IS3.EQ.47) CALL CHNGE 
      WRITE(LU,204) IS1,IS2 
204   FORMAT("&a17r58C",I2,"&a19r58C",I2) 
C 
C     HUMAN'S TURN TO MOVE
C 
2700  J=0 
      WRITE(LU,666)  SL 
666   FORMAT("&a21r45CSCAN CALLS ",1F7.0)
      SL=0. 
2710  WRITE(LU,300) 
300   FORMAT("&a8r62C&dB?        &d@&a+0r-7C_")
      READ(LU,310) IH,M6,IV 
310   FORMAT(A1,A1,A1)
      IH11=(IH/400B)-60B
      IV11=(IV/400B)-60B
C 
C     WHAT DOES HUMAN WANT TO DO? 
C     D=DONE   L=LIST MOVES ON PRINTER   N=NEW GAME(SAME PARAMETERS)
C     P=PASS   R=REFRESH DISPLAY   S=START OVER(NEW PARAMETERS) 
C     T=TRACE TO MAG TAPE  " "=TERMINAL TIMED OUT  X=NO RANDOMNESS
C 
      IF (IH.EQ.1HD) GO TO 9998 
      IF (IH.EQ.1HL) CALL LIST(MOVES,IMOV,IS1,IS2)
      IF (IH.EQ.1HL) GO TO 2710 
      IF (IH.EQ.1HN) GO TO 57 
      IF (IH.EQ.1HP) GO TO 2720 
      IF (IH.EQ.1HR) CALL RFRSH(LU,LINE,WS,IS1,IS2,LA)
      IF (IH.EQ.1HR) GO TO 2710 
      IF (IH.EQ.1HS) GO TO 1
      IF (IH.EQ.1HT) GO TO 3666 
      IF (IH.EQ.1HX) IRAND=0
      IF (IH.EQ.1HX) GO TO 2710 
      IF (IH.EQ.1H ) WRITE(LU,3297) 
      IF (IH.EQ.1H ) GO TO 2710 
      IF (IH11.LT.1.OR.IH11.GT.8) GO TO 2900
      IF (IV11.LT.1.OR.IV11.GT.8) GO TO 2900
      GO TO 2870
3666  T=1 
      WRITE(LU,300) 
      WRITE(LU,3667)
3667  FORMAT("LU?_")
      READ(LU,3668) LUT 
3668  FORMAT(I2)
      IF (LUT.GE.50) GO TO 3666 
      GO TO 2710
C 
C     CHECK FOR LEGAL 'PASS'
C 
2720  DO 50 IC11=1,100
      IF (A(IC11,1).NE.0) GO TO 50
      CALL SCAN(IC11,IX11,1,-1) 
      IF (IX11.NE.0) J=1
50    CONTINUE
3297  FORMAT("&a9r62CTHINK FASTER")
      IF (J.EQ.1)  GO TO 2900 
      GO TO 2250
C 
C     CHECK FOR LEGAL MOVE
C 
2870  IC11=(IH11*10)+IV11+1 
      IF (A(IC11,1).NE.0) GO TO 2900
      CALL SCAN(IC11,IX11,1,-1) 
      IF (IX11.NE.0) GO TO 2920 
2900  WRITE(LU,393) 
393   FORMAT("&a9r62C&dBILLEGAL MOVE&a8r62C?") 
      GO TO 2700
2920  WRITE(LU,304) 
304   FORMAT("&a9r62C&d@            ")
      IF (T.EQ.1) WRITE(LUT,887) IH11,IV11
887   FORMAT(" *************HUMAN PLAYING AT ",2I3) 
      MOVES(IMOV,1)=IH11
      MOVES(IMOV,2)=IV11
      A(IC11,1)=-1
      A(IC11,2)=-1
      A(IC11,3)=-1
      A(IC11,4)=-1
      X4=0
      DO 2930 I=1,8 
      D(I,1,2)=D(I,1,1) 
      X4=X4+D(I,1,1)
2930  CONTINUE
      CALL TRACK(IC11,1,1,2)
      IF (IS3.GE.47) GO TO 6667 
      IF (IC11.EQ.12.OR.IC11.EQ.23) A(23,5)=50
      IF (IC11.EQ.19.OR.IC11.EQ.28) A(28,5)=50
      IF (IC11.EQ.82.OR.IC11.EQ.73) A(73,5)=50
      IF (IC11.EQ.89.OR.IC11.EQ.78) A(78,5)=50
C     IF (T.EQ.1) CALL PRINT(1,2,IH11,IV11) 
6667  IF (LINE.EQ.2HYE) CALL UPDT1(IC11,2,WS,1,2,IDEL,LU) 
      IF (LINE.NE.2HYE) CALL UPDAT(IC11,2,WS,1,2,IDEL,LU) 
      IS1=IS1-X4
      IS2=IS2+1+X4
C 
C     CHANGE WEIGHTS AT INTERVALS TO MAXIMIZE CHANCES FOR WIN 
C 
      IS3=IS1+IS2 
      IF (IS3.EQ.12) CALL SWTCH(1)
      IF (IS3.EQ.24) CALL SWTCH(2)
      IF (IS3.EQ.47) CALL CHNGE 
      WRITE(LU,305) IS1,IS2 
305   FORMAT("&a17r58C",I2,"&a19r58C",I2) 
      GOTO 2250 
9998  IF (LUT.NE.8) GO TO 9999
      ENDFILE 8 
      REWIND 8
9999  WRITE(LU,7654)
7654  FORMAT("H")
      END 
      END$
^^^  :::::::::: * * *  &OTHEL  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &OTSUB  * * * ::::::::::  \|/
FTN4
      SUBROUTINE BORD1(LU,WS,LA)
      INTEGER WS(2,2) 
      WRITE(LU,100) 
100   FORMAT("HJ)B",/,"    1   2   3   4   5   6   7   8",/, 
     1"  Q;;;3;;;3;;;3;;;3;;;3;;;3;;;3;;;W   ",/, 
     2"1 :   :   :   :   :   :   :   :   : 1 ",/, 
     3"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     4"2 :   :   :   :   :   :   :   :   : 2 ",/, 
     5"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     6"3 :   :   :   :   :   :   :   :   : 3 ",/, 
     7"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     8"4 :   :   :   :CCC:???:   :   :   : 4 ",/, 
     9"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ") 
      WRITE(LU,101) 
101   FORMAT("5 :   :   :   :???:CCC:   :   :   : 5 ",/,
     1"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     2"6 :   :   :   :   :   :   :   :   : 6 ",/, 
     3"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     4"7 :   :   :   :   :   :   :   :   : 7 ",/, 
     5"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     6"8 :   :   :   :   :   :   :   :   : 8 ",/, 
     7"  A;;;4;;;4;;;4;;;4;;;4;;;4;;;4;;;S    ",/,
     8/,"    1   2   3   4   5   6   7   8   ") 
      WRITE(LU,102) 
102   FORMAT("&a1r45CTHE GAME OF OTHELLO&a2r45C-------------------",
     1"&a3r45CCOMPLIMENTS OF G.L.BOOTH", 
				 2"&a6r45CCOMPUTER'S MOVE&a8r45CHUMAN'S MOVE ") 
      WRITE(LU,105) 
105   FORMAT("&a10r45CD=DONE  L=LIST MOVES  N=NEW GAME ")
      WRITE(LU,104) 
104   FORMAT("&a11r45CR=REFRESH SCREEN  S=START OVER ",
     1"&a12r45CP=PASS  R.C=ROW.COLUMN OF MOVE")
      WRITE(LU,103) LA
103   FORMAT("&a15r45CSCORE              LEVEL ",I1, 
     1   "&a16r45C-----   ", 
     2   "&a17r45CCOMPUTER     2 &a19r45CHUMAN        2") 
      WRITE(LU,106) 
106   FORMAT("&a13r45CCOMPUTER=???   HUMAN=CCC") 
      WS(1,1)=2H??
      WS(1,2)=1H? 
      WS(2,1)=2HCC
      WS(2,2)=1HC 
      RETURN
      END 
C 
C 
      SUBROUTINE BOARD(LU,WS,LA)
      INTEGER WS(2,2) 
      WRITE(LU,100) 
100   FORMAT("HJ",/,"    1   2   3   4   5   6   7   8",/,
     1"  +---+---+---+---+---+---+---+---+   ",/, 
     2"1 !   :   :   :   :   :   :   :   ! 1 ",/, 
     3"  +---+---+---+---+---+---+---+---+   ",/, 
P    4"2 !   :   :   :   :   :   :   :   ! 2 ",/, 
     5"  +---+---+---+---+---+---+---+---+   ",/, 
     6"3 !   :   :   :   :   :   :   :   ! 3 ",/, 
     7"  +---+---+---+---+---+---+---+---+   ",/, 
     8"4 !   :   :   :&dB   &d@:@@@:   :   :   ! 4 ",/, 
     9"  +---+---+---+---+---+---+---+---+   ") 
      WRITE(LU,101) 
101   FORMAT( 
     1"5 !   :   :   :@@@:&dB   &d@:   :   :   ! 5 ",/, 
     2"  +---+---+---+---+---+---+---+---+   ",/, 
     3"6 !   :   :   :   :   :   :   :   ! 6 ",/, 
     4"  +---+---+---+---+---+---+---+---+   ",/, 
     5"7 !   :   :   :   :   :   :   :   ! 7 ",/, 
     6"  +---+---+---+---+---+---+---+---+   ",/, 
     7"8 !   :   :   :   :   :   :   :   ! 8 ",/, 
     8"  +---+---+---+---+---+---+---+---+    ",/,
     9/,"    1   2   3   4   5   6   7   8   ") 
      WRITE(LU,102) 
102   FORMAT("&a1r45CTHE GAME OF OTHELLO&a2r45C-------------------",
     1"&a3r45CCOMPLIMENTS OF G.L.BOOTH", 
				 2"&a6r45CCOMPUTER'S MOVE&a8r45CHUMAN'S MOVE ") 
      WRITE(LU,105) 
105   FORMAT("&a10r45CD=DONE  L=LIST MOVES  N=NEW GAME ")
      WRITE(LU,104) 
104   FORMAT("&a11r45CR=REFRESH SCREEN  S=START OVER ",
     1"&a12r45CP=PASS  R.C=ROW.COLUMN OF MOVE")
      WRITE(LU,103) LA
103   FORMAT("&a15r45CSCORE              LEVEL ",I1, 
     1   "&a16r45C-----   ", 
     2   "&a17r45CCOMPUTER     2 &a19r45CHUMAN        2") 
      WRITE(LU,106) 
106   FORMAT("&a13r45CCOMPUTER=@@@   HUMAN=&dB   &d@") 
      WS(1,1)=2H@@
      WS(1,2)=1H@ 
      WS(2,1)=2H
      WS(2,2)=1H
      RETURN
      END 
C 
C 
      SUBROUTINE CHNGE
C     SWITCHES TO FINAL VALUES AT 47
      INTEGER A(100,5),D(8,5,2),B(25) 
      COMMON A,D
      DATA B/ 
     1  0,000,000,000,000,
     2  0,050,020,020,020,
     3  0,020,020,010,010,
     4  0,020,010,020,010,
     5  0,020,010,010,020/
      DO 10 I=0,40,10 
      DO 20 J=1,5 
      IJB=(I/2)+J 
      A(I+J,5)=B(IJB) 
      A(I-J+11,5)=B(IJB)
      A(90-I+J,5)=B(IJB)
      A(101-I-J,5)=B(IJB) 
20    CONTINUE
10    CONTINUE
      RETURN
      END 
C 
C 
      SUBROUTINE UPDT1(C,W,WS,L,M,IDEL,LU)
      INTEGER A(100,5),D(8,5,2),H,V,C 
      INTEGER WS(2,2),W,T,H3,V3,C3,H1 
      COMMON A,D
      H1=C/10 
      H3=(H1*2)+1 
      V3=((C-1-(10*H1))*4)-1
C 
C     DISPLAY NEW POSITION ON CRT 
C 
      DO 5 K=1,IDEL 
      WRITE(LU,503) 
5     CONTINUE
      WRITE(LU,500) H3,V3,WS(W,1),WS(W,2) 
500   FORMAT("&a",I2,"r",I2,"C",A2,A1) 
C 
C     FLIP CAPTURED CHIPS 
C     UPDATES LEVEL 'L' AND GREATER OF A ARRAY
C 
5030  L1=L
      IF (L.GT.1) L1=L-1
      DO 5180 I=1,8 
      DO 5170 J=1,D(I,L1,M)+1 
      IF (J.EQ.1) GO TO 5170
      N2=(J-1)*D(I,5,1) 
      C3=N2+C 
      H1=C3/10
      H3=(H1*2)+1 
      V3=(((C3-(H1*10))-1)*4)-1 
      DO 10 K=1,IDEL
      WRITE(LU,503) 
503   FORMAT("H")
10    CONTINUE
      WRITE(LU,501) H3,V3,WS(W,1),WS(W,2) 
501   FORMAT("&a",I2,"r",I2,"C",A2,A1) 
5170  CONTINUE
5180  CONTINUE
      RETURN
      END 
C 
C 
      SUBROUTINE UPDAT(C,W,WS,L,M,IDEL,LU)
      INTEGER A(100,5),D(8,5,2),H,V,C 
      INTEGER WS(2,2),W,T,H3,V3,C3,H1 
      COMMON A,D
      H1=C/10 
      H3=(H1*2)+1 
      V3=((C-1-(10*H1))*4)-1
C 
C     DISPLAY NEW POSITION ON CRT 
C 
      DO 5 K=1,IDEL 
      WRITE(LU,503) 
5     CONTINUE
      IF (W.EQ.2) WRITE(LU,500) H3,V3 
500   FORMAT("&a",I2,"r",I2,"C&dB   &d@")
      IF (W.EQ.1) WRITE(LU,516) H3,V3 
516   FORMAT("&a",I2,"r",I2,"C&d@@@@")
C 
C     FLIP CAPTURED CHIPS 
C     UPDATES LEVEL 'L' AND GREATER OF A ARRAY
C 
5030  L1=L
      IF (L.GT.1) L1=L-1
      DO 5180 I=1,8 
      DO 5170 J=1,D(I,L1,M)+1 
      IF (J.EQ.1) GO TO 5170
      N2=(J-1)*D(I,5,1) 
      C3=N2+C 
      H1=C3/10
      H3=(H1*2)+1 
      V3=(((C3-(H1*10))-1)*4)-1 
      DO 10 K=1,IDEL
      WRITE(LU,503) 
503   FORMAT("H")
10    CONTINUE
      IF (W.EQ.2) WRITE(LU,501) H3,V3 
501   FORMAT("&a",I2,"r",I2,"C&dB   &d@")
      IF (W.EQ.1) WRITE(LU,517) H3,V3 
517   FORMAT("&a",I2,"r",I2,"C&d@@@@")
5170  CONTINUE
5180  CONTINUE
      RETURN
      END 
C 
C 
      SUBROUTINE RFRSH(LU,LINE,WS,IS1,IS2,LA) 
      INTEGER A(100,5),D(8,5,2),WS(2,2) 
      COMMON A,D
      IF (LINE.NE.2HYE) CALL BOARD(LU,WS,LA)
      IF (LINE.EQ.2HYE) CALL BORD1(LU,WS,LA)
      DO 10 I=1,8 
      D(I,1,2)=0
10    CONTINUE
      DO 20 I=1,100 
      IF (LINE.NE.2HYE) GO TO 15
      IF (A(I,1).EQ.1) CALL UPDT1(I,1,WS,1,2,1,LU)
      IF (A(I,1).EQ.-1) CALL UPDT1(I,2,WS,1,2,1,LU) 
      GO TO 20
15    IF (A(I,1).EQ.1) CALL UPDAT(I,1,WS,1,2,1,LU)
      IF (A(I,1).EQ.-1) CALL UPDAT(I,2,WS,1,2,1,LU) 
20    CONTINUE
      WRITE(LU,100) IS1,IS2 
100   FORMAT("&a17r58C",I2,"&a19r58C",I2) 
      RETURN
      END 
C 
C 
      SUBROUTINE LIST(MOVES,IMOV,IS1,IS2) 
      DIMENSION MOVES(50,4) 
      INTEGER A(100,5),D(8,5,2) 
      COMMON A,D
      WRITE(6,3999) 
3999  FORMAT(///) 
      DO 4001 I=1,IMOV-1
      WRITE(6,4000) I,(MOVES(I,J),J=1,4)
4000  FORMAT(3X,I2,3X,"HUMAN ",2I3,3X,"COMPUTER ",2I3)
4001  CONTINUE
      WRITE(6,4002) IS2,IS1 
4002  FORMAT(/,3X,"SCORE -- HUMAN ",I2,"  COMPUTER ",I2)
      WRITE(6,4003) 
4003  FORMAT(//,12X,"1  2  3  4  5  6  7  8",/) 
      DO 4005 I=10,80,10
      I10=I/10
      WRITE(6,4004) I10,(A((I+J),1),J=2,9),(A((I+K),5),K=2,9) 
4004  FORMAT(1X,I2,2X,8I3,4X,8I5,/) 
4005  CONTINUE
      WRITE(6,4006) 
4006  FORMAT(5X,"  COMPUTER=1   HUMAN=-1",///)
      RETURN
      END 
C 
C 
      SUBROUTINE PRINT(N,IP,IH,IV)
      INTEGER A(100,5),D(8,5,2) 
      COMMON A,D
      IF (N.EQ.2) GO TO 100 
      IF (IP.EQ.1) WRITE(8,86) IH,IV
      IF (IP.EQ.2) WRITE(8,87) IH,IV
      IF (N.EQ.1) GO TO 93
86    FORMAT("  * * * *  COMPUTER PLAYING AT ",2I2) 
87    FORMAT("  * * * *  HUMAN PLAYING AT ",2I2)
100   DO 92 I=10,80,10
      WRITE(8,245) (A((I+L),1),L=2,9),(A((I+K),2),K=2,9)
92    CONTINUE
      WRITE(8,244)
      DO 93 I=10,80,10
      WRITE(8,245) (A((I+L),3),L=2,9),(A((I+K),4),K=2,9)
93    CONTINUE
      WRITE(8,246)
245   FORMAT(2X,8I2,5X,8I2) 
244   FORMAT("  * * * * * * * * * * * * ")
246   FORMAT("  *********************** ")
      RETURN
      END 
C 
C 
      SUBROUTINE TRAP(IC,IH,IV,IX)
      INTEGER A(100,5),D(8,5,2) 
      COMMON A,D
      IF (IC.EQ.12.OR.IC.EQ.19) RETURN
      IF (IC.EQ.82.OR.IC.EQ.89) RETURN
      IF (IH.EQ.1.OR.IH.EQ.8) GO TO 1 
      IF (IV.EQ.1.OR.IV.EQ.8) GO TO 1 
      RETURN
C 
C    CORNER TRAP  ! _C__HXX_!
C 
1     IF (IC.EQ.13) GO TO 13
      IF (IC.EQ.18) GO TO 18
      IF (IC.EQ.22) GO TO 22
      IF (IC.EQ.72) GO TO 72
      IF (IC.EQ.29) GO TO 29
      IF (IC.EQ.79) GO TO 79
      IF (IC.EQ.83) GO TO 83
      IF (IC.EQ.88) GO TO 88
      GO TO 100 
13    IF (A(14,1).EQ.0.AND.A(15,1).EQ.0.AND.A(16,1).EQ.(-1)) IX=IX-800
18    IF (A(17,1).EQ.0.AND.A(16,1).EQ.0.AND.A(15,1).EQ.(-1)) IX=IX-800
22    IF (A(32,1).EQ.0.AND.A(42,1).EQ.0.AND.A(52,1).EQ.(-1)) IX=IX-800
72    IF (A(62,1).EQ.0.AND.A(52,1).EQ.0.AND.A(42,1).EQ.(-1)) IX=IX-800
29    IF (A(39,1).EQ.0.AND.A(49,1).EQ.0.AND.A(59,1).EQ.(-1)) IX=IX-800
79    IF (A(69,1).EQ.0.AND.A(59,1).EQ.0.AND.A(49,1).EQ.(-1)) IX=IX-800
83    IF (A(84,1).EQ.0.AND.A(85,1).EQ.0.AND.A(86,1).EQ.(-1)) IX=IX-800
88    IF (A(87,1).EQ.0.AND.A(86,1).EQ.0.AND.A(85,1).EQ.(-1)) IX=IX-800
C 
C    SPLIT TRAP  !__H_H___! 
C 
100   IF (IH.EQ.1.OR.IH.EQ.8) GO TO 200 
      IF (IV.EQ.1.OR.IV.EQ.8) GO TO 300 
      RETURN
200   ICP1=IC+1 
      ICP2=IC+2 
      ICM1=IC-1 
      ICM2=IC-2 
      IF (ICP2.EQ.19.OR.ICP2.EQ.89) RETURN
      IF (ICM2.EQ.12.OR.ICM2.EQ.82) RETURN
      IF (A(ICP1,1).EQ.0.AND.A(ICP2,1).EQ.1) IX=IX-500
      IF (A(ICM1,1).EQ.0.AND.A(ICM2,1).EQ.1) IX=IX-500
      RETURN
300   ICP1=IC+10
      ICP2=IC+20
      ICM1=IC-10
      ICM2=IC-20
      IF (ICP2.EQ.82.OR.ICP2.EQ.89) RETURN
      IF (ICM2.EQ.12.OR.ICM2.EQ.19) RETURN
      IF (A(ICP1,1).EQ.0.AND.A(ICP2,1).EQ.1) IX=IX-500
      IF (A(ICM1,1).EQ.0.AND.A(ICM2,1).EQ.1) IX=IX-500
      RETURN
      END 
      END$
^^^  :::::::::: * * *  &OTSUB  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &SCAN   * * * ::::::::::  \|/
ASMB,R
********************************************************* 
*  PROGRAM PERFORMS SCAN FUNCTION FOR OTHELLO 
*  TABS SET AT 7,22 
********************************************************* 
      NAM SCAN              3/28/77                    GP 
      ENT SCAN,SCAN1
      ENT CS.,XS.,LS.,P.
      EXT .ENTR,MDPOS 
      COM A(500),D(80)
CS.   BSS 1 
XS.   BSS 1 
LS.   BSS 1 
P.    BSS 1 
SCAN1 NOP         ENTRY POINT FROM ASSEMBLY CALLS 
      STA AVAL
      STB APOS
      LDA MDPOS 
      STA DPOS
      LDA SCAN1 
      STA SCAN
      JMP ST
SCAN  NOP    ENTRY POINT FROM FORTRAN CALLS 
      JSB .ENTR 
      DEF CS. 
* 
      LDA LS.,I       GET OFFSET FOR LEVEL [LS.]
      ADA =D-5
      STA I 
      LDA =D399 
      LDB =D40
* 
JMP1  ADA =D-100
      ADB =D-8
      ISZ I 
      JMP JMP1
* 
      ADA A.       GET APOS AND AVAL
      ADA CS.,I 
      STA APOS
      LDA A.
      ADA CS.,I 
      ADA =D399 
      STA AVAL
* 
      ADB D.       GET DPOS AND DVAL
      STB DPOS
* 
ST    LDA C8         -8 -> I
      STA I 
      CLB 
      STB X          0 -> X 
* 
XX1   CLB 
      LDA DPOS
      ADA I 
      STA DADD
      STB 0,I        0 -> D(I,L,1)
      STB VAL        0 -> VAL 
      LDA C8
      STA J          -8 -> J
* 
      LDA DVAL
      ADA I 
      LDB 0,I        D(I,5,1) -> B REG
      LDA APOS
      STA APOS1      INDEX POSITION -> APOS1
* 
YY1   LDA APOS1 
      ADA 1          ONE STEP IN DIRECTION I
      STA APOS1      SAVE STEP
      LDA 0,I        A(CI,L) -> A REG 
      CPA P.,I
      JMP S          JUMP IF A=[P.] 
      ADA P.,I
      SZA 
      JMP TK         JUMP IF A IS NOT OTHER PLAYER
* 
      LDA AVAL       HERE IF A=[P.]NOT
      ADA 1 
      LDA 0,I        VALUE OF A(CI,5) -> A REG
      ADA VAL 
      STA VAL        VAL+A(CI,5) -> VAL 
      ISZ J 
      JMP YY1 
* 
S     LDA J 
      ADA =D8 
      STA DADD,I     # OF CAPTURES -> D(I,L,1)
* 
T     LDA X 
      ADA VAL 
      STA X          X+VAL -> X 
      ISZ I          DONE?
      JMP XX1        NO, NEXT DIRECTION 
      LDA X          YES
      SZA            X=0? 
      ADA AVAL,I     NO,X+A([CS.],5) -> X 
      STA XS.,I       X -> [XS.]
      JMP SCAN,I     RETURN 
* 
TK    CLA 
      STA VAL        0 -> VAL 
      JMP T 
* 
C8    DEC -8         LOOP COUNT 
I     NOP 
J     NOP 
A.    DEF A          ADDRESSES
D.    DEF D 
APOS  NOP 
DADD  NOP 
APOS1 NOP 
X     NOP            CAPTURE TOTAL
VAL   NOP            CAPTURE/DIR CNT
AVAL  NOP 
DPOS  NOP 
DVAL  DEF D+40
      END 
      END$
^^^  :::::::::: * * *  &SCAN   * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &SWTCH  * * * ::::::::::  \|/
FTN4,L
      SUBROUTINE SWTCH(K) 
C     CHANGES WEIGHTS AT 8(1) AND 17(2) 
      INTEGER A(100,5),D(8,5,2),A5(12,2)
      COMMON A,D
      DATA A5/12*-21,12*20/ 
      A(35,5)=A5(1,K) 
      A(36,5)=A5(2,K) 
      A(44,5)=A5(3,K) 
      A(45,5)=A5(4,K) 
      A(46,5)=A5(5,K) 
      A(47,5)=A5(6,K) 
      A(54,5)=A5(7,K) 
      A(55,5)=A5(8,K) 
      A(56,5)=A5(9,K) 
      A(57,5)=A5(10,K)
      A(65,5)=A5(11,K)
      A(66,5)=A5(12,K)
      RETURN
      END 
      END$
^^^  :::::::::: * * *  &SWTCH  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &TRACK  * * * ::::::::::  \|/
ASMB,R,L
*********************************************************************** 
*       PROGRAM PERFORMS THE TRACKING FUNCTION FOR OTHELLO
*       TABS SET A 7,22 
**********************************************************************
      NAM TRACK                     4/12/77                          GLB
      ENT TRACK,TRCK1 
      ENT CT.,LT.,M.,T. 
      EXT .ENTR,MDPOS 
      COM A(500),D(80)
CT.   BSS 1 
LT.   BSS 1 
M.    BSS 1 
T.    BSS 1 
TRCK1 NOP 
      STB APOS        A(C,4)
      STA APOS3       A(C,L-1)
      LDA MDPOS 
      STA DPOS        D(8+,L,1
      LDA TRCK1 
      STA TRACK 
      JMP ST
TRACK NOP 
      JSB .ENTR 
      DEF CT. 
* 
      LDA LT.,I       IF [LT.]=1,LI=[LT.] 
      STA L1
      ADA =D-1
      SZA 
      STA L1         IF [LT.]>1,LI=[LT.]-1
* 
      LDA A.
      ADA CT.,I 
      ADA =D299 
      STA APOS       APOS=A(C,4)
* 
      LDA L1         GET OFFSET FOR L1
      ADA =D-5
      STA I 
      LDA =D399 
      LDB =D40
* 
JMP1  ADA =D-100
      ADB =D-8
      ISZ I 
      JMP JMP1
* 
      ADA A.        GET APOS3 AND DPOS
      ADA CT.,I 
      STA APOS3     APOS3=A(C,L-1)
      LDA T.,I
      CPA =D2 
      ADB =D40       IF T=2, ADD 40 
      ADB D.
      STB DPOS       DPOS=D(8+,L1,T)
* 
* 
ST    LDA LT.,I 
      ADA =D-5
      STA LEV         NUMBER OF LEVELS TO CHANGE
      LDA =D-8
      STA I          -8 -> I
* 
XX1   LDA APOS       APOS=A(C,4)
      STA APOS1 
      LDA DVAL       D(8+,5,1) -> A REG 
      ADA I 
      LDA 0,I 
      STA DADD       DADD=D(I,5,1)
      LDB DPOS       DPOS=D(8+,L1,T)
      ADB I 
      LDB 1,I        D(I,L1,T) -> B REG 
      CMB,INB 
      STB J          J=NUMBER OF CAPTURES 
* 
YY1   LDB APOS1 
      ADB DADD
      STB APOS1      NEW(NEXT) STEP FROM CENTRAL POSITION 
* 
      LDA LEV 
      STA L1
* 
      LDA J 
      SZA,RSS        NO CAPTURES? 
      JMP LIMIT      YES, CHANGE SCAN LIMITS
      LDA 1,I        NO, CAPTURE POSITIONS
      CMA,INA 
      JMP LOOP
* 
LIMIT LDA M.,I
      CPA =D2        IS MODE=2? 
      JMP BACK       YES, BACKDATE TO PREVIOUS LEVEL
* 
      LDA APOS1,I    NO, UPDATE 9'S TO 0'S
      ADA =D-9
      SZA            IS POSITION VALUE =9?
      JMP NEXTI      NO, DO NEXT DIRECTION
      JMP LOOP       YES,DO CHANGES 
* 
BACK  LDA APOS3 
      ADA DADD
      LDA 0,I 
      CPA =D9        IS [APOS3+DADD] =9?
      JMP LOOP       YES, DO CHANGES
      JMP NEXTI      NO, NEXT DIRECTION 
* 
LOOP  STA 1,I 
      ADB =D-100
      ISZ L1
      JMP LOOP
* 
      LDB J 
      SZB,RSS 
      JMP NEXTI 
      ISZ J 
      JMP YY1 
* 
NEXTI ISZ I 
      JMP XX1 
* 
      JMP TRACK,I 
* 
L1    NOP            MODIFIED LEVEL 
APOS  NOP            ADDRESS OF A(C,4)
A.    DEF A          STARTING ADDRESS OF A ARRAY
DPOS  NOP            ADDRESS OF D(8+,L1,T)
D.    DEF D          STARTING ADDRESS OF D ARRAY
DVAL  DEF D+40       ADDRESS OF D(8+,5,1) 
I     NOP            DIRECTION LOOP COUNTER 
J     NOP            CAPTURES COUNTER 
K     NOP            LEVEL LOOP COUNTER 
DADD  NOP            DIRECTION STEP SIZE
APOS1 NOP            DIRECTION STEPPED ADDRESS
APOS2 NOP            DIRECTION LEVEL STEPPED ADDRESS
APOS3 NOP            ADDRESS OF A(C,L-1)
LEV   NOP            LEVELS TO CHANGE LIMITS IN 
      END 
      END$
^^^  :::::::::: * * *  &TRACK  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &VALGT  * * * ::::::::::  \|/
FTN4,L
      SUBROUTINE VALGT(C) 
C     SETS INITIAL WEIGHTS
      INTEGER C(100),B(25)
      DATA B/ 
     1  0,000,000,000,000,
     2  0,500,075,150,100,
     3  0,075,-803,010,010, 
     4  0,150,010,030,20, 
     5  0,100,010,20,20/
      DO 10 I=0,40,10 
      DO 20 J=1,5 
      IJB=(I/2)+J 
      C(I+J)=B(IJB) 
      C(I-J+11)=B(IJB)
      C(90-I+J)=B(IJB)
      C(101-I-J)=B(IJB) 
20    CONTINUE
10    CONTINUE
      RETURN
      END 
      END$
^^^  :::::::::: * * *  &VALGT  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &XTHEL  * * * ::::::::::  \|/
FTN4
      PROGRAM XTHEL,3,100 
      INTEGER A(100,5),D(8,5,2),C(2,4),W,MOVES(50,4)
      INTEGER WS(2,2),IX24,IS2,H,V,P,ITIME(5),IYEAR(1)
      INTEGER VS(8),B(100),T,IPASS(5),AC(100) 
      COMMON A,D
      DATA VS/-10,-9,1,11,10,9,-1,-11/
      DATA AC/
     14,4,4,4,4,4,4,4,4,4,4,9,9,9,9,9,9,9,9,4,
     24,9,9,9,9,9,9,9,9,4,4,9,9,0,0,0,0,9,9,4,
     34,9,9,0,-1,1,0,9,9,4,4,9,9,0,1,-1,0,9,9,4,
     44,9,9,0,0,0,0,9,9,4,4,9,9,9,9,9,9,9,9,4,
     54,9,9,9,9,9,9,9,9,4,4,4,4,4,4,4,4,4,4,4/
      L1=1
      CALL RMPAR(IPASS) 
      L1=IPASS(1) 
C 
C     SET GAME PARAMETERS 
C 
1     WRITE(L1,157) 
157   FORMAT("HJWHICH LU DO YOU WANT TO PLAY AGAINST (2 DIGITS) ?") 
      READ(L1,158) L2 
158   FORMAT(I2)
      WRITE(L1,49)
49    FORMAT("HOW FAST WOULD YOU LIKE THE DISPLAY UPDATED ?",/, 
     1"    (0.02 TO 1.00 SECONDS PER CHIP)  ")
      READ(L1,51) DELAY 
51    FORMAT(F3.2)
      IDEL=DELAY/.08
      WRITE(L1,52)
52    FORMAT("WOULD YOU LIKE TO GO FIRST (YES OR NO) ?")
      READ(L1,53) IANS
53    FORMAT(1A2) 
      WRITE(L1,55)
55    FORMAT("ARE THERE ANY CHANGES TO THE STARTING CONFIGUARTION (YES" 
     1" OR NO) ?")
      READ(L1,53) ICHNG 
      WRITE(L1,56)
56    FORMAT("DOES YOUR TERMINAL HAVE A LINE DRAWING CAPABILITY ",
     1"  (YES OR NO ) ?") 
      READ(L1,53) LINE
      WRITE(L1,159) L2
159   FORMAT("DOES LU ",I2," HAVE A LINE DRAWING CAPABILITY ?") 
      READ(L1,53) LIN2
C 
C     DRAW BOARD -- CALL BORD1 FOR LINE DRAWING SET 
C     L1='SELF'  L2='OPPONENT'
C 
57    IF (LINE.NE.2HYE) CALL BOARD(L1,L1,L2,WS) 
      IF (LIN2.NE.2HYE) CALL BOARD(L2,L1,L2,WS) 
      IF (LINE.EQ.2HYE) CALL BORD1(L1,L1,L2,WS) 
      IF (LIN2.EQ.2HYE) CALL BORD1(L2,L1,L2,WS) 
C 
C     INITIALIZE DATA AND ARRAYS
C 
6     CALL VALGT(B) 
      DO 5 JJ=1,4 
      DO 10 I=1,100 
      A(I,JJ)=AC(I) 
      A(I,5)=B(I) 
10    CONTINUE
      IX21=0
      DO 15 I=1,8 
      D(I,JJ,1)=0 
      D(I,JJ,2)=0 
      D(I,5,1)=VS(I)
      D(I,5,2)=0
15    CONTINUE
5     CONTINUE
      IS1=2 
      IS2=2 
      IF (ICHNG.NE.2HYE) GO TO 70 
C 
C     MODIFY STARTING BOARD IF DESIRED
C 
      WRITE(L1,60)
60    FORMAT("&a23r1CSTARTING CHANGES ? ROW,COL=P" 
     1"   P=(+1=OPPONENT,-1=SELF)   R,C=(0,0=DONE)")
61    WRITE(L1,62)
62    FORMAT("&a24r1C?_")
      READ(L1,63) H,V,P 
63    FORMAT(I1,1X,I1,1X,I2)
      IF (H.EQ.0.AND.V.EQ.0) GO TO 76 
      IF (H.EQ.9.AND.V.EQ.0) GO TO 1
      IF (H.LT.1.OR.H.GT.8.OR.V.LT.1.OR.V.GT.8) GO TO 71
      IF (P.EQ.(-1).OR.P.EQ.(+1)) GO TO 69
71    WRITE(L1,72)
72    FORMAT("INCORRECT PARAMETER") 
69    C=10*H+V+1
      A(C,1)=P
      A(C,2)=P
      A(C,3)=P
      A(C,4)=P
      CALL TRACK(C,1,1,2) 
      H=(H*2)+1 
      V=(V*4)-1 
      W=1 
      IF (P.EQ.(-1)) W=2
      IF (LINE.EQ.2HYE) WRITE(L1,85) H,V,WS(W,1),WS(W,2)
      IF (LIN2.EQ.2HYE) WRITE(L2,85) H,V,WS(W,1),WS(W,2)
      IF (LINE.NE.2HYE.AND.W.EQ.1) WRITE(L1,85) H,V,WS(W,1),WS(W,2) 
      IF (LIN2.NE.2HYE.AND.W.EQ.1) WRITE(L2,85) H,V,WS(W,1),WS(W,2) 
      IF (LINE.NE.2HYE.AND.W.EQ.2) WRITE(L1,87) H,V,WS(W,1),WS(W,2) 
      IF (LIN2.NE.2HYE.AND.W.EQ.2) WRITE(L2,87) H,V,WS(W,1),WS(W,2) 
85    FORMAT("&a",I2,"r",I2,"C",A2,A1) 
87    FORMAT("&a",I2,"r",I2,"C&dB",A2,A1,"&d@")
      GO TO 61
76    WRITE(L1,80)
80    FORMAT("WHAT IS THE CORRECT STARTING SCORE (OPPONENT,SELF) ?",/,
     1"             2 DIGITS EACH  _")
      READ(L1,81) IS1,IS2 
81    FORMAT(I2,1X,I2)
      WRITE(L1,305) IS1,IS2 
      WRITE(L2,305) IS1,IS2 
      WRITE(L1,95)
95    FORMAT("&a23r1CJH")
70    T=0 
      IMOV=1
      DO 13 I=1,4 
      MOVES(IMOV,I)=0 
13    CONTINUE
      SL=0. 
      IS3=IS1+IS2 
C 
C     START GAME  WHO GOES FIRST? 
C 
      IF (IANS.NE.2HNO) GO TO 2700
C 
C     OPPONENT SELECTS MOVE 
C 
2250  J=0 
27109 WRITE(L2,3009)
      WRITE(L1,3007)
3009  FORMAT("&a6r62C&dB?        &d@&a+0r-7C_")
3007  FORMAT("&a6r62C&dB?        &d@&a+0r-7C_") 
      READ(L2,310) IH,M6,IV 
      IH11=(IH/400B)-60B
      IV11=(IV/400B)-60B
C 
C     WHAT DOES OPPONENT WANT TO DO?
C     D=DONE   L=LIST MOVES ON PRINTER   N=NEW GAME(SAME PARAMETERS)
C     P=PASS   R=REFRESH DISPLAY   S=START OVER(NEW PARAMETERS) 
C     T=TRACE TO MAG TAPE  " "=TERMINAL TIMED OUT  X=NO RANDOMNESS
C 
      IF (IH.EQ.1HD) GO TO 9998 
      IF (IH.EQ.1HL) CALL LIST(MOVES,IMOV,IS1,IS2,L1,L2)
      IF (IH.EQ.1HL) GO TO 27109
      IF (IH.EQ.1HN) GO TO 57 
      IF (IH.EQ.1HP) GO TO 27209
      IF (IH.EQ.1HR) CALL RFRSH(L2,L1,L2,LIN2,WS,IS1,IS2) 
      IF (IH.EQ.1HR) GO TO 27109
      IF (IH.EQ.1HS) GO TO 1
      IF (IH.EQ.1HT) GO TO 36669
      IF (IH.EQ.1H ) WRITE(L2,3297) 
      IF (IH.EQ.1H ) GO TO 27109
      IF (IH11.LT.1.OR.IH11.GT.8) GO TO 29009 
      IF (IV11.LT.1.OR.IV11.GT.8) GO TO 29009 
      GO TO 28709 
36669 T=1 
      WRITE(L2,300) 
      WRITE(L2,3667)
      READ(L2,3668) LUT 
      IF (LUT.GE.50) GO TO 36669
      GO TO 27109 
C 
C     CHECK FOR LEGAL 'PASS'
C 
27209 DO 509 IC11=1,100 
      IF (A(IC11,1).NE.0) GO TO 509 
      CALL SCAN(IC11,IX11,1,1)
      IF (IX11.NE.0) J=1
509   CONTINUE
      IF (J.EQ.1)  GO TO 29009
      GO TO 2700
C 
C     CHECK FOR LEGAL MOVE
C 
28709 IC11=(IH11*10)+IV11+1 
      IF (A(IC11,1).NE.0) GO TO 29009 
      CALL SCAN(IC11,IX11,1,1)
      IF (IX11.NE.0) GO TO 29209
29009 WRITE(L2,3939)
      GO TO 27109 
29209 WRITE(L2,3049)
      IF (T.EQ.1) WRITE(LUT,8879) IH11,IV11 
8879  FORMAT(" *********OPPONENT PLAYING AT ",2I3)
      MOVES(IMOV,3)=IH11
      MOVES(IMOV,4)=IV11
      IMOV=IMOV+1 
      A(IC11,1)=1 
      A(IC11,2)=1 
      A(IC11,3)=1 
      A(IC11,4)=1 
      X4=0
      DO 29309 I=1,8
      D(I,1,2)=D(I,1,1) 
      X4=X4+D(I,1,1)
29309 CONTINUE
      CALL TRACK(IC11,1,1,2)
      WRITE(L1,3069) IH11,IV11
3069  FORMAT("&a6r64C",I1,".",I1)
66679 IF (LIN2.EQ.2HYE) CALL UPDT1(IC11,1,WS,1,2,IDEL,L2) 
      IF (LINE.EQ.2HYE) CALL UPDT1(IC11,1,WS,1,2,IDEL,L1) 
      IF (LIN2.NE.2HYE) CALL UPDAT(IC11,1,WS,1,2,IDEL,L2) 
      IF (LINE.NE.2HYE) CALL UPDAT(IC11,1,WS,1,2,IDEL,L1) 
      IS1=IS1+1+X4
      IS2=IS2-X4
      WRITE(L2,305) IS1,IS2 
      WRITE(L1,305) IS1,IS2 
C 
C     SELF'S TURN TO MOVE 
C 
2700  J=0 
2710  WRITE(L1,300) 
      WRITE(L2,3008)
300   FORMAT("&a8r62C&dB?        &d@&a+0r-7C_")
3008  FORMAT("&a8r62C&dB?        &d@&a+0r-7C_") 
      READ(L1,310) IH,M6,IV 
310   FORMAT(A1,A1,A1)
      IH11=(IH/400B)-60B
      IV11=(IV/400B)-60B
C 
C     WHAT DOES SELF WANT TO DO?
C     D=DONE   L=LIST MOVES ON PRINTER   N=NEW GAME(SAME PARAMETERS)
C     P=PASS   R=REFRESH DISPLAY   S=START OVER(NEW PARAMETERS) 
C     T=TRACE TO MAG TAPE  " "=TERMINAL TIMED OUT  X=NO RANDOMNESS
C 
      IF (IH.EQ.1HD) GO TO 9998 
      IF (IH.EQ.1HL) CALL LIST(MOVES,IMOV,IS1,IS2,L1,L2)
      IF (IH.EQ.1HL) GO TO 2710 
      IF (IH.EQ.1HN) GO TO 57 
      IF (IH.EQ.1HP) GO TO 2720 
      IF (IH.EQ.1HR) CALL RFRSH(L1,L1,L2,LINE,WS,IS1,IS2) 
      IF (IH.EQ.1HR) GO TO 2710 
      IF (IH.EQ.1HS) GO TO 1
      IF (IH.EQ.1HT) GO TO 3666 
      IF (IH.EQ.1HX) IRAND=0
      IF (IH.EQ.1HX) GO TO 2710 
      IF (IH.EQ.1H ) WRITE(L1,3297) 
      IF (IH.EQ.1H ) GO TO 2710 
      IF (IH11.LT.1.OR.IH11.GT.8) GO TO 2900
      IF (IV11.LT.1.OR.IV11.GT.8) GO TO 2900
      GO TO 2870
3666  T=1 
      WRITE(L1,300) 
      WRITE(L1,3667)
3667  FORMAT("LU?_")
      READ(L1,3668) LUT 
3668  FORMAT(I2)
      IF (LUT.GE.50) GO TO 3666 
      GO TO 2710
C 
C     CHECK FOR LEGAL 'PASS'
C 
2720  DO 50 IC11=1,100
      IF (A(IC11,1).NE.0) GO TO 50
      CALL SCAN(IC11,IX11,1,-1) 
      IF (IX11.NE.0) J=1
50    CONTINUE
3297  FORMAT("&a9r62CTHINK FASTER")
      IF (J.EQ.1)  GO TO 2900 
      GO TO 2250
C 
C     CHECK FOR LEGAL MOVE
C 
2870  IC11=(IH11*10)+IV11+1 
      IF (A(IC11,1).NE.0) GO TO 2900
      CALL SCAN(IC11,IX11,1,-1) 
      IF (IX11.NE.0) GO TO 2920 
2900  WRITE(L1,393) 
393   FORMAT("&a9r62C&dBILLEGAL MOVE&a8r62C?") 
3939  FORMAT("&a7r62C&dBILLEGAL MOVE&a6r62C?") 
      GO TO 2700
2920  WRITE(L1,304) 
304   FORMAT("&a9r62C&d@            ")
3049  FORMAT("&a7r62C&d@            ")
      IF (T.EQ.1) WRITE(LUT,887) IH11,IV11
887   FORMAT(" *************SELF PLAYING AT ",2I3)
      MOVES(IMOV,1)=IH11
      MOVES(IMOV,2)=IV11
      A(IC11,1)=-1
      A(IC11,2)=-1
      A(IC11,3)=-1
      A(IC11,4)=-1
      X4=0
      DO 2930 I=1,8 
      D(I,1,2)=D(I,1,1) 
      X4=X4+D(I,1,1)
2930  CONTINUE
      CALL TRACK(IC11,1,1,2)
      WRITE(L2,306) IH11,IV11 
306   FORMAT("&a8r64C",I1,".",I1)
6667  IF (LINE.EQ.2HYE) CALL UPDT1(IC11,2,WS,1,2,IDEL,L1) 
      IF (LIN2.EQ.2HYE) CALL UPDT1(IC11,2,WS,1,2,IDEL,L2) 
      IF (LINE.NE.2HYE) CALL UPDAT(IC11,2,WS,1,2,IDEL,L1) 
      IF (LIN2.NE.2HYE) CALL UPDAT(IC11,2,WS,1,2,IDEL,L2) 
      IS1=IS1-X4
      IS2=IS2+1+X4
      WRITE(L1,305) IS1,IS2 
      WRITE(L2,305) IS1,IS2 
305   FORMAT("&a17r55C",I2,"&a19r55C",I2) 
      GOTO 2250 
9998  IF (LUT.NE.8) GO TO 9999
      ENDFILE 8 
      REWIND 8
9999  WRITE(L1,7654)
      WRITE(L2,7654)
7654  FORMAT("H")
      END 
      END$
^^^  :::::::::: * * *  &XTHEL  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  &XTSUB  * * * ::::::::::  \|/
FTN4
      SUBROUTINE BORD1(LU,L1,L2,WS) 
C     LU=DEVICE WRITTEN TO  L1='SELF'  L2='OPPONENT'
      INTEGER WS(2,2) 
      WRITE(LU,100) 
100   FORMAT("HJ)B",/,"    1   2   3   4   5   6   7   8",/, 
     1"  Q;;;3;;;3;;;3;;;3;;;3;;;3;;;3;;;W   ",/, 
     2"1 :   :   :   :   :   :   :   :   : 1 ",/, 
     3"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     4"2 :   :   :   :   :   :   :   :   : 2 ",/, 
     5"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     6"3 :   :   :   :   :   :   :   :   : 3 ",/, 
     7"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     8"4 :   :   :   :CCC:???:   :   :   : 4 ",/, 
     9"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ") 
      WRITE(LU,101) 
101   FORMAT("5 :   :   :   :???:CCC:   :   :   : 5 ",/,
     1"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     2"6 :   :   :   :   :   :   :   :   : 6 ",/, 
     3"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     4"7 :   :   :   :   :   :   :   :   : 7 ",/, 
     5"  1;;;0;;;0;;;0;;;0;;;0;;;0;;;0;;;2   ",/, 
     6"8 :   :   :   :   :   :   :   :   : 8 ",/, 
     7"  A;;;4;;;4;;;4;;;4;;;4;;;4;;;4;;;S    ",/,
     8/,"    1   2   3   4   5   6   7   8   ") 
      WRITE(LU,102) L2,L1 
102   FORMAT("&a1r45CTHE GAME OF OTHELLO&a2r45C-------------------",
     1"&a3r45CCOMPLIMENTS OF G.L.BOOTH", 
				 2"&a6r45CLU ",I2,"'S MOVE&a8r45CLU ",I2,"'S MOVE ")
      WRITE(LU,105) 
105   FORMAT("&a10r45CD=DONE  L=LIST MOVES  N=NEW GAME ")
      WRITE(LU,104) 
104   FORMAT("&a11r45CR=REFRESH SCREEN  S=START OVER ",
     1"&a12r45CP=PASS  R.C=ROW.COLUMN OF MOVE")
      WRITE(LU,103) L2,L1 
103   FORMAT("&a15r45CSCORE   &a16r45C-----   ",
     1"&a17r45CLU ",I2,"     2 &a19r45CLU ",I2,"     2")
      WRITE(LU,106) L2,L1 
106   FORMAT("&a13r45CLU ",I2,"=???   LU ",I2,"=CCC")
      WS(1,1)=2H??
      WS(1,2)=1H? 
      WS(2,1)=2HCC
      WS(2,2)=1HC 
      RETURN
      END 
C 
C 
      SUBROUTINE BOARD(LU,L1,L2,WS) 
C     LU=DEVICE WRITTEN TO  L1='SELF'  L2='OPPONENT'
      INTEGER WS(2,2) 
      WRITE(LU,100) 
100   FORMAT("HJ",/,"    1   2   3   4   5   6   7   8",/,
     1"  +---+---+---+---+---+---+---+---+   ",/, 
     2"1 !   :   :   :   :   :   :   :   ! 1 ",/, 
     3"  +---+---+---+---+---+---+---+---+   ",/, 
P    4"2 !   :   :   :   :   :   :   :   ! 2 ",/, 
     5"  +---+---+---+---+---+---+---+---+   ",/, 
     6"3 !   :   :   :   :   :   :   :   ! 3 ",/, 
     7"  +---+---+---+---+---+---+---+---+   ",/, 
     8"4 !   :   :   :&dB   &d@:@@@:   :   :   ! 4 ",/, 
     9"  +---+---+---+---+---+---+---+---+   ") 
      WRITE(LU,101) 
101   FORMAT( 
     1"5 !   :   :   :@@@:&dB   &d@:   :   :   ! 5 ",/, 
     2"  +---+---+---+---+---+---+---+---+   ",/, 
     3"6 !   :   :   :   :   :   :   :   ! 6 ",/, 
     4"  +---+---+---+---+---+---+---+---+   ",/, 
     5"7 !   :   :   :   :   :   :   :   ! 7 ",/, 
     6"  +---+---+---+---+---+---+---+---+   ",/, 
     7"8 !   :   :   :   :   :   :   :   ! 8 ",/, 
     8"  +---+---+---+---+---+---+---+---+    ",/,
     9/,"    1   2   3   4   5   6   7   8   ") 
      WRITE(LU,102) L2,L1 
102   FORMAT("&a1r45CTHE GAME OF OTHELLO&a2r45C-------------------",
     1"&a3r45CCOMPLIMENTS OF G.L.BOOTH", 
				 2"&a6r45CLU ",I2,"'S MOVE&a8r45CLU ",I2,"'S MOVE ")
      WRITE(LU,105) 
105   FORMAT("&a10r45CD=DONE  L=LIST MOVES  N=NEW GAME ")
      WRITE(LU,104) 
104   FORMAT("&a11r45CR=REFRESH SCREEN  S=START OVER ",
     1"&a12r45CP=PASS  R.C=ROW.COLUMN OF MOVE")
      WRITE(LU,103) L2,L1 
103   FORMAT("&a15r45CSCORE   &a16r45C-----   ",
     1"&a17r45CLU ",I2,"     2 &a19r45CLU ",I2,"     2")
      WRITE(LU,106) L2,L1 
106   FORMAT("&a13r45CLU ",I2,"=@@@   LU ",I2,"=&dB   &d@")
      WS(1,1)=2H@@
      WS(1,2)=1H@ 
      WS(2,1)=2H
      WS(2,2)=1H
      RETURN
      END 
C 
C 
      SUBROUTINE CHNGE 
C     SWITCHES TO FINAL VALUES AT 47
      INTEGER A(100,5),D(8,5,2),B(25) 
      COMMON A,D
      DATA B/ 
     1  0,000,000,000,000,
     2  0,050,020,020,020,
     3  0,020,020,010,010,
     4  0,020,010,020,010,
     5  0,020,010,010,020/
      DO 10 I=0,40,10 
      DO 20 J=1,5 
      IJB=(I/2)+J 
      A(I+J,5)=B(IJB) 
      A(I-J+11,5)=B(IJB)
      A(90-I+J,5)=B(IJB)
      A(101-I-J,5)=B(IJB) 
20    CONTINUE
10    CONTINUE
      RETURN
      END 
C 
C 
      SUBROUTINE UPDT1(C,W,WS,L,M,IDEL,LU)
      INTEGER A(100,5),D(8,5,2),H,V,C 
      INTEGER WS(2,2),W,T,H3,V3,C3,H1 
      COMMON A,D
      H1=C/10 
      H3=(H1*2)+1 
      V3=((C-1-(10*H1))*4)-1
C 
C     DISPLAY NEW POSITION ON CRT 
C 
      DO 5 K=1,IDEL 
      WRITE(LU,503) 
5     CONTINUE
      WRITE(LU,500) H3,V3,WS(W,1),WS(W,2) 
500   FORMAT("&a",I2,"r",I2,"C",A2,A1) 
C 
C     FLIP CAPTURED CHIPS 
C     UPDATES LEVEL 'L' AND GREATER OF A ARRAY
C 
5030  L1=L
      IF (L.GT.1) L1=L-1
      DO 5180 I=1,8 
      DO 5170 J=1,D(I,L1,M)+1 
      IF (J.EQ.1) GO TO 5170
      N2=(J-1)*D(I,5,1) 
      C3=N2+C 
      H1=C3/10
      H3=(H1*2)+1 
      V3=(((C3-(H1*10))-1)*4)-1 
      DO 10 K=1,IDEL
      WRITE(LU,503) 
503   FORMAT("H")
10    CONTINUE
      WRITE(LU,501) H3,V3,WS(W,1),WS(W,2) 
501   FORMAT("&a",I2,"r",I2,"C",A2,A1) 
5170  CONTINUE
5180  CONTINUE
      RETURN
      END 
C 
C 
      SUBROUTINE UPDAT(C,W,WS,L,M,IDEL,LU)
      INTEGER A(100,5),D(8,5,2),H,V,C 
      INTEGER WS(2,2),W,T,H3,V3,C3,H1 
      COMMON A,D
      H1=C/10 
      H3=(H1*2)+1 
      V3=((C-1-(10*H1))*4)-1
C 
C     DISPLAY NEW POSITION ON CRT 
C 
      DO 5 K=1,IDEL 
      WRITE(LU,503) 
5     CONTINUE
      IF (W.EQ.2) WRITE(LU,500) H3,V3 
500   FORMAT("&a",I2,"r",I2,"C&dB   &d@")) 
      IF (W.EQ.1) WRITE(LU,516) H3,V3 
516   FORMAT("&a",I2,"r",I2,"C&d@@@@")
C 
C     FLIP CAPTURED CHIPS 
C     UPDATES LEVEL 'L' AND GREATER OF A ARRAY
C 
5030  L1=L
      IF (L.GT.1) L1=L-1
      DO 5180 I=1,8 
      DO 5170 J=1,D(I,L1,M)+1 
      IF (J.EQ.1) GO TO 5170
      N2=(J-1)*D(I,5,1) 
      C3=N2+C 
      H1=C3/10
      H3=(H1*2)+1 
      V3=(((C3-(H1*10))-1)*4)-1 
      DO 10 K=1,IDEL
      WRITE(LU,503) 
503   FORMAT("H")
10    CONTINUE
      IF (W.EQ.2) WRITE(LU,501) H3,V3 
501   FORMAT("&a",I2,"r",I2,"C&dB   &d@")
      IF (W.EQ.1) WRITE(LU,517) H3,V3 
517   FORMAT("&a",I2,"r",I2,"C&d@@@@")
5170  CONTINUE
5180  CONTINUE
      RETURN
      END 
C 
C 
      SUBROUTINE RFRSH(LU,L1,L2,LINE,WS,IS1,IS2)
      INTEGER A(100,5),D(8,5,2),WS(2,2) 
      COMMON A,D
      IF (LINE.NE.2HYE) CALL BOARD(LU,L1,L2,WS) 
      IF (LINE.EQ.2HYE) CALL BORD1(LU,L1,L2,WS) 
      DO 10 I=1,8 
      D(I,1,2)=0
10    CONTINUE
      DO 20 I=1,100 
      IF (LINE.NE.2HYE) GO TO 15
      IF (A(I,1).EQ.1) CALL UPDT1(I,1,WS,1,2,1,LU)
      IF (A(I,1).EQ.-1) CALL UPDT1(I,2,WS,1,2,1,LU) 
      GO TO 20
15    IF (A(I,1).EQ.1) CALL UPDAT(I,1,WS,1,2,1,LU)
      IF (A(I,1).EQ.-1) CALL UPDAT(I,2,WS,1,2,1,LU) 
20    CONTINUE
      WRITE(L1,100) IS1,IS2 
100   FORMAT("&a17r55C",I2,"&a19r55C",I2) 
      RETURN
      END 
C 
C 
      SUBROUTINE LIST(MOVES,IMOV,IS1,IS2,L1,L2) 
      DIMENSION MOVES(50,4) 
      INTEGER A(100,5),D(8,5,2) 
      COMMON A,D
      WRITE(6,3999) 
3999  FORMAT(///) 
      WRITE(6,5001) L1,L2 
5001  FORMAT(11X,"LU ",I2,6X,"LU ",I2)
      DO 4001 I=1,IMOV-1
      WRITE(6,4000) I,(MOVES(I,J),J=1,4)
4000  FORMAT(3X,I2,5X,2I3,5X,2I3) 
4001  CONTINUE
      WRITE(6,4002) L1,IS2,L2,IS1 
4002  FORMAT(/,3X,"SCORE -- LU ",I2,I5,"     LU ",I2,I5)
      RETURN
      END 
      END$
^^^  :::::::::: * * *  &XTSUB  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  LOTHEL  * * * ::::::::::  \|/
:* TRANSFER FILE TO LOAD OTHELLO
:OF,OTHEL 
:LG,3 
:MR,%OTHEL::.C
:MR,%OTSUB::.C
:MR,%VALGT::.C
:MR,%SWTCH::.C
:MR,%SCAN::.C 
:MR,%TRACK::.C
:MR,%LKAHD::.C
:RU,LOADR,99,0G,,,3 
:TR 
^^^  :::::::::: * * *  LOTHEL  * * * ::::::::::  ^^^
\|/  :::::::::: * * *  LXTHEL  * * * ::::::::::  \|/
:* TRANSFER FILE TO LOAD TWO PLAYER OTHELLO 
:OF,XTHEL 
:LG,3 
:MR,%XTHEL::188 
:MR,%XTSUB::188 
:MR,%VALGT::188 
:MR,%SCAN::188
:MR,%TRACK::188 
:MR,%LKAHD::188 
:RU,LOADR,99,0G,,,3 
:TR 
^^^  :::::::::: * * *  LXTHEL  * * * ::::::::::  ^^^
