' !! Save this source as OTHELLO.BAS !!

'Program      : Othello
'Programmer   : Lawrence Law
'Starting date: 31-1-1996
'Last update  : 12-3-1996 (1-10-196)

DECLARE SUB Drawscreen ()
DECLARE SUB Delay (second AS SINGLE)
DECLARE SUB Initial ()
DECLARE SUB Main ()
DECLARE SUB Message ()
DECLARE SUB Putblock (x AS INTEGER, y AS INTEGER, c AS INTEGER)
DECLARE SUB Putone (x AS INTEGER, y AS INTEGER, c AS INTEGER)
DECLARE SUB Winmessage ()
DECLARE FUNCTION Checking% (x AS INTEGER, y AS INTEGER)
DECLARE FUNCTION Computer$ (x AS INTEGER, y AS INTEGER, c AS INTEGER)
DECLARE FUNCTION Counting% (xpos AS INTEGER, ypos AS INTEGER, Checkcolor AS INTEGER)
DECLARE FUNCTION Most% (x AS INTEGER, y AS INTEGER, c AS INTEGER)
DECLARE FUNCTION Player$ (x AS INTEGER, y AS INTEGER, oldx AS INTEGER, oldy AS INTEGER, xsize AS INTEGER, ysize AS INTEGER)

OPTION BASE 1
CONST White = 15, Black = 0

'Define location of board and its size
DIM SHARED dx AS INTEGER, dy AS INTEGER, xsize AS INTEGER, ysize AS INTEGER
    dx = 300: dy = 40: xsize = 8: ysize = 8
    xsize = (xsize \ 2) * 2
    ysize = (ysize \ 2) * 2

'Define colour of board
DIM SHARED fcolor AS INTEGER, bcolor AS INTEGER, pcolor AS INTEGER
DIM SHARED blockcolor AS INTEGER
    fcolor = 1: bcolor = 2: pcolor = 9: blockcolor = 14

DIM SHARED Board(xsize, ysize) AS INTEGER, Directions(8, 2) AS INTEGER
'----------------- X ------------------- Y ----Directions----
Directions(1, 1) = 0: Directions(1, 2) = -1    'Up
Directions(2, 1) = 1: Directions(2, 2) = -1    'Up & Right
Directions(3, 1) = 1: Directions(3, 2) = 0     'Rigth
Directions(4, 1) = 1: Directions(4, 2) = 1     'Down & Right
Directions(5, 1) = 0: Directions(5, 2) = 1     'Down
Directions(6, 1) = -1: Directions(6, 2) = 1    'Down & Left
Directions(7, 1) = -1: Directions(7, 2) = 0    'Left
Directions(8, 1) = -1: Directions(8, 2) = -1   'Up & Left

DIM SHARED Turns AS INTEGER, Level AS INTEGER
DIM SHARED Players(2) AS STRING * 1, Names(2) AS STRING

DO
    Initial
    SCREEN 12

    FOR i = 1 TO xsize
        FOR j = 1 TO ysize
            Board(i, j) = -1
        NEXT j
    NEXT i
    Board(xsize / 2, ysize / 2) = White
    Board(xsize / 2 + 1, ysize / 2 + 1) = White
    Board(xsize / 2, ysize / 2 + 1) = Black
    Board(xsize / 2 + 1, ysize / 2) = Black

    RANDOMIZE TIMER
    Chance = INT(RND * 100 + 1)
    IF Chance MOD 2 = 1 THEN SWAP Names(1), Names(2): SWAP Players(1), Players(2)


    Drawscreen
    Main

    LOCATE 28: PRINT "Play again?(y/n)"
    DO
        Ans$ = LCASE$(INPUT$(1))
    LOOP UNTIL Ans$ = "y" OR Ans$ = "n"
LOOP UNTIL Ans$ = "n"

FUNCTION Checking% (x AS INTEGER, y AS INTEGER)
DIM cx AS INTEGER, cy AS INTEGER
DIM Check AS INTEGER, Count AS INTEGER, Checkcolor AS INTEGER

Check = 0: Count = 0
IF Turns = White THEN
    Checkcolor = Black
ELSE

    Checkcolor = White
END IF

FOR i = 1 TO 8
    cx = x
    cy = y
    Count = 0
    DO
        cx = cx + Directions(i, 1)
        cy = cy + Directions(i, 2)
        IF cx < 1 OR cx > xsize OR cy < 1 OR cy > ysize THEN
            Count = 0
            EXIT DO
        END IF
        IF Board(cx, cy) = Checkcolor THEN
            Count = Count + 1
        ELSE
            IF Board(cx, cy) = -1 THEN Count = 0
            EXIT DO
        END IF
    LOOP
    IF Count > 0 THEN
        Check = Check + 1
        cx = x
        cy = y
        FOR j = 1 TO Count
            cx = cx + Directions(i, 1)
            cy = cy + Directions(i, 2)
            Board(cx, cy) = Turns
            Putone cx, cy, Turns
        NEXT j
    END IF
NEXT i

IF Check > 0 THEN Checking = -1 ELSE Checking = 0
END FUNCTION

FUNCTION Computer$ (x AS INTEGER, y AS INTEGER, c AS INTEGER)

DIM Checkcolor AS INTEGER, Sum AS INTEGER, Done AS INTEGER, Check AS INTEGER
DIM sx AS INTEGER, sy AS INTEGER, i AS INTEGER, j AS INTEGER
IF Turns = White THEN
    Checkcolor = Black
ELSE
    Checkcolor = White
END IF

Done = 0: Stack = 0: Sum = 0
   
'See if the corners can be put

FOR i = 1 TO xsize STEP xsize - 1
    FOR j = 1 TO ysize STEP ysize - 1
        IF Board(i, j) = -1 THEN
            Check = Counting(i, j, Checkcolor)
            IF Check > Sum THEN
                Sum = Check: sx = i: sy = j
            END IF
        END IF
    NEXT j
NEXT i
IF Sum > 0 THEN x = sx: y = sy: Done = 1

IF Level = 2 THEN
    'See if the borders can be put
    FOR i = 1 TO xsize STEP xsize - 1
        FOR j = 2 TO ysize - 1
            IF Board(i, j) = -1 THEN
                Check = Counting(i, j, Checkcolor)
                IF Check > Sum THEN
                    Sum = Check: sx = i: sy = j
                END IF
            END IF
        NEXT j
    NEXT i
    FOR j = 1 TO ysize STEP ysize - 1
        FOR i = 2 TO xsize - 1
            IF Board(i, j) = -1 THEN
                Check = Counting(i, j, Checkcolor)
                IF Check > Sum THEN
                    Sum = Check: sx = i: sy = j
                END IF
            END IF
        NEXT i
    NEXT j
   
    IF Sum = 0 THEN
        FOR i = 2 TO xsize - 1
            FOR j = 2 TO ysize - 1
                IF NOT (i = 2 AND j = 2) THEN
                IF NOT (i = 2 AND j = ysize - 1) THEN
                IF NOT (i = xsize - 1 AND j = 2) THEN
                IF NOT (i = xsize - 1 AND j = ysize - 1) THEN
                    IF Board(i, j) = -1 THEN
                        Check = Counting(i, j, Checkcolor)
                        IF Check > Sum THEN
                            Sum = Check: sx = i: sy = j
                        END IF
                    END IF
                END IF
                END IF
                END IF
                END IF
            NEXT j
        NEXT i
    END IF
    IF Sum > 0 THEN
        x = sx: y = sy: Done = 1
    END IF
END IF

IF Level = 1 OR Done <> 1 THEN
    Sum = Most(x, y, Checkcolor)
END IF

IF Sum > 0 THEN Computer$ = CHR$(13) ELSE Computer$ = "p"

END FUNCTION

FUNCTION Counting% (xpos AS INTEGER, ypos AS INTEGER, Checkcolor AS INTEGER)
DIM cx AS INTEGER, cy AS INTEGER, Count AS INTEGER, Stack AS INTEGER

Count = 0: Stack = 0
FOR i = 1 TO 8
    cx = xpos + Directions(i, 1)
    cy = ypos + Directions(i, 2)
    DO
        IF cx < 1 OR cx > xsize OR cy < 1 OR cy > ysize THEN
            Count = 0
            EXIT DO
        END IF
        IF Board(cx, cy) = Checkcolor THEN
            Count = Count + 1
        ELSE
            IF Board(cx, cy) = -1 THEN
                Count = 0
            END IF
            EXIT DO
        END IF
        cx = cx + Directions(i, 1)
        cy = cy + Directions(i, 2)
    LOOP
    Stack = Stack + Count
NEXT i
Counting = Stack

END FUNCTION

SUB Delay (second AS SINGLE)
    DIM oldtime AS SINGLE
    oldtime = TIMER
    DO
    LOOP UNTIL TIMER - oldtime > second
END SUB

SUB Drawscreen

CLS
LOCATE 4: PRINT "Level "; LTRIM$(STR$(Level))

LINE (dx - 10, dy - 10)-STEP(xsize * 30 + 20, ysize * 30 + 20), 7, BF
LINE (dx - 11, dy - 12)-STEP(xsize * 30 + 22, 0), 15, BF
LINE (dx - 10, dy - 11)-STEP(xsize * 30 + 20, 0), 15, BF
LINE (dx - 12, dy - 11)-STEP(0, ysize * 30 + 22), 15, BF
LINE (dx - 11, dy - 10)-STEP(0, ysize * 30 + 20), 15, BF
LINE (dx - 10, dy + ysize * 30 + 11)-STEP(xsize * 30 + 20, 0), 8, BF
LINE (dx - 11, dy + ysize * 30 + 12)-STEP(xsize * 30 + 22, 0), 8, BF
LINE (dx + ysize * 30 + 11, dy - 10)-STEP(0, ysize * 30 + 20), 8, BF
LINE (dx + ysize * 30 + 12, dy - 11)-STEP(0, ysize * 30 + 22), 8, BF

LINE (dx - 5, dy - 5)-STEP(xsize * 30 + 10, ysize * 30 + 10), bcolor, BF
FOR i = 1 TO ysize + 1
    LINE (dx, dy + i * 30 - 30)-STEP(xsize * 30, y), fcolor
NEXT i
FOR i = 1 TO ysize + 1
    LINE (dx + i * 30 - 30, dy)-STEP(x, ysize * 30), fcolor
NEXT i
FOR i = 0 TO 1
    FOR j = 0 TO 1
        CIRCLE (dx + xsize / 2 * 30 - 30 + i * 60, dy + ysize / 2 * 30 - 30 + j * 60), 2, pcolor
        PAINT (dx + xsize / 2 * 30 - 30 + i * 60, dy + ysize / 2 * 30 - 30 + j * 60), pcolor
    NEXT j
NEXT i

Putone xsize / 2, ysize / 2, White
Putone xsize / 2 + 1, ysize / 2 + 1, White
Putone xsize / 2, ysize / 2 + 1, Black

Putone xsize / 2 + 1, ysize / 2, Black

END SUB

SUB Initial

SCREEN 0
CLS
PRINT STRING$(80, 177)
PRINT CHR$(177); SPC(31); ">>> OTHELLO! <<<";
PRINT SPC(31); CHR$(177)
PRINT STRING$(80, 177)
PRINT SPC(28); "How many player?(1 or 2)"
DO
    Ans$ = INPUT$(1)
LOOP UNTIL Ans$ = "1" OR Ans$ = "2"
DO
    PRINT SPC(20);
    INPUT "Input name of player 1 :", Names(1)
LOOP UNTIL LTRIM$(RTRIM$(Names(1))) <> ""
Players(1) = "P"
IF Ans$ = "2" THEN
    DO
        PRINT SPC(20);
        INPUT "Input name of player 2 :", Names(2)
    LOOP UNTIL LTRIM$(RTRIM$(Names(2))) <> ""
    Players(2) = "P"
ELSE
    Names(2) = "Cyperpunk"
    Players(2) = "C"
    PRINT SPC(18); "What is the level that you want? (1 to 2) :"
    DO
        Level = VAL(INPUT$(1))
    LOOP UNTIL Level > 0 AND Level < 3
END IF

END SUB

SUB Main

DIM x AS INTEGER, y AS INTEGER, oldx AS INTEGER, oldy AS INTEGER
DIM Counter AS INTEGER, Allowed AS INTEGER, Halt AS INTEGER, Passtimes AS INTEGER
    x = xsize / 2: y = ysize / 2: oldx = x: oldy = y: Halt = 0: Passtimes = 0
    Turns = White: Counter = 4
Putblock x, y, blockcolor

Message
DO
    IF Passtimes > 1 THEN
        Halt = 1
        Key$ = CHR$(27)
    END IF
    IF Halt = 0 THEN
        SELECT CASE Turns
            CASE White
                IF Players(1) = "P" THEN
                    oldx = x: oldy = y
                    Key$ = Computer$(x, y, White)
                    x = oldx: y = oldy
                    IF Key$ <> "p" THEN Key$ = Player$(x, y, oldx, oldy, xsize, ysize)
                ELSE
                    'Computer takes part
                    Key$ = Computer$(x, y, Turns)
                    Putblock oldx, oldy, bcolor
                    oldx = x: oldy = y
                    Putblock x, y, 14
                    Delay .5
                END IF
  
            CASE Black
                IF Players(2) = "P" THEN
                    oldx = x: oldy = y
                    Key$ = Computer$(x, y, Black)
                    x = oldx: y = oldy
                    IF Key$ <> "p" THEN Key$ = Player$(x, y, oldx, oldy, xsize, ysize)
                ELSE
                    'Computer takes part
                    Key$ = Computer$(x, y, Turns)
                    Putblock oldx, oldy, bcolor
                    oldx = x: oldy = y
                    Putblock x, y, 14
                    Delay .5
                END IF
        END SELECT
    END IF

    SELECT CASE Key$
        CASE "P", "p"
            Passtimes = Passtimes + 1
            IF Turns = White THEN Turns = Black ELSE Turns = White
       
        CASE CHR$(13), CHR$(32)
            IF Board(x, y) = -1 THEN
                'Check if it's allowed here
                Allowed = Checking(x, y)
                IF Allowed THEN
                    Passtimes = 0
                    Board(x, y) = Turns
                    Putone x, y, Turns

                    IF Turns = White THEN Turns = Black ELSE Turns = White
                    Counter = Counter + 1
                END IF
            END IF
    END SELECT
    Message
LOOP UNTIL Key$ = CHR$(27) OR Counter = xsize * ysize
Winmessage
END SUB

SUB Message
    LOCATE 1, 1: PRINT "Now is ";
    IF Turns = White THEN
        PRINT Names(1); "'s turn."; SPACE$(10)
        PRINT "White"
    ELSE
        PRINT Names(2); "'s turn."; SPACE$(10)
        PRINT "Black"
    END IF
END SUB

FUNCTION Most% (x AS INTEGER, y AS INTEGER, Checkcolor AS INTEGER)
DIM sx AS INTEGER, sy AS INTEGER, xpos AS INTEGER, ypos AS INTEGER
DIM Check AS INTEGER, Stack AS INTEGER

Check = 0
FOR xpos = 1 TO xsize
    FOR ypos = 1 TO ysize
        IF Board(xpos, ypos) = -1 THEN
            Stack = Counting(xpos, ypos, Checkcolor)
            IF Stack > Check THEN Check = Stack: sx = xpos: sy = ypos
        END IF
    NEXT ypos
NEXT xpos

IF Check > 0 THEN x = sx: y = sy
Most = Check
END FUNCTION

FUNCTION Player$ (x AS INTEGER, y AS INTEGER, oldx AS INTEGER, oldy AS INTEGER, xsize AS INTEGER, ysize AS INTEGER)
DIM pass AS INTEGER
    pass = 0
DO
    DO
        k$ = INKEY$
    LOOP UNTIL k$ <> ""
  
    SELECT CASE k$
        CASE CHR$(nul) + CHR$(72)  'Up
            y = y - 1
            IF y < 1 THEN y = ysize
            pass = 1
        CASE CHR$(nul) + CHR$(80)  'Down
            y = y + 1
            IF y > ysize THEN y = 1
            pass = 1
        CASE CHR$(nul) + CHR$(75)  'Left
            x = x - 1
            IF x < 1 THEN x = xsize
            pass = 1
        CASE CHR$(nul) + CHR$(77)  'Right
            x = x + 1
            IF x > xsize THEN x = 1
            pass = 1
    END SELECT
   
    IF pass THEN
        Putblock oldx, oldy, bcolor
        Putblock x, y, blockcolor
        oldx = x: oldy = y
        pass = 0
    END IF

LOOP UNTIL k$ = CHR$(13) OR k$ = CHR$(32) OR LCASE$(k$) = "p" OR k$ = CHR$(27)

Player$ = k$
END FUNCTION

SUB Putblock (x AS INTEGER, y AS INTEGER, c AS INTEGER)
    LINE (dx + x * 30 - 28, dy + y * 30 - 28)-STEP(26, 26), c, B
END SUB

SUB Putone (x AS INTEGER, y AS INTEGER, c AS INTEGER)
    CIRCLE (dx + x * 30 - 15, dy + y * 30 - 15), 12, c
    PAINT (dx + x * 30 - 15, dy + y * 30 - 15), c
END SUB

SUB Winmessage
DIM Whitecounter AS INTEGER, Blackcounter AS INTEGER
FOR i = 1 TO xsize
    FOR j = 1 TO ysize
        SELECT CASE Board(i, j)
            CASE White
                Whitecounter = Whitecounter + 1
            CASE Black
                Blackcounter = Blackcounter + 1

        END SELECT
    NEXT j
NEXT i

LOCATE 26
PRINT "White = "; Whitecounter, "Black = "; Blackcounter
SELECT CASE Whitecounter - Blackcounter
    CASE IS > 0
        PRINT Names(1); " win!!!"
    CASE IS < 0
        PRINT Names(2); " win!!!"
    CASE 0
        PRINT "Nobody win."
END SELECT

END SUB