util/X86LINUX64/lib/blt2.5/demos/eps.tcl

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