set gamemodes \
{small medium large bonus | 783 3x20 square chessboard monster | triangle flower star | round krazy}

set num_gamesaves 5
frame .m
pack .m -side top -fill x

menubutton .m.game	-text "Game  "		-menu .m.game.m1
menubutton .m.options	-text "Options  "	-menu .m.options.m1
menubutton .m.help	-text "Help  "		-menu .m.help.m1

pack .m.game	-in .m -side left
pack .m.options	-in .m -side left
pack .m.help	-in .m -side right

###### game menu #######

menu .m.game.m1 -tearoff 0
.m.game.m1 add cascade -label "New" -menu .m.game.m1.new
.m.game.m1 add separator
.m.game.m1 add cascade -label "Save" -menu .m.game.m1.save
.m.game.m1 add cascade -label "Load" -menu .m.game.m1.load
.m.game.m1 add separator
.m.game.m1 add command -label "Quit" -command {Quit}

menu .m.game.m1.new -tearoff 1
foreach i $gamemodes {
	if {$i=="|"} {
	  .m.game.m1.new add separator
	} else {
	.m.game.m1.new add command -command "NewGame $i" \
	-label "[string toupper [string range $i 0 0]][string range $i 1 end]"
	}
}

menu .m.game.m1.save -tearoff 0
for {set i 1} {$i<=$num_gamesaves} {incr i} {
	.m.game.m1.save add command -label "Game $i" -command "SaveGame $i"
}
.m.game.m1.save add separator
.m.game.m1.save add command -label "Save As" -command {SaveGameAs}

menu .m.game.m1.load -tearoff 0
for {set i 1} {$i<=$num_gamesaves} {incr i} {
	.m.game.m1.load add command -label "Game $i" -command "LoadGame $i"
}
.m.game.m1.load add separator
.m.game.m1.load add command -label "Load File" -command {LoadGameAs}

###### options menu #######

menu .m.options.m1 -tearoff 0
.m.options.m1 add cascade -label "Colour"  -menu .m.options.m1.colours
.m.options.m1 add cascade -label "Tray ridges" -menu .m.options.m1.trayridges
.m.options.m1 add cascade -label "Piece ridges" -menu .m.options.m1.pieceridges
.m.options.m1 add cascade -label "Show overlapping" -menu .m.options.m1.bold
.m.options.m1 add cascade -label "Check if finished" -menu .m.options.m1.finished

menu .m.options.m1.colours -tearoff 1
set i 1
foreach {c rest} $colour(schemes) {
	.m.options.m1.colours add radio \
	-var colour(current) -value $c \
	-command {SetPieceColours ; RefreshPieceColours} \
	-label "[string toupper [string range $c 0 0]][string range $c 1 end]"
}

menu .m.options.m1.finished -tearoff 0
.m.options.m1.finished add radio -label yes -var flag(check_finished) -value 1
.m.options.m1.finished add radio -label no  -var flag(check_finished) -value 0

menu .m.options.m1.pieceridges -tearoff 0
.m.options.m1.pieceridges add radio -label yes \
  -var flag(piece_ridges) -value 1 -command TogglePieceRidges
.m.options.m1.pieceridges add radio -label no \
  -var flag(piece_ridges) -value 0 -command TogglePieceRidges

menu .m.options.m1.trayridges -tearoff 0
.m.options.m1.trayridges add radio -label yes -var flag(tray_ridges) -value 1 -command ToggleTrayRidges
.m.options.m1.trayridges add radio -label no -var flag(tray_ridges) -value 0 -command ToggleTrayRidges

menu .m.options.m1.bold -tearoff 0
.m.options.m1.bold add radio -label yes -var flag(bold_outline) -value 1 -command ToggleBold
.m.options.m1.bold add radio -label no  -var flag(bold_outline) -value 0 -command ToggleBold

###### help menu #######

menu .m.help.m1 -tearoff 0

.m.help.m1 add command -label "Help Topics" -command showHelp
.m.help.m1 add command -label "Changes" -command {showHelp 4}
.m.help.m1 add command -label "About" -command {showHelp 5}

#####procedures###############################################

proc NewGame {mode} {
        global gamemode
          
        destroy .c
	set gamemode $mode
	NewCanvas
}       
##################
proc SaveGameAs {} {
	global savedir
	set file [tk_getSaveFile -initialdir $savedir]
	if {$file!=""} {SaveGameGo $file}
}
proc SaveGame {slot} {
	global savedir
	if {![file isdirectory $savedir]} {file mkdir $savedir}
	SaveGameGo "$savedir/game$slot"
}
proc SaveGameGo {file} {
	global p gamemode colour deleted

        # When gave is saved, the deleted list is forgotten , and count adjusted

	set fid [open "$file" w]
	puts $fid "set gamemode $gamemode"
	puts $fid "set colour(current) $colour(current)"
	puts $fid "SetPieceColours ; RefreshPieceColours"

	for {set i 1 ; set j 0} {$i<=$p(count)} {incr i} {
        # if not deleted
		if {[lsearch $deleted $i] == -1 } {
			incr j
			set coordlist [.c coords piece$i]      
			puts $fid "set p(coords,$j) \"[string trim $p(coords,$i)]\""
			puts $fid "set p(colour,$j) \"[string trim $p(colour,$i)]\""
			puts $fid "DrawPiece $j [GetMidCoords $coordlist]"
		}
	}
	close $fid
}
##################
proc LoadGameAs {} {
	global savedir
	set file [tk_getOpenFile -initialdir $savedir]
	if {$file!="" && ![string match "*options" $file]} {LoadGameGo $file}
}
proc LoadGame {slot} {
	global savedir
	LoadGameGo "$savedir/game$slot"
}
proc LoadGameGo {file} {
	global gamemode p flag colour

	# these two lines are for cosmetic purposes
	# redraw . (which was covered by a menu or tk_chooseColour)
	raise .
	update idletasks

	# destroy old canvas, even if it is the same size
	destroy .c

	# the first line gives us the gamemode
	set fid [open "$file" r]
	eval [gets $fid]
	close $fid

	# for backwards compatability (you're too nice S.)
	if {[info exists dx]} {
	    switch $dx {
		11 { set gamemode large }
		8  { set gamemode medium }
		5  { set gamemode small }
	    }	
	}

	NewCanvas

	.c delete piece
	source "$file"
        .c raise text all
        set flag(report_finished) 0
	set flag(bold_outline) 1

}
##################

# borrow tkhearts help listbox widget

proc initHelp {} {

  global help data tcl_patchLevel

  # each help text ("k") is just a list of {text format text format ....}
  # where format is the text "tag" that determines any special formatting

  foreach {i j k} {
    0 Overview {
{Poly Puzzle is my first 'original' program to make use of Tk's canvas widget.  It was inspired by a plastic puzzle named Beat The Computer which came in an array of sizes and loud colours.

It now has trays with polygons based on hexagons, squares and equilateral triangles. The new round puzzles are based on smooth triangles, and aren't quite as cute as the original puzzles.

I had planned to incorporate a computer solution feature. This would be handy for the actual plastic game - which you have to put away at the end of the day - but on the computer there are no little pieces to lose under the carpet ;>.  More to the point - it would require quite a bit of programming! The game already has a lot (for me) of complicated and subtle math, I'm suprised myself it works so well.} {}
    }
    1 Instructions {
{Fit all the pieces in the tray.} center \n\n {}

{Controls} {indent1 underline} \n\n {}
{Button 1    : drag piece} indent1 \n {}
{Button 2    : flip piece over (l-r) } indent1 \n {}
{Button 3    : rotate piece clockwise} indent1 \n {}
{Mouse Wheel : rotate piece} indent1 \n\n {}

{Left        : rotate anticlockwise} indent1 \n {}
{Right       : rotate clockwise} indent1 \n {}
{Space | Up  : flip} indent1 \n\n {}

{Q           : quit} indent1 \n {}
    }
    2 Math {
{Polyhexes   - Shapes made of hexagons joined together} indent \n\n {}

{Polyominoes - Shapes made of squares joined together
    Tetromino : 5 distinct pieces
    Pentomino : 12 distinct pieces
    Hexomino  : 35 distinct pieces} indent \n\n {}

{Polyiamonds  - are composed of equilateral triangles.
    Hexiamond  : 12 distinct pieces
    Heptiamond : 24 distinct pieces} indent \n\n {}

{Prefixes:
    Tetra = 4
    Pent = 5
    Hex = 6
    Hept = 7} indent \n\n {}
{* There is (currently) no algorithm for finding the exact number of polyominoes with N squares.} indent \n\n {}
    }
    3 {Todo and Bugs} {
{Wish 8.5.0 has a precision bug that affects the more complicated puzzles in X resolution 1152x864} indent \n\n {}
{Automatically pop up sub menus} indent \n\n {}
{Actually solve the star puzzle} indent \n\n {}

{In the triangular games, the piece overlap function and snap algorithms aren't quite right} {} \n {}
    }

    4 Changelog {
2.0 {}
{ (todo)
Allow creation and deletion of pieces (using shift-double-click and ctl-double click) 27/10/08} indent2 \n {}
1.8.4 {}
{
Bug fix to appease pointless Tk canvas changes} indent2 \n {}
1.8.3 {}
{
Interim release} indent2 \n {}
1.8.2 {}
{
tcl_precision==12 fixes program breaking sometimes with wish8.5
Help menu up/down key bindings 26/11/08} indent2 \n {}
1.8.1 {}
{
Hmmm... backed out the extra code (1.8) - it interferes with key bindings 9/03/08} indent2 \n {}
1.8 {}
{
Implemented the new "help" widget, and place help menu on right 23/10/07
Some extra code to stop aggressive mouse events from falling over 20/10/07
Check help window is on screen 07/11/07} indent2 \n {}
1.7a {}
{
Small check for ~/.polypuzzle on init 03/06/07} indent2 \n {}
1.7 {}
{
Added a hack to enable the WinXP wheel mouse. 0/12/06 
Added the Krazy puzzle. Re-timestamped some files, and removed some CR/LFs.  30/11/06 
Rewrote heaps of colour code for the new game types, including a bugfix! that stopped the colour from being restored after loading a game. 27/11/06 
Added Chessboard puzzle, Improved "wrong gamemode" error handling. 25/11/06} indent2 \n {}
1.6.2 {}
{
+ mousewheel will rotate pieces + swapped buttons 2, 3 5/09/05 
Now correctly catches destroy when deleted by the wm 03/09/05 
Fixed changelog (!) & few small outline bugs. Added Tcl version + doco 27/07/05} indent2 \n {}
1.6.1 {}
{
+ tray ridges option + round pieces rounder 06/07/05} indent2 \n {}
1.6 {}
{
+ round puzzle + ridges option + orange colour + new overlapping code 30/06/05} indent2 \n {}
1.5.3 {}
{
constrain pieces to canvas. small doco rewrites. 3/02/05 
Made a mini icon 07/11/04} indent2 \n {}
1.5.2 {}
{
oops - monster and star canvases were too big 27/09/04} indent2 \n {}
1.5.1 {}
{
half-day to rewrite outline algorithm to fix hexagon-iamond bug 13/06/04 
flower, star, 783, 3x20 gamemodes added. changed name to polypuzzle 11/06/04} indent2 \n {}
1.5 {}
{
triangle gametype added ! 08/06/04} indent2 \n {}
1.2 {}
{
square, monster gamemodes added  - good work 3/06/04 
bug fix: typing 'q' in a tk_SaveFile dialog caused game to quit 01/04/04} indent2 \n {}
1.1 {}
{
added an extra tray!! 11/01/04} indent2 \n {}
1.0 {}
{
added automatic save options, removed command line args, bugfix: grabbing the piece by the edge made snap go awry 8/12/03 
show overlapping pieces feature , removed bisque menu 17/12/03 
rewrote snap algorithm (only snaps if no overlapping pieces) 16/12/03 
made the help menus vfat friendly 05/12/03} indent2 \n {}
0.9 {}
{
added option menus for colours and completion improved the snap algorithm which sometimes was a bit loose 23/05/03 
added simple test for puzzle completion, and a little special effect 21/05/03} indent2 \n {}
0.8 {}
{
bugfix: Double-click piece, don't release -> remotely move it around!!  bugfix: Press a cursor key over the text : oops 20/05/03 
added piece colour option, change name from hextk to hexpuzzle 08/03/03} indent2 \n {}
0.7 {}
{
added menus, game save/load and keyboard bindings, first posting to ibiblio 16/02/03} indent2 \n {}
0.6 {}
{
added the outline polygon(s)! good work 01/02/03 
wrote program over Christmas break : playable 01/01/03} indent2 \n {}
    }

    5 About {

{Thanks to the authors of Tcl/Tk, Sourceforge.net, Freshmeat.net and Ibiblio.org} {} \n\n {}

{http://tkgames.sourceforge.net} {} \n {}
{http://www.freshmeat.net/projects/hextk} {} \n {}
{http://home.hetnet.nl/~paslen/poly/btc.html} {} \n\n {}

{stevenaaus@yahoo.com} {} \n\n {}
    }

  } {
      set help($i) ""
      set help(title,$i) "$j"
      set help(text,$i) "$k"
  }

# insert dereferenced stuff

set help(text,5) [linsert $help(text,5) 0 "Poly Puzzle $data(version) ($data(date)) (c) Steven A, released under version 2 of the GPL.\n\nTcl Version $tcl_patchLevel" {} \n\n {}]


}

proc showHelp {{topic 0}} {

  global help data

  set w .help

  if { [winfo exists $w] } {
    showHelpTopic  $w $topic
    wm deiconify $w
    raise $w
    focus $w
    return
  }

  initSubWindow $w "$data(name) - Help" 0

  pack [listbox $w.l -selectmode single -font $data(font_default) -width 12] \
    -expand 0 -fill y -side left -anchor nw
  bind $w.l <<ListboxSelect>> "showHelpTopic $w"
  pack [text $w.t -width 40 -height 22 -yscrollcommand "$w.s set" \
                  -wrap word -font $data(font_default) -padx 5 -pady 8] \
        -expand 1 -fill both -side left -anchor nw
  $w.t tag configure "title" -font $data(font_large) -justify center
  $w.t tag configure "center"  -justify center
  $w.t tag configure "underline" -underline 1 
  $w.t tag configure "tabs" -tabs {4c 8c 12c 16c}
  $w.t tag configure "indent" -lmargin2 15
  $w.t tag configure "indent1" -lmargin1 40
  $w.t tag configure "indent2" -lmargin1 16 -lmargin2 20
  $w.t tag configure "italic" -font "[font actual [$w.t cget -font]] -slant italic"
  $w.t tag configure "link" -font "[font actual [$w.t cget -font]] -underline 1" \
                            -foreground blue 
  $w.t tag bind link <Enter> "%W configure -cursor hand2"
  $w.t tag bind link <Leave> "%W configure -cursor {}"
  pack [scrollbar $w.s -command "$w.t yview"] -fill y -side left -anchor ne

  # populate list, show index topic
  foreach x [lsort [array names help -regexp {^[0-9]+$}]] {
    $w.l insert end $help(title,$x)
    $w.t tag bind goto$x <Button-1> "showHelpTopic $w $x"
  }

  bind $w <KeyPress-q> "destroy $w"
  # there's a minor unresolved issue with wish8.5 and focus
  bind $w <KeyPress-Up> "$w.t yview scroll -1 unit"
  bind $w <KeyPress-Down> "$w.t yview scroll +1 unit"
  bind $w <KeyPress-Prior> "$w.t yview scroll -1 page"
  bind $w <KeyPress-Next> "$w.t yview scroll +1 page"
  focus $w
  update
  center $w
  wm deiconify $w
  showHelpTopic $w $topic
  $w.t configure -state disabled

}

proc showHelpTopic {w {topic {}}} {
  global help

  # show a specific help topic in the window
  # $w is toplevel, $w.t is the text frame

if { $topic != {}} {
  $w.l selection clear 0 end
  $w.l selection set $topic
  $w.l activate $topic
}

  $w.t configure -state normal
  $w.t delete 1.0 end
  set helpFile [$w.l curselection]
  $w.t insert end $help(title,$helpFile) title
  $w.t image create end -image ::img::logo -align center -padx 20
  $w.t insert end "\n\n"
  foreach {text tags} $help(text,$helpFile) {
    $w.t insert end $text $tags
  }
  $w.t configure -state disabled

}

proc initSubWindow {w title transient} {

  # Initilaises a toplevel window offscreen and withdrawn
  # (to allow the user to pack it before centering and being drawn)

  # I tried to use bind <FocusIn|Enter> to raise the window,
  # but using "grab" stops this command taking effect.
  # Additionally, using grab is the only way I know of to disable menus

  catch {destroy $w}
  toplevel $w
  wm title $w $title
  wm withdraw $w
  wm geometry $w +2000+2000

  if {$transient} {
    wm transient $w .

    bind . <FocusIn> "raise $w ; focus -force $w"
  }
}

proc grabSubWindow {w} {

  # There is an obscure bug in the grab code that means grab shouldn't be used till window
  # is drawn, so put grab here

  global data

  if { $data(platform) == "unix"} {
    grab set $w
  }
}

proc closeSubWindow {w} {
  bind . <FocusIn> ""
  grab release $w
  destroy $w
}

proc closeDialog {w {cmd ""}} {

  closeSubWindow $w
  .c configure -state normal
  if { $cmd != "" } {
       uplevel #0 $cmd
     }
}

proc center {win} {
  # Center window $win on the screen

  set w [winfo reqwidth $win]
  set h [winfo reqheight $win]
  set parent [winfo parent $win]

  if {"$parent" == "" } {
    set sh [winfo screenheight $win]
    set sw [winfo screenwidth $win]
    set reqX [expr {($sw-$w)/2}]
    set reqY [expr {($sh-$h)/2}]
  } else {
    scan [wm geometry $parent] "%dx%d+%d+%d" a b c d
    set reqX [expr $c + ($a-$w)/2]
    set reqY [expr $d + ($b-$h)/2]
  }
  if {$reqX < 0} {set reqX 0}
  if {$reqY < 0} {set reqY 0}

  wm geometry $win +$reqX+$reqY
  update idletasks
  return;
}

image create photo ::img::logo -file polylogo.gif

initHelp
bind . <F1> showHelp

######end#########
