grue@lance.hss.bu.oz (Frobozz) (11/30/89)
hiya,
I'm posting a corrected version of the othello program to the world.
I have re-entered the program from this (corrected) listing and it still
seems to play correctly. Thus, I believe that this version is correct. The
lines that have changed have a '#' in column one. [ there are three changes ]
If there are any residual problems, I'd love to hear about them.
Could the people who enter this program send me mail indicating that
they've done so and perhaps give me some comments as their feeling towards
the program.
As before, the program can be used for an non-profit purpose. Other
usages require my permission (which can be obtained by sending me some mail).
Many thanks to Alan Weiss for finding most of the bugs in the program.
Paul Dale
seeya
SNIF
Language Centre internet : grue@lance.hss.bu.oz{.au}
Bond University JANET : grue%lance.hss.bu.oz@uk.ac.ukc
Gold Coast, Qld 4229 ARPA, bitnet: grue%lance.hss.bu.oz.au@uunet.uu.net
Australia UUCP : ..!uunet!munnari!lance.hss.bu.oz!grue
--------------------------------------------------------------------------------
I suppose I should get round to this bit, the program follows:
PLAY [ A644 ]
<< FAST SETUP "You first?" 4 DISS
IF GETK "Y" == THEN PMOV END
WHILE 3 FC?
REPEAT
"Thinking..." 4 DISS CMOV
IF DUP
THEN 5 CF -1 MKMOV
ELSE DROP2
IF 5 FS?
THEN 3 SF
ELSE 5 SF "Pass" 1 DISS
END
END
IF CCT PCT + 64 == THEN 3 SF END
IF 3 FC? THEN PMOV END
IF CCT PCT + 64 == THEN 3 SF END
END SCOR PCT CCT -
IF DUP 0 < THEN "I win"
ELSE
IF DUP 0 > THEN "You win"
ELSE "Draw"
END
END 1 DISS ABS "by " SWAP ->STR + " disks" + 4 DISS CLEAN
>>
CKPASS [433D]
<< BD NEG 'BD' STO CMOV
IF NOT THEN 7 SF 5 SF END
DROP BD NEG 'BD' STO
>>
GETK [87A]
<< #11CAh SYSEVAL -> sttme
<<
DO
IF #11CAh SYSEVAL sttme - B->R 491520 >
THEN #18E58h SYSEVAL #11CAh SYSEVAL 'sttme' STO
END
UNTIL KEY
END
>>
>>
CMOV [11AD]
<<
IF CCT DUP PCT + 64 SWAP - >
THEN CM1
ELSE CM2
END DUP2 R->C
IF DUP 0 ==
THEN DROP "I pass"
ELSE (1,1) - ->STR "My move " SWAP +
END 1 DISS
>>
CM2 [ 5F79 ]
<< { 10 10 } 0 CON 0 DUP DUP2 -> s maxs x y mct
<< 2 9
FOR a 2 9
FOR b
IF BD a b 2 ->LIST GET -1 ==
THEN -1 -1 fr -1 0 fr -1 1 fr 0 -1 fr 0 1 fr 1 -1 fr 1 0 fr 1 1 fr
END
NEXT
NEXT 2 9
FOR a 2 9
FOR b
IF s a b 2 ->LIST GET DUP
THEN
# IF WTS a b 2 ->LIST GET + DUP maxs DUP2 >
THEN DROP2 a 'x' STO b 'y' STO 'maxs' STO 1 'mct' STO
ELSE
IF ==
THEN 1 mct + 'mct' STO
IF 0 > RAND mct INV < AND
THEN a 'x' STO b 'y' STO
END
END
END
ELSE DROP
END
NEXT
NEXT x y
>>
>>
MKFR [ 1FD4 ]
<< 0 DUP DUP -> s a b
<<
<< 1 -> x y j
<<
WHILE BD a x j * + b y j * + 2 ->LIST GET 1 ==
REPEAT j 1 + 'j' STO
END
IF j 1 > BD a x j * + b y j * + 2 ->LIST GET NOT AND
THEN s a x j * + b y j * + 2 ->LIST DUP2 GET j 1 - + PUT 's' STO
END
>>
>> 'fr' STO
>>
>>
SCOR [ 3CB1 ]
<< " My total= " CCT ->STR + 2 DISS
"Your total= " PCT ->STR + 3 DISS
>>
SDBL [ 9958 ]
<< DUP + DUP + >>
CM1 [ C849 ]
<< 0 DUP DUP2 1 -> maxs curs x y mct
<< 2 9
FOR a 2 9
FOR b
IF BD a b 2 ->LIST GET NOT
THEN 0 'curs' STO -1 -1 ckrun -1 0 ckrun -1 1 ckrun 0 -1 ckrun
0 1 ckrun 1 -1 ckrun 1 0 ckrun 1 1 ckrun
IF curs 0 >
THEN curs WTS a b 2 ->LIST GET +
IF DUP maxs >
THEN 'maxs' STO a 'x' STO b 'y' STO 1 'mct' STO
ELSE
IF maxs == THEN 1 mct + 'mct' STO
IF RAND mct INV <
THEN a 'x' STO b 'y' STO
END
END
END
END
END
NEXT
NEXT x y
>>
>>
PMOV [ C4A8 ]
<< 0 DUP -> c1 c2
<<
WHILE 7 FC?C
REPEAT GETK 'c1' STO c1 1 DISS
IF "1" c1 > "8" c1 < OR
THEN { CKPASS << 3 6 7 SF SF SF >> << CLMF HALT FAST SCR ->LCD SCOR >>
<< #18E58h SYSEVAL >> } "PQHO" c1 POS
IF DUP
THEN GET EVAL 8 SF
ELSE DROP
END
ELSE GETK 'c2' STO c1 c2 + 1 DISS
IF "0" c2 < "9" c2 > AND
THEN c1 STR-> 1 + c2 STR-> 1 +
IF DUP2 2 ->LIST BD SWAP GET NOT
THEN 1 CKMOV
IF 4 FC?C THEN 7 SF END
END
END
END
IF 7 FC? 8 FC?C AND
THEN "Illegal" 1 DISS ERRBELL
END
END
>>
>>
DRWP [ A43D ]
<< -> x y c
<<
IF c 1 == THEN [ 0 5 ] ELSE [ 7 2 ] END
IF y 2 MOD THEN 16 * END
ARRY-> DROP CHR SWAR CHR OVER + + x 4 * 102 + 8 y - 2 / IP 137 * + -> c p
<< SZER 1 p 1 - SUB c + SZER p 3 + 548 SUB + SCR OR DUP 'SCR' STO ->LCD
>>
>>
>>
DISS [ 1F4F ]
<< DISP LCD-> SCR OR ->LCD
>>
FLIPS [ 4112 ]
<< -> x y
<<
IF y 2 MOD THEN 112 ELSE 7 END
CHR DUP DUP + + x 4 * 102 + 8 y - 2 / IP 137 * + -> c p
<< SZER 1 p 1 - SUB c + SZER p 3 + 548 SUB + SCR XOR DUP 'SCR' STO ->LCD
>>
>>
>>
MKMOV [ AC89 ]
<< 0 DUP -> x y c j adj
<< x y 2 ->LIST 'BD' OVER c PUT WTS SWAP GET DUP 30 < SWAP 13 > 2 1 IFTE
10 IFTE 'adj' STO x 1 - y 1 - c DRWP 1
IF c -1 == THEN 'CCT' ELSE 'PCT' END STO+ -1 1
FOR a -1 1
FOR b 1 'j' STO
WHILE BD x a j * + y b j * + 2 ->LIST GET c NEG ==
REPEAT 1 j + 'j' STO
END
IF BD x a j * + y b j * + 2 ->LIST GET c ==
THEN
DO j 1 - 'j' STO
IF 'BD' x a j * + y b j * + 2 ->LIST DUP2 GET c NEG ==
THEN c PUT x a j * + 1 - y b j * + 1 - FLIPS 'PCT' 'CCT'
IF c -1 ==
THEN SWAP
END -1 STO+ 1 STO+
ELSE DROP2 9 SF
END
UNTIL 9 FS?C
END
END
IF c -1 ==
THEN 'WTS' x a + y b + 2 ->LIST DUP2 GET adj + PUT
END
NEXT
NEXT
>> SCOR
>>
CKMOV [ A969 ]
<< 0 -> a b c curs
<< BD NEG 'BD' STO -1 1
FOR p -1 1
FOR q
IF p q OR
THEN p q chrun
END
NEXT
NEXT BD NEG 'BD' STO
IF curs
THEN a b c MKMOV
ELSE 4 SF ERRBELL
END
>>
>>
CLEAN [ BB6A ]
# << CLEAR STK LIST-> DROP FLG STOF
{ BD CCT ckrun FLG fr PCT SCR STK SZER WTS } PURGE
>>
SETUP [ 784 ]
<< FAST RCLF 'FLG' STO HEX DEPTH ->LIST 'STK' STO 2 DUP 'PCT' STO 'CCT' STO
"[[0 0 0 0 0 0 0 0 0 0[0 30 4 15 12 12 15 4 30 0[0 4 2 6 7 7 6 2 4 0[0 15 6 10 9
9 10 6 15 0[0 12 7 9 0 0 9 7 12 0[0 12 7 9 0 0 9 7 12 0[0 15 6 10 9 9 10 6 15 0
[0 4 2 6 7 7 6 2 4 0[0 30 4 15 12 12 15 4 30 0[0 0 0 0 0 0 0 0 0 0"
STR-> 'WTS' STO
"1 9 FOR j j CF NEXT{10 10}0 CON{5 5}1 PUT{5 6}-1 PUT{6 5}-1 PUT{6 6}1 PUT"
STR-> 'BD' STO 0 CHR SDBL DUP SDBL DUP + DUP SDBL SDBL + + 'SZER' STO
SSCR 'SCR' STO MKCR MKFR SCR ->LCD SCOR
>>
MKCR [ E5AD ]
<< 0 DUP DUP -> a b curs
<<
<< 0 1 -> x y scr j
<<
WHILE BD a x j * + b y j * + 2 ->LIST GET 1 ==
REPEAT 1 DUP scr + 'scr' STO j + 'j' STO
END
IF j 1 >
THEN
# IF BD a x j * + b y j * + 2 ->LIST GET -1 ==
THEN scr curs + 'curs' STO
END
END
>>
>> 'ckrun' STO
>>
>>
SSCR [ CB29 ]: This is a screen dump. Create it using the following procedure:
{ 0 .... 0 [ 92 zeros ]
255 0 3 52 67 48 7 112 7 112 7 0 136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0
136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136
0 .... 0 [ 92 zeros ]
255 0 0 0 3 52 67 48 7 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136 32 112 32
136 80 0 80 136 0 0 0 136 0 0 0 136 0 0 0 136
0 .... 0 [ 92 zeros ]
255 0 0 0 119 0 115 4 115 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136 5 0 5
136 2 7 2 136 0 0 0 136 0 0 0 136 0 0 0 136
0 .... 0 [ 92 zeros ]
255 0 0 0 0 7 112 7 0 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0
136 0 0 0 136 0 0 0 136 0 0 0 136 0 0 0 136
}
<< -> L
<< "" 1 L SIZE
FOR j L j GET CHR +
NEXT
>>
>> EVAL 'SSCR' STO
--------------------------------------------------------------------------------