This is pencilTCL_startup.tcl in view mode; [Download] [Up]
puts "PencilTCL --- a tcl client for the vector-drawing program Pencil.app"
puts " 1995 by Florian Marquardt (a0047@freenet.uni-bayreuth.de)"
puts " This is based on tcl 7.3 by John Ousterhout, University of California at Berkeley"
puts " Use 'help' for a description of communicating with the Pencil.app server."
proc help {} {
puts "PencilTCL help"
puts " You send commands to Pencil with the \"pencil\"-command. Syntax:"
puts " pencil \"<commandstring>\""
puts " Valid commands: (use 'display' to make changes visible)"
puts " pencil new --- open a new document"
puts " pencil objectcount --- give number of objects in current document"
puts " pencil \"getobject <num>\" --- give description of object <num> (starts at 0)"
puts " pencil \"addobject <prop>\" --- add object with properties <prop>"
puts { pencil "changeobject <num> <prop>" --- change object <num> to <prop>}
puts { pencil "resize <x> <y> <w> <h>" --- resize and move window}
puts { pencil "open <filename>"}
puts { pencil "save <filename>"}
puts { pencil print --- print document (runs PrintPanel)}
puts { pencil copyPS --- copy view as PS to pasteboard}
puts { pencil "import <filename> <x> y>" --- import image}
puts { pencil name --- document name}
puts { pencil "move <dx> <dy>" --- scroll}
puts { pencil "scale <factor%>" --- zoom}
puts { pencil selection --- return list of positions of selected objects}
puts { pencil "select <num1> <num2> ..." --- select objects}
puts { pencil "select1 <num>" --- select single object (use this prior to ungroup)}
puts { pencil front, pencil back --- current selection to front/back}
puts { pencil "delete <num>" --- delete object <num>}
puts { pencil paste --- like Cmd-v}
puts { pencil group, pencil clipgroup, pencil ungroup --- grouping }
puts " There are a number of built-in commands as \"front-ends\" to these basic cmds:"
puts { addobject <prop> --- shortcut for 'pencil "addobject <prop>"' (returns obj-#)}
puts " polygon <r> <g> <b> {<x y x y ..>} --- return <prop> for polygon of given color"
puts " text <x> <y> <string> --- return <prop> for RichText <string> (Helvetica 12)"
puts { get <var> <num> --- shortcut for 'set <var> [pencil "getobject <num>"]' }
puts { getobj <num> --- short for pencil "getobject <num>"}
puts { changeobject <num> <prop>}
puts { change --- shortcut for changeobject <num> $<var>, referring to last 'get'}
puts { display, select {<num1> <num2> ...}, selection, deselect}
puts ""
puts " Use 'exit' to quit."
puts " Use 'info commands' to display a list of all available commands."
puts " Use 'helptcl' for some general examples of tcl commands."
puts " Use 'help-prop' for explanation of the meaning of a graphic-object's \"properties\""
puts " Use 'examples' to get some examples."
puts " For undocumented features: Look at 'pencilTCL_startup.tcl' ;-)"
}
proc examples {} {
puts "Examples:"
puts " addobject \[polygon 1 0 0 {20 30 90 20 40 50}\]; pencil display"
puts { addobject [text 50 50 "This is text."]; pencil display}
puts { forto i 0 [expr [pencil objectcount]-1] { puts [controlpts [pencil "getobject $i"]] } }
puts { (loop through all objects in current document, print out controlpoints)}
puts { source graph.tcl --- load graph.tcl}
puts { graph {10 20 30 40 90 130} --- draw a graph}
puts { get o 1 --- get <prop> of 2nd object}
puts { - o set-fill-method sphGrad --- change fill-method}
puts { change; display --- send changed object to Pencil, display}
puts { set sel [selection]; foreach i $sel { puts [bounding-box [getobj $i]] }}
puts { (print out bounding-boxes of all elements in current selection)}
puts { pencil "import /tmp/myeps.eps 30 20"; display -- import eps image, display it}
puts " for {set i \[expr \[pencil objectcount\]-1\]} {\$i>=0} {incr i -1} {"
puts " if \[type \[getobj \$i\]\]==1 { puts \"\$i\"; select \$i; pencil front } }; display"
puts { (loop through all objects, bring to front all text objects)}
}
proc help-prop {} {
puts "The string returned by 'pencil \"getobject <num>\"' has the following fields:
<type> --- 0 for standard graphic object, 1 for RTF, 2 for Group, 3 for image
{ {<path-method>} {<draw-method>} {<stroke-method>} {<fill-method>}"
puts " {<user-def>} <color1-red> <c1-green> <c1-blue> <color2-red> <c2-green> <c2-blue>"
puts " <linewidth> <translation:tx> <translation:ty> <angle:phi> <scale:sx> <scale:sy>"
puts " <number of controlpoints>}"
puts "{ <bounding-box: x> <y> <width> <height> }"
puts "{ <controlpoints: x y x y x y ...> }"
puts "Only for groups: <number-of-members> <data of member 1> <member 2> ..."
puts "Only for RTF: <length of RichText> {<Rich-Text>}"
puts "You can use the following procedures to access an object's field's:"
puts " type, path-method, draw-method, fill-method, stroke-method, color1, color2,"
puts " tx, ty, phi, sx, sy, bounding-box, controlpts, text (for RTF)"
puts "Example:"
puts " set obj \[pencil \"getobject 0\"\]"
puts " puts \"Color 1: \[color1 \$obj\]\""
puts "Use the names given above, preceded with 'set-' to set attributes, e. g.:"
puts " set obj \[pencil \"getobject 0\"\]"
puts " set obj \[set-fill-method \$obj \"sphGrad\"\]"
puts " set obj \[set-phi \$obj \[expr 45*3.141592/180\]\] (phi is given in rad!)"
puts " set obj \[set-color2 \$obj 0 .5 1\]"
puts " addobject \$obj --- add the changed object to the document"
puts " pencil display"
puts "There is a shortcut for this:"
puts " - obj set-tx 13 (equivalent to set obj \[set-tx \$obj 13\])"
puts " - obj set-controlpts {13 20 80 4 50 90}"
puts "Changing the bounding-box of standard graphics object is useless, since"
puts "it is recalculated before the object is displayed. However you must correctly"
puts "set the bounding-box of a text-object."
}
proc helptcl {} {
puts "Note: To understand the powerful and flexible \"tool command language\" (tcl), you"
puts "should try to get the draft of John Ousterhout's book on tcl (and tk) via anonymous"
puts "ftp, e. g. from \"ucb/tcl\" on ftp.cs.berkeley.edu. Or at least you should read the tcl"
puts "man-pages (if you have access to them). These examples are only intended as a"
puts "help for someone who doesn't have access to these sources."
puts ""
puts " puts \"Hello\" --- Output a string"
puts " set i 34 --- Set variable i to value 34"
puts " set str {Hello there} --- Set variable str to the string \"Hello there\""
puts " set str \"The value is \$i.\" --- Insert the variable's value and assign resulting string to str"
puts " puts {You won't get a value now --- \$i} --- Curly braces remove special meaning of \$ etc."
puts " puts \[set i 12\] --- Execute command in \[..\] first, then use it as an argument for puts"
puts " puts \[expr \$i*23+(7-\$i)*2\] --- expr evaluates an arithmetic expression"
puts " set result \"\$i * 2=\[expr \$i*2\]\" --- you can use \[..\] inside a string \"..\""
puts " set mylist {8 hello 3.4} --- assigns a list (string with spaces) to 'mylist'"
puts " puts \"The second entry is:\[lindex \$mylist 1\]\" --- access list's elements with 'lindex'"
puts { lappend mylist ABC --- append 'ABC' at end of list}
puts { set mylist [lreplace $mylist 2 2 "Foo"] --- replace third element with "Foo" }
puts { puts "The list has [llength $mylist] elements." }
puts " forto i 1 10 { puts \"Value: \$i\"; set sum \[expr \$sum+\$i\] } ---
forto <var> <start> <end> <command-list> (not part of standard tcl)
Use ';' to separate commands in the body of a procedure {..}"
puts " proc sumit {a b} { return \[expr \$a+\$b\] } --- proc <name> <args> <body> defines a procedure"
puts " if \$i==7 { puts \"i is equal to seven.\" }"
puts { foreach element {NS 4.0 {comes soon?}} { puts ">>>$element<<<" } }
puts {To find out about other commands: Use info commands to get a list of them,}
puts {then type in a command without parameters. It will complain and tell you}
puts {what type of parameters it expects.}
}
proc addobject {s} {
pencil "addobject $s"
}
proc path-method {s} { return [lindex [lindex $s 1] 0] }
proc draw-method {s} { return [lindex [lindex $s 1] 1] }
proc fill-method {s} { return [lindex [lindex $s 1] 3] }
proc stroke-method {s} { return [lindex [lindex $s 1] 2] }
proc user-def {s} { return [lindex [lindex $s 1] 4] }
proc color1 {s} { set dt [lindex $s 1]; return "[lindex $dt 5] [lindex $dt 6] [lindex $dt 7]" }
proc color2 {s} { set dt [lindex $s 1]; return "[lindex $dt 8] [lindex $dt 9] [lindex $dt 10]" }
proc linewidth {s} { return [lindex [lindex $s 1] 11] }
proc tx {s} { return [lindex [lindex $s 1] 12] }
proc ty {s} { return [lindex [lindex $s 1] 13] }
proc phi {s} { return [lindex [lindex $s 1] 14] }
proc sx {s} { return [lindex [lindex $s 1] 15] }
proc sy {s} { return [lindex [lindex $s 1] 16] }
proc controlpts {s} { return [lindex $s 3] }
proc bounding-box {s} { return [lindex $s 2] }
proc type {s} { return [lindex $s 0] }
proc text {s} { return [lindex $s 5] }
proc rtf-length {s} { return [string length [lindex $s 5]] }
proc correct-rtf-length {s} { return [lreplace $s 4 4 [rtf-length $s]] }
# give estimated width of string in pts
proc width-of {s} { global FontWidth; return [expr ([string length $s]+1)*$FontWidth] }
# good for Helvetica 12 pt:
set RTFont ""
set FontWidth 8
set FontHeight 15
proc text {x y s} {
global RTFont FontHeight
return [correct-rtf-length "1 { {RT} {drawFS} {stroke} {fill} {} 0 0 0 0.836695 0.705588 0.220603 0 0 0 0 1 1 0 } { $x $y [width-of $s] $FontHeight } { } 173 {{\\rtf0\\ansi$RTFont $s}}"]
}
proc polygon {r g b cp} {
return "0 { {polygon} {drawF} {stroke} {fill} {} 0 0 0 $r $g $b 0 0 0 0 1 1 [expr [llength $cp]/2] } { 0 0 0 0 } { $cp }"
}
proc mlrep {s p w} { return [concat [lrange $s 0 [expr $p-1]] "{$w}" [lrange $s [expr $p+1] e]] }
proc set-path-method {s e} { set t [lindex $s 1]; return [lreplace $s 1 1 [mlrep $t 0 $e]] }
proc set-draw-method {s e} { set t [lindex $s 1]; return [lreplace $s 1 1 [mlrep $t 1 $e]] }
proc set-fill-method {s e} { set t [lindex $s 1]; return [lreplace $s 1 1 [mlrep $t 3 $e]] }
proc set-stroke-method {s e} { set t [lindex $s 1]; return [lreplace $s 1 1 [mlrep $t 2 $e]] }
proc set-user-def {s e} { set t [lindex $s 1]; return [lreplace $s 1 1 [mlrep $t 4 $e]] }
proc set-color1 {s r g b} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 5 7 $r $g $b]] }
proc set-color2 {s r g b} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 8 10 $r $g $b]] }
proc set-linewidth {s z} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 11 11 $z]] }
proc set-tx {s z} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 12 12 $z]] }
proc set-ty {s z} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 13 13 $z]] }
proc set-phi {s z} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 14 14 $z]] }
proc set-sx {s z} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 15 15 $z]] }
proc set-sy {s z} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 16 16 $z]] }
proc set-nc {s z} { set t [lindex $s 1]; return [lreplace $s 1 1 [lreplace $t 17 17 $z]] }
proc set-controlpts {s c} { return [set-nc [lreplace $s 3 3 $c] [expr [llength $c]/2]] }
proc set-bounding-box {s c} { return [lreplace $s 2 2 $c] }
proc set-type {s t} { return [lreplace $s 0 0 t] }
proc set-text {s t} { return [correct-rtf-length [mlrep $s 5 $t]] }
proc - {o c a} { upvar $o m; set m [$c $m $a] }
proc get {o c} { global lcount lobj; upvar $o m; set lcount $c; set lobj $o; set m [pencil "getobject $c"] }
proc changeobject {c o} { pencil "changeobject $c $o" }
proc change {} { global lcount lobj; upvar $lobj m; pencil "changeobject $lcount $m"; pencil display }
proc getobj {n} { pencil "getobject $n" }
proc display {} { pencil display }
proc selection {} { pencil selection }
proc select {s} { pencil "select $s" }
proc deselect {} { pencil "select" }
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.