#!/usr/local/bin/wish8.2
# 
# Merlin - a pointless puzzle game
#
# Copyright 1997, Nat Pryce
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
#
# IN NO EVENT SHALL THE AUTHOR BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, 
# SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF 
# THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE AUTHOR HAS BEEN ADVISED 
# OF THE POSSIBILITY OF SUCH DAMAGE.
#
# THE AUTHOR SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING, BUT NOT 
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A 
# PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS" 
# BASIS, AND THE AUTHOR HAS NO OBLIGATION TO PROVIDE  MAINTENANCE, SUPPORT,
# UPDATES, ENHANCEMENTS, OR MODIFICATIONS.


set score_file {~/merlin.score}
#[file join Users np2 Dev Tcl Merlin merlin.sc]

font create Merlin -family Helvetica -size 24

set init_score 16
set reward 7
set penalty -5

set score 0
set level 1
set hiscore $init_score
set hilevel 1

set started 0

proc OpenWindow {} {
    set n 1

    foreach row {0 1 2} {
        foreach col {0 1 2} {
            label .toggle-$n -text $n -font Merlin -relief raised -borderwidth 2 -width 2
            grid .toggle-$n -row $row -column $col -padx 1 -pady 1 -sticky nsew
            incr n
        }
    }

    frame .score
        label .score.sc_title -text "Score: " -anchor w
        label .score.sc_value -textvariable score -anchor e
        label .score.hs_title -text "Hiscore: " -anchor w
        label .score.hs_value -textvariable hiscore -anchor e

        label .score.lv_title -text "Level: " -anchor w
        label .score.lv_value -textvariable level -anchor e
        label .score.hl_title -text "Hilevel: " -anchor w
        label .score.hl_value -textvariable hilevel -anchor e

        grid .score.sc_title -row 0 -column 0 -sticky nsew
        grid .score.sc_value -row 0 -column 1 -sticky nsew
        grid .score.hs_title -row 0 -column 2 -sticky nsew
        grid .score.hs_value -row 0 -column 3 -sticky nsew
        grid .score.lv_title -row 1 -column 0 -sticky nsew
        grid .score.lv_value -row 1 -column 1 -sticky nsew
        grid .score.hl_title -row 1 -column 2 -sticky nsew
        grid .score.hl_value -row 1 -column 3 -sticky nsew

        grid columnconfigure .score 0 -weight 0
        grid columnconfigure .score 1 -weight 1
        grid columnconfigure .score 2 -weight 0
        grid columnconfigure .score 3 -weight 1
    grid .score -row 3 -column 0 -columnspan 3 -sticky nsew

    foreach n {0 1 2} {
        grid rowconfigure . $n -weight 1
        grid columnconfigure . $n -weight 1
    }

    bind .toggle-1 <ButtonPress-1> {Toggle 1 2 4 5}
    bind . <KeyPress-1> {Toggle 1 2 4 5}
    bind .toggle-2 <ButtonPress-1> {Toggle 1 2 3}
    bind . <KeyPress-2> {Toggle 1 2 3}
    bind .toggle-3 <ButtonPress-1> {Toggle 2 3 5 6}
    bind . <KeyPress-3> {Toggle 2 3 5 6}
    bind .toggle-4 <ButtonPress-1> {Toggle 1 4 7}
    bind . <KeyPress-4> {Toggle 1 4 7}
    bind .toggle-5 <ButtonPress-1> {Toggle 2 4 5 6 8}
    bind . <KeyPress-5> {Toggle 2 4 5 6 8}
    bind .toggle-6 <ButtonPress-1> {Toggle 3 6 9}
    bind . <KeyPress-6> {Toggle 3 6 9}
    bind .toggle-7 <ButtonPress-1> {Toggle 4 5 7 8}
    bind . <KeyPress-7> {Toggle 4 5 7 8}
    bind .toggle-8 <ButtonPress-1> {Toggle 7 8 9}
    bind . <KeyPress-8> {Toggle 7 8 9}
    bind .toggle-9 <ButtonPress-1> {Toggle 5 6 8 9}
    bind . <KeyPress-9> {Toggle 5 6 8 9}

    menu .menu -tearoff 0
        menu .menu.game -tearoff 0
	.menu.game add command -label "Skip Level" -underline 0 -accelerator Esc \
		-command SkipLevel
        .menu.game add command -label "Start Again" -underline 6 -command StartGame
        .menu.game add separator
        .menu.game add command -label "Exit" -underline 1 -command ConfirmExit
    .menu add cascade -label Game -menu .menu.game -underline 0
        menu .menu.help -tearoff 0
        .menu.help add command -label "Instructions..." -underline 0 \
        	-accelerator F1 -command ShowHelp
        .menu.help add separator
        .menu.help add command -label "About..." -underline 0 -command ShowAbout
    .menu add cascade -label Help -menu .menu.help -underline 0

    . configure -menu .menu -borderwidth 2 -relief sunken
    wm title . "Merlin"
	wm protocol . WM_DELETE_WINDOW ConfirmExit

    bind . <F1> ShowHelp
    bind . <Escape> SkipLevel

    StartGame
}

# This should be rewritten with a decent random number generator
#
proc InitialiseBoard {} {
    foreach n {1 2 3 4 5 6 7 8 9} {
        if {rand() >= 0.5} {
            .toggle-$n configure -relief raised
        } else {
            .toggle-$n configure -relief sunken
        }
        after 0
    }
}

proc Perform {times delay each_cmd after_cmd} {
    if {$times == 0} {
        eval $after_cmd
    } else {
        eval $each_cmd
        incr times -1
        after $delay [list Perform $times $delay $each_cmd $after_cmd]
    }
}

proc NextLevel {} {
    global score hiscore reward level hilevel
    incr score $reward
	incr level
	if {$level > $hilevel} {
		set hilevel $level
		FlashWidgets .score.hl_title .score.hl_value
	}
    if {$score > $hiscore} {
        set hiscore $score
		expr {srand($hiscore)}
		FlashWidgets .score.hs_title .score.hs_value

        #tk_messageBox -type ok \
        #    -title "High score!" \
        #    -message "You have the high score!"
    }

    InitialiseBoard
    bell
}

proc SkipLevel {} {
	global score penalty level hilevel
	
	incr score $penalty

	if {$score <= 0} {
		set score 0
		GameOverDialog
	} else {
		incr level
		if {$level > $hilevel} {
			set hilevel $level
`			FlashWidgets .score.hl_title .score.hl_value
		}
		InitialiseBoard
		bell
	}
}

proc StartGame {} {
    global score hiscore init_score started level

    set score $init_score
	set level 1
    set started 0

    expr {srand($hiscore)}

    InitialiseBoard
}

proc Toggle {args} {
    global score started

    set started 1

    foreach n $args {
        set w .toggle-$n
        if [string match raised [$w cget -relief]] {
            $w configure -relief sunken
        } else {
            $w configure -relief raised
        }
    }

    incr score -1

    if {[HasCompletedLevel]} {
        Perform 10 100 FlashBoard NextLevel
    } elseif {[HasLost]} {
        GameOverDialog
    }
}


proc HasCompletedLevel {} {
    foreach n {1 2 3 4 5 6 7 8 9} {
        if [string match raised [.toggle-$n cget -relief]] {
            return 0
        }
    }
    return 1
}

proc HasLost {} {
    global score
    return [expr {$score == 0}]
}

proc FlashBoard {} {
    foreach n {1 2 3 4 5 6 7 8 9} {
        if [string match raised [.toggle-$n cget -relief]] {
            .toggle-$n configure -relief sunken
        } else {
            .toggle-$n configure -relief raised
        }
    }
}

proc FlashWidgets {args} {
	Perform 10 100 [list foreach w $args {
		$w configure -background [$w cget -foreground] \
					 -foreground [$w cget -background]
	}] \#
}


proc GameOverDialog {} {
    set choice [tk_messageBox -type yesno -default yes -title "Game Over"\
        -message "You have run out of points!\nDo you want to play again?"]

    switch $choice {
        yes StartGame
        no  Exit
    }
}

proc ConfirmExit {} {
    global started

    if {$started} {
        set choice [tk_messageBox -type yesno -default no -title "Confirm Exit" \
            -message "Do you really want to exit?"]
        switch $choice {
            yes Exit
            no  return
        }
    } else {
        Exit
    }
}

proc ShowHelp {} {
    tk_messageBox -type ok -title "Merlin Help" \
        -message \
{Toggle the buttons with the mouse or number keys.
You have completed the level when all buttons are pushed in.
Each toggle costs one point. You get more points at the start of each level.
The game is over when you run out of points.
Can you get enough points to beat the high score?}
}

proc ShowAbout {} {
    tk_messageBox -type ok -title "About Merlin" \
        -message "Merlin v1.0\nBy Nat Pryce\nJune 1997"
}

proc Exit {} {
	global score_file hiscore hilevel
	if [catch {SaveHiscores} error] {
		tk_messageBox -type ok -icon error -title "Merlin" -message \
			"Failed to save hiscore information: $error"
	}

	exit
}

proc ReadHiscores {} {
	global score_file hiscore hilevel
	
	set f [open $score_file r]
	set hiscore_val [gets $f]
	set hilevel_val [gets $f]
	close $f

	set hiscore $hiscore_val
	set hilevel $hilevel_val
}

proc SaveHiscores {} {
	global score_file hiscore hilevel

	set f [open $score_file w]
	puts $f $hiscore
	puts $f $hilevel
	close $f
}

after 0 {
	catch { ReadHiscores }
    OpenWindow
    StartGame
}

