util/X86LINUX64/lib/blt2.5/demos/graph2.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
  28 source scripts/demo.tcl
  29
  30 source scripts/stipples.tcl
  31
  32 if { ![string match "*gray*" [winfo screenvisual .]] } {
  33     option add *Button.Background       red
  34     option add *TextMarker.Foreground   black
  35     option add *TextMarker.Background   yellow
  36     option add *LineMarker.Foreground   black
  37     option add *LineMarker.Background   yellow
  38     option add *PolyMarker.Fill         yellow2
  39     option add *PolyMarker.Outline      ""
  40     option add *PolyMarker.Stipple      bdiagonal1
  41     option add *activeLine.Color        red4
  42     option add *activeLine.Fill         red2
  43     option add *Element.Color           purple
  44 }
  45
  46 set data {
  47     R0lGODlhEAANAMIAAAAAAH9/f///////AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
  48     AAM8WBrM+rAEQWmIb5KxiWjNInCkV32AJHRlGQBgDA7vdN4vUa8tC78qlrCWmvRKsJTquHkp
  49     ZTKAsiCtWq0JADs=
  50 }
  51 set data {
  52     R0lGODlhEAANAMIAAAAAAH9/f///////AL+/vwAA/wAAAAAAACH5BAEAAAUALAAAAAAQAA0A
  53     AAM1WBrM+rAEMigJ8c3Kb3OSII6kGABhp1JnaK1VGwjwKwtvHqNzzd263M3H4n2OH1QBwGw6
  54     nQkAOw==
  55 }
  56 set image [image create photo -format gif -data $data]
  57
  58 set graph [graph .g]
  59 table . \
  60     0,0 $graph -fill both
  61
  62 source scripts/graph2.tcl
  63
  64 $graph postscript configure \
  65     -maxpect yes \
  66     -landscape yes
  67 $graph configure \
  68     -width 5i \
  69     -height 5i
  70 $graph axis configure x \
  71     -title "X Axis"
  72
  73 if 1 {
  74     $graph element configure line1 \
  75         -areapattern solid -areaforeground green
  76 #       -areatile $image
  77     $graph element configure line3 \
  78         -areapattern @bitmaps/sharky.xbm \
  79         -areaforeground red \
  80         -areabackground "" -areapattern solid
  81 }
  82
  83 set fileName testImg.jpg
  84 if { [file exists $fileName] } {
  85     set image [image create photo]
  86     winop image readjpeg $fileName $image
  87     if 1 {
  88         puts stderr [time {
  89             $graph marker create image -image $image \
  90                 -coords "-360.0 -1.0 360.0 1.0" \
  91                 -under yes \
  92                 -mapx degrees \
  93                 -name $fileName
  94         }]
  95     }
  96 }
  97
  98
  99 bind $graph <Control-ButtonPress-3> { MakeSnapshot }
 100 bind $graph <Shift-ButtonPress-3> {
 101     %W postscript output demo2.ps
 102     %W snap -format emf demo2.emf
 103 }
 104
 105 set unique 0
 106 proc MakeSnapshot {} {
 107     update idletasks
 108     global unique
 109     set top ".snapshot[incr unique]"
 110     set im [image create photo]
 111     $graph snap $im 210 150
 112
 113     toplevel $top
 114     wm title $top "Snapshot \#$unique of \"[$graph cget -title]\""
 115     label $top.lab -image $im
 116     button $top.but -text "Dismiss" -command "DestroySnapshot $top"
 117     table $top $top.lab
 118     table $top $top.but -pady 4
 119     focus $top.but
 120 }
 121
 122 proc DestroySnapshot { win } {
 123     set im [$win.lab cget -image]
 124     $im write test.ppm
 125     image delete $im
 126     destroy $win
 127     exit
 128 }
 129
 130 if { $tcl_platform(platform) == "windows" } {
 131     if 0 {
 132         set name [lindex [blt::printer names] 0]
 133         set printer {Lexmark Optra E310}
 134         blt::printer open $printer
 135         blt::printer getattrs $printer attrs
 136         puts $attrs(Orientation)
 137         set attrs(Orientation) Landscape
 138         set attrs(DocumentName) "This is my print job"
 139         blt::printer setattrs $printer attrs
 140         blt::printer getattrs $printer attrs
 141         puts $attrs(Orientation)
 142         after 5000 {
 143             $graph print2 $printer
 144             blt::printer close $printer
 145         }
 146     } else {
 147         after 5000 {
 148             $graph print2
 149         }
 150     }
 151     if 1 {
 152         after 2000 {$graph snap -format emf CLIPBOARD}
 153     }
 154 }