#!/usr/dist/bin/wishx -f

######################################################################
#
# dontspaceMenus.tcl
#
# Copyright (C) 1993,1994 by John Heidemann <johnh@ficus.cs.ucla.edu>
# All rights reserved.  See the main dontspace file for a full copyright
# notice.
#
# $Id: dontspaceMenus.tcl,v 2.14 1997/01/27 21:19:00 johnh Exp $
#
# from: Id: klondikeMenus.tcl,v 1.17 1994/01/27 18:49:11 johnh Exp
#
######################################################################

#
# menu stuff
#
set rcsid(dontspaceMenus.tcl) {$Id: dontspaceMenus.tcl,v 2.14 1997/01/27 21:19:00 johnh Exp $}

global tk_version tkMenuOffset
if {$tk_version < 4.0} {
	set tkMenuOffset 0
} else {
	tk_bisque
	set tkMenuOffset 1
}
proc menuOffset {n} {
	global tk_version tkMenuOffset
	return [expr $n + $tkMenuOffset]
}

proc mkMenus {} {
	global table menu helpMenuList game score

	frame .menu -relief raised -borderwidth 1

	set table(release) [readRelease]

	#
	# Do bindings like Netscape:  bind to both Alt-X and Meta-X.
	# Also, the underlines seem to be broken.  Sigh.
	#
	menubutton .menu.file -text "Game" -menu .menu.file.m -underline 0
	menu .menu.file.m
	.menu.file.m add command -label "New" \
		-command "menuNewGame" -accelerator "^n" -underline 0
	addToMenuBindings "n" menuNewGame
	.menu.file.m add command -label "Old Game" \
		-command "menuOldGame" -accelerator "^o" -underline 0
	addToMenuBindings "o" menuOldGame
	.menu.file.m add command -label "Give Up" \
		-command "menuFinishGame" -accelerator "^g" -underline 0
	addToMenuBindings "g" menuFinishGame
	.menu.file.m add command -label "Pause" \
		-command "menuPauseGame" -accelerator "^p" -underline 0
	addToMenuBindings "p" menuPauseGame
	.menu.file.m add separator
	.menu.file.m add command -label "High Scores..." \
		-command "menuHighScores" -underline 0
	.menu.file.m add separator
	.menu.file.m add command -label "Quit" \
		-command "menuQuit" -accelerator "^q" -underline 0
	addToMenuBindings "q" menuQuit

	menubutton .menu.options -text "Options" \
		-menu .menu.options.m -underline 0
	menu .menu.options.m

	# Use -command instead of -variable because
	# -variable brakes "trace variable..." (as of Tk 3.6).
	# Sigh.  We have to have -variable and -value to get
	# grouping to work.
	.menu.options.m add radiobutton -label "No Scoring" -underline 0 \
		-command {global game; set game(scoreMethod) non-scored} \
		-variable game(scoreMethod) -value non-scored
	.menu.options.m add radiobutton -label "Unofficial Scoring" -underline 0 \
		-command {global game; set game(scoreMethod) unofficial} \
		-variable game(scoreMethod) -value unofficial
	.menu.options.m add radiobutton -label "Official Scoring" -underline 0 \
		-command {global game; set game(scoreMethod) official} \
		-variable game(scoreMethod) -value official
	.menu.options.m add separator
	.menu.options.m add radiobutton -label "Always Show Scores" \
		-value always -variable score(showScoresWhen) -underline 0
	.menu.options.m add radiobutton -label "High Score Shows Scores" \
		-value high -variable score(showScoresWhen) -underline 0
	.menu.options.m add radiobutton -label "Don't show scores" \
		-value never -variable score(showScoresWhen) -underline 0

	# # backFace is already set
	# .menu.options.m add cascade -label "Card Back" \
	# 	-menu .menu.options.m.back -underline 5
	# menu .menu.options.m.back
	# foreach i $table(backChoices) {
	# 	.menu.options.m.back add radiobutton \
	# 		-label $i \
	# 		-value $i -variable table(backChoice) \
	# 		-command setBackBitmap
	# }

	mkHelp
	menubutton .menu.help -text "Help" \
		-menu .menu.help.m -underline 0
	menu .menu.help.m
	.menu.help.m add command -label "Rules..." \
		-command "menuHelp rules" -underline 0
	.menu.help.m add command -label "Interface..." \
		-command "menuHelp interface" -underline 0
	.menu.help.m add command -label "Scoring..." \
		-command "menuHelp scoring" -underline 0
	.menu.help.m add command -label "Release notes..." \
		-command "menuHelp release" -underline 0
	.menu.help.m add separator
	.menu.help.m add command -label "About..." \
		-command "menuHelp about" -underline 0
	set helpWindowList {rules interface scoring release about}


	set padValue [expr $table(padValue)/2]
	pack .menu.file -side left -padx $padValue
	pack .menu.options -side left -padx $padValue

	pack .menu.help -side right -padx $padValue

	tk_menuBar .menu .menu.file .menu.options .menu.help

	endGameChangeMenus

	return .menu
}

proc addToMenuBindings {key menu} {
	global game
#	lappend game(menuBindings) [list "<Alt-$key>" $menu]
	lappend game(menuBindings) [list "<Meta-$key>" $menu]
	lappend game(menuBindings) [list "<Control-$key>" $menu]
}

proc mkMenuBindings args {
	global game tk_version
	set default 0
	# puts $game(menuBindings)
	foreach i $args {
		if { $i == "-default" } { set default 1; continue }
		tk_bindForTraversal $i
		foreach j $game(menuBindings) {
			bind $i [lindex $j 0] [lindex $j 1]
		}
		if {$tk_version < 4.0} { focus $i }
		if { $default && $tk_version < 4.0 } { focus default $i }
	}
}

proc mkHelp {} {
	global help rcsid table
	set help(rules) {\
<big>The Layout</big>

When you start the game, you will see the basic layout of Dontspace solitaire in the game window:  four <italic>spaces</italic> in the upper left corner, the four <italic>foundations</italic> to the upper right corner, and the eight columns of the <italic>tableau</italic> below them.

When the game begins all fifty-two cards are dealt face-up on to the tableau.

<big>The Game</big>

The object of the game is to move all the cards to the foundations.  Each foundation builds upward, in sequence, from the ace to the king.  Only aces may be moved to an empty foundation, and only the next higher card of the same suit can be added to a foundation.

The spaces in the upper left corner of the board each hold a single card.  The spaces are good places to store cards temporary to reveal other cards on the tableau.

Cards on the tableau are played in descending sequence of alternating colors (or shades on a black and white display).  For example, only the 9 of hearts or diamonds (``red'' suits) may play on the 10 of spades (a ``black'' suit).  At the game beginning the cards are dealt randomly onto the tableau, not following this rule, but once the game begins all future moves on the tableau must be red-black and descending.

The rules allow only one card to move at a time.  Moving one card at a time makes for a lot of repetitive motion, so the computer automatically breaks moves of stacks of cards into a sequence of individual moves.  Moves of multiple cards therefore require sufficient room (empty spaces or tableau columns) to complete each of the intermediate moves.  Of course, all intermediate moves must be legal.  If there is insufficient space for all cards of a stack it will be impossible to drag or drop a stack of cards.

<big>Winning</big>

Without scoring, the game is over when all cards are placed on the foundations.

To make scored games more interesting, scored games are completed when all cards on the tableau are arranged in descending sequences.  This means you don't have to go through the then trivial exercise of moving each card to the foundation, but you also don't get the points for doing so.
}
	set help(interface) {\
<big>Cards</big>

Cards which can be moved will highlight when beneath the mouse cursor.  Move cards about the screen by clicking and dragging with the left button.

A double-click on a card will send it to the foundation, if possible.

<big>Menus</big>

The File menu allows games to be started (New Game) and completed (in a way) with ``Give Up''.  You can also replay old games if you give the computer the seed word, but such games are not scored.  It may be useful to pause the game (for example, if your advisor wants to ask you why this stack won't move).  While paused your score will not decay, but you cannot see the cards.  Finally, you can show the high score list (in case you don't see it enough already).

The Options menu allows you set the scoring method and how frequently that high score list appears.

The Help menu lists various explanatory text which is probably far to complicated to explain.
}
	set help(scoring) {\
<big>Scoring</big>

The game is scores much like a video game, including a penalty for slow play.  Scores are accumulated as follows:

<italic>Plus</italic>

10 points--Adding a card to the foundations, either from the deck or the tableau.  Maximum: 520 points. 

2 points--Placing a card on the tableau in the correct order for the first time.  Maximum: 104 points.

Maximum available: 520 points.

<italic>Minus</italic>

-2 points--Each 15 seconds of elapsed time.

In addition, a <italic>Winning Bonus</italic> is calculated as follows:

[ ( End of game score ) - ( 1 point per card moved) ]  times 10.

The game is won when all cards are on the foundations.

Since the maximum end of game score is 624 points (assuming you took no time to win the game), the largest conceivable bonus is 6240 points.
}
	set ids ""
	foreach i [array names rcsid] {
		set ids "$ids$rcsid($i)\n"
	}
	set help(release) "\
<big>Dontspace $table(release)</big>

<big>New Features</big>

First network release.

Games are replayable based on a keyword.

<big>Known Bugs</big>

The proper name for the game should really by dontntspace, but that's too hard to pronounce.

Card hilighting is sometimes broken.

Centering the new score in the high score lists is off.

The game is slow--I'm liberal with variable names, comments, and whitespace, all of which slows down the Tcl interpreter.

<big>Desired Features</big>

Keyboard control (in progress).

Sound would be nice.

A Tcl optimizer which would convert my verbose code into optimized code (short variable names, no comments or extra whitespace) would be great.  The alternative is a post-alpha TkPerl.

When playing on a small screen, card overlap should adjust as needed.  The cards should spread out when possible.

<big>Jacoby--the big picture</big>

Dontspace is intended to be one of a family of Tk-based solitaire games.  It's a descendent of Klondike; eventually these two programs (and others) will share the same source code base.

The name for this family of programs is ``Jacoby'' after Oswald Jacoby, a noted bridge player.

<big>Dontspace--the hidden agenda</big>

Unix has a number of strong technical features, however other operating systems often recieve much more press.  Since operating-systems vendors have begun to ship games as a standard part of their operating systems (and perhaps as the most enjoyed part, at that), dontspace, together with klondike and xbomb, represent my attempt to keep Unix feature-for-feature equivalent with other operating systems.
"

	set help(about) "\
<big>Dontspace $table(release)</big>

Copyright (C) 1993-1994 by John Heidemann
All rights reserved.
Comments to <computer><johnh@ficus.cs.ucla.edu></computer>

Card bitmaps by Gary Sager, <computer><75270.1453@compuserve.com></computer> from the Macintosh game <italic>Video Poker...NOT!</italic>.  Used with permission.

Game rules are modeled after Microsoft's game FreeSpace, designed and implemented by some faceless Seattle programmer.  I'd like to properly credit the original developer, should he or she come forward.
"
}


proc beginGameChangeMenus {} {
	.menu.file.m entryconfigure [menuOffset 2] -state normal
	.menu.file.m entryconfigure [menuOffset 3] -state normal
	.menu.options.m entryconfigure [menuOffset 0] -state disabled
	.menu.options.m entryconfigure [menuOffset 1] -state disabled
	.menu.options.m entryconfigure [menuOffset 2] -state disabled
}

proc endGameChangeMenus {} {
	.menu.file.m entryconfigure [menuOffset 2] -state disabled
	.menu.file.m entryconfigure [menuOffset 3] -state disabled
	.menu.options.m entryconfigure [menuOffset 0] -state normal
	.menu.options.m entryconfigure [menuOffset 1] -state normal
	.menu.options.m entryconfigure [menuOffset 2] -state normal
}


proc menuNewGame {} {
	endGame "quit"
	.menu.options.m entryconfigure [menuOffset 2] -state normal
	mkNewGame
}


proc menuOldGame {} {
	global table game tk_version

	set padValue $table(padValue)

	set w ".oldGame"
	catch {unmenuHelp $w}

	toplevel $w -relief raised -bd 3
	wmConfig $w "Dontspace--Game Selection"
	wm transient $w .
	grab set $w

	set halfPad [expr $padValue/2]
	set doublePad [expr $padValue*2]

	frame $w.top
	frame $w.bottom

	label $w.icon -bitmap question
	label $w.query -text "Old game seed:" -anchor w
	text $w.seed \
		-relief sunken -bd 2 \
		-pady $halfPad -padx $halfPad \
		-height 1 -width 20 
	$w.seed mark set insert 0.0
	$w.seed insert end $game(randomSeed)
	button $w.cancel -text Cancel -padx $doublePad \
		-command "menuOldGameCancel $w"
	button $w.ok -text OK -padx $doublePad \
		-command "menuOldGameOk $w"

	pack $w.query $w.seed -in $w.top -side top -anchor w
	pack $w.ok $w.cancel -in $w.bottom \
		-pady $padValue -padx $padValue -side right

	pack $w.icon -side left -anchor nw \
		-padx $padValue -pady $padValue
	pack $w.top -side top \
		-padx $padValue -pady $padValue
	pack $w.bottom -side bottom -anchor e \
		-padx $padValue -pady $padValue

	# bindings
	set target $w.seed
	if {$tk_version < 4.0} { bind $w <Any-Enter> "focus $target" }
	bind $target <Any-KeyPress-Return> "menuOldGameOk $w"
	bind $target <Any-KeyPress-KP_Enter> "menuOldGameOk $w"
	bind $target <Any-KeyPress-Escape> "menuOldGameCancel $w"
	mkMenuBindings $target
}

proc mkOldGame {seed} {
	global game
	# Games with pre-set seeds can't score.
	if { $game(scoreMethod) == "official" } {
		set game(scoreMethod) unofficial
		.menu.options.m entryconfigure [menuOffset 2] -state disabled
	}
	# Now start the new game.
	endGame "quit"
	set game(presetRandomSeed) $seed
	mkNewGame
}

proc menuOldGameOk {w} {
	global game
	set seed [string trim [$w.seed get 0.0 end]]
	unmenuHelp $w
	mkOldGame $seed
}

proc menuOldGameCancel {w} {
	unmenuHelp $w
}


proc menuPauseGame {} {
	global game
	if { $game(status) == "paused" } {
		unpauseGame
		return
	}
	.menu.file.m entryconfigure [menuOffset 3] -label "Continue"
	obscureTable
	set game(status) "paused"
	set game(pauseStartTime) [getclock]
}

proc unpauseGame {} {
	global game
	.menu.file.m entryconfigure [menuOffset 3] -label "Pause"
	unobscureTable
	set game(status) "running"
	set game(pauseEndTime) [getclock]
	set pauseDelta [expr $game(pauseEndTime)-$game(pauseStartTime)]
	incr game(pauseTime) $pauseDelta
}

#  LocalWords:  DoNTspace clickable Tcl Tk SGML ish markup Dontspace replayable


#  LocalWords:  hilighting dontntspace Sager compuserve com FreeSpace


