#
# short intro
#
# game "memory": the player is supposed N pairs of pictures with the
# least possible amount of tries. We thus keep track of:
# s the current status of the pictures
#   0 backside up
#   1 front up
#   2 permanently open
# i the array of pictures used for this game
#   (varies with each reshufflement)
# l the current level (translates into N)
# h which pictures have been "hit", ie selected by the player
# r the refresh rate
#
# the application needs to
# * reshuffle --> generate new i
# * find matching --> check/modify status
# * change level --> keep track of l and reshuffle
# * show help text
# * change refresh rate
# * keep track of best player
#

# turn logging on
#web::logfilter add memory.-debug
#web::logdest add memory.-debug file [file join / tmp websh memory.log]

# config: map level number to X-Y dimensions
set _levels(1) [list 1 2]
set _levels(2) [list 1 4]
set _levels(3) [list 2 5]
set _levels(4) [list 3 6]
set _levels(5) [list 4 7]
set _levels(6) [list 5 8]
set _levels(7) [list 6 9]

# setup file context
web::filecontext mctx -path /tmp/websh/%s.ctx
if {![file exists /tmp/websh/memory.ctx]} {
    catch {
	# make sure context directory exists
	# (note: in a production environment you make sure that this exists 
	# at install time. You don't want to create that directory with every request)
	file mkdir /tmp/websh
	# hack ot make the filecontext work
	close [open /tmp/websh/memory.ctx w]
    }
}

# formatLink -- helper function to generate hrefs
proc formatLink {url {show ""}} {

    if {$show == ""} { set show $url }
    return "<a href=\"$url\">$show</a>"
}

# putLink -- helper function to output links
proc putLink {url {show ""}} {

    web::put [formatLink $url $show]
}

# putLinkHtmlified -- helper function to output links
proc putLinkHtmlified {url show} {

    web::put [formatLink $url [web::htmlify $show]]
}

# commandList -- add "commands" line to HTML page
proc commandList {} {


    web::put "<tt>"

    putLinkHtmlified [web::cmdurl decrementLevel] "<"
    web::put " | "

    putLinkHtmlified [web::cmdurl incrementLevel] ">"
    web::put " | "

    putLinkHtmlified [web::cmdurl reset] "x"
    web::put " | "

    putLinkHtmlified [web::cmdurl new] new
    web::put " | "

    putLinkHtmlified [web::cmdurl help] "?"
    web::put " | "

    putLinkHtmlified [web::cmdurl incrRefreshTime] "+"
    web::put " | "

    putLinkHtmlified [web::cmdurl decrRefreshTime] "-"

    # load hall of fame
    mctx::init memory

    # get the lowest number of tries for this level from the session context
    # why do I use web::cmdurlcfg here instead of web::param ?
    # I do not want to bother about the level when I generate a URL
    # using web::cmdurl - I keep it in the static parameters (managed
    # by web::cmdurlcfg).
    set best [mctx::cget hof([web::cmdurlcfg l]) "n/a"]

    web::put "&nbsp;&nbsp;(level: [web::cmdurlcfg l], [web::cmdurlcfg c] tries, best: $best)"
    web::put "</tt>\n"

    web::put "<br>\n"
}

# page -- helper function to produce an  HTML page
proc page {title code} {

    # HTML header stuff
    web::put "
	<html>
	<head>
	  <title>$title</title>
        </head>
        <body bgcolor=\"#ffffff\">
    "
    web::put "<br>\n"

    # depends on the caller
    uplevel 1 $code

    # add list of commands
    web::put "<hr>\n"
    commandList

    # footer and end-of-HTML
    web::put "
	<hr><font size=\"-2\"><tt>
	[web::config version]</tt></font><br>
	</BODY>
        </HTML>
    "
}

# table -- helper function to output a HTML table
proc table {code} {

    web::put {<table border="0" cellspacing="0" cellpadding="0">}
    web::put "\n"

    uplevel 1 $code
    web::put "\n</table>\n"
}

# tablerow --
proc tablerow {code {bgcolor {}}} {
    if {[string length $bgcolor] } {
	web::put "<tr bgcolor=\"$bgcolor\">\n"
    } else {
	web::put "<tr>\n"
    }
    uplevel 1 $code
    web::put "\n</tr>\n"
}

# tablecell --
proc tablecell {code} {

    web::put "<td>\n"
    uplevel 1 $code
    web::put "\n</td>\n"
}

# image --
proc image {gif} {

    set res "<img src=\"/websh/images/memory/$gif\" width=\"50\" height=\"50\" vspace=\"0\" hspace=\"0\""
    append res "border=\"1\" ALIGN=\"middle\">"
    return $res
}


# validateImg -- check current game status
proc validateImg {vImg vStatus} {

    global _levels

    upvar $vImg img
    upvar $vStatus status


    # no images - this calls for a new game. Reshuffle.
    if { [string length $img] < 2} {

	# reset try counter
	web::cmdurlcfg -set c 0

	# get current level
	set tmp $_levels([web::cmdurlcfg l])

	# reshuffle (number of images depends on level)
	set numImg [expr ([lindex $tmp 0] * [lindex $tmp 1]) / 2]

	for {set i 0} {$i < $numImg} {incr i} {

	    set timg [format %2.2d $i]

	    # for this image, generate two random numbers which will
	    # determine the position of the image in the game

	    while {1} {
		set r1 [expr rand()]
		if { ![info exists shuffle($r1)] } { break }
	    }

	    while {1} {
		set r2 [expr rand()]
		if { ![info exists shuffle($r2)] } { break }
	    }

	    set shuffle($r1) $timg
	    set shuffle($r2) $timg
	}

	# compile string which describes game outline
	set img ""

	foreach tmp [array names shuffle] {

	    append img $shuffle($tmp)
	}

	# and set status of every image to "closed"
	set status [string repeat "0" [expr {$numImg * 2}]]
    }
}

# listOpen -- helper function to list currently open pictures
proc listOpen {vStatus {val 1}} {

    upvar $vStatus status

    set i 0
    set res ""
    foreach tmp [split $status ""] {

	if { $tmp == $val } {lappend res $i}
	incr i
    }
    return $res
}

# countOpen -- helper to count all pictures that have a given status
proc countOpen {vStatus {val 1}} {

    upvar $vStatus status

    set res [listOpen status $val]
    return [llength $res]
}


# doMatch -- helper to decide if two selected images match
proc doMatch {vImg vOpens} {

    upvar $vImg img
    upvar $vOpens opens

    set img1 [getImageFromArray img [lindex $opens 0]]
    set img2 [getImageFromArray img [lindex $opens 1]]

    if {[string equal $img1 $img2]} {

	set res [list 1]
	lappend res [lindex $opens 0]
	lappend res [lindex $opens 1]

    } else {

	set res [list 0]
	lappend res [lindex $opens 0]
	lappend res [lindex $opens 1]
    }
    return $res
}

# getImageFromArray -- helper to extract two letters from string
proc getImageFromArray {vImg pos} {

    upvar $vImg img

    return [string range $img [expr {$pos * 2}] [expr {$pos * 2 + 1}]]
}

# getStat -- helper to pick status for a given picture
proc getStat {vStatus pos} {

    upvar $vStatus status

    return [string index $status $pos]
}

# setStat -- set status
proc setStat {vStatus pos {new 0}} {

    upvar $vStatus status

    set res [string range $status 0 [expr $pos - 1]]
    set res $res$new
    set res $res[string range \
		     $status [expr {$pos + 1}] [string length $status]]
    set status $res
}

# toggleStat -- toggle status: switch 0->1 or 1->0, but keep 2 at 2
proc toggleStat {vStatus pos} {

    upvar $vStatus status

    set cur [getStat status $pos]


    if {$cur == 0} {
	setStat status $pos 1
    } elseif { $cur == 2 } {
	setStat status $pos 2
    } else {
	setStat status $pos 0
    }
}


# findMatching -- see if the user did find two matching images
proc findMatching {vImg vStatus} {

    upvar $vImg img
    upvar $vStatus status

    # in case only one is open, we prevent closing it again
    set tmp [listOpen status 1]
    set onlyone -1
    if { [llength $tmp] == 1 } {

	set onlyone [lindex $tmp 0]
    }


    # which ones are selected ?
    set hitlst [web::param h]
    foreach tmp $hitlst {

	# if it is not the single one that is already open, flip it
	if {$tmp != $onlyone} {
	    toggleStat status $tmp
	}
    }

    # now, how many are open, really ?
    set opens [listOpen status]
    set Nopen [llength $opens]

    # more than two open ? (no tricks !)
    if { $Nopen > 2 } {

	foreach tmp $opens {
	    setStat status $tmp 0
	}

    } elseif { $Nopen == 2 } {

	# get current try counter (or 0 if not set) ...
	set tmp [web::cmdurlcfg c 0]
	# ... and increment it and store it back as static parameter
	web::cmdurlcfg -set c [incr tmp]

	# do the two selected pictures match ?
	set tmp [doMatch img opens]

	if { [lindex $tmp 0] == 1 } {

	    # yes, open permanently
	    setStat status [lindex $tmp 1] 2
	    setStat status [lindex $tmp 2] 2


	} else {

	    # no. use the refresh feature

	    set opens [listOpen status]

	    # add img and status as static parameters
	    # (ensure that we have status and img in the URL)
	    web::cmdurlcfg -set s $status
	    web::cmdurlcfg -set i $img

	    # for refresh: simulate clicks on the two open pictures
	    # that will close them
	    set tmp [web::cmdurl "" [list h [lindex $opens 0] h [lindex $opens 1]]]

	    # add the HTTP "refresh" header, using the parameter r for the
	    # refresh time (using 2 sec as default)
	    web::response -set Refresh "[web::cmdurlcfg r 2];URL=$tmp"
	}
    }

    # add img and status as static parameters
    # (ensure that we have status and img in the URL)
    web::cmdurlcfg -set s $status
    web::cmdurlcfg -set i $img
}

# display table with memory
proc showMemory {} {

    global _levels
    global _cache

    # get current status from URL
    set status [web::param s]

    # get current game outline from URL
    set img [web::param i]

    # asses status of game
    validateImg img status

    # do we have any matching images ?
    findMatching img status

    # no more closed ? --> game over --> perhaps we need to update hof
    if { [countOpen status 0] == 0} {

	mctx::init memory
	set best [mctx::cget hof([web::cmdurlcfg l]) -1]

	if { ($best == -1) ||
	     ([web::cmdurlcfg c] < $best) } {
	    mctx::cset hof([web::cmdurlcfg l]) [web::cmdurlcfg c]
	    mctx::commit
	}
    }

    # get X-Y dimension for game outline from level
    set tmp $_levels([web::cmdurlcfg l 5])
    set numX [lindex $tmp 0]
    set numY [lindex $tmp 1]

    # output HTML page
    page "memory game" {

	# output HTML table
	table {

	    # table rows
	    for {set i 0} {$i < $numX} {incr i} {

		tablerow {

		    for {set j 0} {$j < $numY} {incr j} {

			set tmpCnt [expr {$i * $numY + $j}]

			set timg [getImageFromArray img $tmpCnt]

			set curImgStat [getStat status $tmpCnt]

			# table cells

			tablecell {

			    if {$curImgStat == 0} {

				# show backside
				#
				# actually, it is a link back to the CGI app,
				# recursion of some sort.
				#
				# from parameter h, showMemory will know which
				# picture the player did select
				putLink [web::cmdurl "" h $tmpCnt] \
				    [image back.gif]

			    } elseif {$curImgStat == 2} {

				# two matching found - no link any more, just the image
				web::put [image $timg.jpg]

			    } else {

				# show front side
				putLink [web::cmdurl "" h $tmpCnt] \
				    [image $timg.jpg]
			    }
			}
		    }
		}
	    }
	}
    }
}

# web::command help -- display help text
web::command help {

    page "memory game - help text" {

	web::put "<tt>"
	web::put "Memory -- find the matching images."
	web::put "<p>"
	web::put "You can see the hidden image by clicking on its back side. "
	web::put "When you have found two matching images, they will remain open "
	web::put "from then on. If two images do not match, they will be "
	web::put "closed again."
	web::put "<p>"
	web::put "If the images close again too quickly on your system, "
	web::put "you can make the images stay open longer with the "
	web::put "&quot;+&quot; command (&quot;-&quot; to close them "
	web::put "more quickly)."
	web::put "<p>"
	web::put "&quot;new&quot; shuffels the images again. "
	web::put "&quot;&times;&quot; restarts the game from the beginning."
	web::put "</tt><p>"
    }
}


# web::command decrementLevel -- reduce level and show game
web::command decrementLevel {

    # I do not want to have to bother about the level when I generate
    # URLs using web::cmdurl. So, I put level to the static parameters
    # and let web::dispatch track it.
    # That's why web::cmdurlcfg is used here, instead of web::param.

    set level [web::cmdurlcfg l 5]
    if {$level > 1} {incr level -1}
    web::cmdurlcfg -set l $level

    # changing the level implies resetting the game
    web::param -set i ""

    showMemory
}

# web::command incrementLevel -- increase level and show game
web::command incrementLevel {

    set level [web::cmdurlcfg l 5]
    if {$level < 7} {incr level}
    web::cmdurlcfg -set l $level

    # changing the level implies resetting the game
    web::param -set i ""

    showMemory
}

# web::command incrRefreshTime -- increase refresh time
web::command incrRefreshTime {

    set r [web::cmdurlcfg r 2]
    if {$r < 30} {incr r 2}
    web::cmdurlcfg -set r $r

    showMemory
}

# web::command decrRefreshTime -- decrease refresh time
web::command decrRefreshTime {

    set r [web::cmdurlcfg r 2]
    if {$r > 2} {incr r -2}
    web::cmdurlcfg -set r $r

    showMemory
}

# web::command new -- new game on the same level (reshuffle)
web::command new {

    web::param -set i ""

    showMemory
}

# web::command reset -- back to the defaults
web::command reset {

    web::param -set i ""
    web::cmdurlcfg -set l 5

    showMemory
}

# web::command default -- if nothing is specified, use this one
web::command default {

    showMemory
}

# web::dispatch -- decide which command to call
#
# here, we use the tracking feature of dispatch. Whenever dispatch
# finds a parameter from the -track list, it copies it over to the
# static parameters
#
# also, we use -hook to execute code just before web::dispatch will
# call the web::command command. Here, we set the default level to 5
# if it is not yet known.
web::dispatch -track [list l c r] -hook {web::cmdurlcfg -set l [web::cmdurlcfg l 5]}

# cleanup context after the request (prevent session crosstalk)
mctx::delete