No registered users in community xowiki
in last 10 minutes
in last 10 minutes
[Xotcl] Railroad example in XOTcl
From: Gustaf Neumann <neumann_at_wu-wien.ac.at>
Date: Fri, 16 Mar 2001 19:30:12 +0100
Here is a small fun-example of a Tk program translated to XOTcl.
Start it with xowish
enjoy
-gustaf
=====================================================================================
#!/usr/local/bin/xowish
# Example by <Richard Suchenwirth> translated from Tcl to XOTcl by gustaf neumann
# Left mousebutton starts, middle slows down, right stops
package require XOTcl
Class Wheel -parameter {r x y {spokes 24} {pivot 0} {color red} {tag ""}}
Wheel instproc drawSpokes {} {
[[self] info parent] instvar c alpha
[self] instvar W color spokes r x y
set delta [expr {360./$spokes}]
set deg2arc [expr {atan(1.0)*8/360.}]
for {set i 0} {$i<$spokes} {incr i} {
set x1 [expr {$x+cos($deg2arc*$alpha)*$r}]
set y1 [expr {$y+sin($deg2arc*$alpha)*$r}]
$c create line $x $y $x1 $y1 -fill $color -tag spoke
set alpha [expr {$alpha+$delta}]
}
if {[[self] exists act_pivot]} {
foreach {item perc} [[self] set act_pivot] break
set rp [expr {$r*$perc}]
set xp [expr {$x-$rp*cos($deg2arc*$alpha)}]
set yp [expr {$y-$rp*sin($deg2arc*$alpha)}]
$c coords $item $xp $yp [expr {$xp+1}] [expr {$yp+1}]
}
}
Wheel instproc init {} {
[[self] info parent] instvar c alpha
[self] instvar pivot color tag W r x y
set alpha 0.
set y [expr {$y-$r}]
$c create oval [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}] \
-outline white
set r1 [expr {$r-2}]
set W [$c create oval [expr {$x-$r1}] [expr {$y-$r1}] [expr {$x+$r1}] \
[expr {$y+$r1}] -outline $color -width 2]
[self] drawSpokes
if {$pivot} {
set deg2arc [expr {atan(1.0)*8/360.}]
set rp [expr {$r1*$pivot}]
set xp [expr {$x-$rp*cos($deg2arc*$alpha)}]
set yp [expr {$y-$rp*sin($deg2arc*$alpha)}]
set new_pivot [$c create rect $xp $yp \
[expr {$xp+1}] [expr {$yp+1}] -fill $color \
-tag [list $tag pivot]]
[self] set act_pivot [list $new_pivot $pivot]
$c create arc [expr {$x-$r1}] [expr {$y-$r1}]\
[expr {$x+$r1}] [expr {$y+$r1}] \
-style chord -fill $color -start 310\
-extent 80 -tag counterweight
set pivot $new_pivot
}
set rh [expr {$r/12.}]
$c create oval [expr {$x-$rh}] [expr {$y-$rh}] [expr {$x+$rh}] \
[expr {$y+$rh}] -fill white -tag hub
set r $r1
}
Class Railroad -parameter {{speed 4}}
Railroad instproc turn {} {
[self] instvar c alpha speed
set alpha [expr {round($alpha+360-$speed)%360}]
foreach i [$c find withtag counterweight] {
$c itemconfig $i -start [expr {310-$alpha}]
}
$c delete spoke
foreach wheel [[self] info children] { $wheel drawSpokes }
$c raise hub
set xp0 [expr {105+15*sin(($alpha-90)*atan(1.0)*8/360)}]
$c delete piston
eval $c coords p0 $xp0 120 [expr {$xp0+2}] 122 ;#CW
$c create line 90 121 $xp0 121 -width 2 -fill white -tag piston ;#CW
[self] drawRod p0 p1 p2 p3
$c raise p0
foreach i [$c find withtag smoke] {
if {[lindex [$c bbox $i] 3]<0} {
$c delete $i
} else {
$c move $i [expr {rand()*$speed/3.}] [expr {rand()*2-2}]
}
}
set t [eval $c create oval [$c bbox chimney] -fill white -outline white -tag smoke]
$c move $t 0 -10
$c lower smoke
}
Railroad instproc drawRod {p0 p1 p2 p3} {
[self] instvar c
$c delete rod
eval $c create rect [$c bbox $p1 $p3] -fill white -tag rod
eval $c create line [lrange [$c bbox $p0] 0 1] \
[lrange [$c bbox $p2] 0 1] -width 3 -fill white -tag rod
$c raise rod
$c raise pivot
}
Railroad instproc tick {} {
[self] turn
foreach i [after info] {after cancel $i}
after 10 [self] tick
}
Railroad instproc throttle {} {
[self] incr speed 6
[self] tick
}
Railroad instproc break {} {
[self] incr speed -2
if {[[self] set speed]<0} {[self] set speed 0}
[self] tick
}
Railroad instproc emergencyBreak {} {
[self] set speed 0
[self] tick
}
Railroad instproc init {} {
[self] instvar c
set c [canvas .c -width 600 -height 160 -background lightblue]
pack $c
bind $c <1> [list [self] throttle]
bind $c <2> [list [self] break]
bind $c <3> [list [self] emergencyBreak]
$c delete all
$c create rect 32 115 360 125 -fill black ;# frame
$c create rect 22 118 32 122 -fill grey30 ;# buffer
$c create line 22 115 22 125
$c create poly 60 95 40 115 50 115 70 95 -fill black
$c create rect 60 45 310 95 -fill grey25 ;# boiler
$c create oval 55 50 65 90 -fill black ;# smokebox
$c create rect 70 32 85 50 -fill black -tag chimney
$c create rect 40 52 90 75 -fill black ;# wind diverter
$c create oval 130 36 150 52 -fill black ;# dome
$c create rect 195 35 215 50 -fill black ;# sandbox
$c create oval 260 36 280 52 -fill black ;# dome
$c create rect 65 100 90 135 -fill black ;# cylinder
$c create rect 90 120 92 122 -fill red -tag p0 ;# crossbar
$c create rect 72 87 82 100 -fill black ;# steam tube
$c create rect 310 40 370 115 -fill black ;# cab
$c create rect 310 32 390 42 -fill grey30 ;# cab roof
$c create text 338 82 -text "01 234" -fill gold -font {Times 7}
$c create rect 318 48 333 66 -fill white ;# cab window #1
$c create rect 338 48 355 66 -fill white ;# cab window #2
Wheel newChild -x 50 -y 150 -r 13 -spokes 12
Wheel newChild -x 105 -y 150 -r 13 -spokes 12
Wheel newChild -x 150 -y 150 -r 30 -pivot 0.5 -tag p1
Wheel newChild -x 215 -y 150 -r 30 -pivot 0.5 -tag p2
Wheel newChild -x 280 -y 150 -r 30 -pivot 0.5 -tag p3
[self] drawRod p0 p1 p2 p3
Wheel newChild -x 340 -y 150 -r 16 -spokes 12
$c create rect 360 110 380 118 -fill black
$c create rect 380 65 560 125 -fill black -tag tender
$c create rect 560 118 570 122 -fill grey30 ;# buffer
$c create line 571 116 571 125
$c create rect 390 45 525 65 -fill black -tag tender
Wheel newChild -x 395 -y 150 -r 13 -spokes 12
Wheel newChild -x 440 -y 150 -r 13 -spokes 12
$c create rect 380 132 456 142 -fill red
Wheel newChild -x 495 -y 150 -r 13 -spokes 12
Wheel newChild -x 540 -y 150 -r 13 -spokes 12
$c create rect 480 132 556 142 -fill red -outline red
$c create rect 0 150 600 160 -fill brown ;# earth
$c create line 0 150 600 150 -fill grey -width 2 ;# rail
[self] tick
}
Railroad r
Date: Fri, 16 Mar 2001 19:30:12 +0100
Here is a small fun-example of a Tk program translated to XOTcl.
Start it with xowish
enjoy
-gustaf
=====================================================================================
#!/usr/local/bin/xowish
# Example by <Richard Suchenwirth> translated from Tcl to XOTcl by gustaf neumann
# Left mousebutton starts, middle slows down, right stops
package require XOTcl
Class Wheel -parameter {r x y {spokes 24} {pivot 0} {color red} {tag ""}}
Wheel instproc drawSpokes {} {
[[self] info parent] instvar c alpha
[self] instvar W color spokes r x y
set delta [expr {360./$spokes}]
set deg2arc [expr {atan(1.0)*8/360.}]
for {set i 0} {$i<$spokes} {incr i} {
set x1 [expr {$x+cos($deg2arc*$alpha)*$r}]
set y1 [expr {$y+sin($deg2arc*$alpha)*$r}]
$c create line $x $y $x1 $y1 -fill $color -tag spoke
set alpha [expr {$alpha+$delta}]
}
if {[[self] exists act_pivot]} {
foreach {item perc} [[self] set act_pivot] break
set rp [expr {$r*$perc}]
set xp [expr {$x-$rp*cos($deg2arc*$alpha)}]
set yp [expr {$y-$rp*sin($deg2arc*$alpha)}]
$c coords $item $xp $yp [expr {$xp+1}] [expr {$yp+1}]
}
}
Wheel instproc init {} {
[[self] info parent] instvar c alpha
[self] instvar pivot color tag W r x y
set alpha 0.
set y [expr {$y-$r}]
$c create oval [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}] \
-outline white
set r1 [expr {$r-2}]
set W [$c create oval [expr {$x-$r1}] [expr {$y-$r1}] [expr {$x+$r1}] \
[expr {$y+$r1}] -outline $color -width 2]
[self] drawSpokes
if {$pivot} {
set deg2arc [expr {atan(1.0)*8/360.}]
set rp [expr {$r1*$pivot}]
set xp [expr {$x-$rp*cos($deg2arc*$alpha)}]
set yp [expr {$y-$rp*sin($deg2arc*$alpha)}]
set new_pivot [$c create rect $xp $yp \
[expr {$xp+1}] [expr {$yp+1}] -fill $color \
-tag [list $tag pivot]]
[self] set act_pivot [list $new_pivot $pivot]
$c create arc [expr {$x-$r1}] [expr {$y-$r1}]\
[expr {$x+$r1}] [expr {$y+$r1}] \
-style chord -fill $color -start 310\
-extent 80 -tag counterweight
set pivot $new_pivot
}
set rh [expr {$r/12.}]
$c create oval [expr {$x-$rh}] [expr {$y-$rh}] [expr {$x+$rh}] \
[expr {$y+$rh}] -fill white -tag hub
set r $r1
}
Class Railroad -parameter {{speed 4}}
Railroad instproc turn {} {
[self] instvar c alpha speed
set alpha [expr {round($alpha+360-$speed)%360}]
foreach i [$c find withtag counterweight] {
$c itemconfig $i -start [expr {310-$alpha}]
}
$c delete spoke
foreach wheel [[self] info children] { $wheel drawSpokes }
$c raise hub
set xp0 [expr {105+15*sin(($alpha-90)*atan(1.0)*8/360)}]
$c delete piston
eval $c coords p0 $xp0 120 [expr {$xp0+2}] 122 ;#CW
$c create line 90 121 $xp0 121 -width 2 -fill white -tag piston ;#CW
[self] drawRod p0 p1 p2 p3
$c raise p0
foreach i [$c find withtag smoke] {
if {[lindex [$c bbox $i] 3]<0} {
$c delete $i
} else {
$c move $i [expr {rand()*$speed/3.}] [expr {rand()*2-2}]
}
}
set t [eval $c create oval [$c bbox chimney] -fill white -outline white -tag smoke]
$c move $t 0 -10
$c lower smoke
}
Railroad instproc drawRod {p0 p1 p2 p3} {
[self] instvar c
$c delete rod
eval $c create rect [$c bbox $p1 $p3] -fill white -tag rod
eval $c create line [lrange [$c bbox $p0] 0 1] \
[lrange [$c bbox $p2] 0 1] -width 3 -fill white -tag rod
$c raise rod
$c raise pivot
}
Railroad instproc tick {} {
[self] turn
foreach i [after info] {after cancel $i}
after 10 [self] tick
}
Railroad instproc throttle {} {
[self] incr speed 6
[self] tick
}
Railroad instproc break {} {
[self] incr speed -2
if {[[self] set speed]<0} {[self] set speed 0}
[self] tick
}
Railroad instproc emergencyBreak {} {
[self] set speed 0
[self] tick
}
Railroad instproc init {} {
[self] instvar c
set c [canvas .c -width 600 -height 160 -background lightblue]
pack $c
bind $c <1> [list [self] throttle]
bind $c <2> [list [self] break]
bind $c <3> [list [self] emergencyBreak]
$c delete all
$c create rect 32 115 360 125 -fill black ;# frame
$c create rect 22 118 32 122 -fill grey30 ;# buffer
$c create line 22 115 22 125
$c create poly 60 95 40 115 50 115 70 95 -fill black
$c create rect 60 45 310 95 -fill grey25 ;# boiler
$c create oval 55 50 65 90 -fill black ;# smokebox
$c create rect 70 32 85 50 -fill black -tag chimney
$c create rect 40 52 90 75 -fill black ;# wind diverter
$c create oval 130 36 150 52 -fill black ;# dome
$c create rect 195 35 215 50 -fill black ;# sandbox
$c create oval 260 36 280 52 -fill black ;# dome
$c create rect 65 100 90 135 -fill black ;# cylinder
$c create rect 90 120 92 122 -fill red -tag p0 ;# crossbar
$c create rect 72 87 82 100 -fill black ;# steam tube
$c create rect 310 40 370 115 -fill black ;# cab
$c create rect 310 32 390 42 -fill grey30 ;# cab roof
$c create text 338 82 -text "01 234" -fill gold -font {Times 7}
$c create rect 318 48 333 66 -fill white ;# cab window #1
$c create rect 338 48 355 66 -fill white ;# cab window #2
Wheel newChild -x 50 -y 150 -r 13 -spokes 12
Wheel newChild -x 105 -y 150 -r 13 -spokes 12
Wheel newChild -x 150 -y 150 -r 30 -pivot 0.5 -tag p1
Wheel newChild -x 215 -y 150 -r 30 -pivot 0.5 -tag p2
Wheel newChild -x 280 -y 150 -r 30 -pivot 0.5 -tag p3
[self] drawRod p0 p1 p2 p3
Wheel newChild -x 340 -y 150 -r 16 -spokes 12
$c create rect 360 110 380 118 -fill black
$c create rect 380 65 560 125 -fill black -tag tender
$c create rect 560 118 570 122 -fill grey30 ;# buffer
$c create line 571 116 571 125
$c create rect 390 45 525 65 -fill black -tag tender
Wheel newChild -x 395 -y 150 -r 13 -spokes 12
Wheel newChild -x 440 -y 150 -r 13 -spokes 12
$c create rect 380 132 456 142 -fill red
Wheel newChild -x 495 -y 150 -r 13 -spokes 12
Wheel newChild -x 540 -y 150 -r 13 -spokes 12
$c create rect 480 132 556 142 -fill red -outline red
$c create rect 0 150 600 160 -fill brown ;# earth
$c create line 0 150 600 150 -fill grey -width 2 ;# rail
[self] tick
}
Railroad r