Version 1 of Mahjong_Style_Deletion

Updated 2009-01-24 14:34:05 by gold

This is an empty page. Mahjong_Style_Deletion

  ----

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

on the Wiki Ask page. I thought I would 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

Comments

Please place any comments here, Thanks.

gold Change:Redundant procedure ? deleted.


References

   *Programming References ( TCL & C# )***

Appendices

Tables

Auxiliary Programs


***Auxilary Program***