'===========================================================================
' Subject: REVERSI                            Date: 02-20-96 (15:59)       
'  Author: Peter Cooper                       Code: QB, QBasic, PDS        
'  Origin: comp.lang.basic.misc             Packet: GAMES.ABC
'===========================================================================
'Hello friends!
'I thought I'd be kind and give you all a late christmas present! It is an
'Othello Game and I am releasing it to the Public Domain now. You can do
'anything you want with it, try and learn some tips maybe. The computer can
'be set to try and lose or win but only in the code... There is no AI at all
'but I am working on it.. infact I'm converting it to Pascal\ASM. ;-) 
'The game has been tested on TWO machines this time and it has no sound or
'anything to make it incompatable so it should work! hehe 8-)

'BTW, the next fanzine WILL DEFINATELY be out this next coming weekend, but
'it will probably be on WWW first and so you'll have to look there, it will 
'be on the newsgroups by the following weekend. (March 2nd) I really 
'apologize for the delay in its appearance.

DECLARE SUB StartupStuff ()
DECLARE SUB scrolltext (y%, txt$)
DECLARE SUB cooldisplay (a$)
DECLARE SUB endofgame (red%, green%)
DECLARE SUB cancompgo (x%, y%, canigo%, d%, depth%)
DECLARE SUB compgo (x%, y%)
DECLARE SUB DrawBits ()
DECLARE SUB MoveAround ()
DECLARE FUNCTION validmove% ()
DECLARE SUB ComputerMove ()
DECLARE SUB SetupScreen ()
DECLARE SUB SetupGrid ()
DIM SHARED grid%(1 TO 10, 1 TO 10)
COMMON SHARED gx%, gy%, name1$
gx% = 1: gy% = 1
StartupStuff
SetupGrid
SetupScreen
DO
DrawBits
MoveAround
DrawBits
ComputerMove
LOOP

SUB cancompgo (x%, y%, canigo%, d%, depth%)
DIM dx%(1 TO 8)
DIM dy%(1 TO 8)
dx%(1) = 0: dx%(2) = 1: dx%(3) = 1: dx%(4) = 1: dx%(5) = 0: dx%(6) = -1: dx%(7) = -1: dx%(8) = -1
dy%(1) = -1: dy%(2) = -1: dy%(3) = 0: dy%(4) = 1: dy%(5) = 1: dy%(6) = 1: dy%(7) = 0: dy%(8) = -1
loops% = 0
gotto% = 0
canigo% = 0
redoloops2:

FOR d% = gotto% + 1 TO 8
FOR depth% = 1 TO 10
IF x% + (dx%(d%) * depth%) > 10 OR y% + (dy%(d%) * depth%) > 10 THEN EXIT FOR
IF x% + (dx%(d%) * depth%) < 1 OR y% + (dy%(d%) * depth%) < 1 THEN EXIT FOR
IF grid%(x% + (dx%(d%) * depth%), y% + (dy%(d%) * depth%)) = 2 THEN GOTO found2:
NEXT depth%
NEXT d%
EXIT SUB

found2:

tcou% = 0

FOR d1% = 1 TO depth%
IF grid%(x% + (dx%(d%) * d1%), y% + (dy%(d%) * d1%)) = 1 THEN tcou% = tcou% + 1
NEXT d1%


IF loops% = 8 THEN EXIT SUB
IF tcou% = 0 THEN loops% = loops% + 1: gotto% = d%: GOTO redoloops2:
IF tcou% = depth% - 1 THEN
        canigo% = canigo% + 1
'FOR d1% = 1 TO depth%
'IF grid%(x% + (dx%(d%) * d1%), y% + (dy%(d%) * d1%)) = 2 THEN grid%(x% + (dx%(d%) * d1%), y% + (dy%(d%) * d1%)) = 1
'NEXT d1%
        gotto% = d%
        loops% = loops% + 1
        GOTO redoloops2:

ELSE
        gotto% = d%
        loops% = loops% + 1
        GOTO redoloops2:
END IF


END SUB

SUB compgo (x%, y%)
DIM dx%(1 TO 8)
DIM dy%(1 TO 8)
dx%(1) = 0: dx%(2) = 1: dx%(3) = 1: dx%(4) = 1: dx%(5) = 0: dx%(6) = -1: dx%(7) = -1: dx%(8) = -1
dy%(1) = -1: dy%(2) = -1: dy%(3) = 0: dy%(4) = 1: dy%(5) = 1: dy%(6) = 1: dy%(7) = 0: dy%(8) = -1
loops% = 0
gotto% = 0

redoloops3:

FOR d% = gotto% + 1 TO 8
FOR depth% = 1 TO 10
IF x% + (dx%(d%) * depth%) > 10 OR y% + (dy%(d%) * depth%) > 10 THEN EXIT FOR
IF x% + (dx%(d%) * depth%) < 1 OR y% + (dy%(d%) * depth%) < 1 THEN EXIT FOR
IF grid%(x% + (dx%(d%) * depth%), y% + (dy%(d%) * depth%)) = 2 THEN GOTO found3:
NEXT depth%
NEXT d%
EXIT SUB
found3:
tcou% = 0
FOR d1% = 1 TO depth%
IF grid%(x% + (dx%(d%) * d1%), y% + (dy%(d%) * d1%)) = 1 THEN tcou% = tcou% + 1
NEXT d1%
IF tcou% = 0 THEN loops% = loops% + 1: gotto% = d%: GOTO redoloops3:
IF tcou% = depth% - 1 THEN
        vm% = 1
FOR d1% = 1 TO depth%
IF grid%(x% + (dx%(d%) * d1%), y% + (dy%(d%) * d1%)) = 1 THEN grid%(x% + (dx%(d%) * d1%), y% + (dy%(d%) * d1%)) = 2
NEXT d1%
        gotto% = d%
        loops% = loops% + 1
        vm% = vm% + 1
        GOTO redoloops3:

ELSE
        gotto% = d%
        loops% = loops% + 1
        GOTO redoloops3:
END IF
IF loops% = 8 THEN EXIT SUB

END SUB

SUB ComputerMove
DIM allmoves%(100)
DIM xa%(100)
DIM ya%(100)
FOR a% = 0 TO 100
allmoves%(a%) = 0
NEXT a%
LOCATE 22, 30
PRINT "       "
COLOR 14
nos% = 0
LOCATE 22, 30
PRINT " MY GO"
        FOR delay% = 1 TO 10000
        NEXT delay%
        FOR xx% = 10 TO 1 STEP -1
        FOR yy% = 10 TO 1 STEP -1
        IF grid%(xx%, yy%) = 1 OR grid%(xx%, yy%) = 2 THEN GOTO saddy:
        cancompgo xx%, yy%, c%, d%, depth%
        allmoves%(nos%) = c%
        xa%(nos%) = xx%
        ya%(nos%) = yy%
        nos% = nos% + 1

saddy:
        NEXT yy%
        NEXT xx%

        highp% = 0
        high% = 0
loopagain:
        FOR a% = 0 TO nos%              ' WINNER ALGORITHM
        IF allmoves%(a%) > high% THEN high% = allmoves%(a%) + 1: highp% = a% + 1
        NEXT a%

        'FOR a% = 0 TO nos%              ' LOSER ALGORITHM
        'IF allmoves%(a%) < high% AND allmoves%(a%) <> 0 THEN high% = allmoves%(a%) + 1: highp% = a% + 1
        'NEXT a%
        IF high% > 15 THEN EXIT SUB
        IF highp% = 0 THEN high% = high% + 1: GOTO loopagain:


        IF highp% <> 0 THEN

                compgo xa%(highp% - 1), ya%(highp% - 1)

                grid%(xa%(highp% - 1), ya%(highp% - 1)) = 2
                EXIT SUB
        END IF

LOCATE 22, 30
PRINT "       "
COLOR 14
LOCATE 22, 30
PRINT " I PASS"

END SUB

SUB cooldisplay (a$)
FOR c% = 1 TO 3
LOCATE 21, 9
COLOR 10
PRINT a$
FOR a = 1 TO 1000
NEXT a
LOCATE 21, 9
COLOR 0
PRINT a$
FOR a = 1 TO 1000
NEXT a
NEXT c%
END SUB

SUB DrawBits
freegaps% = 0
red% = 0
green% = 0
FOR x% = 1 TO 10
FOR y% = 1 TO 10
IF grid%(x%, y%) = 1 THEN
        CIRCLE (36 + (x% * 14) - 7, 36 + (y% * 10) - 5), 5, 12
        PAINT (36 + (x% * 14) - 7, 36 + (y% * 10) - 5), 12
        red% = red% + 1
END IF
IF grid%(x%, y%) = 2 THEN
        CIRCLE (36 + (x% * 14) - 7, 36 + (y% * 10) - 5), 5, 10
        PAINT (36 + (x% * 14) - 7, 36 + (y% * 10) - 5), 10
        green% = green% + 1
END IF
IF grid%(x%, y%) = 0 THEN
        freegaps% = freegaps% + 1
END IF
NEXT y%
NEXT x%

IF freegaps% = 0 OR red% = 0 OR green% = 0 THEN
        endofgame red%, green%
END IF
COLOR 12
LOCATE 9, 31
PRINT ":"; red%
COLOR 12
LOCATE 12, 31
PRINT ":"; green%


END SUB

SUB endofgame (red%, green%)
FOR c% = 16 TO 31
WAIT &H3DA, 8                                   ' wait for vertical retrace
LINE (c% * 2, c% * 2)-(320 - c% * 2, 200 - c% * 2), c%, BF' draw
NEXT c%
LINE (31 * 2, 31 * 2)-(320 - 31 * 2, 200 - 31 * 2), 15, B
LINE (31 * 2 + 1, 31 * 2 + 1)-(320 - 31 * 2 - 1, 200 - 31 * 2 - 1), 0, BF
COLOR 14
LOCATE 10, 17
PRINT "Outcome"
LOCATE 12, 16
COLOR 12
IF red% > green% THEN oc$ = "You won"
IF red% = green% THEN oc$ = "You drew!": GOTO lala:
IF red% < green% THEN oc$ = "You lost"
IF ABS(green% - red%) > 20 AND green% <> red% THEN oc$ = oc$ + " by a large margin." ELSE oc$ = oc$ + " by a small margin."
lala:
scrolltext 15, "                      Scores are as follows. " + name1$ + " :" + STR$(red%) + " - Computer :" + STR$(green%) + " This means that " + oc$ + " Press any key to continue_                            "

SCREEN 0
CLS
WIDTH 80, 25
PRINT "Thanks for playing."
SYSTEM

END SUB

SUB MoveAround

LOCATE 22, 30
PRINT "       "
COLOR 14
LOCATE 22, 30
PRINT "YOUR GO"
lp1:
LINE (36 + (gx% * 14) - 14, 36 + (gy% * 10) - 10)-(36 + (gx% * 14), 36 + (gy% * 10)), 0, B

a$ = INKEY$
IF a$ = "" THEN GOTO lp1:

LINE (36 + (gx% * 14) - 14, 36 + (gy% * 10) - 10)-(36 + (gx% * 14), 36 + (gy% * 10)), 15, B

IF LEFT$(a$, 1) = CHR$(0) THEN
        q$ = RIGHT$(a$, 1)
        IF q$ = "K" AND gx% <> 1 THEN gx% = gx% - 1
        IF q$ = "M" AND gx% <> 10 THEN gx% = gx% + 1
        IF q$ = "P" AND gy% <> 10 THEN gy% = gy% + 1
        IF q$ = "H" AND gy% <> 1 THEN gy% = gy% - 1
END IF
IF a$ = "P" THEN
        cooldisplay "    Passing"
        EXIT SUB
END IF
IF a$ = CHR$(13) THEN

a% = validmove%
        IF grid%(gx%, gy%) = 1 OR grid%(gx%, gy%) = 2 THEN
                        cooldisplay "Already occupied"
                        GOTO lp1:
        END IF
        IF a% >= 1 THEN
                grid%(gx%, gy%) = 1
        ELSE
                cooldisplay "Invalid move"
        GOTO lp1:
        END IF

        EXIT SUB
END IF
IF a$ = "q" THEN
         grid%(gx%, gy%) = 1
        EXIT SUB
END IF
IF a$ = "w" THEN
         grid%(gx%, gy%) = 2
        EXIT SUB
END IF
IF a$ = "e" THEN endofgame 2, 2
GOTO lp1:
END SUB

SUB scrolltext (y%, txt$)
' 9 - 32 widths
c% = 1
COLOR 11
DO
LOCATE 15, 9
PRINT MID$(txt$, c%, 23)
c% = c% + 1
a$ = INKEY$
IF a$ = " " THEN EXIT SUB
FOR delay% = 1 TO 25000: NEXT delay%
FOR delay% = 1 TO 25000: NEXT delay%
IF MID$(txt$, c%, 1) = "_" THEN
LOCATE 15, 9
PRINT SPACE$(23)
EXIT SUB
END IF
LOOP
END SUB

SUB SetupGrid
FOR x% = 1 TO 10
FOR y% = 1 TO 10
grid%(x%, y%) = 0               ' set all grid positions to 0
NEXT y%
NEXT x%
grid%(5, 5) = 1
grid%(6, 6) = 1
grid%(6, 5) = 2
grid%(5, 6) = 2

END SUB

SUB SetupScreen
SCREEN 13
FOR c% = 16 TO 35
WAIT &H3DA, 8                                   ' wait for vertical retrace
LINE (c%, c%)-(212 - c%, 171 - c%), c%, BF       ' draw
NEXT c%
LINE (210, 20)-(310, 180), 25, B
LINE (211, 21)-(309, 179), 28, B
LINE (212, 22)-(308, 178), 31, B
LINE (212, 164)-(308, 164), 15
LINE (212, 50)-(308, 50), 15
COLOR 10
LOCATE 4, 29
PRINT "Current"
LOCATE 6, 33
PRINT "Score "
COLOR 11
LOCATE 8, 29
PRINT name1$
LOCATE 11, 29
PRINT "CPU"

 
x1% = 36
y1% = 36
x2% = 213 - 37
y2% = 180 - 37
d% = 10
xl% = x2% - x1%
yl% = y2% - y1%
xd% = xl% \ d%
yd% = yl% \ d%
oy% = y1%
ox% = x1%
FOR x% = 1 TO d% + 1
LINE (ox%, y1%)-(ox%, y2% - 8), 15
ox% = ox% + xd%
NEXT x%
FOR y% = 1 TO d% + 1
LINE (x1%, oy%)-(x2%, oy%), 15
oy% = oy% + yd%
NEXT y%
LOCATE 2, 11
COLOR 12
PRINT "Reversi"
COLOR 15
END SUB

SUB StartupStuff
SCREEN 0
WIDTH 80, 25
INPUT "Players name:", name1$
END SUB

FUNCTION validmove%
DIM dx%(1 TO 8)
DIM dy%(1 TO 8)
dx%(1) = 0: dx%(2) = 1: dx%(3) = 1: dx%(4) = 1: dx%(5) = 0: dx%(6) = -1: dx%(7) = -1: dx%(8) = -1
dy%(1) = -1: dy%(2) = -1: dy%(3) = 0: dy%(4) = 1: dy%(5) = 1: dy%(6) = 1: dy%(7) = 0: dy%(8) = -1
loops% = 0
gotto% = 0

redoloops:

FOR d% = gotto% + 1 TO 8
FOR depth% = 1 TO 10
IF gx% + (dx%(d%) * depth%) > 10 OR gy% + (dy%(d%) * depth%) > 10 THEN EXIT FOR
IF gx% + (dx%(d%) * depth%) < 1 OR gy% + (dy%(d%) * depth%) < 1 THEN EXIT FOR
IF grid%(gx% + (dx%(d%) * depth%), gy% + (dy%(d%) * depth%)) = 1 THEN GOTO found:
NEXT depth%
NEXT d%
EXIT FUNCTION
found:
tcou% = 0
FOR d1% = 1 TO depth%
IF grid%(gx% + (dx%(d%) * d1%), gy% + (dy%(d%) * d1%)) = 2 THEN tcou% = tcou% + 1
NEXT d1%
IF loops% = 8 THEN EXIT FUNCTION
IF tcou% = 0 THEN loops% = loops% + 1: gotto% = d%: GOTO redoloops:
IF tcou% = depth% - 1 THEN
        validmove% = 1
FOR d1% = 1 TO depth%
IF grid%(gx% + (dx%(d%) * d1%), gy% + (dy%(d%) * d1%)) = 2 THEN grid%(gx% + (dx%(d%) * d1%), gy% + (dy%(d%) * d1%)) = 1
NEXT d1%
        gotto% = d%
        loops% = loops% + 1
        
        GOTO redoloops:

ELSE
        gotto% = d%
        loops% = loops% + 1
        GOTO redoloops:
END IF
END FUNCTION