Tcl and Unicon: a Tale of Two VHLL's

#!/usr/bin/wish -f
button .b -text "Hello world" -command exit
pack .b

procedure main()
   write("hello, world")
end

set a 122
set 122 a
expr 24/3.2
eval {set a 122} # a True interpreter
set y x+10
set b [expr $a*4]
incr x 12

a := 122
122 := a # would cause a runtime error
24/3.2
# no "eval" in Unicon
y := "x+10"
b := a*4
x +:= 12

set msg {Eggs: $2.18/dozen}
set msg "Eggs: \$$x/dozen"
set b 101    ;# line comment
set L {red green blue purple}; lindex $L 2
concat {a b c} {d e} f {g h i}
list {a b c} {d e} f {g h i}
llength {{a b c} {d e} f {g h i}}
linsert $L 2 X Y Z
string length abracadabra
{$s == "New York"}
set earnings(January) 87966
set earnings(February) 95400
set cell $matrix($i,$j) ;# index spaces significant!

msg := "Eggs: $2.18/dozen"
msg := "Eggs: $" || x || "/dozen"
b := 101    # line comment
L := ["red", "green", "blue", "purple"]; L[2]
[a, b, c] ||| [d, e] ||| [f] ||| [g, h, i]
[[a, b, c], [d, e], f, [g, h, i]]
*[[a, b, c], [d, e], f, [g, h, i]]
insert(L, 3, [ X Y Z ])
*"abracadabra"
s == "New York"
earnings := table(); earnings["January"] := 87966
earnings["February"] := 95400
cell := matrix[i,j]

($x > 4) && ($x < 10)
button .b -text Hello -fg red
if {$x<2} {set x 2}
for {set i 1} {$i <= 10} {incr i} {puts [format "%8d" $i]}
foreach i {1 2 3 4 5} {
   append msg "$i squared is [expr $i*$i]\n"
}

4 < x < 10
b := TextButton("label=Hello", "fg=red")
if x<2 then x := 2	-or-      x <:= 2
every i := 1 to 10 do { write(sprintf("%8d", i)) }
every i := ![1, 2, 3, 4, 5] do {
   msg ||:= i || " squared is " || i*i || "\n"
}

global x y ;# inside EACH procedure
proc inc {value {increment 1}} { ... }
proc sum args { ... }

global x, y # once outside all procedures, visible everywhere
procedure inc(value, increment:1);  ... end
procedure sum (args[]);  ... end

proc power {base p} {
    set result 1
    while {$p>0} {
        set result [expr $result*$base]
        set p [expr $p-1]
    }
    return $result
}

procedure power(base, p)
   result := 1
   while p>0 do {
      result *:= base
      p -:= 1
      }
   return result
end

procedure power(base, p)
   result := 1
   every 1 to p do result *:= base
   return result
end

- or -

base ^ p

set new {}
foreach el $L {
   if [string match Tcl*baz $el] {
   lappend new $el
   }
}
regexp {^((0x)?[0-9a-fA-F]+|[0-9]+)$} $x

new := ""
every el := !L do {
   if el ? (="Tcl" & tab(-3) & ="baz") then
      new ||:= el
}
hex := &digits ++ 'abcdefABCDEF'
x ? (((="0x"|"") & tab(many(hex))) | tab(many(&digits))) & pos(0))

#!/usr/bin/tclsh
if {$argc != 2} {
    error "Usage: tgrep pattern filename"
}
set f [open [lindex $argv 1] r]
set pat [lindex $argv 0]
while {[gets $f line] >= 0} {
    if [regexp $pat $line] {
        puts $line
    }
}

link regexp
procedure main(argv)
   if *argv ~= 2 then
      stop("Usage: tgrep pattern filename")
   f := open(argv[2])
   pat := argv[1]
   while line := read(f) do {
      if ReFind(pat, line) then
         write(line)
      }
end

entry .base -width 6  -relief sunken -textvariable base
label .label1 -text "to the power"
entry .power -width 6 -relief sunken -textvariable power
label .label2 -text "is"
label .result -textvariable result
pack .base .label1 .power .label2 .result -side left \
   -padx 1m -pady 2m
bind .base  {set result [power $base $power]}
bind .power  {set result [power $base $power]}

package require Itcl
namespace import itcl::*
class Point {
  public variable x
  public variable y
  constructor {_x _y} {
    set x $_x
    set y $_y
  }
  destructor {}
  public method move {dx dy} {
    set x [expr {$x + $dx}]
    set y [expr {$y + $dy}]
    return [list $x $y]
  }
}

class Point (x, y)
  method move(dx, dy)
    x +:= dx
    y +:= dy
    return [x, y]
  end
end