***  Call Procedure Fortran like Example ***
----   
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

----
<<TOC>>
----
**Introduction**

----

[gold]Started 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 grain> or <king sell 20 land>, lower case. 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. 
----


 

**Pseudocode Section**
======
   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: 
======
----
*** Screenshot Section***
----
*** Screenshot 1 ***
----
[Call Procedure Fortran like Example screenshot 2]
----

*** Screenshot 2 ***
[Call Procedure Fortran like Example screenshot 3]
----
***References:***
       
   * [Radical Language Modification]
   * [Functional Programming]
   * [expr shorthand for Tcl9]
   * [Steps towards functional programming]
   * [Tacit programming]
   * The fortran call statement appeared in Fortran2 (1958).  example of call exit, fortran 4     
   * Thocp code, http://www.thocp.net/software/languages/fortran.htm
   * [Natural User Interface]
   * [Natural Languages] category
   * [Game kingdom of strategy]
   * wikipedia.org wiki The_Sumerian_Game
   * [A Program That Learns]
  
----
     
**** Pretty Print Version ****
======
        # 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
======

****Appendix Code****
****appendix TCL programs and scripts ****

**Example 2, code scraps**
======
  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

**Example 3, Code scraps**

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


**Example 4, Code scraps**
======
  #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 deck
======
----
**Example 5, Code scraps**
----
output 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.
======
----
**Example 6, Call Procedure Fortran like V2**
----
======
        # pretty print from autoindent and ased editor
        # call procedure like fortran V2
        # easy eye console V3, large black type on green
        # used as testbed for one liners programs
        # written on Windows 10 on TCL
        # working under TCL version 8.6
        # base one liner derived from
        # gold on TCL WIKI , 10Sep2020
        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 call {args} {uplevel catch [list $args]}
        proc math { args } { set tcl_precision 17; puts [ expr [ expr { $args } ] ] }
        # translating Fortran control flow statements
        proc stop {} { return }
        proc end {}  { exit }
        proc pause {} { wait .00010}
        proc C {args} { set C # }
        proc REM {args}  { set REM # }     ;# attack of bots from Quickbasic
        proc write {args}  { puts $args }
        proc print {args}  { puts $args }  ;# attack of bots from Quickbasic
        proc SUBROUTINE {args}  { proc $args }
        proc SUB  {args}  { proc $args }   ;# attack of bots from Quickbasic
        proc initilize {aa} {
            puts "subroutine initilize active"
            call return }
        proc subroutine1 {aa} {
            puts "subroutine 1 active"
            puts " fired subroutine $aa "
            call return }
        proc  subroutine2 {aa} {
            puts "subroutine 2 active"
            puts " fired subroutine $aa "
            call return }
        proc subroutine3 {aa} {
            puts "subroutine 3 active"
            puts " fired subroutine $aa "
            call return }
        proc subroutine4 {aa} {
            puts "subroutine 4 active"
            call math sin (.5)
            write " fired subroutine $aa "
            if { 1 == 1 } { puts "bye" }
            if { 1 == 2 } { call exit }
            print " *******************************"
            REM testing Quickbasic control words too
            print " attack of bots from Quickbasic  "
            print " testing Quickbasic control words too "
            print "  Quickbasic bots now in retreat  "
            print " *******************************"
            # swapping C args  for # comments
            C messege to terminal, operator stop or proceed
            C pause
            C redundant subroutine terminators
            C return control from subroutine to main program
            return
            C stop means stop execution to subprogram or main program
            stop
            C end means end execution to subprogram or main program
            end }
        call initilize                   ;#  list variables
        # foreach list organizes control to pass through numbered subroutines
        foreach item {1 2 3 4 } {subroutine$item $item }
        call math sin (.5)
        if { 1 == 1 } { puts "bye bye" }
        console show
        console eval {.console config -bg palegreen}
        # normally use extra big font 40 and but
        # big fonts 30 or 40, rectangle 40x20 do not display well on wiki
        console eval {.console config -font {fixed 20 bold}}
        console eval {wm geometry . 20x20}
        console eval {wm title . " Call procedure like Fortran V2, screen grab and paste from console 2 to texteditor"}
        console eval {. configure -background orange -highlightcolor brown -relief raised -border 30}
        console eval { proc self_helpx {} {
                set msg "in TCL, large black type on green
                from TCL,
                self help listing
                Conventional text editor formulas grabbed
                from internet screens can be pasted
                into green console
                # Call procedure like Fortran V2
                # testbed  for one liner programs
                # loading math ops, TCLLIB components
                # suggest maintain dead spaces and air gaps near expr, brackets, etc
                # Note spaces near expr statement must be maintained
                # or program deck will not work.
                # blanks _b must be there
                # pretty print from autoindent and ased editor
                # call procedure like fortran V2
                # easy eye console V3, large black type on green
                # used as testbed for one liners programs
                # written on Windows 10 on TCL
                # working under TCL version 8.6
                # control passes in sucesssion through 4 subroutines
                # example >> math .5
                # example >> call math .5
                # example >> call exit
                # example >> math 1*2*3*4*5*6*7*8*9
                # example math 5 * 5 * [tand 1.]
                # gold on TCL Club , 10Sep2020       "
                tk_messageBox -title "self_helpxx" -message $msg } }
        console eval {.menubar.help add command -label Self_help -command self_helpx }
        puts "*******************************************************  "
        puts " console session >>    loads Fortran like call into console "
        puts " console session >>    self_help specific loaded in console help "
        puts " creating  new commands inside TCL deck "
        puts " example >> math .5   "
        puts " example >> call math .5   "
        puts " example >> call exit      "
        puts " example >>  math 5 * 5 * [tand 1.]  "
        puts "  *******************************************************  "       
        # End of deck
======

----
***Example 7, Natural Language if King's English? V2 ***
----
======
    # 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
    # Note: king can be both winner and loser
    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 "example >>   king buy 20 land "
        puts "example >>   king sell 30 land  "
        puts "example >>   king buy 33 barley "
        puts "example >>   king sell 11 barley "
        puts "example >> 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 >= 900 } {
            puts " king is winner declared "
            puts " king is winner declared "
            puts "king is winner declared"
            set winner5 1
        }
        if { $sumerians <= 70 } {
            puts "king is  loser declared"
            set loser5 1
        }
        if { $sumitbarley <= 300 } {
            puts "king is 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 5 5
        # advisor_game_format_examples 1
        puts " ********************************************** "
        if {$counter < 4 } { advisor_game_format_examples 1 }
        if { $counter > 6 } { puts "update: game ends at 5 years " }
        if { $counter > 6 } { puts "update: 5 years is finish line  " }
        if {$counter > 5 } { puts " 5 years set as finish line" }
        if {$counter > 5 } { puts " king can be both winner and loser" }
        if {$counter > 5 } { puts " Suggest reset 1 for new game " }
        if {$counter > 5 } { puts " Otherwise, game loop continues " }
        puts " ********************************************** "
    }
    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 on TCL Club, 07oct2020
    # This posting, prose, screenshots, and TCL source code is
    # copyrighted under the TCL/TK license terms.
    # Editorial rights and disclaimers retained
    # under the TCL/TK license terms
    # and will be defended as necessary in court.
    # end of file
======
----
[gold] This page is copyrighted under the TCL/TK license terms, [http://tcl.tk/software/tcltk/license.html%|%this license]. 
----
**Hidden Comments Section**
----
<<discussion>>
----
Please place any comments here with your wiki MONIKER and date, Thanks.[gold]12Dec2018

----


<<categories>> Numerical Analysis | Toys | Calculator | Mathematics| Example| Toys and Games | Games | Application | GUI
----
<<categories>> Development | Concept| Algorithm|Language|programming language| Fortran |Natural Languages