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 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.
#!/usr/bin/env wish #start of deck #start of deck #start of deck #start of deck 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 #end of deck #end of deck #end of deck
Please place any comments here, Thanks.
gold Change:Redundant procedure ? deleted.
*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# )***
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#!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073 #: CanvasDemo: On button-click, draw something on the canvas set winner "no" set goofy [list one two three four one two three four one two three four one two three four] set ind 0 set baseline {list 1} proc K { x y } { set x } proc shuffle { list } { set n 1 set slist {} foreach item $list { set index [expr {int(rand()*$n)}] set slist [linsert $slist $index $item] incr n } return $slist } for {set i 1} {$i < 30} {incr i 1} { lappend alist $i } set goofy [join $alist $alist] #set goofy [shuffle $goofy ] #set alist [list ] # set goofy [ list 1 2 3 4 5 6 7 8 9 11 12 ] set goofy [shuffle $goofy ] proc xpop { topper } { global liner global ind global goofy global baseline set topper [ lindex $goofy $ind ]; if {$topper >= 200} {set topper "1"} if {$topper == "00" } {set topper "1"} set ind [ expr { $ind + 1}] lappend $baseline $topper; return $topper; } proc populateCanvas {w 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} set canvas $w # parameters for drawing boxes set boxwidth 50 set boxheight 20 set padx 3 set pady 3 set colors {red orange yellow green gray} 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])}]] set text [xpop topper] # create the boxes set boxid [$canvas create rectangle $x1 $y1 $x2 $y2 \ -fill $color -tags rect \ -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 {w} { # 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 set canvas $w if {$selectedid ne "" && [$canvas find withtag $selectedid] ne ""} { $canvas itemconfigure $selectedid -outline black } set selectedid "" set selectedtext "" } proc handleSelection {w 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) set canvas $w variable ids variable boxes variable selectedid variable selectedtext set canvas $w 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 {w x y} { set canvas $w # 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] } } proc winnergame { canvas } { set winnerstate 0 #foreach id [ $canvas find all] { $canvas delete $id }; # foreach item [ $canvas find withtag grey ] { $canvas itemconfigure $item -outline red }; #foreach item [ $canvas find all] { $canvas itemconfigure -bg red }; foreach item [ $canvas find withtag rect ] {$canvas itemconfigure rect -outline blue} if {[ $canvas find withtag rect ] == ""} { $canvas configure -bg red } set checkr "[ $canvas find withtag rect ]" if {[ $canvas find withtag rect ] != ""} { .wxxccc delete 1.0 end;} if {[ $canvas find withtag rect ] != "" } {.wxxccc insert end " remaining tiles $checkr "; } if {[ $canvas find withtag rect ] == "" } { .wxxccc delete 1.0 end;} if {[ $canvas find withtag rect ] == ""} { .wxxccc insert end " apparent winner detected "} } proc reset { canvas } { .wxxccc delete 1.0 end; .wxxccc insert end " reset activated"; .cv configure -bg beige; populateCanvas .cv 6 10 } proc ClrCanvas {w} { $w delete "all" } proc DrawAxis {w} { set midX [expr { $::maxX / 2 }] set midY [expr { $::maxY / 2 }] $w create line 0 $midY $::maxX $midY -tags "axis" $w create line $midX 0 $midX $::maxY -tags "axis" } proc PaintText {w Txt} { global y incr y 10 $w create text 20 $y -text $Txt -tags "text" } proc DrawBox {w} { global x1 y1 x2 y2 $w create rect 50 10 100 60 -tags "box" $w create rect $x1 $y1 $x2 $y2 -tags "box" incr x1 15 incr x2 15 incr y1 10 incr y2 10 } proc DrawFn1 {w} { $w create line 0 100 50 200 100 50 150 70 200 155 250 50 300 111 350 222\ -tags "Fn1" -smooth bezier } proc DrawFn2 {w} { set offY 0 ;# [expr { $::maxY / 2 }] for { set x 0 } { $x <= $::maxX } { incr x 5 } { set y [expr { rand() * $::maxY + $offY }] #puts "$x $y" if {$x>0} { $w create line $x0 $y0 $x $y -tags "Fn2" } set x0 $x set y0 $y } } #: Main : frame .f1 frame .f2 pack .f1 .f2 set maxX 320 set maxY 240 set y 0 set x1 120 set x2 150 set y1 50 set y2 80 set state 1 #set canvas [canvas $win.canvas] set w canvas canvas .cv -width $maxX -height $maxY -bg beige bind .cv <Button-1> [list processClick %W %x %y] pack .cv -in .f1 populateCanvas .cv 6 10 set selectedid "" set selectedtext "" button .b0 -text "Clear" -command { ClrCanvas .cv } button .b1 -text "Text" -command { PaintText .cv "Canvas" } button .b2 -text "Axis" -command { DrawAxis .cv } button .b3 -text "Box" -command { DrawBox .cv } button .b4 -text "Fn1" -command { DrawFn1 .cv } button .b5 -text "Fn2" -command { DrawFn2 .cv } button .b6 -text "check" -command {winnergame .cv } button .b7 -text "reset" -command { reset canvas } button .b8 -text "exit" -command { exit } pack .b0 .b1 .b2 .b3 .b4 .b5 .b6 .b7 .b8 -in .f2 -side left -padx 2 set colorground beige pack [ label .ww -text "mahjong holding tank " -bg $colorground] pack [ text .wxxccc -width 80 -height 5 -bg beige ] focus .wxxccc ;# allow keyboard input .wxxccc insert end "xxx starter xxx ";
.wxxccc insert end "hexxx";
#catch {console show}
as $canvas 4 5
set selectedid "" set selectedtext ""
#trial code saving #cheap_poker chips #end of deck #end of deck # trial code saving #end of deck #end of deck #end of deck