**Game kingdom of Strategy**

      This page is under development. Comments are welcome,
      but please load any comments in the comments section
      at the middle of the page. Thanks,[gold]

----
----
   Here is some starter code for
   Game kingdom of Strategy.
   There is a post on wiki asking 
   for a TCL version of
   a text and strategy game, originally in basic language.
   See Ideas for Projects in Tcl/Tk,
   http://wiki.tcl.tk/14335.
   I am trying to find out
   the status of the old game.
   A stategy game can be cobbled from
   older scraps of Iching code.
   The Iching has a good handle on the
   actions of an ancient kingdom, though
   in a random scattered pattern.
   The elements in most adventure
   games are random generators,
   castles, tiled game boards, mazes, wildcards,
   gamepieces, and strategy situation.
   
        
----
      The canvas and buttons presented here
 are largely based on the 
 Simple Canvas Demo by [HJG].
 See http://wiki.tcl.tk/15073   
 The random pick algorithm was posted by Suchenworth [RS]
 on Horseracing in Tcl,http://wiki.tcl.tk/3467.
  Another source of randomness was
   A funny cookbook,http://wiki.tcl.tk/9213
 
                                              
----
       
      In pseudocode, the text adventure game
  is essentially a three line program
  in the old style unix wish. In etcl and
  windows, some buffering may be necessary.
  One display for response and one display for
  input would be easier in windows. 
    
    1)puts stdout "Please enter your name:"
        2)gets stdin  name
             3)puts stdout "Hello $name"
     
     pseudocode.The user is directed into various possibilities. 
   2) 3) and 4) are looped.
      console show  
     1)puts stdout "Please enter your name:"
     2)gets stdin   
     pseudocode: analyse name and internal-references
     pseudocode : set random situation.
     pseudocode : game closes after 5 trials or 5 situations.
     3)puts stdout "action $name"
     4)  pseudocode.      return to 2) stdin 
    
     
 ---- 
 ----
     
   

 
----
       
----
     In the trial deck for console,
     the advisor would present the situation
     and the king's responces would have to
     be a table of abbreviated commands,
     like buy 200 , sell 300 , .
     Otherwise, there would be a lot difficult 
     parsing, like the human language command
     of computers. The trial deck could
     call the procedure "advisor" to present 
     the situation derived from random circumstances.
     The trial deck 
     could call the procedure "king", so
     the command on the console window 
     would be king sell 20 or
     king buy 50. This have the advantange 
     of looking as a typical English sentence:
     subject verb object. In a loop, the
     king procedure calls on the advisor procedure,
     which presents a new situation.
     The king wins or loses based on his responces
     to the random situation. The game can be
     closed after a certain number of situation
     trials by a limiting statement in the advisor
     procedure. The major subroutines or procedures
     were diagramed with TKpaint in the flowchart below.
     Those interested in flowcharting programs should
     be able to load the flowchart file into TKpaint
     or else load the file into eTCL with a few
     canvas display statements.

     
----
  session   from trial console strip
    buy or sell, my lord? 
    starts with 1000 units 
    answer has form:  king buy 20 or king sell 30  
   1% king buy 20
    decision was buy 20, total was 1020.0 
 
   advisor:  new situation 
   need 10 liters of grain.
   need 60 hectares of land.
   predict rain.
   subjects from census 5000. 

    advisor: buy or sell, my lord? 
    2% king sell 500
    decision was sell 500, total was 520.0 
 
    advisor:  new situation 
   need 10 liters of grain.
   need 100 hectares of land.
   predict cold.
   subjects from census 3000. 

     advisor: buy or sell, my lord? 
----

----
** canvas button operation 
     So the order of button actions should be:
     push castle
     push situation, read advisors' comment
     type in king's responce in upper entry field
     push console
     push record, should see record of play on console.
    %quit day job
    %{advisor:buy or sell, my lord?} {king:get lost}
         note: pass or veto should be option
    clear to resume play
     

    Commands from the king on the eTCL console  
    or commands in the king entry field (canvas)
    vary on versions, but here are some samples.
      initial land is 1000 barleyfields
      initial barley is 1000 measures
      king buy 22
      king sell 100
       else 
      king buy 100 land
      king sell 33 land
      king buy 222 barley
      king sell 33 barley
    conditions for winner are very liberal.
    pseudocode: game is halted after 5 trials, count > 5,
    and estimate if (winner) conditions prevail.
    pseudocode:  if barleyfields > 500 , winner declared
    pseudocode:  if barley  > 500 winner declared
    pseudocode:  clear resets counter to zero
    pseudocode:  clear zeros king & advisor entry fields, 
    pseudocode:  & zeros canvas

     
    Note. On 27Jul2010, there was a challenge posted on
   converting Hamurabi.bas to "modern" computer language.
   The turn-around from other languages (not me!) is fairly
   impressive. There was a Lua program posted on 28Jul2010,
   Java on 28Jul2010,
   common Lisp program on 31Jul210, and Factor program by 3Aug2010.   
   The original basic code was fairly terse, so
   there has been some real hoofing on the contributions.
   As a fortran programmer, I remember basic envy
   on the basic string addition, let it$ = "be"+"so"
    
----
**Screenshots Section**


 
 


[http://farm5.static.flickr.com/4120/4854141292_07b57692b7.jpg]


[http://farm5.static.flickr.com/4096/4857240469_6d23f1b62c.jpg] 


----
**Comments Section**
         Please place any comments here, Thanks.

[gold] Changes.

----
**References**

   * [Simple Canvas Demo]
  
   http://wiki.tcl.tk/14617

    Ideas for Projects in Tcl/Tk
    http://wiki.tcl.tk/14335


    A funny cookbook
    http://wiki.tcl.tk/7801
    Tkpaint
    http://mars.netanya.ac.il/~samy/tkpaint.html
     
    http://wiki.tcl.tk/9213
    The older tkpaint  1.5 executable that I used was loaded here.
     ftp://ftp.procplace.com/pub/tcl/sorted/packages-8.0/graphics/tkpaint/1.51/TKPAINT-1.5.3.TAR.GZ
     ftp://ftp.procplace.com/pub/tcl/sorted/packages-8.0/graphics/tkpaint/1.52/tkpaint.zip




    http://en.wikipedia.org/wiki/Hamurabi

    http://www.dunnington.u-net.com/public/basicgames/HMRABI

    http://www.apollowebworks.com/russell/samples/hamurabi.html



    http://www.cse.lehigh.edu/~munoz/ComputerGameDesignClass/classes/GameTheory.pptx.
    http://en.wikipedia.org/wiki/Hamurabihttp://en.wikipedia.org/wiki/List_of_games_in_game_theory
    http://en.wikipedia.org/wiki/Game_theory
    http://www.dallasuu.org/re/adult/huumanist/TitTatSagan.pdf
    http://en.wikipedia.org/wiki/Dictator_game

    http://www.hammurabigame.com/hammurabi-game.php

    http://www.codeproject.com/KB/game/Hammurabi.aspx



    http://www.esajournals.org/doi/abs/10.1890/1540-9295(2003)001%5B0367%3AMRAPTB%5D2.0.CO%3B2
    http://ipsnews.net/fao_magazine/indian.shtml
    http://biology.clc.uc.edu/courses/bio104/sci_meth.htm
    http://programmingpraxis.com/2010/07/27/hamurabi-bas/
    http://www.pbs.org/wgbh/nova/nature/plant-vs-predator.html
    http://lisp.pastebin.com/r1gL4zYT
    http://codepad.org/pc8FSfnQ
    http://www.econ.umn.edu/~foster/Handouts%20Games.pdf
    http://re-factor.blogspot.com/2010/08/hamurabi.html


    http://www.moorecad.com/classicbasic/basic/creative/hamurabi.bas
    http://www.cis.upenn.edu/~matuszek/cit590-2010/Assignments/02-hammurabi.html
     http://playtechs.blogspot.com/2009/06/charlemagne-disraeli-and-jefferson.html
     http://www.econ.cam.ac.uk/seminars/Marshall_Lecture/09/marshall_lecture_2_Oct_21.pdf
     http://roseindia.net/java/java-tips/oop/q-hammurabi/q-pr-hammurabi-1.shtml
    http://en.wikipedia.org/wiki/Hammurabi
**appendix TCL programs**

----
      #start of deck
        #start of deck
        #start of deck 
 


 #:by gold,   Game kingdom of strategy

 # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 1Aug2010

  
  package require Tk
     
       proc ? L {
       lindex $L [expr {int(rand()*[llength $L])}]
       }
       if 0 {This is used several times in:}
     proc tidings {} {
   set a {
     {70 measures of barleys} {20 measures of barley} {10 measures of barley}
     {10 measures of barley} {50 measures of barley}
   }
   set b {
     {400 barleyfields of land} {60 barleyfields of land} {50 barleyfields of land}
     {100 barleyfields of land} {20 barleyfields of land}
   }
   set c {rain dry heat cold drought  snow }
   set d {
      {census 1000} {census 3000} {census 2000} {census 5000} {census 8000} {census 4000}
   }
   return "   need [? $a].
   need [? $b].
   predict [? $c].
   subjects from [? $d].  
   ans.form:king buy 20 or king sell 30 \n                         "
     }
      proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
    #proc poly args {eval .cv create polygon $args}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    proc transnumber {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext \u4E00}
    if { $item == 5 } {lappend choutext \u3024}
    if { $item == 6 } {lappend choutext \u4E00}
    if { $item == 7 } {lappend choutext \u4E00}
    if { $item == 8 } {lappend choutext \u3024}
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}
    proc advisorcom {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext "second rate" }
    if { $item == 2 } {lappend choutext "fifth rate" }
    if { $item == 3 } {lappend choutext "performance comparable to bonzo" }
    if { $item == 4 } {lappend choutext "fourth rate" }
    if { $item == 5 } {lappend choutext "no bread left" }
    if { $item == 6 } {lappend choutext "surving inhabitants have fled" }
    if { $item == 7 } {lappend choutext "third rate" }
    if { $item == 8 } {lappend choutext "lacking any sense" }
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}  

  set counter 0
  set sumit 1000
  set sumitland 1000
  set sumitbarley 1000
  proc winnerx {aa bb} {
  global sumit sumitland sumitbarley
  puts "end of game"
  .zzz delete 0 end
  .xxx delete 0 end
  .t delete 1.0 end
  .t insert 1.0 "end of game"
  .zzz insert 0 "end of game"
  .xxx insert 0 "end of game"
  if { $sumit >= 500 } {
  .zzz insert 0 "winner declared"
  .xxx insert 0 "winner declared"
 .t insert 1.0 "winner declared"
     puts "winner declared"
  }
   if { $sumitland >= 500 } {
  .zzz insert 0 "winner declared"
  .xxx insert 0 "winner declared"
  .t insert 1.0 "winner declared"
   puts "winner declared"
  }
   if { $sumitbarley >= 500 } {
  .zzz insert 0 "winner declared"
  .xxx insert 0 "winner declared"
   .t insert 1.0 "winner declared"
   puts "winner declared"
  }



  }
  proc advisorx {aa bb} {
     global counter
  if { $counter >= 5 } {winnerx $aa $bb }
  .t delete 1.0 end  
   puts " "
   puts "advisor:  new situation " 
   if { $counter <= 6 } { 
     .t insert 1.0 [ tidings ] } 


    if { $counter >= 6 } { 
     .t delete 1.0 end } 

  
   puts  [.t get 1.0 end ]
   puts "advisor: buy or sell, my lord? "
   incr counter
  }

   
  proc calculation { aa bb cc dd ee } {
  global counter 
  global sumit sumitland sumitbarley 
  global  buyland  buybarley
  set year    1       
  set people  100        
  set food    1000        
  set bushels 5000   
  set land    1000      
  set acres   1000
  set landprice 26
  set bushelsperacre  3 
  set totalDeaths   10
  set cumDeathRate  10 
  set ratbushels 1
  set localdeath 5
  set landfraction .1
  set peoplegain 5
  set produce 4
  set buyland 1
  set buybarley 1
  set ratbushels  [ expr { $bushels*.1*rand()   } ]
  set ratbushels [ expr { int($ratbushels) } ]
  set peoplestarved [ expr { $people*.02*rand()   } ]
  set peoplestarved [ expr { int($peoplestarved)  } ]
  set landfraction  [ expr {   rand() } ] 
  set peoplegain   [ expr {  $people  * .01 } ]  
  set peoplegain   [ expr {  int($peoplegain) } ] 
  set people [ expr { $people + $peoplegain   } ]
  set produce [ expr {  $land * 3 } ]
  set landprice [ lpick { 26 25 24 23 22 21 20 19 18 17 16 } ] 
  set landprice [ expr { int($landprice) } ] 
  set bushels [ expr {  $bushels - $landprice* $buyland } ]
  set bushels [ expr {  $bushels - $people* 20 } ] 
  set sumitland  [ expr { int($sumitland)  } ]
  set people  [ expr { $people + $people*.05 } ] 
  set people [ expr { int($people) } ]
  puts  "year $counter "
  puts "$peoplestarved people starved"
  puts "$peoplegain immigrated to city."
  puts "population $people  "
  puts "total  $sumitland barleyfields."
  puts "harvested 3 measures per barleyfield"
  puts "rats devoured $ratbushels measures."
  puts  "$bushels  measures in stores."
  puts "land $landprice measures per barleyfield"
  puts "how many barleyfields do you wish to buy?" 

  
  return " $aa $bb $cc $dd $ee "
  }

  
  proc king { aa bb cc} {
  global sumit sumitland sumitbarley 
  global buyland buybarley
  if { $aa == "buy" } {set token [ expr { 1.* $bb } ] }
  if { $aa == "sell" } {set token [ expr { -1.* $bb } ] }
  set sumit [ expr { $sumit + $token } ]
  if { $cc == "land" } { set sumitland [ expr { $sumitland + $token } ] }
  if { $cc == "barley" } { set sumitbarley [ expr { $sumitbarley + $token } ] }
  if { $cc == "land" } { set buyland  $token  }
  if { $cc == "barley" } { set buybarley  $token  }
  puts [ calculation 10 10 10 10 10 ]
  puts " decision was $aa $bb, total was $sumit, land $sumitland, barley $sumitbarley "
  puts " advisor says   [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]]   "
  advisorx 50 50
  }
   #puts [ tidings ]
   #puts "buy or sell, my lord? "
   #puts " starts with 1000 units "
   #puts "answer has form:  king buy 20 or king sell 30  "
    set listx [ transnumber $lister ]
    proc tactics  {w} {
    global listx
    set yy 100
    set font3 {Hevetica 20}
    set font5 {Hevetica 150}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    $w create rect 150 50 250 400 -fill gold 
    $w create polygon  -80 100  -80 70  -50 70  -20 -10  -40 -50  -20 -100  20 -100  40 -50  20 -10  50 70  80 70  80 100 -fill gold -tags figure
    $w move figure 150 150
    # $w create text 200 400 -text \u2617  -tags "text" -fill tan -font $font5
    foreach i {1 2 3 4 5 6 } {
    $w create text 200 $yy -text [lpick $listx ]  -tags "text"  -font $font3
    incr yy 50
    }
    }








      proc clrcanvas {w} {
    global counter
   $w delete  "all"
   .zzz delete  0 end  
   .xxx delete  0 end  
   .t delete 1.0 end
    set counter 0
  }

 
  proc leave {w} {
     exit
  }

   proc board {w} {
    #set state3 1
    set state2 1
    clrcanvas $w
    . configure -background orange -highlightcolor brown -relief raised -border 30
    $w configure -bg tan
     
    }
  proc  talkit {w} {
   .t delete 1.0 end
  # .t insert 1.0 [ tidings ]
   
   }
   proc  replyit {w} {

   .zzz delete  0 end  
   .xxx delete  0 end  
   .zzz insert  end "advisor:buy or sell, my lord?"
   .xxx insert  end "king "
   }
    set keeperer { 1 2 3 }
    proc  record {w} {
     global side2 side1 buy sell 
   
      
   lappend keeperer $side2
   lappend keeperer $side1
   puts $keeperer
   eval [ split  $side1 " " ]
   }

   proc  reportx {w} {
   console show
    puts "fifth rate"
    puts "performance comparable to bonzo"
    puts "surving inhabitants have fled"
    puts "mandated poll results"
    puts "lacking any sense"
    puts "second rate";
    puts "no bread left"
    puts "third rate"
    puts "quit day job"
   }

    proc castle {w} {
      global dx dy 
      set dx 50
      set dy 30
      set gualisting { 8 8 8 8 8 7 }
      set second_hexagram { 8 8 8 8 8 7 }
      set colorx black;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx brown;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx brown;
         if { $j == 1} {
        if { [lindex $gualisting $i ] == 6} {set colorx tan}

         if { [lindex $gualisting $i ] == 7} {set colorx brown}
         if { [lindex $gualisting $i ] == 8} {set colorx tan}
         if { [lindex $gualisting $i ] == 9} {set colorx brown}
         }

          $w create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}
            set dx 50
            set dy 30
          set colorx blue;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx blue;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx blue;
         if { $j == 1} {
        if { [lindex $second_hexagram $i ] == 6} {set colorx tan}

         if { [lindex $second_hexagram $i ] == 7} {set colorx blue}
         if { [lindex $second_hexagram $i ] == 8} {set colorx tan}
         if { [lindex $second_hexagram $i ] == 9} {set colorx blue}
         }

          $w create rectangle [expr $x + 180] $y [expr {[expr $x +180 ]+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}

     }
    proc about {w} {
    set msg "Game kingdom of strategy.
          from TCL WIKI,
          written on eTCL "
    
    tk_messageBox -title "About" -message $msg
    }

  #: Main :
  frame .f1
  frame .f2
  frame .f3
  pack  .f1 .f2 .f3

  set maxX 400
  set maxY 300
  set y      0

  set x1 120
  set x2 150
  set y1  50
  set y2  80

  canvas  .cv -width $maxX -height $maxY  -bg tan
  pack    .cv -in .f1
  
   #set side2 2
  button  .b0 -text "clear" -command { clrcanvas .cv }
  button  .b3 -text "castle"   -command {clrcanvas .cv; castle   .cv }
  button  .b5 -text "wildcard"   -command {clrcanvas .cv; tactics   .cv }
     
      button  .b6 -text "record"   -command { record  .cv }
      button  .b7 -text "situation"   -command {talkit .cv; replyit .cv; advisorx 50 50  }
      button .b4 -text "console"   -command {reportx .cv  }
      button  .b8 -text "exit"   -command {leave   .cv } 
      button  .b9 -text "about"   -command {about   .cv } 
      text .t -width 40 -height 5 -bg bisque
      entry .xxx -width 50  -bg bisque -textvariable side1
      entry .zzz -width 50 -textvariable side2 -bg bisque
     pack .b0 .b3 .b5  .b6 .b7 .b7 .b4 .b9 .b8  -in .f2  -side left -padx 2
  .f2 configure  -bg orange
      label .kingx  -text "king" 
      label .advisora  -text "advisor" 
      #text .r -width 40 -height 5 -bg bisque
      pack  .advisora .zzz .t   .kingx  .xxx -in .f3  -side bottom -padx 2
      focus .xxx
      focus .zzz
      board   .cv
   
     bind . <Motion> {wm title . " Game kingdom of strategy "}




 #:by gold,   trial console operation

 # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 1Aug2010


    console show 
      proc ? L {
       lindex $L [expr {int(rand()*[llength $L])}]
       }
       if 0 {This is used several times in:}
     proc tidings {} {
   set a {
     {70 liters of grains} {20 liters of grain} {10 liters of grain}
     {10 liters of grain} {50 liters of grain}
   }
   set b {
     {400 hectares of land} {60 hectares of land} {50 hectares of land}
     {100 hectares of land} {20 hectares of land}
   }
   set c {rain dry heat cold drought  snow }
   set d {
      {census 1000} {census 3000} {census 2000} {census 5000} {census 8000} {census 4000}
   }
   return "   need [? $a].
   need [? $b].
   predict [? $c].
   subjects from [? $d]. \n"
     }
  set sumit 1000
  proc advisorx {aa bb} {
   puts " "
   puts "advisor:  new situation " 
   puts [ tidings ]
   puts "advisor: buy or sell, my lord? "

  }
  proc king { aa bb } {
  global sumit
  if { $aa == "buy" } {set token [ expr { 1.* $bb } ] }
  if { $aa == "sell" } {set token [ expr { -1.* $bb } ] }
  set sumit [ expr { $sumit + $token } ]
  puts " decision was $aa $bb, total was $sumit "
  advisorx 50 50   
  }
   puts [ tidings ]
   puts "buy or sell, my lord? "
   puts " starts with 1000 units "
   puts "answer has form:  king buy 20 or king sell 30  "



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

----
 
***FIRST VERSION*** 

======
        #start of deck  
        #start of deck
        #start of deck
        #start of deck

 #:by gold,   Game kingdom of strategy

 # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 1Aug2010

  
  package require Tk
     
       proc ? L {
       lindex $L [expr {int(rand()*[llength $L])}]
       }
       if 0 {This is used several times in:}
     proc tidings {} {
   set a {
     {70 measures of barleys} {20 measures of barley} {10 measures of barley}
     {10 measures of barley} {50 measures of barley}
   }
   set b {
     {400 barleyfields of land} {60 barleyfields of land} {50 barleyfields of land}
     {100 barleyfields of land} {20 barleyfields of land}
   }
   set c {rain dry heat cold drought  snow }
   set d {
      {census 1000} {census 3000} {census 2000} {census 5000} {census 8000} {census 4000}
   }
   return "   need [? $a].
   need [? $b].
   predict [? $c].
   subjects from [? $d].  
   ans.form:king buy 20 or king sell 30 \n                         "
     }
      proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
    #proc poly args {eval .cv create polygon $args}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    proc transnumber {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext \u4E00}
    if { $item == 5 } {lappend choutext \u3024}
    if { $item == 6 } {lappend choutext \u4E00}
    if { $item == 7 } {lappend choutext \u4E00}
    if { $item == 8 } {lappend choutext \u3024}
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}
    proc advisorcom {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext "second rate" }
    if { $item == 2 } {lappend choutext "fifth rate" }
    if { $item == 3 } {lappend choutext "performance comparable to bonzo" }
    if { $item == 4 } {lappend choutext "fourth rate" }
    if { $item == 5 } {lappend choutext "no bread left" }
    if { $item == 6 } {lappend choutext "surving inhabitants have fled" }
    if { $item == 7 } {lappend choutext "third rate" }
    if { $item == 8 } {lappend choutext "lacking any sense" }
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}  

  set counter 0
  set sumit 1000
  set sumitland 1000
  set sumitbarley 1000
  proc winnerx {aa bb} {
  global sumit sumitland sumitbarley
  puts "end of game"
  .zzz delete 0 end
  .xxx delete 0 end
  .t delete 1.0 end
  .t insert 1.0 "end of game"
  .zzz insert 0 "end of game"
  .xxx insert 0 "end of game"
  if { $sumit >= 500 } {
  .zzz insert 0 "winner declared"
  .xxx insert 0 "winner declared"
 .t insert 1.0 "winner declared"
     puts "winner declared"
  }
   if { $sumitland >= 500 } {
  .zzz insert 0 "winner declared"
  .xxx insert 0 "winner declared"
  .t insert 1.0 "winner declared"
   puts "winner declared"
  }
   if { $sumitbarley >= 500 } {
  .zzz insert 0 "winner declared"
  .xxx insert 0 "winner declared"
   .t insert 1.0 "winner declared"
   puts "winner declared"
  }



  }
  proc advisorx {aa bb} {
     global counter
  if { $counter >= 5 } {winnerx $aa $bb }
  .t delete 1.0 end  
   puts " "
   puts "advisor:  new situation " 
   if { $counter <= 6 } { 
     .t insert 1.0 [ tidings ] } 


    if { $counter >= 6 } { 
     .t delete 1.0 end } 

  
   puts  [.t get 1.0 end ]
   puts "advisor: buy or sell, my lord? "
   incr counter
  }
  proc king { aa bb cc} {
  global sumit sumitland sumitbarley 
  if { $aa == "buy" } {set token [ expr { 1.* $bb } ] }
  if { $aa == "sell" } {set token [ expr { -1.* $bb } ] }
  set sumit [ expr { $sumit + $token } ]
  if { $cc == "land" } { set sumitland [ expr { $sumitland + $token } ] }
  if { $cc == "barley" } { set sumitbarley [ expr { $sumitbarley + $token } ] }

  puts " decision was $aa $bb, total was $sumit, land $sumitland, barley $sumitbarley "
  puts " advisor says   [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]]   "
  advisorx 50 50
  }
   #puts [ tidings ]
   #puts "buy or sell, my lord? "
   #puts " starts with 1000 units "
   #puts "answer has form:  king buy 20 or king sell 30  "
    set listx [ transnumber $lister ]
    proc tactics  {w} {
    global listx
    set yy 100
    set font3 {Hevetica 20}
    set font5 {Hevetica 150}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    $w create rect 150 50 250 400 -fill gold 
    $w create polygon  -80 100  -80 70  -50 70  -20 -10  -40 -50  -20 -100  20 -100  40 -50  20 -10  50 70  80 

70  80 100 -fill gold -tags figure
    $w move figure 150 150
    # $w create text 200 400 -text \u2617  -tags "text" -fill tan -font $font5
    foreach i {1 2 3 4 5 6 } {
    $w create text 200 $yy -text [lpick $listx ]  -tags "text"  -font $font3
    incr yy 50
    }
    }








      proc clrcanvas {w} {
    global counter
   $w delete  "all"
   .zzz delete  0 end  
   .xxx delete  0 end  
   .t delete 1.0 end
    set counter 0
  }

 
  proc leave {w} {
     exit
  }

   proc board {w} {
    #set state3 1
    set state2 1
    clrcanvas $w
    . configure -background orange -highlightcolor brown -relief raised -border 30
    $w configure -bg tan
     
    }
  proc  talkit {w} {
   .t delete 1.0 end
  # .t insert 1.0 [ tidings ]
   
   }
   proc  replyit {w} {

   .zzz delete  0 end  
   .xxx delete  0 end  
   .zzz insert  end "advisor:buy or sell, my lord?"
   .xxx insert  end "king "
   }
    set keeperer { 1 2 3 }
    proc  record {w} {
     global side2 side1 buy sell 
   
      
   lappend keeperer $side2
   lappend keeperer $side1
   puts $keeperer
   eval [ split  $side1 " " ]
   }

   proc  reportx {w} {
   console show
    puts "fifth rate"
    puts "performance comparable to bonzo"
    puts "surving inhabitants have fled"
    puts "mandated poll results"
    puts "lacking any sense"
    puts "second rate";
    puts "no bread left"
    puts "third rate"
    puts "quit day job"
   }

    proc castle {w} {
      global dx dy 
      set dx 50
      set dy 30
      set gualisting { 8 8 8 8 8 7 }
      set second_hexagram { 8 8 8 8 8 7 }
      set colorx black;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx brown;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx brown;
         if { $j == 1} {
        if { [lindex $gualisting $i ] == 6} {set colorx tan}

         if { [lindex $gualisting $i ] == 7} {set colorx brown}
         if { [lindex $gualisting $i ] == 8} {set colorx tan}
         if { [lindex $gualisting $i ] == 9} {set colorx brown}
         }

          $w create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}
            set dx 50
            set dy 30
          set colorx blue;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx blue;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx blue;
         if { $j == 1} {
        if { [lindex $second_hexagram $i ] == 6} {set colorx tan}

         if { [lindex $second_hexagram $i ] == 7} {set colorx blue}
         if { [lindex $second_hexagram $i ] == 8} {set colorx tan}
         if { [lindex $second_hexagram $i ] == 9} {set colorx blue}
         }

          $w create rectangle [expr $x + 180] $y [expr {[expr $x +180 ]+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}

     }
    proc about {w} {
    set msg "Game kingdom of strategy.
          from TCL WIKI,
          written on eTCL "
    
    tk_messageBox -title "About" -message $msg
    }

  #: Main :
  frame .f1
  frame .f2
  frame .f3
  pack  .f1 .f2 .f3

  set maxX 400
  set maxY 300
  set y      0

  set x1 120
  set x2 150
  set y1  50
  set y2  80

  canvas  .cv -width $maxX -height $maxY  -bg tan
  pack    .cv -in .f1
  
   #set side2 2
  button  .b0 -text "clear" -command { clrcanvas .cv }
  button  .b3 -text "castle"   -command {clrcanvas .cv; castle   .cv }
  button  .b5 -text "wildcard"   -command {clrcanvas .cv; tactics   .cv }
     
      button  .b6 -text "record"   -command { record  .cv }
      button  .b7 -text "situation"   -command {talkit .cv; replyit .cv; advisorx 50 50  }
      button .b4 -text "console"   -command {reportx .cv  }
      button  .b8 -text "exit"   -command {leave   .cv } 
      button  .b9 -text "about"   -command {about   .cv } 
      text .t -width 40 -height 5 -bg bisque
      entry .xxx -width 50  -bg bisque -textvariable side1
      entry .zzz -width 50 -textvariable side2 -bg bisque
     pack .b0 .b3 .b5  .b6 .b7 .b7 .b4 .b9 .b8  -in .f2  -side left -padx 2
  .f2 configure  -bg orange
      label .kingx  -text "king" 
      label .advisora  -text "advisor" 
      #text .r -width 40 -height 5 -bg bisque
      pack  .advisora .zzz .t   .kingx  .xxx -in .f3  -side bottom -padx 2
      focus .xxx
      focus .zzz
      board   .cv
   
     bind . <Motion> {wm title . " Game kingdom of strategy "}

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







***Version with added hacks ***



        #start of deck
        #start of deck
 #:by gold,   Game kingdom of strategy

 # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 1Aug2010

  
  package require Tk
     
       proc ? L {
       lindex $L [expr {int(rand()*[llength $L])}]
       }
       if 0 {This is used several times in:}
     proc tidings {} {
   set a {
     {70 liters of grains} {20 liters of grain} {10 liters of grain}
     {10 liters of grain} {50 liters of grain}
   }
   set b {
     {400 hectares of land} {60 hectares of land} {50 hectares of land}
     {100 hectares of land} {20 hectares of land}
   }
   set c {rain dry heat cold drought  snow }
   set d {
      {census 1000} {census 3000} {census 2000} {census 5000} {census 8000} {census 4000}
   }
   return "   need [? $a].
   need [? $b].
   predict [? $c].
   subjects from [? $d].  
   ans.form:king buy 20 or king sell 30 \n                         "
     }
      proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
    #proc poly args {eval .cv create polygon $args}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    proc transnumber {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext \u4E00}
    if { $item == 5 } {lappend choutext \u3024}
    if { $item == 6 } {lappend choutext \u4E00}
    if { $item == 7 } {lappend choutext \u4E00}
    if { $item == 8 } {lappend choutext \u3024}
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}
    proc advisorcom {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext "second rate" }
    if { $item == 2 } {lappend choutext "fifth rate" }
    if { $item == 3 } {lappend choutext "performance comparable to bonzo" }
    if { $item == 4 } {lappend choutext "fourth rate" }
    if { $item == 5 } {lappend choutext "no bread left" }
    if { $item == 6 } {lappend choutext "surving inhabitants have fled" }
    if { $item == 7 } {lappend choutext "third rate" }
    if { $item == 8 } {lappend choutext "lacking any sense" }
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}  

  set counter 0
  set sumit 1000
  set sumitland 1000
  set sumitbarley 1000
  proc winnerx {aa bb} {
  puts "end of game"
  .zzz delete 0 end
  .xxx delete 0 end
  .t delete 1.0 end
  .t insert 1.0 "end of game"
  .zzz insert 0 "end of game"
  .xxx insert 0 "end of game"
  }
  proc advisorx {aa bb} {
     global counter
  if { $counter >= 5 } {winnerx $aa $bb }
  .t delete 1.0 end  
   puts " "
   puts "advisor:  new situation " 
   if { $counter <= 6 } { 
     .t insert 1.0 [ tidings ] } 


    if { $counter >= 6 } { 
     .t delete 1.0 end } 

  
   puts  [.t get 1.0 end ]
   puts "advisor: buy or sell, my lord? "
   incr counter
  }
  proc king { aa bb } {
  global sumit
  if { $aa == "buy" } {set token [ expr { 1.* $bb } ] }
  if { $aa == "sell" } {set token [ expr { -1.* $bb } ] }
  set sumit [ expr { $sumit + $token } ]
  puts " decision was $aa $bb, total was $sumit "
  puts " advisor says   [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]]   "
  advisorx 50 50
  }
   #puts [ tidings ]
   #puts "buy or sell, my lord? "
   #puts " starts with 1000 units "
   #puts "answer has form:  king buy 20 or king sell 30  "
    set listx [ transnumber $lister ]
    proc tactics  {w} {
    global listx
    set yy 100
    set font3 {Hevetica 20}
    set font5 {Hevetica 150}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    $w create rect 150 50 250 400 -fill gold 
    $w create polygon  -80 100  -80 70  -50 70  -20 -10  -40 -50  -20 -100  20 -100  40 -50  20 -10  50 70  80 

70  80 100 -fill gold -tags figure
    $w move figure 150 150
    # $w create text 200 400 -text \u2617  -tags "text" -fill tan -font $font5
    foreach i {1 2 3 4 5 6 } {
    $w create text 200 $yy -text [lpick $listx ]  -tags "text"  -font $font3
    incr yy 50
    }
    }








      proc clrcanvas {w} {
    global counter
   $w delete  "all"
   .zzz delete  0 end  
   .xxx delete  0 end  
   .t delete 1.0 end
    set counter 0
  }

 
  proc leave {w} {
     exit
  }

   proc board {w} {
    #set state3 1
    set state2 1
    clrcanvas $w
    . configure -background orange -highlightcolor brown -relief raised -border 30
    $w configure -bg tan
     
    }
  proc  talkit {w} {
   .t delete 1.0 end
  # .t insert 1.0 [ tidings ]
   
   }
   proc  replyit {w} {

   .zzz delete  0 end  
   .xxx delete  0 end  
   .zzz insert  end "advisor:buy or sell, my lord?"
   .xxx insert  end "king "
   }
    set keeperer { 1 2 3 }
    proc  record {w} {
     global side2 side1 buy sell 
   
      
   lappend keeperer $side2
   lappend keeperer $side1
   puts $keeperer
   eval [ split  $side1 " " ]
   }

   proc  reportx {w} {
   console show
    puts "fifth rate"
    puts "performance comparable to bonzo"
    puts "surving inhabitants have fled"
    puts "mandated poll results"
    puts "lacking any sense"
    puts "second rate";
    puts "no bread left"
    puts "third rate"
    puts "quit day job"
   }

    proc castle {w} {
      global dx dy 
      set dx 50
      set dy 30
      set gualisting { 8 8 8 8 8 7 }
      set second_hexagram { 8 8 8 8 8 7 }
      set colorx black;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx brown;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx brown;
         if { $j == 1} {
        if { [lindex $gualisting $i ] == 6} {set colorx tan}

         if { [lindex $gualisting $i ] == 7} {set colorx brown}
         if { [lindex $gualisting $i ] == 8} {set colorx tan}
         if { [lindex $gualisting $i ] == 9} {set colorx brown}
         }

          $w create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}
            set dx 50
            set dy 30
          set colorx blue;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx blue;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx blue;
         if { $j == 1} {
        if { [lindex $second_hexagram $i ] == 6} {set colorx tan}

         if { [lindex $second_hexagram $i ] == 7} {set colorx blue}
         if { [lindex $second_hexagram $i ] == 8} {set colorx tan}
         if { [lindex $second_hexagram $i ] == 9} {set colorx blue}
         }

          $w create rectangle [expr $x + 180] $y [expr {[expr $x +180 ]+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}

     }
    proc about {w} {
    set msg "Game kingdom of strategy.
          from TCL WIKI,
          written on eTCL "
    
    tk_messageBox -title "About" -message $msg
    }

  #: Main :
  frame .f1
  frame .f2
  frame .f3
  pack  .f1 .f2 .f3

  set maxX 400
  set maxY 300
  set y      0

  set x1 120
  set x2 150
  set y1  50
  set y2  80

  canvas  .cv -width $maxX -height $maxY  -bg tan
  pack    .cv -in .f1
  
   #set side2 2
  button  .b0 -text "clear" -command { clrcanvas .cv }
  button  .b3 -text "castle"   -command {clrcanvas .cv; castle   .cv }
  button  .b5 -text "wildcard"   -command {clrcanvas .cv; tactics   .cv }
     
      button  .b6 -text "record"   -command { record  .cv }
      button  .b7 -text "situation"   -command {talkit .cv; replyit .cv; advisorx 50 50  }
      button .b4 -text "console"   -command {reportx .cv  }
      button  .b8 -text "exit"   -command {leave   .cv } 
      button  .b9 -text "about"   -command {about   .cv } 
      text .t -width 40 -height 5 -bg bisque
      entry .xxx -width 50  -bg bisque -textvariable side1
      entry .zzz -width 50 -textvariable side2 -bg bisque
     pack .b0 .b3 .b5  .b6 .b7 .b7 .b4 .b9 .b8  -in .f2  -side left -padx 2
  .f2 configure  -bg orange
      label .kingx  -text "king" 
      label .advisora  -text "advisor" 
      #text .r -width 40 -height 5 -bg bisque
      pack  .advisora .zzz .t   .kingx  .xxx -in .f3  -side bottom -padx 2
      focus .xxx
      focus .zzz
      board   .cv
   
     bind . <Motion> {wm title . " Game kingdom of strategy "}
        
       #end of deck
      #end of deck
      #end of deck
      #end of deck      
      #end of deck
     #end of deck
======

***Version with added hacks ***

======



    #start of deck
        #start of deck
        #start of deck 
 
   # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 17Jul2010

    package require Tk
         #start of deck
        #start of deck
        #start of deck 
 


 #:by gold,   Game kingdom of strategy

 # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 1Aug2010

  
  package require Tk
       proc ? L {
       lindex $L [expr {int(rand()*[llength $L])}]
       }
     proc tidings {} {
   set a {
     {70 liters of grains} {20 liters of grain} {10 liters of grain}
     {10 liters of grain} {50 liters of grain}
   }
   set b {
     {400 hectares of land} {60 hectares of land} {50 hectares of land}
     {100 hectares of land} {20 hectares of land}
   }
   set c {rain dry heat cold drought  snow }
   set d {
      {census 1000} {census 3000} {census 2000} {census 5000} {census 8000} {census 4000}
   }
   return "   need [? $a].
   [? $b].
   predicted [? $c].
   subjects from [? $d]. \n"
     }
      proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
    #proc poly args {eval .cv create polygon $args}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    proc transnumber {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext \u4E00}
    if { $item == 5 } {lappend choutext \u3024}
    if { $item == 6 } {lappend choutext \u4E00}
    if { $item == 7 } {lappend choutext \u4E00}
    if { $item == 8 } {lappend choutext \u3024}
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}
    set listx [ transnumber $lister ]
    proc tactics  {w} {
    global listx
    set yy 100
    set font3 {Hevetica 20}
    set font5 {Hevetica 150}
    set lister { 5 5 6 6 6 6 6 6 7 7 7 7 8 8 1 1 1 1 1 1 1 1 1 }
    $w create rect 150 50 250 400 -fill gold 
    $w create polygon  -80 100  -80 70  -50 70  -20 -10  -40 -50  -20 -100  20 -100  40 -50  20 -10  

50 70  80 70  80 100 -fill gold -tags figure
    $w move figure 150 150
    # $w create text 200 400 -text \u2617  -tags "text" -fill tan -font $font5
    foreach i {1 2 3 4 5 6 } {
    $w create text 200 $yy -text [lpick $listx ]  -tags "text"  -font $font3
    incr yy 50
    }
    }








      proc clrcanvas {w} {
    $w delete  "all"
  }

 
  proc leave {w} {
     exit
  }

   proc board {w} {
    #set state3 1
    set state2 1
    clrcanvas $w
    . configure -background orange -highlightcolor brown -relief raised -border 30
    $w configure -bg tan
     
    }
  proc  talkit {w} {
   .t insert 1.0 [ tidings ]
   
   }
   proc  reportx {w} {
   console show
    puts "fifth rate"
    puts "performance comparable to bonzo"
    puts "surving inhabitants have fled"
    puts "mandated poll results"
    puts "lacking any sense"
    puts "second rate";
    puts "no bread left"
    puts "third rate"
    puts "quit day job"
   }

    proc castle {w} {
      global dx dy 
      set dx 50
      set dy 30
      set gualisting { 8 8 8 8 8 7 }
      set second_hexagram { 8 8 8 8 8 7 }
      set colorx black;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx brown;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx brown;
         if { $j == 1} {
        if { [lindex $gualisting $i ] == 6} {set colorx tan}

         if { [lindex $gualisting $i ] == 7} {set colorx brown}
         if { [lindex $gualisting $i ] == 8} {set colorx tan}
         if { [lindex $gualisting $i ] == 9} {set colorx brown}
         }

          $w create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}
            set dx 50
            set dy 30
          set colorx blue;
      for {set i 0; set y 100} {$i<6} {incr i; incr y $dy} {
           set colorx blue;
       for {set j 0; set x 50} {$j<3} {incr j; incr x $dx} {
         set colorx blue;
         if { $j == 1} {
        if { [lindex $second_hexagram $i ] == 6} {set colorx tan}

         if { [lindex $second_hexagram $i ] == 7} {set colorx blue}
         if { [lindex $second_hexagram $i ] == 8} {set colorx tan}
         if { [lindex $second_hexagram $i ] == 9} {set colorx blue}
         }

          $w create rectangle [expr $x + 180] $y [expr {[expr $x +180 ]+$dx}] [expr {$y+$dy}] \
            -fill $colorx

          }}

     }

  #: Main :
  frame .f1
  frame .f2
  frame .f3
  pack  .f1 .f2 .f3

  set maxX 400
  set maxY 450
  set y      0

  set x1 120
  set x2 150
  set y1  50
  set y2  80

  canvas  .cv -width $maxX -height $maxY  -bg tan
  pack    .cv -in .f1

  button  .b0 -text "clear" -command { clrcanvas .cv }
  button  .b3 -text "castle"   -command {clrcanvas .cv; castle   .cv }
  button  .b5 -text "wildcard"   -command {clrcanvas .cv; tactics   .cv }
     
      button  .b6 -text "exit"   -command { leave  .cv }
      button  .b7 -text "situation"   -command {talkit .cv  }
      button .b4 -text "console"   -command {reportx .cv  }
      button  .b8 -text "exit"   -command {leave   .cv } 
      text .t -width 40 -height 5 -bg bisque
 pack .b0 .b3 .b5  .b6 .b7 .b7 .b4 .b8 .t -in .f2  -side left -padx 2
  .f2 configure  -bg orange
     board   .cv
   
     bind . <Motion> {wm title . " Game kingdom of strategy "}


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

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




   # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 17Jul2010
 


    #end of deck
    #end of deck
   #end of deck
   #end of  deck
   #end of deck
   #end of deck
    #end of deck
 
======
***Extra Program*** 
======
    ======
 
***Real TEST on  trial code trial code***

 #note: this Tkpaint diagram 
 # script is *correct* in the wiki editor.
 # It is rewrapping on the Wiki display page.
  set maxX 400
  set maxY 400
  set y      0

  set x1 120
  set x2 150
  set y1  50
  set y2  80

 pack [ canvas  .c  -width $maxX -height $maxY  -bg bisque ]
set Graphics(arrowshape) {8 10 4}
set Graphics(fill,color) {}
set Graphics(fill,style) {}
set Graphics(font,bold) 1
set Graphics(font,color) black
set Graphics(font,italic) 0
set Graphics(font,normal) 0
set Graphics(font,overstrike) 0
set Graphics(font,roman) 0
set Graphics(font,size) 10
set Graphics(font,stipple) {}
set Graphics(font,style) bold
set Graphics(font,type) Arial
set Graphics(font,underline) 0
set Graphics(grid,on) 0
set Graphics(grid,size) 10m
set Graphics(grid,snap) 1
set Graphics(line,arrow) none
set Graphics(line,capstyle) butt
set Graphics(line,color) black
set Graphics(line,joinstyle) miter
set Graphics(line,smooth) 0
set Graphics(line,style) {}
set Graphics(line,width) 1
set Graphics(mode) NULL
set Graphics(shape) circle
set Graphics(snap,on) 0
set Graphics(snap,size) 1
set Graphics(splinesteps) 20
set Graphics(text,anchor) c
set Graphics(ticks,on) 0
set Graphics(mode) NULL
### End of Graphics parameters


set Zoom(button,text) 100%
set Zoom(caller) {}
set Zoom(factor) 1
set Zoom(font,size) 10
set Zoom(selected,button) 1
set utagCounter 62


set Image(ctr) 0


set Canv(H) 368
set Canv(W) 610
set Canv(SH) 1500
set Canv(SW) 1500
set Canv(bg) white
.c config -width $Canv(W)  -height $Canv(H)  -bg $Canv(bg)  -scrollregion "0 0 $Canv(SW) $Canv(SH)"
wm geometry . ""
.c xview moveto 0
.c yview moveto 0
set TextInfo(utag52) {Game  kingdom  of  strategy}
set TextInfo(utag34) {}
set TextInfo(utag16) initial
set TextInfo(utag53) {}
set TextInfo(utag17) {random
situation}
set TextInfo(utag54) {TCL  WIKI}
set TextInfo(utag18) {}
set TextInfo(utag19) stop
set TextInfo(utag20) {}
set TextInfo(utag56) {}
set TextInfo(utag21) {}
set TextInfo(utag57) LOOP
set TextInfo(utag39) stop
set TextInfo(utag22) {winner declared}
set TextInfo(utag58) {COUNTER  >  5}
set TextInfo(utag23) {}
set TextInfo(utag60) {}
set TextInfo(utag42) {set  counter}
set TextInfo(utag61) {call  records}
set TextInfo(utag43) {call first  situation}
set TextInfo(utag25) records
set TextInfo(utag62) {incr  counter}
set TextInfo(utag26) {}
set TextInfo(utag27) ratings
set TextInfo(utag28) {       counts}
set TextInfo(utag47) totals
set TextInfo(utag29) {}
set TextInfo(utag12) {new situation}
set TextInfo(utag48) {}
set TextInfo(utag13) {}
set TextInfo(utag50) {}
set TextInfo(utag49) {}
set TextInfo(utag14) king
set TextInfo(utag51) {}
set TextInfo(utag15) advisor
.c create line 387.0 140.0 409.0 192.0 449.0 139.0 385.0 140.0 -joinstyle miter -tags {Line obj utag2}
.c create line 210.0 37.0 232.0 89.0 272.0 36.0 208.0 37.0 -joinstyle miter -tags {Line obj utag3}
.c create line 195.0 140.0 217.0 192.0 257.0 139.0 193.0 140.0 -joinstyle miter -tags {Line obj utag6}
.c create line 43.0 274.0 65.0 326.0 105.0 273.0 41.0 274.0 -joinstyle miter -tags {Line obj utag5}
.c create line 52.0 146.0 74.0 198.0 114.0 145.0 50.0 146.0 -joinstyle miter -tags {Line obj utag4}
.c create oval 126.0 214.0 294.0 276.0 -tags {Ellipse obj utag11}
.c create oval 332.0 287.0 500.0 349.0 -tags {Ellipse obj utag9}
.c create text 206.0 240.0 -font {Arial 10 bold} -text {new situation} -tags {text obj utag12}
.c create text 68.0 286.0 -font {Arial 10 bold} -text king -tags {text obj utag14}
.c create text 81.0 155.0 -font {Arial 10 bold} -text advisor -tags {text obj utag15}
.c create text 238.0 47.0 -font {Arial 10 bold} -text initial -tags {text obj utag16}
.c create text 216.0 155.0 -font {Arial 10 bold} -text {random
situation} -tags {text obj utag17}
.c create text 416.0 317.0 -font {Arial 10 bold} -text {winner declared} -tags {text obj utag22}
.c create rectangle 347.0 220.0 482.0 267.0 -tags {Rectangle obj utag24}
.c create text 419.0 241.0 -font {Arial 10 bold} -text records -tags {text obj utag25}
.c create text 481.0 146.0 -font {Arial 10 bold} -text ratings -tags {text obj utag27}
.c create text 466.0 165.0 -font {Arial 10 bold} -text {       counts} -tags {text obj utag28}
.c create line 232.0 95.0 233.0 127.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag31}
.c create line 264.0 153.0 377.0 151.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag32}
.c create line 72.0 207.0 74.0 262.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag33}
.c create line 120.0 156.0 177.0 155.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag35}
.c create line 146.0 275.0 102.0 289.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag36}
.c create line 410.0 197.0 410.0 213.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag37}
.c create line 416.0 272.0 416.0 283.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag38}
.c create text 555.0 319.0 -font {Arial 10 bold} -text stop -tags {text obj utag39}
.c create line 506.0 318.0 522.0 318.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag40}
.c create line 217.0 195.0 217.0 208.0 -arrow last -arrowshape {8 10 4} -joinstyle miter -tags {Line obj utag41}
.c create text 320.0 66.0 -font {Arial 10 bold} -text {set  counter} -tags {text obj utag42}
.c create text 339.0 47.0 -font {Arial 10 bold} -text {call first  situation} -tags {text obj utag43}
.c create text 416.0 151.0 -font {Arial 10 bold} -text totals -tags {text obj utag47}
.c create text 218.0 18.0 -font {Arial 18 bold} -text {Game  kingdom  of  strategy} -tags {text obj utag52}
.c create text 224.0 339.0 -font {Arial 18 bold} -text {TCL  WIKI} -tags {text obj utag54}
.c create line 32.000  177.0 29.67  23.999    -arrow first -arrowshape {8 10 4} -smooth 1 -tags {arc arc obj utag55 spline}
.c create text 44.0 224.0 -font {Arial 10 bold} -text LOOP -tags {text obj utag57}
.c create text 322.0 134.0 -font {Arial 10 bold} -text {COUNTER  >  5} -tags {text obj utag58}
.c create oval 529.0 296.0 577.0 344.0 -tags {Circle obj utag59}
.c create text 501.0 185.0 -font {Arial 10 bold} -text {call  records} -tags {text obj utag61}
.c create text 278.0 183.0 -font {Arial 10 bold} -text {incr  counter} -tags {text obj utag62}



  
----


----

***test on  trial code trial code***
We could bust up or split
     phrases looking for words buy or sell ,
     and no not sell.
     set answer [split $lister "" ]
     llength $answer
     foreach item {buy sell no not nay } {
     lsearch all $answer $item
      }    
     if we find one of the command words in list,
     does it operate on the next number found?
     Better check on how to identify a number element?
     say if { catch{ expr { 1.*$element} != 1 }
         foreach item $bee1 {
      if { [catch {expr {1 * $item}}] >> 0} {lappend cat  $item }

      if { [catch {expr {1 * $item}}] == 0 } {lappend bat [ expr 200*$factor*.1 + $item * log($factor)  ]}
       }

 #start of deck
        #start of deck
        #start of deck 
 
 #:by gold,   trial console operation

 # written on Windowws XP on eTCL
     # working under TCL version 8.5.6 and eTCL 1.0.1
     # gold on TCL WIKI , 1Aug2010




    console show 
      proc ? L {
       lindex $L [expr {int(rand()*[llength $L])}]
       }
    proc lpick L {lindex $L [expr int(rand()*[llength $L])];}
    proc advisorcom {lister} {
     set choutext [list ]
    foreach item $lister {
    if { $item == 1 } {lappend choutext "second rate" }
    if { $item == 2 } {lappend choutext "fifth rate" }
    if { $item == 3 } {lappend choutext "performance comparable to bonzo" }
    if { $item == 4 } {lappend choutext "fourth rate" }
    if { $item == 5 } {lappend choutext "no bread left" }
    if { $item == 6 } {lappend choutext "surving inhabitants have fled" }
    if { $item == 7 } {lappend choutext "third rate" }
    if { $item == 8 } {lappend choutext "lacking any sense" }
    if { $item >= 9 } {lappend choutext ? }
    }
    return $choutext}
     








     proc tidings {} {
   set a {
     {70 liters of grains} {20 liters of grain} {10 liters of grain}
     {10 liters of grain} {50 liters of grain}
   }
   set b {
     {400 hectares of land} {60 hectares of land} {50 hectares of land}
     {100 hectares of land} {20 hectares of land}
   }
   set c {rain dry heat cold drought  snow }
   set d {
      {census 1000} {census 3000} {census 2000} {census 5000} {census 8000} {census 4000}
   }
   return "   need [? $a].
   need [? $b].
   predict [? $c].
   subjects from [? $d]. \n"
     }
  set sumit 1000
  set sumitland 1000
  set sumitbarley 1000

  proc advisorx {aa bb} {
   puts " "
   puts "advisor:  new situation " 
   puts [ tidings ]
   puts "advisor: buy or sell, my lord? "

  }
  proc king { aa bb } {
  global sumit
  if { $aa == "buy" } {set token [ expr { 1.* $bb } ] }
  if { $aa == "sell" } {set token [ expr { -1.* $bb } ] }
  set sumit [ expr { $sumit + $token } ]
  puts " decision was $aa $bb, total was $sumit "
  puts " advisor says   [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]]   "
  advisorx 50 50
  }
   puts [ tidings ]
   puts "buy or sell, my lord? "
   puts " starts with 1000 units "
   puts "answer has form:  king buy 20 or king sell 30  "



       
<<categories>> Toys | Example | Games | Characters | Math  | Math |