interfaces/xmaxima/Tkmaxima/Printops.tcl

   1 # -*-mode: tcl; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
   2 #
   3 #       $Id: Printops.tcl,v 1.11 2006-08-24 07:03:23 vvzhy Exp $
   4 #
   5 ###### Printops.tcl ######
   6 ############################################################
   7 # Netmath       Copyright (C) 1998 William F. Schelter     #
   8 # For distribution under GNU public License.  See COPYING. #
   9 ############################################################
  10
  11 ### FIXME: fix a4 size !
  12 global paperSizes printOptions
  13 set paperSizes {{letter 8.5 11} { A4 8.5 11} {legal 8.5 13}}
  14
  15 set printOptions {
  16     { landscape 0 "Non zero means use landscape mode in printing"}
  17     { papersize letter "letter, legal or A4"}
  18     { hoffset 0.5 "Left margin for printing"}
  19     { voffset 0.5 "Top margin for printing"}
  20     { xticks 20 "Rough number of ticks on x axis"}
  21     { yticks 20 "Rough number of ticks on y axis"}
  22 #   { title "" "Title"}
  23     { psfilename "~/sdfplot.ps" "Postscript filename"}
  24     { centeronpage 1 ""}
  25 }
  26
  27 # proc getPageOffsets { widthbyheight} {
  28 #     global printOption paperSizes
  29 #     puts "wbh=$widthbyheight"
  30 #     set pwid 8.5
  31 #     set phei 11.0
  32
  33 #     foreach v $paperSizes {
  34 #       if { "[lindex $v 0]" == "$printOption(papersize)" } {
  35 #           set pwid [lindex $v 1]
  36 #           set phei [lindex $v 2]
  37 #       }
  38 #     }
  39 #     set wid [expr {$pwid - 2* $printOption(hoffset)}]
  40 #     set hei [expr {$phei - 2* $printOption(voffset)}]
  41 # #    if { $printOption(landscape) } {set widthbyheight [expr  {1.0 /$widthbyheight}]}
  42 # #    set w $wid ; set hei $wid ; set wid $w
  43
  44 #     puts "pw=$wid,ph=$hei,w/h=$widthbyheight,hh=[expr {$hei * $widthbyheight}], ww=[expr {$wid / $widthbyheight}]"
  45
  46 #     set fac   $widthbyheight
  47 #     puts "fac=$fac"
  48 #     if { $fac * $hei < $wid } {
  49     #   set iwid [expr {$fac *$hei}]
  50 #       set ihei $hei
  51
  52 #     } else {
  53     #   set ihei [expr {$wid / $fac}]
  54
  55 #       set iwid $wid
  56
  57 #     }
  58
  59 #     if { $printOption(landscape) } { set fac1 [expr {1/$fac}] }
  60 #     if { $wid/$hei > $fac } {
  61 #       set ihei $hei
  62     #   set iwid   [expr {$hei / $fac }]
  63
  64 #     } else {
  65 #        set iwid $wid
  66     #    set ihei [expr {$wid * $fac }]
  67 #     }
  68
  69 #     #-pagex = left margin (whether landscape or not)
  70 #     #-pagey = right margin (whether landscape or not)
  71 #     #-pagewidth becomes vertical height if landscape
  72 #     #-pageheight becomes horiz width if landscape
  73
  74 #     set xoff [expr {($pwid-$iwid)/2.0}]
  75 #     set yoff [expr  {($phei-$ihei)/2.0}]
  76
  77 #     if { $printOption(landscape) } {
  78 #       set h $ihei
  79 #       set ihei $iwid
  80 #       set iwid $h
  81 #     }
  82
  83 #     puts "phei=$phei,ihei=$ihei,yoff=$yoff,voff=$printOption(voffset)"
  84 #     set ans "-pagex [set xoff]i -pagey [set yoff]i \
  85 #           -pagewidth [set iwid]i -pageheight [set ihei]i"
  86 #     set ans "-pagex [set xoff]i -pagey [set yoff]i \
  87 #           -pagewidth [set iwid]i -pageheight [set ihei]i"
  88 #     return $ans
  89 # }
  90
  91 proc swap { a b } {
  92     set me [uplevel 1 set $b]
  93     uplevel 1 set $b \[set $a\]
  94     uplevel 1 set $a [list $me]
  95 }
  96
  97 proc getPageOffsets { widthbyheight} {
  98     global printOption paperSizes
  99     #puts "wbh=$widthbyheight"
 100     set pwid 8.5
 101     set phei 11.0
 102
 103     foreach v $paperSizes {
 104         if { "[lindex $v 0]" == "$printOption(papersize)" } {
 105             set pwid [lindex $v 1]
 106             set phei [lindex $v 2]
 107         }
 108     }
 109     set wid [expr {$pwid - 2* $printOption(hoffset)}]
 110     set hei [expr {$phei - 2* $printOption(voffset)}]
 111     if { $printOption(landscape) } {
 112         swap wid hei
 113         #       swap pwid phei
 114     }
 115     if { $wid / $hei  < $widthbyheight  } {
 116         # width dominates
 117         set iwid $wid
 118         set ihei [expr {$wid / $widthbyheight }]
 119         append opts " -pagewidth [set wid]i"
 120     } else {
 121         set ihei $hei
 122         set iwid [expr {$hei * $widthbyheight }]
 123         append opts " -pageheight [set hei]i"
 124     }
 125
 126     #-pagex = left margin (whether landscape or not)
 127     #-pagey = right margin (whether landscape or not)
 128     #-pagewidth becomes vertical height if landscape
 129     #-pageheight becomes horiz width if landscape
 130
 131     append opts " -pagex [expr {$pwid / 2.0}]i -pagey [expr {$phei / 2.0}]i "
 132
 133     if { $printOption(landscape) } {
 134         append opts " -rotate $printOption(landscape)"
 135     }
 136     return $opts
 137 }
 138
 139 global printOption
 140 set printOption(setupDone) 0
 141
 142 proc getEnv { name } {
 143     global env
 144     if { [catch { set tem $env($name) } ] } { return "" }
 145     return $tem
 146 }
 147 proc setPrintOptions { lis } {
 148     global browser_version
 149     global printOptions printOption printSetUpDone
 150     if { !$printOption(setupDone) } {
 151         set printOption(setupDone) 1
 152         getOptions $printOptions $lis -allowOtherKeys 1 \
 153                 -setdefaults [catch { source [getEnv HOME]/.printOptions }] -usearray printOption
 154     }
 155 }
 156
 157 proc mkentryPr { w var text buttonFont }  {
 158     set fr $w ; frame $fr
 159     uplevel 1 append topack [list " $fr"]
 160     label $fr.lab1
 161     label $fr.lab -text "$text:" -font $buttonFont -width 0
 162     entry $fr.e -width 20 -textvariable $var -font $buttonFont
 163     pack $fr.lab1 -side left -expand 1 -fill x
 164     pack $fr.lab -side left
 165     pack $fr.e -side right -padx 3 -fill x
 166 }
 167
 168
 169 proc mkPrintDialog { name args } {
 170     global printSet argv env printOptions printOption printSetUpDone paperSizes buttonfont
 171
 172     set canv [assoc -canvas $args ]
 173     set buttonFont [assoc -buttonfont $args $buttonfont]
 174     catch { destroy $name }
 175     set dismiss "destroy $name"
 176     if { "$canv" == "" } {
 177         catch {destroy $name}
 178         toplevel $name
 179         wm geometry $name -0+20
 180
 181     } else {
 182         $canv delete printoptions
 183         set name [winfo parent $canv].printoptions
 184         # set name $canv.fr1
 185         catch {destroy $name}
 186         frame $name -borderwidth 2 -relief raised
 187
 188         set item [$canv create window [$canv canvasx 10] [$canv canvasy  10] -window $name -anchor nw -tags printoptions]
 189         $canv raise printoptions
 190         set dismiss "$canv delete $item; destroy $name "
 191     }
 192
 193     frame $name.fr
 194
 195     set w $name.fr
 196     label $w.msg  -wraplength 600 -justify left -text [mc "Encapsulated PostScript File Options"] -font $buttonFont
 197     pack $w
 198     pack $w.msg
 199     set wb $w.buttons
 200     frame $wb
 201     pack $wb -side left -fill x -pady 2m
 202     set topack ""
 203     catch { set printOption(psfilename) \
 204             [file nativename $printOption(psfilename)]}
 205     set win [winfo parent $canv]
 206     button $wb.save -text [mc "Save"] -font $buttonFont -command "destroy $name; writePostscript $win; $canv delete printoptions"
 207     button $wb.cancel -text [mc "Cancel"] -font $buttonFont -command "destroy $name ; $canv delete printoptions"
 208     mkentryPr  $wb.psfilename printOption(psfilename) [mc "Postscript filename"] $buttonFont
 209     mkentryPr  $wb.hoffset printOption(hoffset) [mc "Left margin (inches)"] $buttonFont
 210     mkentryPr  $wb.voffset printOption(voffset) [mc "Top margin (inches)"] $buttonFont
 211     eval pack $topack -expand 1
 212
 213     foreach v  $paperSizes {
 214         set papersize [lindex $v 0]
 215         set lower [string tolower $papersize]
 216         radiobutton $wb.$lower -text [lindex $v 0] -variable printOption(papersize) \
 217                 -value [lindex $v 0] -font $buttonFont -highlightthickness 0
 218         pack $wb.$lower -pady 2 -anchor w -fill x
 219     }
 220
 221     checkbutton $wb.b1 -text [mc "Center on Page"] -variable printOption(centeronpage) -relief flat -font $buttonFont
 222     checkbutton $wb.b2 -text [mc "Landscape Mode"] -variable printOption(landscape) -relief flat -font $buttonFont
 223     pack $wb.b1 $wb.b2
 224
 225     frame $w.grid
 226     pack $w.grid -expand yes -fill both -padx 1 -pady 1
 227     pack $wb.save $wb.cancel
 228     grid rowconfig    $w.grid 0 -weight 1 -minsize 0
 229     grid columnconfig $w.grid 0 -weight 1 -minsize 0
 230 }
 231
 232 proc markToPrint { win tag title } {
 233     # puts "$win $tag"
 234     # bind $win <1> "bindBeginDrag $win %x %y $tag [list $title]"
 235     pushBind $win <1> "$win delete printrectangle ; popBind $win <1>"
 236     pushBind $win <1> "bindBeginDrag $win %x %y $tag [list $title]; popBind $win <1>"
 237 }
 238
 239 proc bindBeginDrag { win x y tag title } {
 240     $win delete $tag printrectangle
 241     set beginRect "[$win canvasx $x] [$win canvasy $y]"
 242     set it1 [eval $win create rectangle $beginRect $beginRect -tags $tag -width 3]
 243     set old [bind $win <B1-Motion>]
 244     set new "eval $win coords $it1 \
 245             $beginRect \[$win canvasx %x\] \[$win canvasy %y\]; \
 246             "
 247     if { "$old" == "$new" } {set old ""}
 248     #mike FIXME: rip this out
 249     bind $win <B1-Motion> $new
 250     bind $win <ButtonRelease-1> "bind $win <B1-Motion> [list $old];\
 251             bind $win <ButtonRelease-1> {} ; unbindAdjustWidth $win $tag [list $title];"
 252 }
 253
 254 proc unbindAdjustWidth { canv tag title } {
 255     set win [winfo parent $canv]
 256     global printOption
 257
 258     set it [$canv find withtag $tag]
 259     set co1 [$canv coords $tag]
 260     set co [$canv coords $it]
 261     # if { "$co" != "$co1" } {puts differ,$co1,$co}
 262     desetq "x1 y1 x2 y2" $co
 263     set center [expr { ($x1+$x2 )/2}]
 264     set h [expr {$y2 - $y1}]
 265     set it [$canv find withtag $tag]
 266     set new [$canv create rectangle $x1 $y1 $x2 $y2 -outline white -width [expr {$h* .04}] -tags [concat $tag bigger] ]
 267
 268     # puts "<marginTicks $canv $x1 $y1 $x2 $y2 printrectangle>"
 269     marginTicks $canv [storx$win $x1] [story$win $y2] [storx$win $x2] [story$win $y1] "printrectangle marginticks"
 270     desetq "a1 b1 a2 b2" [$canv bbox $new]
 271     set textit [$canv create text $center [expr {$y1 - $h *.03}] \
 272             -font [font create -family Courier -size 14 -weight bold] -text "$title" \
 273             -anchor s -tags [concat $tag bigger title]]
 274
 275     set bb [$canv bbox $textit]
 276     $canv create rectangle $a1 [lindex $bb 1]  $a2 [expr {$y1 - 0.02 * $h}]  -tags $tag -fill white -outline {}
 277     $canv itemconfig $it -width [expr {$h *.002}]
 278     $canv raise $it
 279     $canv raise $textit
 280     $canv raise marginticks
 281     if { $printOption(domargin) == 0 } {
 282         $canv delete marginticks
 283     }
 284
 285     $canv create text [expr {($a1 + $a2)/2.0}] [expr {$y2 + .01*$h  }] -anchor nw -tag $tag
 286     # puts h=$h
 287
 288 }
 289
 290
 291 proc getPSBbox  { } {
 292     set fi [open /home/wfs/sdfplot.ps r]
 293     set me [read $fi 500]
 294     regexp {BoundingBox: (-*[0-9]+) (-*[0-9]+) (-*[0-9]+) (-*[0-9]+)} $me junk x1 y1 x2 y2
 295     set w [expr {72 * 8.5}]
 296     set h [expr {72 * 11}]
 297     # puts "hei=[expr {$y2-$y1}],tm=[expr {$h - $y2}],bm=$y1"
 298     # puts "wid=[expr {$x2-$x1}],lm=$x1,rm=[expr {$w - $x2}]"
 299     # puts "hei=[expr {($y2-$y1)/72.0}],tm=[expr {($h - $y2)/72.0}],bm=([expr {$y1/72.0}])"
 300     #puts "wid=[expr {($x2-$x1)/72.0}],lm=([expr {$x1/72.0}]),rm=[expr {($w - $x2)/72.0}]"
 301     close $fi
 302 }
 303
 304
 305 ## endsource printops.tcl