Added support for canvas background images.

- unresolved problems with image resizing
- background images are disabled in initgui.tcl

Bug found by:
Submitted by:
Reviewed by:
Approved by:
Obtained from:

diff --git a/canvas.tcl b/canvas.tcl
index 5ab638b92ede89658913ae6ba27650dc8f2049b4..48d75bfe9126b54cec85f4a893cb3311fd399007 100755 (executable)
--- a/canvas.tcl
+++ b/canvas.tcl
@@ -1,4 +1,4 @@
-# $Id: canvas.tcl,v 1.9.2.1 2007/05/07 08:20:09 ana Exp $ 
+# $Id: canvas.tcl,v 1.9.2.2 2007/07/11 12:08:40 miljenko Exp $ 
 #
 # Copyright 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -42,7 +42,7 @@
 #
 #****
 
-#****f* nodecfg.tcl/removeCanvas
+#****f* canvas.tcl/removeCanvas
 # NAME
 #   removeCanvas -- remove canvas 
 # SYNOPSIS
@@ -63,7 +63,7 @@ proc removeCanvas { canvas } {
     set $canvas {}
 }
 
-#****f* nodecfg.tcl/newCanvas
+#****f* canvas.tcl/newCanvas
 # NAME
 #   newCanvas -- craete new canvas 
 # SYNOPSIS
@@ -118,7 +118,7 @@ proc getCanvasSize { canvas } {
     }
 }
 
-#****f* nodecfg.tcl/getCanvasName
+#****f* canvas.tcl/getCanvasName
 # NAME
 #   getCanvasName -- get canvas name
 # SYNOPSIS
@@ -138,7 +138,7 @@ proc getCanvasName { canvas } {
     return [string trim $entry \{\}]
 }
 
-#****f* nodecfg.tcl/setCanvasName
+#****f* canvas.tcl/setCanvasName
 # NAME
 #   setCanvasName -- set canvas name
 # SYNOPSIS
@@ -160,3 +160,73 @@ proc setCanvasName { canvas name } {
        set $canvas [linsert [set $canvas] 1 "name {$name}"]
     }
 }
+
+#****f* canvas.tcl/getCanvasBkg
+# NAME
+#   getCanvasBkg -- get canvas background image file name
+# SYNOPSIS
+#   set canvasBkgImage [getCanvasBkg $canvas_id]
+# FUNCTION
+#   Returns the name of the canvas background image file.
+# INPUTS
+#   * canvas_id -- canvas id
+# RESULT
+#   * canvasBkgImage -- image file name
+#****
+
+proc getCanvasBkg { canvas } {
+    global $canvas
+
+    set entry [lrange [lsearch -inline [set $canvas] "bkgImage *"] 1 end]
+    return [string trim $entry \{\}]
+}
+
+#****f* canvas.tcl/setCanvasBkg
+# NAME
+#   setCanvasBkg -- set canvas background
+# SYNOPSIS
+#   setCanvasBkg $canvas_id $bkgImage
+# FUNCTION
+#   Sets the background image for the canvas.
+# INPUTS
+#   * canvas_id -- canvas id
+#   * bkgImage -- image file name
+#****
+
+proc setCanvasBkg { canvas name } {
+    global $canvas
+
+    set i [lsearch [set $canvas] "bkgImage *"]
+    if { $i >= 0 } {
+       set $canvas [lreplace [set $canvas] $i $i "bkgImage {$name}"]
+    } else {
+       set $canvas [linsert [set $canvas] 1 "bkgImage {$name}"]
+    }
+}
+
+
+set bkgImage ""
+
+#****f* canvas.tcl/selectBkgImage
+# NAME
+#   selectBkgImage -- select and set canvas background image
+# SYNOPSIS
+#   selectBkgImage
+# FUNCTION
+#   Select image file (gif) and use it as canvas background image
+#****
+
+proc selectBkgImage {} {
+    global bkgImage imageFileTypes showBkgImage curcanvas
+    set imageFileTypes {{"GIF images" {.gif}}
+                        {"All files"  {*}   }}
+
+    set selectedFile [tk_getOpenFile -filetypes $imageFileTypes]
+    if { $selectedFile != ""} {
+        set bkgImage $selectedFile
+        set showBkgImage 1
+        setCanvasBkg $curcanvas $bkgImage
+        redrawAll
+    }
+}
+