***Mahjong_Style_Deletion *** This page is under development. Comments are welcome, but please load any comments at the bottom of the page. Thanks, [gold] ---- This page uses [Tcl]8.5 for [windows] to develop Mahjong_Style_Deletion . (note: file is working in 8.5,but you might try saving in ANSCII, if you get a glyph compiler error ) This original code was provided by [aricb] [aricb] on the Wiki Ask page. Probably could start a wiki page, since it is a good baby game engine for Mahjong style games. I added a few buttons at the bottom and tried to keep the clean code separate uptop. In developing a computer program or application, it is helpful to develop analogs for the individual tasks of the application. ---- ***Pretty Print Version *** ====== # test indent from ased editor # written on Windows XP on eTCL # working under TCL version 8.5.6 and eTCL 1.0.1 # gold on TCL WIKI #!/usr/bin/env wish package require Tk proc populateCanvas {canvas cols rows} { variable ids ;# links text ids with respective rect ids variable boxes ;# lists text id and text associated with each rect id catch {unset ids boxes} # parameters for drawing boxes set boxwidth 50 set boxheight 20 set padx 3 set pady 3 set colors {red orange yellow green blue purple} set labels {one two three four} # draw the boxes for {set row 0} {$row < $rows} {incr row} { for {set col 0} {$col < $cols} {incr col} { # calculate coordinates set x1 [expr {$col * ($boxwidth + $padx) + $padx}] set x2 [expr {$x1 + $boxwidth}] set x3 [expr {$x1 + ($boxwidth / 2)}] set y1 [expr {$row * ($boxheight + $pady) + $pady}] set y2 [expr {$y1 + $boxheight}] set y3 [expr {$y1 + ($boxheight / 2)}] # choose color and text set color [lindex $colors [expr {int(rand() * [llength $colors])}]] set text [lindex $labels [expr {int(rand() * [llength $labels])}]] # create the boxes set boxid [$canvas create rectangle $x1 $y1 $x2 $y2 -fill $color -outline black] set textid [$canvas create text $x3 $y3 -text $text] # remember which text item goes with which box and what the text says set boxes($boxid) [list $textid $text] set ids($textid) $boxid set ids($boxid) $boxid } } } proc clearSelection {canvas} { # if there is an existing currently selected box, change its border back to # black; set variables selectedid and selectedtext to empty strings variable selectedid variable selectedtext if {$selectedid ne "" && [$canvas find withtag $selectedid] ne ""} { $canvas itemconfigure $selectedid -outline black } set selectedid "" set selectedtext "" } proc handleSelection {canvas id} { # determine the "next step" by comparing the newly selected box id and text # to the box id and text of the previously selected box (contained in # the variables $selectedid and $selectedtext) variable ids variable boxes variable selectedid variable selectedtext set boxid $ids($id) lassign $boxes($boxid) textid text if {$boxid eq $selectedid} { # user has selected the same box twice; deselect the box clearSelection $canvas return } elseif {$text eq $selectedtext} { # user has selected two boxes with the same text; delete both boxes $canvas delete $boxid $textid $selectedid [lindex $boxes($selectedid) 0] clearSelection $canvas return } else { # user has selected a box when there is no selection, or user has # selected a box with different text than the previously selected box; # try to deselect the previous box, then select the new box clearSelection $canvas set selectedid $boxid set selectedtext $text $canvas itemconfigure $boxid -outline white return } } proc processClick {canvas x y} { # determine whether the user has clicked on something; if so, call # proc handleSelection set id [$canvas find overlapping $x $y $x $y] if {[llength $id] > 0} { handleSelection $canvas [lindex $id 0] } } set win [toplevel .demo] wm title $win "Mahjong-style deletion" set canvas [canvas $win.canvas] pack $canvas -expand 1 -fill both bind $canvas [list processClick %W %x %y] set state 1 proc mahjongstyle { state } { global coloritem canvas details set coloritem gray set details { Mahjong-style deletion. press in succession two tiles with the same text. both tiles should be deleted. The Mahjong-style deletion is for the right mouse press.} $canvas create window 15 210 -window [button $canvas.r -width 10 -text report \ -bg $coloritem -command {tk_messageBox -message $details}] $canvas create window 30 230 -window [button $canvas.c -width 10 -height 1 -text exit \ -bg $coloritem -command {exit }] } mahjongstyle { $state } populateCanvas $canvas 4 5 set selectedid "" set selectedtext "" console hide ====== ---- ***Screenshots*** [WikiDbImage TCL_wiki_Mahjong_Style_Deletion.PNG] [http://farm5.static.flickr.com/4023/4685677488_29f32589be_s.jpg] [http://farm5.static.flickr.com/4023/4685677488_29f32589be_m.jpg] **Comments** Please place any comments here, Thanks. [gold] Change:Redundant procedure ? deleted. ---- **References** * http://en.wikipedia.org/wiki/calculators * Search on google.com for "counting rods" * http://en.mahjong-zone.com/ * http://home.halden.net/vkp/vkp/mac.html * http://www.tcl.tk/software/plugin/match.html * http://www.eiu.edu/~philos/retro/dos/games.htm * http://www.lcdf.org/xmahjongg/ * http://scien.stanford.edu/class/psych221/projects/99/dmerrill/ * http://www.scriptics.com/ * http://www.photomosaic.com/ * http://opencircuitdesign.com/magic/magic7_2.html * images give some ideas? http://opencircuitdesign.com/magic/giffiles/wind3d.gif * http://www.karlrunge.com/x11vnc/recurse_x11vnc.jpg * http://e.irigoyen.home.comcast.net/~e.irigoyen/d3kalphablendingdemo2.jpg * http://linuxshellaccount.blogspot.com/2008_11_01_archive.html * Programming References ( TCL & C# )*** * [Base conversion] * Syntax [I love foreach] [use while to iterate over a list] * [additional list functions], [string reverse], * [split], [list] * [recursive list searching] ---- **Appendices** ***Tables*** ***Auxiliary Programs*** *** mahjong style deletion in tcl,jan20,2009 *** This question has been pretty well answered and closed out. I have posted the answer etc in a new wiki page. Thanks,[gold] [aricb] 2009-1-23: Does the following code do what you have in mind? [aricb] The code doesn't use any special 8.5 features. It sounds like the script got corrupted either while you were pasting it or when you converted it to Unicode. I would copy and save the script one more time (I assume you know to do this with a text editor rather than a word processor). Save it using your default system encoding or UTF-8 (don't use any other Unicode encoding than UTF-8). Look at the saved code, possibly with a different program than the editor you used to save it, to make sure it hasn't been corrupted. proc populateCanvas {canvas cols rows} { variable ids ;# links text ids with respective rect ids variable boxes ;# lists text id and text associated with each rect id catch {unset ids boxes} # parameters for drawing boxes set boxwidth 50 set boxheight 20 set padx 3 set pady 3 set colors {red orange yellow green blue purple} set labels {one two three four} # draw the boxes for {set row 0} {$row < $rows} {incr row} { for {set col 0} {$col < $cols} {incr col} { # calculate coordinates set x1 [expr {$col * ($boxwidth + $padx) + $padx}] set x2 [expr {$x1 + $boxwidth}] set x3 [expr {$x1 + ($boxwidth / 2)}] set y1 [expr {$row * ($boxheight + $pady) + $pady}] set y2 [expr {$y1 + $boxheight}] set y3 [expr {$y1 + ($boxheight / 2)}] # choose color and text set color [lindex $colors [expr {int(rand() * [llength $colors])}]] set text [lindex $labels [expr {int(rand() * [llength $labels])}]] # create the boxes set boxid [$canvas create rectangle $x1 $y1 $x2 $y2 \ -fill $color \ -outline black] set textid [$canvas create text $x3 $y3 \ -text $text] # remember which text item goes with which box and what the text says set boxes($boxid) [list $textid $text] set ids($textid) $boxid set ids($boxid) $boxid } } } proc clearSelection {canvas} { # if there is an existing currently selected box, change its border back to # black; set variables selectedid and selectedtext to empty strings variable selectedid variable selectedtext if {$selectedid ne "" && [$canvas find withtag $selectedid] ne ""} { $canvas itemconfigure $selectedid -outline black } set selectedid "" set selectedtext "" } proc handleSelection {canvas id} { # determine the "next step" by comparing the newly selected box id and text # to the box id and text of the previously selected box (contained in # the variables $selectedid and $selectedtext) variable ids variable boxes variable selectedid variable selectedtext set boxid $ids($id) lassign $boxes($boxid) textid text if {$boxid eq $selectedid} { # user has selected the same box twice; deselect the box clearSelection $canvas return } elseif {$text eq $selectedtext} { # user has selected two boxes with the same text; delete both boxes $canvas delete $boxid $textid $selectedid [lindex $boxes($selectedid) 0] clearSelection $canvas return } else { # user has selected a box when there is no selection, or user has # selected a box with different text than the previously selected box; # try to deselect the previous box, then select the new box clearSelection $canvas set selectedid $boxid set selectedtext $text $canvas itemconfigure $boxid -outline white return } } proc processClick {canvas x y} { # determine whether the user has clicked on something; if so, call # proc handleSelection set id [$canvas find overlapping $x $y $x $y] if {[llength $id] > 0} { handleSelection $canvas [lindex $id 0] } } set win [toplevel .demo] wm title $win "Mahjong-style deletion?" set canvas [canvas $win.canvas] pack $canvas -expand 1 -fill both bind $canvas [list processClick %W %x %y] populateCanv ---- ---- ====== ====== ---- !!!!!! <> Games | Toys | Calculator | Example | Syntax %| [Category Canvas] |% !!!!!! ----