=== 
if false {
===

[wdb]: For my [cartoon] project, I need some output for graphics ideas.
I found out that [ImageMagick] provides a pretty command-line vector graphics system.
So, I wrote this [quick'n'dirty] routine to freeze current canvas state in an ImageMagic vector file.

Usage: 

===
% canvas2mvg .c
viewbox 0 0 342 240
stroke none
fill #ffffff
rectangle 0 0 342 240
stroke-width 10.0
fill #ffff00
stroke #0000ff
stroke-linejoin miter
# polygon ... current
path 'M 165.0 65.0 L 120.0 20.0 120.0 110.0 210.0 110.0 165.0 65.0 Z'
% 
===

Write it to a file named ''image.mvg'', then check it with ''display image.mvg'' or convert it to any format, e.g. ''convert image.mvg image.png''.

Supported: [line], [polygon], [rectangle], [oval], [image] (photo), [arc].

Restricted support: text. See comments in procedure body below.

Not supported: window.

Licence: [OLL]. Have fun!

'''Attention:''' copy&paste in browser window is dangerous because render reformatter of source code has "optimized" some line breaks.
It is preferable to copy&paste from edit mode!

===
}

proc canvas2mvg {canvas} {
  set col2hex {color {
      if {[winfo exists $color] && [winfo class $color] eq "Canvas"} then {
        set color [$color cget -bg]
      }
      if {$color eq ""} then {
        set result none
      } else {
        set result #
        foreach x [winfo rgb . $color] {
          append result [format %02x [expr {int($x / 256)}]]
        }
      }
      set result
    }}
  set splinecoords2mvg {{coords {canBeClosed yes}} {
      set closed [expr {$canBeClosed &&
                        [lindex $coords 0] == [lindex $coords end-1] &&
                        [lindex $coords 1] == [lindex $coords end]}]
      if {$closed} then {
        lassign [lrange $coords end-3 end] x0 y0 x1 y1
        set x [expr {($x0+$x1)/2.0}]
        set y [expr {($y0+$y1)/2.0}]
        lset coords end-1 $x
        lset coords end $y
        set coords [concat $x $y $coords]
      }
      if {[llength $coords] == 6} then {
        lreplace $coords 2 1 Q
      } else {
        lappend result {*}[lrange $coords 0 1]
        set co1 [lrange $coords 2 end-4]
        set co2 [lrange $coords 4 end-2]
        foreach {x1 y1} $co1 {x2 y2} $co2 {
          lappend result $x1 $y1 [expr {($x1+$x2)/2.0}] [expr {($y1+$y2)/2.0}]
        }
        lappend result {*}[lrange $coords end-3 end]
        lreplace $result 2 1 Q
      }
    }}
  array set mode {fill "" stroke "" strokewidth "" joinstyle "" capstyle "" fontfamily "" fontsize ""}
  lappend result [list viewbox 0 0 [winfo width $canvas] [winfo height $canvas]]\
    [list stroke none]\
    [list fill [apply $col2hex $canvas]]\
    [list rectangle 0 0 [winfo width $canvas] [winfo height $canvas]]
  foreach item [$canvas find all] {
    set type [$canvas type $item]
    lappend result "# $type ... [$canvas gettags $item]"
    # outline width
    if {$type in {polygon oval arc rectangle line}} then {
      set width [$canvas itemcget $item -width]
      if {$width != $mode(strokewidth)} then {
        set mode(strokewidth) $width
        lappend result [list stroke-width $width]
      }
    }
    # fill, stroke
    if {$type in {polygon oval arc rectangle}} {
      set fill [apply $col2hex [$canvas itemcget $item -fill]]
      if {$mode(fill) ne $fill} then {
        set mode(fill) $fill
        lappend result [list fill $fill]
      }
      set stroke [apply $col2hex [$canvas itemcget $item -outline]]
      if {$mode(stroke) ne $stroke} then {
        set mode(stroke) $stroke
        lappend result [list stroke $stroke]
      }
    }
    # joinstyle
    if {$type in {polygon}} then {
      set joinstyle [$canvas itemcget $item -joinstyle]
      if {$mode(joinstyle) ne $joinstyle} then {
        lappend result [list stroke-linejoin $joinstyle]
      }
    }
    # line color, capstyle
    if {$type in {line}} then {
      if {$mode(fill) ne "none"} then {
        set mode(fill) none
        lappend result [list fill none]
      }
      set stroke [apply $col2hex [$canvas itemcget $item -fill]]
      if {$mode(stroke) ne $stroke} then {
        set mode(stroke) $stroke
        lappend result [list stroke $stroke]
      }
      set capstyle [dict get {butt butt
                              projecting square
                              round round} [$canvas itemcget $item -capstyle]]
      if {$mode(capstyle) ne $capstyle} then {
        set mode(capstyle) $capstyle
        lappend result [list stroke-linecap $capstyle]
      }
    }
    # text color, font, size
    if {$type in {text}} then {
      if {$mode(stroke) ne "none"} then {
        set mode(stroke) none
        lappend result [list stroke none]
      }
      set fill [apply $col2hex [$canvas itemcget $item -fill]]
      if {$mode(fill) ne $fill} then {
        set mode(fill) $fill
        lappend result [list fill $fill]
      }
      set font [$canvas itemcget $item -font]
      # font-family, font-size
      if {$font in [font names]} then {
        set fontsize [font configure $font -size]
        set fontfamily [font configure $font -family]
      } else {
        if {[llength $font] == 1} then {
          set fontsize 12
        } else {
          set fontsize [lindex $font 1]
        }
        set fontfamily [lindex $font 0]
      }
      if {$fontsize < 0} then {
        set fontsize [expr {int(-$fontsize / [tk scaling])}]
      }
      if {$mode(fontsize) ne $fontsize} then {
        set mode(fontsize) $fontsize
        lappend result [list font-size $fontsize]
      }
      #
      # Attention! In some cases, IM assumes 72dpi,
      # where 90dpi is necessary.
      # Then, on cmd line, use switch -density as follows:
      # convert -density 90 test.mvg test.png
      #
      if {$mode(fontfamily) ne $fontfamily} then {
        set mode(fontfamily) $fontfamily
        lappend result [list font $fontfamily]
      }
      #
      # Attention! Care that IM has access to fonts.
      # If not, an error msg is shown,
      # then the default font is used silently.
      #
    }
    set line {}
    set coords [$canvas coords $item]
    switch -exact -- $type {
      line {
        # start of path
        lappend line path 'M
        set smooth [$canvas itemcget $item -smooth]
        if {[string is true -strict $smooth]} then {
          if {[$canvas itemcget $item -arrow] eq "none"} then {
            lappend line {*}[apply $splinecoords2mvg $coords]
          } else {
            lappend line {*}[apply $splinecoords2mvg $coords false]
          }
        } elseif {[string is false -strict $smooth]} then {
          lappend line {*}[lrange $coords 0 1] L {*}[lrange $coords 2 end]
        } else {
          lappend line {*}[lrange $coords 0 1] C {*}[lrange $coords 2 end]
        }
        append line '
        lappend result $line
      }
      polygon {
        lappend line path 'M
        set smooth [$canvas itemcget $item -smooth]
        if {[string is false -strict $smooth]} then {
          lassign $coords x0 y0
          lassign [lrange $coords end-1 end] x1 y1
          set x [expr {($x0+$x1)/2.0}]
          set y [expr {($y0+$y1)/2.0}]
          lappend line $x $y L {*}$coords $x $y Z
        } elseif {[string is true -strict $smooth]} then {
          if {[lindex $coords 0] != [lindex $coords end-1] ||
              [lindex $coords 1] != [lindex $coords end]} then {
            lappend coords {*}[lrange $coords 0 1]
          }
          lappend line {*}[apply $splinecoords2mvg $coords]
        } else {
          lappend line {*}[lrange $coords 0 1] C {*}[lrange $coords 2 end]
        }
        append line '
        lappend result $line
      }
      oval {
        lassign $coords x0 y0 x1 y1
        lappend line ellipse [expr {($x0+$x1)/2.0}] [expr {($y0+$y1)/2.0}]\
          [expr {$x1-($x0+$x1)/2.0}] [expr {$y1-($y0+$y1)/2.0}] 0 360
        lappend result $line
      }
      arc {
        lappend line path 'M
        lassign $coords x0 y0 x1 y1
        set rx [expr {($x1-$x0)/2.0}]
        set ry [expr {($y1-$y0)/2.0}]
        set x [expr {($x0+$x1)/2.0}]
        set y [expr {($y0+$y1)/2.0}]
        set f [expr {acos(0)/90}]
        set start [$canvas itemcget $item -start]
        set startx [expr {cos($start*$f)*$rx+$x}]
        set starty [expr {sin(-$start*$f)*$ry+$y}]
        set angle [expr {$start+[$canvas itemcget $item -extent]}]
        set endx [expr {cos($angle*$f)*$rx+$x}]
        set endy [expr {sin(-$angle*$f)*$ry+$y}]
        # start point
        lappend line [expr [format %f $startx]] [expr [format %f $starty]]
        lappend line A
        # radiusx, radiusy
        lappend line $rx $ry
        # angle -- always 0
        lappend line 0
        # "big" or "small"?
        lappend line [expr {$angle-$start > 180}]
        # right side (always)
        lappend line 0
        # end point
        lappend line [expr [format %f $endx]] [expr [format %f $endy]]
        # close path
        lappend line L $x $y Z
        append line '
        lappend result $line
      }
      rectangle {
        lappend result [concat rectangle $coords]
      }
      text {
        lassign [$canvas bbox $item] x0 y0 x1 y1
        lappend line text $x0 $y1
        append line " '[$canvas itemcget $item -text]'"
        lappend result $line
      }
      image - bitmap {
        set img [$canvas itemcget $item -image]
        set file [$img cget -file]
        lassign [$canvas bbox $item] x0 y0
        lappend result [list image over $x0 $y0 0 0 '$file']       
      }
      default {
        lappend result\
          "# not yet done:\
             [$canvas type $item] [$canvas coords $item] ([$canvas gettags $item])"
      }
    }
  }
  join $result \n
}

===

----
'''[AK] - 2010-08-23 18:06:30'''

How difficult would it be to implement arc and label support ?

I am asking because these two are the only pieces missing (I believe) to make this code a viable backend for the dia application based on the [tklib] diagram package derived from [Drawing diagrams]. The application currently uses the canvas::snap package derived from [Canvas2Image] to convert to tk photo and then the raster formats supported by [Img].

[wdb]: arc -- done (had some mental blocks of drawing model at ImageMagick).

[wdb]: text -- works with these restrictions:

   * One-liners only
   * Font family must be made availabe. (If anybody knows more about that, I am looking forward to your comments!)
   * Font-size is fine when using display, but when converted to bitmap file, IM uses 72dpi instead of 90 dpi.
   * Workaround -- manually use option -density as follows: convert -density 90 test.mvg test.png

'''Attention:''' copy&paste in browser window is dangerous because render reformatter of source code has "optimized" some line breaks.
It is preferable to copy&paste from edit mode!

From my point of view, all necessary is done. 
If necessary, feel free to extend to your needs. 
(But don't forget to comment your improvements!)
I hope that my code is readable.

Btw -- Why did'nt I do all that with the [canvas] [postscript] sub-command? 
I found that the width of lines drawn with option -smooth raw were ''really'' crazy,
and I was not willed to wait until this bug is recognized and fixed.
Additionally, text in resulting postscript was head-under such that I preferred to write sth myself.

<<categories>> Graphics | Introspection