/usr/share/blt2.4/demos/eps.tcl is in blt-demo 2.4z-7ubuntu2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 | #!/usr/bin/wish
package require BLT
# --------------------------------------------------------------------------
# Starting with Tcl 8.x, the BLT commands are stored in their own
# namespace called "blt". The idea is to prevent name clashes with
# Tcl commands and variables from other packages, such as a "table"
# command in two different packages.
#
# You can access the BLT commands in a couple of ways. You can prefix
# all the BLT commands with the namespace qualifier "blt::"
#
# blt::graph .g
# blt::table . .g -resize both
#
# or you can import all the command into the global namespace.
#
# namespace import blt::*
# graph .g
# table . .g -resize both
#
# --------------------------------------------------------------------------
if { $tcl_version >= 8.0 } {
namespace import blt::*
namespace import -force blt::tile::*
}
source scripts/demo.tcl
bltdebug watch ResizeEpsItem
proc MoveEpsItem { canvas tagName x y } {
global lastX lastY
$canvas move $tagName [expr $x - $lastX] [expr $y - $lastY]
set lastX $x; set lastY $y
}
proc GetEpsBBox { canvas tagName } {
global left top right bottom
set anchor [$canvas coords $tagName-image]
set left [lindex $anchor 0]
set top [lindex $anchor 1]
set width [$canvas itemcget $tagName-image -width]
set height [$canvas itemcget $tagName-image -height]
set right [expr $left + $width]
set bottom [expr $top + $height]
}
proc SaveImageCoords { canvas x y } {
global lastX lastY
set lastX $x
set lastY $y
$canvas configure -cursor sb_h_double_arrow
}
array set cursors {
sw bottom_left_corner
ne top_right_corner
se bottom_right_corner
nw top_left_corner
}
proc StartResize { canvas tagName x y anchor } {
global left top right bottom image
GetEpsBBox $canvas $tagName
$canvas itemconfigure $tagName-image -quick yes
$canvas itemconfigure $tagName-grip -fill red
$canvas create line $left $top $right $bottom \
-tags "$tagName $tagName-cross $tagName-l1" \
-fill red -width 2
$canvas create line $left $bottom $right $top \
-tags "$tagName $tagName-cross $tagName-l2" \
-fill red -width 2
$canvas raise $tagName-grip
global cursors
$canvas configure -cursor $cursors($anchor)
global lastX lastY
set lastX $x
set lastY $y
}
proc EndResize { canvas tagName x y anchor } {
$canvas itemconfigure $tagName-image -quick no \
-showimage yes
ResizeEpsItem $canvas $anchor $tagName $x $y
$canvas itemconfigure $tagName-grip -fill green
$canvas delete $tagName-cross
$canvas configure -cursor ""
}
proc ResetGrips { canvas tagName } {
global gripSize
global left top right bottom
GetEpsBBox $canvas $tagName
$canvas coords $tagName-nw \
$left $top [expr $left + $gripSize] [expr $top + $gripSize]
$canvas coords $tagName-se \
[expr $right - $gripSize] [expr $bottom - $gripSize] $right $bottom
$canvas coords $tagName-ne \
[expr $right - $gripSize] [expr $top + $gripSize] $right $top
$canvas coords $tagName-sw \
$left $bottom [expr $left + $gripSize] [expr $bottom - $gripSize]
$canvas coords $tagName-l1 $left $top $right $bottom
$canvas coords $tagName-l2 $left $bottom $right $top
}
proc ResizeEpsItem { canvas anchor tagName x y } {
global lastX lastY left top right bottom
GetEpsBBox $canvas $tagName
switch $anchor {
sw {
set left $x ; set bottom $y
set cursor bottom_left_corner
}
ne {
set right $x ; set top $y
set cursor top_right_corner
}
se {
set right $x ; set bottom $y
set cursor bottom_right_corner
}
nw {
set left $x ; set top $y
set cursor top_left_corner
}
default {
error "anchor can't be $anchor"
}
}
set w [expr $right - $left]
set h [expr $bottom - $top]
set options ""
if { $w > 1 } {
append options "-width $w "
}
if { $h > 1 } {
append options "-height $h "
}
$canvas coords $tagName-image $left $top
eval $canvas itemconfigure $tagName-image $options
GetEpsBBox $canvas $tagName
ResetGrips $canvas $tagName
}
set numGroups 0
set id 0
proc MakeEps { canvas {epsFile ""} {imageFile ""} } {
global numGroups id gripSize image
# set image [image create photo -width 200 -height 200]
# if { $imageFile != "" } {
# $image configure -file $imageFile
# }
set tagName "epsGroup[incr numGroups]"
$canvas create eps 20 20 \
-anchor nw \
-borderwidth 4 \
-tags "$tagName $tagName-image" \
-titlecolor white \
-titlerotate 90 \
-titleanchor nw \
-font *helvetica*24* \
-stipple BLT \
-outline orange4 \
-fill orange \
-file $epsFile \
# -image $image
set gripSize 8
GetEpsBBox $canvas $tagName
global left top right bottom
$canvas create rectangle \
$left $top [expr $left + $gripSize] [expr $top + $gripSize] \
-tags "$tagName $tagName-grip $tagName-nw" \
-fill red -outline ""
$canvas create rectangle \
[expr $right - $gripSize] [expr $bottom - $gripSize] $right $bottom \
-tags "$tagName $tagName-grip $tagName-se" \
-fill red -outline ""
$canvas create rectangle \
[expr $right - $gripSize] [expr $top + $gripSize] $right $top \
-tags "$tagName $tagName-grip $tagName-ne" \
-fill red -outline ""
$canvas create rectangle \
$left $bottom [expr $left + $gripSize] [expr $bottom - $gripSize] \
-tags "$tagName $tagName-grip $tagName-sw" \
-fill red -outline ""
$canvas bind $tagName <ButtonRelease-1> \
"$canvas configure -cursor {}"
$canvas bind $tagName-image <ButtonPress-1> \
"SaveImageCoords $canvas %x %y"
$canvas bind $tagName-image <B1-Motion> \
"MoveEpsItem $canvas $tagName %x %y"
foreach grip { sw ne se nw } {
$canvas bind $tagName-$grip <ButtonPress-1> \
"StartResize $canvas $tagName %x %y $grip"
$canvas bind $tagName-$grip <B1-Motion> \
"ResizeEpsItem $canvas $grip $tagName %x %y"
$canvas bind $tagName-$grip <ButtonRelease-1> \
"EndResize $canvas $tagName %x %y $grip"
$canvas raise $tagName-$grip
}
}
source scripts/stipples.tcl
#
# Script to test the BLT "eps" canvas item.
#
canvas .layout -bg white
button .print -text "Print" -command {
wm iconify .
update
.layout postscript -file eps.ps
wm deiconify .
update
}
button .quit -text "Quit" -command {
exit 0
}
table . \
0,0 .layout -fill both -cspan 2 \
1,0 .print \
1,1 .quit \
table configure . r1 -resize none
foreach file { ./images/out.ps xy.ps test.ps } {
if { [file exists $file] } {
MakeEps .layout $file
}
}
.layout create rectangle 10 10 50 50 -fill blue -outline white
.layout create text 200 200 \
-text "This is a text item" \
-fill yellow \
-anchor w \
-font *helvetica*24*
.layout create rectangle 50 50 150 150 -fill green -outline red
wm colormapwindows . .layout
.layout configure -scrollregion [.layout bbox all]
|