Version 124 of Game kingdom of strategy

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 I am trying to find out the status of the old game. A strategy game can be cobbled from older scraps of Iching code. Using the Iching code, this page presents a trial console version for testing the concept, a console version, and a canvas version with some graphics, 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. The random pick algorithm was posted by Suchenworth RS on Horseracing in Tcl. Another source of randomness was A funny cookbook.

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: analyze 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 responses 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 advantage 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 responses 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 script
    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 response 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"

Followup note: I was able to compile this TCL game on the freewrap TCL compiler for the pc. I've about reached the limit without some feedback. Also, I found a Facebook game called Farmville, with some similar features.

Note: Quite possible to add the Eliza namespace to the game. This will get some context sensitive analysis/quirks into the game. Refer to A simple version of Eliza.

      Console:  king sell 11 barley 
     1% ::Talk::replyto { barley }
      advisor says : Shall we continue? 
     2% ::Talk::replyto { king sell barley }
       advisor says worried about total  barleyfields. ? 
     3% ::Talk::replyto { king sell 11 barley }
       advisor says : worried about total barleyfields. ? 
     4% king sell 11 barley
     decision was sell 11, total was   land 1000, barley 989.0

Screenshots Section

Comments Section

Please place any comments here, Thanks.

gold Changes.

What is your purpose in binding the motion event on your main window to execute the wm title command. I.e., this line:

  bind . <Motion> {wm title . " Game kingdom of strategy "}

The result of that binding is that every time you move the mouse, the "wm title" subcommand is called repeatedly. To set the window title, you just need to call "wm title . title" once, not on every event update upon mouse pointer motion.

References

appendix TCL programs

    #  pretty print autoindent from ased editor
    #  trial console operation    
    # written on Windows 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  "

 ----

FIRST VERSION

        #  pretty print autoindent from ased editor
        #: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 99} {census 100} {census 120} {census 110} {census 120} {census 80}
            }
            return "   need [? $a].
            need [? $b].
            predict [? $c].
            subjects from [? $d].
            ans.form:king buy 20 land  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 loser5 0
        set counter 0
        set sumit 1000
        set sumitland 1000
        set sumitbarley 1000
        proc winnerx {aa bb} {
            global sumit sumitland sumitbarley
            global sumarians liters winner5
            global loser5
            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 { $sumarians >= 120 } {
                .zzz insert 0 " king is winner declared "
                .xxx insert 0 " king is winner declared "
                .t insert 1.0 " king is winner declared "
                puts " king is winner declared "
                set winner5 1
            }
            if { $sumitland >= 700 } {
                .zzz insert 0 "king is winner declared"
                .xxx insert 0 "king is winner declared"
                .t insert 1.0 "king is winner declared"
                puts "king is winner declared"
                set winner5 1
            }
            if { $sumarians <= 40 } {
                .zzz insert 0 "loser declared"
                .xxx insert 0 "loser declared"
                .t insert 1.0 "loser declared"
                puts "loser declared"
                set loser5 1
            }
            if { $sumitbarley <= 300 } {
                .zzz insert 0 "loser declared"
                .xxx insert 0 "loser declared"
                .t insert 1.0 "loser declared"
                puts "loser declared"
                set loser5 1
            }
        }
        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 ]
                .zzz delete  0 end
                set bl "               "
                .zzz insert  end "advisor:buy or sell, my lord? $bl (for year $counter )"
            }
            if { $counter >= 6 } {
                .t delete 1.0 end }
            puts  [.t get 1.0 end ]
            puts "advisor: buy or sell, my lord? (for year $counter ) "
            incr counter
        }
        set sumarians  100
        proc calculation { aa bb cc dd ee } {
            global counter fieldsdisplay
            global  sumitland sumitbarley
            global  buyland  buybarley sumarians
            set annum    0
            set provisions    1000
            set liters 5000
            set land    1000
            set barleyfields   1000
            set landprice 26
            set litersperacre  3
            set totalmortality   10
            set mortalrateer  10
            set ratliters 1
            set citymortal 5
            set landfraction .1
            set sumariansgain 5
            set produce 4
            set buyland 1
            set buybarley 1
            set plaguethisyear 0
            set ratinfestthisyear 0
            set famineyear 0
            set immigrantyear 0
            set fieldsdisplay 20
            if { [ expr { rand() } ] <= .15 } {set immigrantyear  1 }
            if { [ expr { rand() } ] <= .15 } {set plaguethisyear 1 }
            if { [ expr { rand() } ] <= .41 } {set ratinfestthisyear 1 }
            set ratliters  [ expr { $liters*.1*rand()   } ]
            set ratliters [ expr { int($ratliters) } ]
            set sumariansstarved [ expr { $sumarians*.02*rand()   } ]
            set landfraction  [ expr {   rand() } ]
            if { $immigrantyear == 1 } {
                set sumariansgain   [ expr {  $sumarians  * .05 } ] }
            set sumariansgain   [ expr {  int($sumariansgain) } ]
            set sumarians [ expr { $sumarians + $sumariansgain   } ]
            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 liters $sumitbarley
            set liters [ expr {  $liters + $sumitland*.8 } ]
            set liters [ expr {  $liters - $landprice* $buyland } ]
            set liters [ expr {  $liters - $sumarians* 7 } ]
            set liters [ expr {  $liters - $liters*.1*$ratinfestthisyear } ]
            set liters [ expr { int($liters) } ]
            set foodrequire [ expr {$sumarians*7 }]
            if {   $liters <= $foodrequire   } {
                set sumariansstarved [expr {$sumarians*.2  } ]
                set famineyear 1                                              }
            set sumariansstarved [ expr { int($sumariansstarved)  } ]
            set sumitbarley $liters
            set sumitland  [ expr { int($sumitland)  } ]
            set sumarians  [ expr { $sumarians + $sumarians*.1 -$sumariansstarved} ]
            set sumarians  [ expr { $sumarians - $sumarians*.5*$plaguethisyear } ]
            set sumarians [ expr { int($sumarians) } ]
            set percentfields [ expr { ($sumitland/1000.)*100.   } ]
            set percentfields [ expr { int($percentfields) } ]
            set fieldsdisplay [ expr { 35*$percentfields*.01 } ]
            set fieldsdisplay [ expr {int($fieldsdisplay)  } ]
            if {  $fieldsdisplay <= 1   } { set fieldsdisplay 1 }
            if {  $fieldsdisplay >= 35   } { set fieldsdisplay 35 }
            .cv delete landbarley
            barley .cv $fieldsdisplay
            puts  "annum $counter "
            puts  "$plaguethisyear plague this year,  0 or 1. "
            puts  "$ratinfestthisyear rats infest  this year,  0 or 1."
            puts "$percentfields percent fields "
            puts " $fieldsdisplay  fieldsdisplay "
            puts "$sumariansstarved sumarians starved"
            puts "$sumariansgain immigrated to city."
            puts "census $sumarians  "
            puts "total  $sumitland barleyfields."
            puts "yielded 3 measures per barleyfield"
            puts "rats devoured $ratliters measures."
            puts  "$liters  measures in palace."
            puts "land $landprice measures per barleyfield"
            puts "how many barleyfields do you wish to buy?"
            set listx  "
            annum $counter,   $liters  measures
            census $sumarians,  $sumitland barleyfields.
            $landprice landprice measures
            $plaguethisyear plague this year,  0 or 1.
            $famineyear  famineyear ,0 or 1
            $ratinfestthisyear rats infest  this year,  0 or 1.
            $sumariansstarved sumarians starved
            $sumariansgain immigrated to city.
            census $sumarians
            total  $sumitland barleyfields.
            yielded 3 measures per barleyfield
            rats devoured $ratliters measures.
            $liters  measures in palace.
            land $landprice measures per barleyfield "
            return " $listx "
        }
        proc king { aa bb cc} {
            global  sumitland sumitbarley
            global buyland buybarley
            global counter
            if { $aa == "buy" } {set token [ expr { 1.* $bb } ] }
            if { $aa == "sell" } {set token [ expr { -1.* $bb } ] }
            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 " decision was $aa $bb, total was  land $sumitland, barley $sumitbarley "
            puts " advisor says   [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]]   "
            advisorx 50 50
        }
        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 winner5
            $w delete  "all"
            .zzz delete  0 end
            .xxx delete  0 end
            .t delete 1.0 end
            set counter 0
            set winner5 0
            set loser5 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  replyit {w} {
            global counter
            .t delete 1.0 end
            .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
            global winner5 loser5
            lappend keeperer $side2
            lappend keeperer $side1
            puts $keeperer
            eval [ split  $side1 " " ]
            set results  [ calculation 10 10 10 10 10 ]
            puts $results
            .t delete 1.0 end
            .t insert 1.0 $results
            .zzz delete  0 end
            .zzz insert  end "advisor says: [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]]"
            if { $winner5 == 1} {
                .zzz delete  0 end
                .zzz insert  end "advisor says: king is winner " }
        }
        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 fieldsdisplay
            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 20} {$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 20} {$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 barley {w fieldsdisplay } {
            global dx dy
            set dx 5
            set dy 10
            set gualisting { 8 8 8 8 8 7 }
            set second_hexagram { 8 8 8 8 8 7 }
            set colorx black;
            $w delete landbarley
            for {set i 0; set y 220} {$i<6} {incr i; incr y $dy} {
                set colorx green;
                for {set j 0; set x 30} {$j<$fieldsdisplay} {incr j; incr x $dx} {
                    set colorx green;
                    if { $j == 1} {
                        if { [lindex $gualisting $i ] == 6} {set colorx green}
                        if { [lindex $gualisting $i ] == 7} {set colorx green}
                        if { [lindex $gualisting $i ] == 8} {set colorx green}
                        if { [lindex $gualisting $i ] == 9} {set colorx green}
                    }
$w create rectangle $x $y [expr {$x+$dx}] [expr {$y+$dy}] -fill $colorx -tag landbarley }}
            set dx 5
            set dy 10
            set colorx green;
            for {set i 0; set y 220} {$i<6} {incr i; incr y $dy} {
                set colorx blue;
                for {set j 0; set x 30} {$j<$fieldsdisplay} {incr j; incr x $dx} {
                    set colorx green;
                    if { $j == 1} {
                        if { [lindex $second_hexagram $i ] == 6} {set colorx green}
                        if { [lindex $second_hexagram $i ] == 7} {set colorx green}
                        if { [lindex $second_hexagram $i ] == 8} {set colorx green}
                        if { [lindex $second_hexagram $i ] == 9} {set colorx green}
                    }
   $w create rectangle [expr $x + 180] $y [expr {[expr $x +180 ]+$dx}] [expr {$y+$dy}] -fill $colorx -tag landbarley
                }}
        }
        proc about {w} {
            set msg "Game kingdom of strategy.
            from TCL WIKI,
            written on eTCL
            cmds take form
            king buy 33 land
            king sell 11 land
            king sell 55 barley
            king buy 33 barley "
            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;barley .cv 20; castle  .cv; }
        button  .b5 -text "wildcard"   -command {clrcanvas .cv; tactics   .cv }
        button  .b6 -text "record"   -command { record  .cv }
        button  .b7 -text "situation"   -command {castle .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"
        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 "}