Changeset 2985 for branches/blt4

Timestamp:

Apr 30, 2012, 3:23:41 PM (13 years ago)

Author:

gah

Message:

 

Location:

branches/blt4/gui/scripts

Files:

• drawingentry.tcl (modified) (7 diffs)
• htmlviewer.tcl (modified) (1 diff)

branches/blt4/gui/scripts/drawingentry.tcl

@@ -20 +20 @@
     private variable _path
     private variable _cname2id
-    private variable _worldX 0
-    private variable _worldY 0
-    private variable _worldWidth 0
-    private variable _worldHeight 0
-
+    private variable _xMin 0
+    private variable _yMin 0
+    private variable _xScale 0
+    private variable _yScale 0
+    private variable _xOffset 0
+    private variable _yOffset 0
+    private variable _canvasWidth 0
+    private variable _canvasHeight 0
+    private variable _xAspect 0
+    private variable _yAspect 0
     constructor {owner path args} { # defined below }
 
@@ -38 +43 @@
     private method ParseStringDescription { cname }
     private method ParseNumberDescription { cname }
-    private method GetCanvasHeight { } 
-    private method GetCanvasWidth { } 
+    private method AdjustDrawingArea { xAspect yAspect } 
     private method ScreenX { x } 
     private method ScreenY { y } 
@@ -45 +49 @@
     private method Highlight { tag } 
     private method Unhighlight { tag } 
+    private method Redraw {}
 }
 
@@ -150 +155 @@
         error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
     }
+}
+
+itcl::body Rappture::DrawingEntry::Redraw {args} {
+    # Remove exists canvas items and hints
+    $itk_component(drawing) delete all
+    # Recompute the size of the canvas/drawing area
+    set _canvasWidth [winfo width $itk_component(drawing)] 
+    if { $w < 2 } {
+        set _canvasWidth [winfo reqwidth $itk_component(drawing)]
+    }
+    set _canvasHeight [winfo height $itk_component(drawing)]
+    if { $_canvasHeight < 2 } {
+        set _canvasHeight [winfo reqheight $itk_component(drawing)]
+    }
+    set _drawingWidth $_canvasWidth
+    set _drawingHeight $_canvasHeight
+    set _xOffset 0
+    set _yOffset 0
+    array set _hints {
+        set background white
+    }
+    ParseDecription
 }
 
@@ -395 +422 @@
 
 itcl::body Rappture::DrawingEntry::ScreenX { x } {
-    set norm [expr ($x - $_worldX) / double($_worldWidth)]
-    puts stderr "ScreenX x=$x, norm=$norm wx=$_worldX ww=$_worldWidth"
-    set x [expr int($norm * [GetCanvasWidth])]
-    puts stderr "ScreenX after x=$x cw=[GetCanvasWidth]"
+    set norm [expr ($x - $_xMin) * $_xScale]
+    set x [expr int($norm * $_drawingWidth) + $_xOffset]
     return $x
 }
 
 itcl::body Rappture::DrawingEntry::ScreenY { y } {
-    set norm [expr ($y - $_worldY) / double($_worldWidth)]
-    set y [expr int($norm * [GetCanvasHeight])]
+    set norm [expr ($y - $_yMin) * $_yScale]
+    set y [expr int($norm * $_drawingHeight) + $_yOffset]
     return $y
 }
@@ -416 +441 @@
 }
 
-itcl::body Rappture::DrawingEntry::GetCanvasWidth { } {
-    set w [winfo width $itk_component(drawing)] 
-    if { $w < 2 } {
-        set w [winfo reqwidth $itk_component(drawing)]
-    }
-    return $w
-}
-
-itcl::body Rappture::DrawingEntry::GetCanvasHeight { } {
-    set h [winfo height $itk_component(drawing)]
-    if { $h < 2 } {
-        set h [winfo reqheight $itk_component(drawing)]
-    }
-    return $h
+itcl::body Rappture::DrawingEntry::AdjustDrawingArea { xAspect yAspect } {
+    set _drawingWidth $_canvasWidth 
+    set _drawingHeight $_canvasHeight
+    if { $xAspect <= 0 || $yAspect <= 0 } {
+        return
+    }
+    set current [expr double($_canvasWidth) / double($_canvasHeight)]
+    set wanted [expr double($xAspect) / double($yAspect)]
+    if { $current > $wanted } {
+        set sw [ expr int($_canvasWidth * $wanted)]
+        if { $sw < 1 } {
+            set sw 1
+        }
+        set _xOffset [expr $_canvasWidth - $sw]
+        set _drawingWidth $sw
+    } else {
+        set sh [expr int($_canvaseHeight / $wanted)]
+        if { $sh < 1 }  {
+            set sh 1
+        }
+        set _xOffset [expr $_canvasHeight - $sh]
+        set _drawingHeight $sh
+    }
 }
 
 itcl::body Rappture::DrawingEntry::ParseDescription {} {
     puts stderr "ParseDescrption description owner=$_owner path=$_path"
-    set bbox [$_owner xml get $_path.about.bbox] 
-    puts stderr bbox=$bbox
-    if { [llength $bbox] != 4 } {
-        set bbox "0 0 [GetCanvasWidth] [GetCanvasHeight]"
-    } 
-    foreach { x1 y1 x2 y2 } $bbox break
-    set _worldWidth [expr $x2 - $x1]
-    set _worldHeight [expr $y2 - $y1]
-    set _worldX $x1
-    set _worldY $y1
+    ParseBackground
     foreach cname [$_owner xml children $_path.components] {
         switch -glob -- $cname {
@@ -476 +501 @@
         -fill ""
 }
+
+#
+#      <background>
+#       <!-- background color of the drawing canvas (default white) -->
+#       <color>black</color>
+#       <!-- coordinate system:  x0 y0 ?at screenx screeny? x1 y1 
+#                               ?at screenx screeny?
+#            The screenx/screeny values are optional, so you can also say
+#          something like "-.1 0 1.1 1" as you had in your example.
+#          This lets you put the origin at a specific point on screen,
+#          and also define the directions of the axes.  We still compute
+#          the overall bounding box.  In the example below, the bounding
+#          box goes from -1,1 in the upper-left corner to 1,-1 in the
+#          lower right.
+#       -->
+#       <coordinates>0 0 at 50% 50% 1 1 at 100% 100%</coordinates>
+
+#       <!-- aspect ratio:  scales coordinate system so that pixels may not
+#            be square.  A coordinate system like the one above implies a
+#          square drawing area, since x and y both go from -1 to 1.  But
+#          if you set the aspect to 2:1, you'll get something twice as
+#          wide as it is tall.  This effectively says that x goes from
+#          -1 to 1 in a certain distance, but y goes from -1 to 1 in half
+#          that screen distance.  Default is whatever aspect is defined
+#          by the coordinates.  If x goes 0-3 and y goes 0-1, then the
+#          drawing (without any other aspect ratio) would be 3x wide and
+#          1x tall.  The aspect ratio could be used to force it to be
+#          square instead by setting "1 1" instead.  In that case, x goes
+#          0-3 over the width, and y goes 0-1 over the same screen distance
+#          along the height.
+#       -->
+#       <aspect>2 1</aspect>
+#     </background>
+#
+
+itcl::body Rappture::DrawingEntry::ParseCoordinates {} {
+    set len [llength $values]
+    if { $len == 4 } {
+        if { [scan $values "%g %g %g %g" x1 y1 x2 y2] != 4 } {
+            error "bad coordinates specification \"$values\""
+        }
+        set _xScale [expr 1.0 / ($x2 - $x1)]
+        set _yScale [expr 1.0 / ($y2 - $y2)]
+        set _xMin $x1
+        set _yMin $y1
+    } elseif { $len == 10 } {
+        if { [scan $values "%g %g %s %d%% %d%% %g %g %s %d%% %d%%" \
+                  sx1 sy1 at1 x1 y1 sx2 sy2 at2 x2 y2] != 10 } {
+            error "bad coordinates specification \"$values\""
+        }
+        if { $at1 != "at" || $at2 != "at" } {
+            error "bad coordinates specification \"$values\""
+        }           
+        set x1 [expr $x1 / 100.0]
+        set x2 [expr $x2 / 100.0]
+        set y1 [expr $y1 / 100.0]
+        set y2 [expr $y2 / 100.0]
+        set _xScale [expr ($sx2 - $sx1) / ($x2 - $x1)]
+        set _yScale [expr ($sy2 - $sy2) / ($y2 - $y2)]
+        set _xMin $x1
+        set _yMin $y1
+    }
+}
+
+itcl::body Rappture::DrawingEntry::ParseBackground {} {
+    foreach elem [$_owner xml children $_path.background] {
+        switch -- $elem {
+            #  Background color of the drawing canvas (default white)
+            "color" {
+                set value [$_owner xml get $_path.background.$elem]
+                set _hints(background) $value
+            }
+            "aspect" {
+                set value [$_owner xml get $_path.background.$elem]
+                foreach { xAspect yAspect } $value break
+                AdjustDrawingArea $xAspect $yAspect
+            }
+            "coordinates" {
+                set value [$_owner xml get $_path.background.$elem]
+                ParseCoordinates $value
+            }
+        }
+    }
+}
+

branches/blt4/gui/scripts/htmlviewer.tcl

@@ -348 +348 @@
     }
     puts stderr "Problem in your html: image \"$fileName\" does not exist"
-    # The htmlwidget assumes it owns the image and will delete it.
-    # Always create a copy of the image.
     set img [Rappture::icon exclaim]
     # Htmlwidget will free the image itself, so make a duplicate image