This page is under development. Comments are welcome, but please load any comments at the bottom of the page. Thanks, gold
This page uses Tcl8.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 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 up top.
In developing a computer program or application, it is helpful to develop analogs for the individual tasks of the application.
# 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 <Button-1> [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
test of offsite image retrieval
Please place any comments here, Thanks.
gold Change:Redundant procedure ? deleted.
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 <Button-1> [list processClick %W %x %y] populateCanv