This page is under development. Comments are welcome, but please load any comments in the comments section at the bottom of the page. Please include your wiki MONIKER and date in your comment with the same courtesy that I will give you. Aside from your courtesy, your wiki MONIKER and date as a signature and minimal good faith of any internet post are the rules of this TCL-WIKI. Its very hard to reply reasonably without some background of the correspondent on his WIKI bio page. Thanks, gold 12Dec2018
goldStarted roughly 2011-05-18. Here is an eTCL script on Call Procedure Fortran like. A call statement has some advantages in both Fortran and TCL languages. In some of the Fortran language versions, the call statement was used to call subroutines. For example, a call exit could be used to halt the program execution. For TCL, a call procedure can be developed that does not have to use brackets. A call procedure is a possible sugar for most TCL core commands and subroutines. Also, a similar procedure for Call Return in a TCL subroutine is possible. The call statement may be used to organize programs into a list of subroutines and to exit the program. Exiting a program was not a trivial function in the early days of programming. Usually the dogma was a conditional STOP or END statement at the end of a punched card deck to prevent endless loops. So a statement like "call exit" seemed pretty swank to beginner Fortran programmers. Below, a generic TCL program passes control through various dummy procedures. Some "puts bye " and math statements are used to show control is passing through the procedures.
gold 12Dec2018. I have been informed that an advanced TCL user has added and checked this Call Exit subroutine into his homebrew TCL interpreter on his local copy of TCL on a PC system. I have added this subroutine code to my local TCL copy <meaning the source code library TCLLIB>, but I am not sure this routine adds much to what is already available on TCL.
gold 05Oct2020. A console program was added for experiment on Natural Language, if the King's English is a natural language. The console program was based on the antique program King Hamurabi.bas, ref Game kingdom of strategy. The idea was a limited set of input commands in the King's English, SVO as subject verb object. The initial commands in the computer game were King buy 30 or King sell 20. English is ambiguous language in that terms can either be used as verbs or objects. For example, the above term exit could either be used as a noun or verb, as in please exit though the exit.
console show
proc call {args} {uplevel catch [list $args]}
call initilize ;# list variables
call subroutine1
call subroutine2
call subroutine3
call subroutine4
call exit ;# stop statement
proc initilize
return
proc subroutine1
return
proc subroutine2
return
proc subroutine3
return
proc subroutine4
call math sin(.5)
return
... pseudocode: # autoindent syntax from ased editor.
# call procedure like fortran example
# written on Windows XP on eTCL
# working under TCL version 8.5.6 and eTCL 1.0.1
package require Tk
console show
proc call {args} {uplevel catch [list $args]}
proc math { args } { set tcl_precision 17; puts [ expr [ expr { $args } ] ] }
proc initilize {aa} {
puts "subroutine initilize active"
return }
proc subroutine1 {aa} {
puts "subroutine 1 active"
return }
proc subroutine2 {aa} {
puts "subroutine 2 active"
return }
proc subroutine3 {aa} {
puts "subroutine 3 active"
return }
proc subroutine4 {aa} {
puts "subroutine 4 active"
call math sin (.5)
if { 1 == 1 } { puts "bye" }
if { 1 == 2 } { call exit }
return }
call initilize ;# list variables
call subroutine1 1
call subroutine2 2
call subroutine3 3
call subroutine4 4
call math sin (.5)
if { 1 == 1 } { puts "bye bye" }
% console output
0.479425538604203
bye
0.479425538604203
bye bye console show
proc pie {} {expr acos(-1)}
proc writer {args } { puts $args }
proc call {args} {uplevel catch [list $args]}
call writer "jack" "&" "jill"
call writer jack & jill went up the hill with [pie]% console output jack & jill jack & jill went up the hill with 3.141592653589793
console show
proc pie {} {expr acos(-1)}
proc writer {args } { puts $args }
proc math { args } { set tcl_precision 17; puts [ expr [ expr { $args } ] ] }
proc mathx { args } { set tcl_precision 17; return [ expr [ expr { $args } ] ] }
proc call {args} {uplevel catch [list $args]}
call math 5 + 5
call math 5 + 5
call math sin (.5)
set ccc [ mathx sin (.5) ]
puts " value $ccc "% console output 10 10 0.479425538604203 value 0.479425538604203
#ref. func proc from http://wiki.tcl.tk/14006
#Tacit programming
#Tacit programming.mht,RS
console show
proc pie {} {expr acos(-1)}
set aa 1
proc call {args} {uplevel catch [list $args]}
proc math { args } { set tcl_precision 17; puts [ expr [ expr { $args } ] ] }
proc func {name argl body} {proc $name $argl [list expr $body]}
func atand aa (180./[pie])*atan($aa)
puts " [atand 1. ] "
console show
proc pie {} {expr acos(-1)}
set aa 1
proc call {args} {uplevel catch [list $args]}
proc math { args } { set tcl_precision 17; puts [ expr [ expr { $args } ] ] }
proc func {name argl body} {proc $name $argl [list expr $body]}
func atand aa (180./[pie])*atan($aa)
set aaa [ atand 1. ]
puts $aaa
#end of deckoutput from console with program loaded, gold
1% call subroutine2 call
subroutine 2 active6
% call
0
7% call call
0
8% call call call
0
#trivial (zero list) but no errors from multiple calls. # pretty print autoindent from ased editor
# trial console operation
# Natural Language if King's English? V2
# based on Hamurabi.bas antique game
# written on Windows 10 on TCL
# working under TCL version 8.6
# gold on TCL Club , 05ct2020
# console has large black type on green
# used as testbed for natural language
# if the King's English is a natural language???
# random list proc written by RS
# gold added cosmetics and extensions
package require Tk
package require math::numtheory
package require math::constants
package require math::trig
package require math
namespace path {::tcl::mathop ::tcl::mathfunc math::numtheory math::trig math::constants }
set tclprecision 17
proc ? L {
lindex $L [expr {int(rand()*[llength $L])}] ;# RS
}
proc lpick L {lindex $L [expr int(rand()*[llength $L])];} ;# RS
proc advisor_game_format_examples { value } {
puts " buy or sell, my lord? "
puts " "
puts " kingdom starts with 1000 units land "
puts " "
puts " example statements for king's entry "
puts " can be cut & paste from console"
puts " "
puts "king's answer has lower case form: "
puts "eg. king buy 20 land "
puts "eg. king sell 30 land "
puts "eg. king buy 33 barley "
puts "eg. king sell 11 barley "
puts "eg. for new game, enter command reset 1 "
puts " new advisor prompt follows "
puts " "
puts " buy or sell, my lord? "
}
proc advisorcom {lister} {
set choutext [list ]
foreach item $lister {
if { $item == 1 } {lappend choutext "grain market crashed" }
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 "no milk in frig" }
if { $item == 8 } {lappend choutext "lacking any sense" }
if { $item >= 9 } {lappend choutext "???" }
}
return $choutext}
proc winnerx {aa } {
global sumit sumitland sumitbarley
global sumerians liters winner5
global loser5
puts " end of game "
if { $sumerians >= 120 } {
puts " king is winner declared "
puts " king is winner declared "
puts " king is winner declared "
set winner5 1
}
if { $sumitland >= 700 } {
puts " king is winner declared "
puts " king is winner declared "
puts " king is winner declared"
set winner5 1
}
if { $sumerians <= 40 } {
puts "loser declared"
set loser5 1
}
if { $sumitbarley <= 300 } {
puts "loser declared"
set loser5 1
}
}
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].
example format >> king buy 20 land \n "
}
set sumerians 100
set counter 0
set sumit 1000
set sumitland 1000
set sumitbarley 1000
proc calculation { aa } {
global counter percentfields
global sumit sumitland sumitbarley
global buyland buybarley sumerians
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 sumeriansgain 5
set produce 4
set buyland 1
set buybarley 1
set plaguethisyear 0
set ratinfestthisyear 0
set famineyear 0
set immigrantyear 0
if { [ expr { rand() } ] <= .90 } {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 sumeriansstarved [ expr { $sumerians*.02*rand() } ]
set landfraction [ expr { rand() } ]
set sumeriansgain [ expr { $sumerians * .10 * rand() } ]
set sumeriansgain [ expr { int($sumeriansgain) } ]
set sumerians [ expr { $sumerians + $sumeriansgain } ]
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 - $sumerians* 7 } ]
set liters [ expr { $liters - $liters*.1*$ratinfestthisyear } ]
set liters [ expr { int($liters) } ]
set foodrequire [ expr {$sumerians*7 }]
if { $liters <= $foodrequire } {
set sumeriansstarved [expr {$sumerians*.2 } ]
set famineyear 1 }
set sumeriansstarved [ expr { int($sumeriansstarved) } ]
set sumitbarley $liters
set sumitland [ expr { int($sumitland) } ]
set sumerians [ expr { $sumerians + $sumerians*.1 -$sumeriansstarved} ]
set sumerians [ expr { $sumerians - $sumerians*.5*$plaguethisyear } ]
set sumerians [ expr { int($sumerians) } ]
set percentfields [ expr { ($sumitland/1000.)*100. } ]
if { $percentfields <= 1 } { set percentfields 1 }
if { $percentfields >= 100 } { set percentfields 100 }
set percentfields [ expr { int($percentfields) } ]
puts "annum $counter "
puts "$plaguethisyear plague this year, 0 or 1. "
puts "$ratinfestthisyear rats infest this year, 0 or 1."
puts "$percentfields percent "
puts "$sumeriansstarved sumerians starved"
puts "$sumeriansgain immigrated to city."
puts "census $sumerians "
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 $sumerians, $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.
$sumeriansstarved sumerians starved
$sumeriansgain immigrated to city.
census $sumerians
total $sumitland barleyfields.
yielded 3 measures per barleyfield
rats devoured $ratliters measures.
$liters measures in palace.
land $landprice measures per barleyfield "
incr counter
return " $listx "
}
set sumit 1000
set sumitland 1000
set sumitbarley 1000
proc advisorx {aa bb} {
global counter
puts " "
puts "advisor: new situation "
puts [ tidings ]
if { $counter <= 5 } {puts "advisor: buy or sell, my lord? "}
if { $counter >= 6 } { puts "update: game ends" }
if { $counter >= 6 } { winnerx 1 }
if { $counter >= 6 } { puts "for new game, enter reset 1 " }
}
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 }
set kingx "king"
puts " decision was $aa $bb, total was land $sumitland, barley $sumitbarley "
puts " advisor says [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }] ] "
puts " advisor says [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]] "
puts " advisor says [ advisorcom [ lpick { 1 2 3 4 5 6 7 8 }]] "
record 1
advisorx 50 50
advisor_game_format_examples 1
}
proc record aa {
set results [ calculation 10 ]
puts $results
return 1 }
proc reset aa {
global counter
set counter 0
set sumitland 1000
set sumitbarley 1000
set sumerians 100
advisorx 1 2
}
puts [ tidings ]
advisor_game_format_examples 1
console show
console eval {.console config -bg palegreen}
console eval {.console config -font {fixed 20 bold}}
console eval {wm geometry . 40x20}
console eval {wm title . " Natural Language if King's English V2, screen grab and paste from console 2 to texteditor"}
console eval {. configure -background orange -highlightcolor brown -relief raised -border 30}gold This page is copyrighted under the TCL/TK license terms, this license .
| Category Numerical Analysis | Category Toys | Category Calculator | Category Mathematics | Category Example | Toys and Games | Category Games | Category Application | Category GUI |