/* Connect 4, by Joey Robert
 * Backup Final Project for ICS 3M1 - May 19 - 20/2006
 */
% VARIABLE DECLARATION
const ROWS := 6
const COLUMNS := 7

var Pieces : array 1 .. ROWS, 1 .. COLUMNS of int
var Names : array 1 .. 2 of string
var Score : array 1 .. 2 of real := init (0, 0)
var counter, Focus, Turn, Value, FontVar : int
var PlayAgain : string (1)

FontVar := Font.New ("sans serif:10:Bold")

% FUNCTION/PROCEDURE DECLARATION

procedure TurnColour (player, rule : int)
    var Holder : string
    if player = 1 then
        drawfillbox (0, maxy - 40, maxx, maxy - 25, red)
    elsif player = 2 then
        drawfillbox (0, maxy - 40, maxx, maxy - 25, blue)
    end if
    if rule = 1 then
        Holder := Names (1) + ": " + realstr (Score (1), 0) + "  " + Names (2) + ": " + realstr (Score (2), 0)
        Draw.Text (Holder, 4, maxy - 37, FontVar, white)
    end if
end TurnColour

/* Format for Position: 21
 * 2 as in Row, 1 as in Column
 */
procedure DisplayScreen
    for i : 1 .. ROWS
        for j : 1 .. COLUMNS
            if Pieces (i, j) = 1 then
                drawfilloval ((50 * j), (50 * i), 20, 20, red)
            elsif Pieces (i, j) = 2 then
                drawfilloval ((50 * j), (50 * i), 20, 20, blue)
            else
                drawfilloval ((50 * j), (50 * i), 20, 20, gray)
            end if

        end for
        Draw.Text (intstr (i), 8, (50 * i) - 4, FontVar, black)
    end for
    for i : 1 .. COLUMNS
        Draw.Text (intstr (i), (50 * i) - 4, 8, FontVar, black)
    end for
end DisplayScreen

procedure RawInsert (player : int)
    var x, y, btnNumber, btnUpDown : int
    Mouse.ButtonWait ("up", x, y, btnNumber, btnUpDown)
    Value := ((x + 25) div 50)
end RawInsert

procedure Insert (player : int)
    put Names (player), ", Select a column to input it in."
    RawInsert (player)
    loop
        if Value > COLUMNS or Value < 1 then
            cls
            TurnColour (player, 1)
            DisplayScreen
            put Names (player), ", Incorrect Selection. Choose Again."
            RawInsert (player)
        elsif Pieces (ROWS, Value) not= 0 then
            cls
            TurnColour (player, 1)
            DisplayScreen
            put Names (player), ", Row is full. Choose Again."
            RawInsert (player)
        else
            exit
        end if
    end loop
    for i : 1 .. ROWS
        if Pieces (i, Value) = 0 then
            Pieces (i, Value) := player
            counter := i
            Music.PlayFile ("check.WAV")
            exit
        end if
    end for

    for decreasing j : ROWS .. 1 + counter
        if player = 1 then
            drawfilloval ((50 * Value), (50 * j), 20, 20, red)
        elsif player = 2 then
            drawfilloval ((50 * Value), (50 * j), 20, 20, blue)
        end if
        delay (50)
        drawfilloval ((50 * Value), (50 * j), 20, 20, gray)
    end for
end Insert

% Rules = 0 to exclude k, 1 to add k, and -1 to minus k.
function RawLineCheck (player, istart, iend, jstart, jend, rule1, rule2 : int) : boolean
    for i : istart .. iend
        for j : jstart .. jend
            counter := 0
            for k : 0 .. 3
                if Pieces (i + (rule1 * k), j + (rule2 * k)) = player then
                    counter := counter + 1
                end if
                if counter = 4 then
                    result true
                end if
            end for
        end for
    end for
    result false
end RawLineCheck

% Result 0 = NO WIN
% Result 1 = Win
% FYI - The reason it minus's 3 for the for loops is because you can't
% connect 4 if there is only 3 spaces available.
function LineCheck (player : int) : int
    if RawLineCheck (player, 1, ROWS, 1, COLUMNS - 3, 0, 1) then % HORIZONTAL
        result 1
    elsif RawLineCheck (player, 1, ROWS - 3, 1, COLUMNS, 1, 0) then % VERTICAL
        result 1
    elsif RawLineCheck (player, 1, ROWS - 3, 1, COLUMNS - 3, 1, 1) then % DIAGONAL /
        result 1
    elsif RawLineCheck (player, 1, ROWS - 3, 4, COLUMNS, 1, -1) then % DIAGONAL \
        result 1
    else
        counter := 0
        for i : 1 .. COLUMNS
            if Pieces (ROWS, i) not= 0 then
                counter := counter + 1
            end if
        end for
        if counter = COLUMNS then
            result 2
        end if
    end if
    result 0
end LineCheck

procedure ClearBoard
    for j : 1 .. ROWS
        for k : 1 .. COLUMNS
            Pieces (j, k) := 0
        end for
    end for
end ClearBoard

% GAME CODE
ClearBoard
setscreen ("graphics:400;400, nobuttonbar")
Turn := 1
TurnColour (1, 0)
DisplayScreen
put "What is Player One's Name?"
get Names (1)
cls
TurnColour (2, 0)
DisplayScreen
put "What is Player Two's Name?"
get Names (2)
loop
    cls
    DisplayScreen
    TurnColour (Turn, 1)
    Insert (Turn)
    cls
    if LineCheck (Turn) = 1 then
        DisplayScreen
        TurnColour (Turn, 1)
        put Names (Turn), " Wins! Play Again? (n to exit)"
        Score (Turn) := Score (Turn) + 1
        delay (100)
    elsif LineCheck (Turn) = 2 then
        DisplayScreen
        TurnColour (Turn, 1)
        put "Draw Game! Play Again? (n to exit)"
        Score (1) := Score (1) + 0.5
        Score (2) := Score (2) + 0.5
        delay (100)
    end if
    if LineCheck (Turn) not= 0 then
        getch (PlayAgain)

        if PlayAgain = 'n' then
            exit
        else
            ClearBoard
        end if
    end if
    if Turn = 1 then
        Turn := 2
    elsif Turn = 2 then
        Turn := 1
    end if
end loop