----
***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.
  
                      
----

***Program Listing***
======
       #!/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
======
----
***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 <Button-1> [list processClick %W %x %y]
  
  populateCanv

----
   #trial code saving:later version
    #cheap_poker chips
   







     #!/bin/sh
 
 
  # majong style deletion code inserted into base program, from gold at tcl wiki
 # base used demo2-canvas.tcl - HaJo Gurt - 2005-12-13 - http://wiki.tcl.tk/15073
 

 
   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 0} {$i<30} {incr i} {lappend nums $i}
     for {set i 0} {$i<30} {incr i} {lappend nums $i}

        set goofy [join $nums $nums]

   



       #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 } { 
        ClrCanvas .cv
      .wxxccc delete 1.0 end;
       .wxxccc insert end  "  reset activated"; 
     .cv configure  -bg beige;
      populateCanvas .cv 6 10

      }
   

 
  
  proc ClrCanvas {w} {
    $w delete "all"
     .wxxccc delete 1.0 end
    .wxxccc insert end  "clear canvas activated  ";
  }

  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}
















    #end of deck
    #end of deck
 # trial code saving


    #end of deck
    #end of deck
    #end of deck

----


----
======
======

----
!!!!!!
%| [Category Toys] |%
!!!!!!
----