'
' This is a remake of Color Lines, AKA Clines - http://en.wikipedia.org/wiki/Color_Lines
' 
' July 2013 - PvE.
'
' Version 1.0: Initial release
' Version 1.1: Improved end game detection
' Version 1.2: Adapted for BaCon 3.0 and higher
' Version 1.3: Improved gameplay
'--------------------------------------------------------------

INCLUDE "hug.bac", INIT, HUGOPTIONS, WINDOW, CANVAS, FRAME, ATTACH, DISPLAY, SQUARE, LINE, \
    CIRCLE, CALLBACK, MOUSE, TIMEOUT, STOCK, QUIT, SHOW, HIDE, MSGDIALOG, FRAME, TEXT, MARK, PROPERTY

OPTION BASE 1

CONST PATH_VAL = 100
CONST EMPTY = 0

DECLARE field[10][10]
DECLARE org_x, org_y, Score, Hiscore

'--------------------------------------------------------------

SUB Clear_Field

    LOCAL x, y

    FOR y = 1 TO 10
        FOR x = 1 TO 10
            field[x][y] = EMPTY
        NEXT
    NEXT

END SUB

'--------------------------------------------------------------

SUB Print_Field

    LOCAL x, y

    SQUARE("#000000", 0, 0, 399, 399, FALSE)

    FOR x = 0 TO 400 STEP 40
        LINE("#000000", x, 0, x, 400)
        LINE("#000000", 0, x, 400, x)
    NEXT

    FOR y = 1 TO 10
        FOR x = 1 TO 10
            IF field[x][y] > 15 THEN
                SQUARE("#FFFF00", (x-1)*40+1, (y-1)*40+1, 38, 38, TRUE)
            ELSE
                SQUARE("#FFFFFF", (x-1)*40+1, (y-1)*40+1, 38, 38, TRUE)
            ENDIF

            SELECT (field[x][y] & 15)
                CASE 1
                    CIRCLE("#0000FF", (x-1)*40+2, (y-1)*40+2, 36, 36, TRUE)
                    CIRCLE("#000000", (x-1)*40+2, (y-1)*40+2, 36, 36, FALSE)
                CASE 2
                    CIRCLE("#00FF00", (x-1)*40+2, (y-1)*40+2, 36, 36, TRUE)
                    CIRCLE("#000000", (x-1)*40+2, (y-1)*40+2, 36, 36, FALSE)
                CASE 3
                    CIRCLE("#FF0000", (x-1)*40+2, (y-1)*40+2, 36, 36, TRUE)
                    CIRCLE("#000000", (x-1)*40+2, (y-1)*40+2, 36, 36, FALSE)
                CASE 4
                    CIRCLE("#FF00FF", (x-1)*40+2, (y-1)*40+2, 36, 36, TRUE)
                    CIRCLE("#000000", (x-1)*40+2, (y-1)*40+2, 36, 36, FALSE)
                CASE 5
                    CIRCLE("#FFFF00", (x-1)*40+2, (y-1)*40+2, 36, 36, TRUE)
                    CIRCLE("#000000", (x-1)*40+2, (y-1)*40+2, 36, 36, FALSE)
                CASE 6
                    CIRCLE("#888888", (x-1)*40+2, (y-1)*40+2, 36, 36, TRUE)
                    CIRCLE("#000000", (x-1)*40+2, (y-1)*40+2, 36, 36, FALSE)
            END SELECT
        NEXT
    NEXT

END SUB

'--------------------------------------------------------------

FUNCTION Find_Connection(NUMBER x, NUMBER y, NUMBER p, NUMBER q)

    IF x = p AND y = q THEN RETURN TRUE

    IF x < 1 OR x > 10 OR y < 1 OR y > 10 OR field[x][y] = 2 THEN RETURN FALSE

    IF field[x][y] <> EMPTY THEN RETURN FALSE

    field[x][y] = PATH_VAL

    IF Find_Connection(x+1, y, p, q) THEN RETURN TRUE
    IF Find_Connection(x-1, y, p, q) THEN RETURN TRUE
    IF Find_Connection(x, y+1, p, q) THEN RETURN TRUE
    IF Find_Connection(x, y-1, p, q) THEN RETURN TRUE

    RETURN FALSE

END FUNCTION

'--------------------------------------------------------------

FUNCTION Find_Path(NUMBER x, NUMBER y, NUMBER p, NUMBER q)

    LOCAL result

    result = FALSE

    IF Find_Connection(x+1, y, p, q) THEN result = TRUE
    IF Find_Connection(x-1, y, p, q) THEN result = TRUE
    IF Find_Connection(x, y+1, p, q) THEN result = TRUE
    IF Find_Connection(x, y-1, p, q) THEN result = TRUE

    FOR y = 1 TO 10
        FOR x = 1 TO 10
            IF field[x][y] = PATH_VAL THEN field[x][y] = EMPTY
        NEXT
    NEXT

    RETURN result

END FUNCTION

'--------------------------------------------------------------

FUNCTION Init_Game

    LOCAL x, xpos, ypos

    Clear_Field

    FOR x = 1 TO 3
        REPEAT
            xpos = RANDOM(10)+1
            ypos = RANDOM(10)+1
        UNTIL field[xpos][ypos] = 0
        field[xpos][ypos] = RANDOM(5)+1
    NEXT

    Print_Field
    Score = 0
    TEXT(mark1, "0")

    RETURN FALSE

END FUNCTION

'--------------------------------------------------------------

FUNCTION Check_Five

    LOCAL x, y, val, org, result, count

    result = FALSE

    ' Horizontal 5 or more
    FOR y = 1 TO 10
        org = 0
        count = 0
        FOR x = 1 TO 10
            val = field[x][y]
            IF val = org THEN
                INCR count
            ELSE
                org = val
                count = 0
            END IF

            IF count > 3 AND org > 0 THEN
                FOR z = x TO x-count STEP -1
                    field[z][y] = EMPTY
                NEXT
                INCR Score, (count+1)*10
                TEXT(mark1, STR$(Score))
                result = TRUE
            END IF
        NEXT
    NEXT

    ' Vertical 5 or more
    FOR x = 1 TO 10
        org = 0
        count = 0
        FOR y = 1 TO 10
            val = field[x][y]
            IF val = org THEN
                INCR count
            ELSE
                org = val
                count = 0
            END IF

            IF count > 3 AND org > 0 THEN
                FOR z = y TO y-count STEP -1
                    field[x][z] = EMPTY
                NEXT
                INCR Score, (count+1)*10
                TEXT(mark1, STR$(Score))
                result = TRUE
            END IF
        NEXT
    NEXT

    RETURN result

END FUNCTION

'--------------------------------------------------------------

FUNCTION Check_Space(NUMBER spaces)

    LOCAL x, y, total

    ' Check on empty space
    FOR x = 1 TO 10
        FOR y = 1 TO 10
            IF field[x][y] = EMPTY THEN INCR total
        NEXT
    NEXT

    ' No space left, end game   
    IF total < spaces THEN
        SHOW(End_Dialog)
        IF Hiscore < Score THEN
            Hiscore = Score
            OPEN GETENVIRON$("HOME") & "/.clines.txt" FOR WRITING AS hs
                WRITELN STR$(Score) TO hs
            CLOSE FILE hs
            TEXT(mark2, STR$(Hiscore))
            SHOW(Hi_Dialog)
        END IF
        RETURN FALSE
    END IF

    RETURN TRUE

END FUNCTION

'--------------------------------------------------------------

SUB New_Balls

    LOCAL xpos, ypos

    ' Check space for 3 new balls
    IF Check_Space(3) THEN
        FOR x = 1 TO 3
            REPEAT
                xpos = RANDOM(10)+1
                ypos = RANDOM(10)+1
            UNTIL field[xpos][ypos] = 0
            field[xpos][ypos] = RANDOM(6)+1
        NEXT

        Check_Five
        Print_Field
    END IF

    ' Check space for player
    Check_Space(1)

END SUB

'--------------------------------------------------------------

SUB User_Click

    LOCAL xpos, ypos

    xpos = MOUSE(0) / 40 + 1
    ypos = MOUSE(1) / 40 + 1

    IF field[xpos][ypos] > 0 THEN
        field[org_x][org_y] = (field[org_x][org_y] & 15)
        org_x = xpos
        org_y = ypos
        INCR field[org_x][org_y], 16
    ELSE
        IF org_x <> 0 OR org_y <> 0 THEN
            IF Find_Path(org_x, org_y, xpos, ypos) THEN
                field[xpos][ypos] = (field[org_x][org_y] & 15)
                field[org_x][org_y] = EMPTY
                IF NOT(Check_Five()) THEN
                    New_Balls
                END IF
                org_x = 0
                org_y = 0
            ELSE
                SHOW(Error_Dialog)
            END IF
        END IF
    END IF

    Print_Field

END SUB

'--------------------------------------------------------------

SUB Show_Help

    SHOW(Help_Dialog)

END SUB

'-----------------------------------------------------------------------------------

SUB Close_Dlg(NUMBER widget)

    HIDE(widget)

    IF widget = End_Dialog THEN SHOW(New_Dialog)

END SUB

'-----------------------------------------------------------------------------------

SUB Handle_New(NUMBER dialog, int button)

    HIDE(dialog)

    IF button = GTK_RESPONSE_YES THEN
        Init_Game
    ELSE
        QUIT
    END IF

END SUB

'-----------------------------------------------------------------------------------

INIT

HUGOPTIONS("NOSCALING")

win = WINDOW("Color Lines", 420, 465)
PROPERTY(win, "icon-name", "gtk-about")

frame = FRAME(410, 410)
ATTACH(win, frame, 5, 5)

canvas = CANVAS(400, 400)
ATTACH(win, canvas, 10, 10)
CALLBACK(canvas, User_Click)

exitbutton = STOCK("gtk-quit", 90, 40)
ATTACH(win, exitbutton, 325, 420)
CALLBACK(exitbutton, QUIT)

helpbutton = STOCK("gtk-help", 90, 40)
ATTACH(win, helpbutton, 230, 420)
CALLBACK(helpbutton, Show_Help)

' Create help dialog
txt$ = "       This is a remake of the classic 'Clines' game." & NL$ & NL$ \
& "Goal is to get 5 or more stones of the same color in a row." & NL$ \
& "Move existing stones by clicking on it, and then by clicking" & NL$ \
& "    on the new position. No barrier may be in between!" & NL$ & NL$ \
& "                What highscore can you reach?"
Help_Dialog = MSGDIALOG(txt$, -1, -1, 0, 2)
CALLBACK(Help_Dialog, Close_Dlg)

Error_Dialog = MSGDIALOG("Cannot move that stone because there is a barrier in between!", -1, -1, 1, 2)
CALLBACK(Error_Dialog, Close_Dlg)

End_Dialog = MSGDIALOG("Game has finished!", -1, -1, 0, 2)
CALLBACK(End_Dialog, Close_Dlg)

Hi_Dialog = MSGDIALOG("Congratulations! You have reached a new high score!", -1, -1, 0, 2)
CALLBACK(Hi_Dialog, Close_Dlg)

New_Dialog = MSGDIALOG("Want to play another game?", -1, -1, 2, 4)
CALLBACK(New_Dialog, Handle_New)

'Score frame
frame1 = FRAME(95, 40)
TEXT(frame1, " Score ")
ATTACH(win, frame1, 5, 420)
mark1 = MARK("0", 85, 30)
ATTACH(win, mark1, 10, 430)

'Hiscore frame
frame2 = FRAME(95, 40)
TEXT(frame2, " High Score ")
ATTACH(win, frame2, 105, 420)
mark2 = MARK("0", 85, 30)
ATTACH(win, mark2, 110, 430)

' Get former hiscore
IF FILEEXISTS(GETENVIRON$("HOME") & "/.clines.txt") THEN
    OPEN GETENVIRON$("HOME") & "/.clines.txt" FOR READING AS hs
        READLN High_Score$ FROM hs
    CLOSE FILE hs
    TEXT(mark2, High_Score$)
    Hiscore = VAL(High_Score$)
END IF

TIMEOUT(50, Init_Game)

DISPLAY