This is PENCILinit.tcl in view mode; [Download] [Up]
# this file will be "sourced" at startup
proc P_find {n} {
global P_searchpath P_appdir env
foreach i $P_searchpath {
if [file exists [P_subst $i]$n] { return [P_subst $i]$n }
}
}
proc out {t} {puts $t}
# initialize PopUpLists:
proc P_initPopUps {} {
global tgs _load
set tgs 0
for {set j 0} {$j<4} {incr j} {P_clearitems $j}
if [catch {set _load [lindex [exec dread PencilTWO load] 2]}] {
exec dwrite PencilTWO load "BASIC EXTRAS EFFECTS1"
set _load "BASIC EXTRAS EFFECTS1"
alertPanel "Welcome!" "I guess this is the first time you're using PencilTWO (at least on this account). Read about the 'Searchpath' in the HELP panel and consider moving your PencilLibrary directory to some place in your HOME-folder (if you haven't already done so). Then read about the Palette and Attributes windows and convert the Palette.pencil and the Attributes.pencil documents in the SampleImages directory.\nHave fun!\n Florian Marquardt" "OK"
}
foreach i $_load {loadMeth $i}
}
proc loadMeth {n} {
global P_t P_l tgs
out "PencilTWO: Loading $n..."
set fname [P_find $n.mth]
set f [open $fname]
set l [read $f]
close $f
for {set i 0} {$i<4} {incr i} {
foreach x [lindex $l $i] {
P_additem [lindex $x 0] [incr tgs] $i
set P_l($i.$tgs) [lindex $x 1]
set P_t([lindex $x 1]) $tgs
}
}
P_setPath pol
P_setDraw dFS
P_setFill fill
P_setStroke stroke
}
if [catch {set _qual [lindex [exec dread PencilTWO quality] 2]}] {set _qual "3 1"}
# loading PS definitions
proc P_PSdraw {} {
global _qual
openPSdef .PS.ps
openPSdef .CP.ps
drawPS "\n/qual [lindex $_qual 0] def\n"
}
set PrintOwnDict 0
# for level 1 printers:
if ![catch {set po [lindex [exec dread PencilTWO ownDict] 2]}] {
if $po {
set PrintOwnDict 1
}
}
proc P_PSprint {} {
global _qual
global PrintOwnDict
if $PrintOwnDict {drawPS "\n150 dict begin\n"}
openPSdef .PS.ps
drawPS "\n/qual [lindex $_qual 1] def\n"
if ![catch {set flag [lindex [exec dread PencilTWO nxcolors] 2]}] {
if $flag {
drawPS "/setrgbcolor {nxsetrgbcolor} bind def"
}
}
}
proc P_PSprintend {} {
global PrintOwnDict
if $PrintOwnDict {drawPS "\nend\n"}
}
proc openPSdef {e} {
global _load
foreach n $_load {
catch {
set f [open [P_find $n$e]]
drawPS [read $f]
close $f
}
}
}
# "Shapes" panel
proc openPaths {} {
global pathsWin
set pathsWin [new window 123 500 240 60 "Shapes"]
set x 0
set y 0
set w 30
set h 30
set path [P_find Shapes/]
foreach i {{RT.tiff RT} {CP.tiff charP} {Hermite.tiff her} {HermiteO.tiff herO} {Polygon.tiff pol} {PolygonO.tiff polO} {Bezier.tiff bez} {BezierO.tiff bezO} {Circle.tiff cir} {Rect.tiff rect} {RRect.tiff rrect} {Arc.tiff arcP} {ArcO.tiff arcPO} {Catm.tiff cat}} {
set img [new image -load $path[lindex $i 0]]
set b [new button $x $y $w $h "" "shape [lindex $i 1]"]
$b setImage $img
set x [expr $x+$w]
if $x>=240 {set x 0; set y [expr $y+$h]}
}
set b [new button $x $y $w $h "" {P_setPath polO; P_setDraw dS; P_setStroke stroke}]
$b setImage [new image -load ${path}line.tiff]
set x [expr $x+$w]
set b [new button $x $y $w $h "" {P_convert2CP}]
$b setImage [new image -load ${path}R2C.tiff]
$pathsWin display
}
proc shape {n} {
P_setPath $n
}
openPaths
# Layers
set curL 0
proc takeLayer {} {
global curBr curL
$curBr select [set curL [P_getCurLayer]]
}
proc correctLayer {} {
global visibleBr selectBr curL
set curL [P_getCurLayer]
set l [P_getLayers]
set v [lindex $l 0]
set s [lindex $l 1]
set v [lreplace $v $curL $curL 1]
set s [lreplace $s $curL $curL 1]
$visibleBr setValue $v
$selectBr setValue $s
P_setLayers "{[$visibleBr value]} {[$selectBr value]}"
}
proc setLy {} {
global visibleBr selectBr
P_setLayers "{[$visibleBr value]} {[$selectBr value]}"
P_display
}
proc setCurLy {} {
global curBr curL
if ![P_setCurLayer [set curL [lsearch [$curBr value] 1]]] correctLayer
P_dispCurGr
}
set layers ""
for {set i 0} {$i<128} {incr i} {
lappend layers $i
}
set s "1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1"
set layerWin [new window 123 600 300 120 Layers]
$layerWin hideDisplay {
set visibleBr [new browser 0 0 100 120 layers setLy]
$visibleBr setTitle Visible
$visibleBr setMultipleSelection 1
$visibleBr setValue $s
set selectBr [new browser 100 0 100 120 layers setLy]
$selectBr setTitle Selectable
$selectBr setMultipleSelection 1
$selectBr setValue $s
set curBr [new browser 200 0 100 120 layers setCurLy]
$curBr setTitle Current
$curBr select 0
$visibleBr autosize h
$selectBr autosize h
$curBr autosize h
}
$layerWin display
proc P_pageLayout {w h l r t b} {
set res [alertPanel "Resize document?" "Do you want to change the document size according to the settings in the PageLayout panel?" Yes "No, only for printing"]
if $res {
out "[expr $w-$l-$r] [expr $h-$t-$b]"
P_resizeView [expr $w-$l-$r] [expr $h-$t-$b]
P_display
}
}
# dragging (Palette window):
set P.dr takeDrag
proc takeDrag {x y n} {
global P_drags curL
if [info exists P_drags($n)] {eval $P_drags($n)} {
global PDobj
if [info exists PDobj($n)] {
global PDpath
P_select1 -1
set m [P_objectcount]
P_readObject $PDpath/$PDobj($n)
set b [P_objectBounds $m]
P_moveObject $m [expr $x-[lindex $b 0]] [expr $y-[lindex $b 1]]
P_display1 $m
}
}
}
set PDnum 0
proc PDds {} {
global PDimg _width _height PDrag PDnum PDx PDy
set r [$PDrag visibleRect]
set y [lindex $r 1]
set min [expr int($y/80)]
set max [expr int(($y+[set h [lindex $r 3]]+79)/80)]
if $PDnum<$max {set max $PDnum}
drawPS ".666 setgray 0 $y $_width $h rectfill"
for {set i $min} {$i<$max} {incr i} {
set y [expr $i*80]
drawPS ".666 setgray 0 $y /w $_width def w 80 rectfill 0 setgray 0 $y 1 add moveto w 0 rlineto stroke 1 setgray 0 $y 79 add moveto w 0 rlineto stroke"
$PDimg($i) composite $PDx($i) [expr $y+$PDy($i)] s
}
}
proc PDmd {} {
global PDimg PDrag _my PDnum PDx PDy
set i [expr int($_my/80)]
if $i<$PDnum {
$PDrag startDragging $i $PDimg($i) $PDx($i) [expr $i*80+$PDy($i)]
}
}
proc PDadd {i o} {
global PDnum PDx PDimg PDpath PDobj PDdorefresh PDy
set PDimg($PDnum) [new image -load $PDpath/$i]
set s [$PDimg($PDnum) size]
set PDx($PDnum) [expr (80-[lindex $s 0])/2]
set PDy($PDnum) [expr (80-[lindex $s 1])/2]
set PDobj($PDnum) $o
incr PDnum
global PDrag PDsc
if $PDdorefresh {
$PDsc free
PDrefresh
}
}
proc PDrefresh {} {
global PDwin PDrag PDsc PDnum .curwin
$PDwin hideDisplay {
set .curwin $PDwin
set PDrag [new view 0 0 90 [expr $PDnum*80] PDds -nowindow]
set PDsc [new scrollview 0 20 100 100 $PDrag]
$PDsc autosize w h
$PDrag setDragSource 1
$PDrag setMouseDown PDmd
}
$PDwin display
}
proc PDaddObj {} {
global PDaddWin .curwin PDpath
set l [P_selection]
if ([llength $l]==0)||([llength $l]>1) {alertPanel "Add object" "Please select exactly one object before trying to add it to the palette. Group several objects, if necessary." OK} {
if ![info exists PDaddWin] {
new fromNIB $PDpath/../addObj.nib
set PDaddWin ${.curwin}
} {
$PDaddWin orderFront
}
}
}
proc PDdoAddObj {} {
global PDtf PDaddWin
$PDaddWin close
P_addToPalette [$PDtf value]
}
catch {
set PDwin [new window 228 21 100 120 "Palette"]
new button 0 0 100 20 "Add object" PDaddObj
set PDpath [P_find Palette]
for {set i 0} {$i<$PDnum} {incr i} {
catch {
set PDimg($i) [new image -load [P_find drag$i.tiff]]
}
}
catch {
set PDdorefresh 0
foreach f [glob $PDpath/*.obj] {
set F [file tail [file root $f]]
catch {PDadd $F.tiff $F.obj}
}
set PDdorefresh 1
PDrefresh
}
}
proc P_selToTIFF {name gw gh} {
global W H n
set n [P_selection]
set b [P_objectBounds $n]
set x [lindex $b 0]
set y [lindex $b 1]
set w [lindex $b 2]
set h [lindex $b 3]
P_select1 -1
P_setClearBG 0
P_writePS $x $y $w $h /tmp/temp.eps
P_setClearBG 1
set e [new image -load /tmp/temp.eps]
set f 1.0
if [set F [expr $gw/$w]]<$f {set f $F}
if [set F [expr $gh/$h]]<$f {set f $F}
$e setSize [set W [expr int($w*$f)]] [set H [expr int($h*$f)]]
set i [new image -size $W $H]
$i lockFocus {
drawPS "0 setalpha 0 0 $gw $gh rectfill"
$e composite 0 0 s
}
$i saveAs $name
$e free
$i free
}
proc P_addToPalette {name} {
global PDpath W H n
P_selToTIFF $PDpath/$name.tiff 75.0 75.0
P_writeObject $n $PDpath/$name.obj
PDadd $name.tiff $name.obj
}
source [P_find PENCILinspector.tcl]
source [P_find Attributes.tcl]
proc P_beforeImgImport {} {
global P_getImageFromFile
if [alertPanel "Import TIFF/EPS" "Do you want to include the image in the document or do you want a link to the image?" Link Include] {
set P_getImageFromFile 1
}
}
proc P_afterImgImport {} {
global P_getImageFromFile
catch {unset P_getImageFromFile}
}
proc P_Img {m} {
set dir [file dir [P_name]]
set n [file tail $m]
if [file exists $dir/$n] {return $dir/$n}
if [file exists $dir/../$n] {return $dir/../$n}
if [file exists $dir/Bilder/$n] {return $dir/Bilder/$n}
if [file exists $dir/Images/$n] {return $dir/Images/$n}
if [file exists $m] {return $m}
return ""
}
proc getCenter {} {
global cx cy
set b [P_objectBounds [lindex [P_selection] 0]]
set cx [expr [lindex $b 0]+[lindex $b 2]/2]
set cy [expr [lindex $b 1]+[lindex $b 3]/2]
}
# Inspectors menu:
catch {
foreach k {
{Shapes... S {$pathsWin orderFront}}
{Layers... L {$layerWin orderFront}}
{Palette... "" {$PDwin orderFront}}
} {
P_addMenuItem 3 [lindex $k 0] [lindex $k 1] [lindex $k 2]
}
}
# Tools
catch {
foreach k {
{"TCL interpreter..." T {if [info exists TIN] {openTIN} {source [P_find TIN.tcl]}}}
} {
P_addMenuItem 1 [lindex $k 0] [lindex $k 1] [lindex $k 2]
}
}
# Actions
catch {
foreach k {
{"Deselect+To Back" < {P_back;P_select1 -1}}
{"Redraw selection" y {P_dispCurGr}}
{"Convert Doc to palette" "" {source [P_find DocToPalette.tcl]}}
{"Convert Doc to attributes" "" {source [P_find DocToAttr.tcl]}}
{"Convert From Pencil 1.0" "" {source [P_find convertFromPencil1.tcl]}}
{"Flip x" "" {
getCenter
foreach i [P_selection] {P_scaleObject $i $cx $cy -1 1}
P_dispCurGr
}}
{"Shear" "" {
getCenter
foreach i [P_selection] {
P_rotateObject $i .7 $cx $cy
P_scaleObject $i $cx $cy 1.3 .76923076
P_rotateObject $i -.7 $cx $cy
}
P_dispCurGr
}
}
} {
P_addMenuItem 2 [lindex $k 0] [lindex $k 1] [lindex $k 2]
}
}
source [P_find Blend.tcl]
source [P_find Transparency.tcl]
These are the contents of the former NiCE NeXT User Group NeXTSTEP/OpenStep software archive, currently hosted by Netfuture.ch.