=== 
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).

Not supported: arc, label, text, windows.

Licence: [Oll]. Have fun!

===
}

proc canvas2mvg canvas {
  set col2hex {color {
      if {[winfo exists $color]} 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 [list fill "" stroke "" strokewidth "" joinstyle "" capstyle ""]
  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]
    # 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]
      }
    }
    set line {}
    set coords [$canvas coords $item]
    switch -exact -- $type {
      line {
        # start of path
        lappend result "# line ... [$canvas gettags $item]"
        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 result "# polygon ... [$canvas gettags $item]"
        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
      }
      rectangle {
        lappend result [concat rectangle $coords]
      }
      image - bitmap {
        lappend result "# bitmap -- [$canvas gettags $item]"
        set img [$canvas itemcget $item -image]
        set file [$img cget -file]
        lassign $coords x0 y0
        set width [image width $img]
        set height [image height $img]
        set anchor [$canvas itemcget $item -anchor]
        puts "x0 $x0 y0 $y0"
        switch -exact -- $anchor {
          ne - e - se {
            set x0 [expr {$x0 - $width}]
          }
          n - center - s {
            set x0 [expr {$x0 - $width / 2.0}]
          }
        }
        switch -exact -- $anchor {
          se - s - ne {
            set y0 [expr {$y0 - $height}]
          }
          e - center - w {
            set y0 [expr {$y0 - $height / 2.0}]
          }
        }
        lappend result [list image over $x0 $y0 0 0 '$file']
      }
      default {
        lappend result "# not yet done: [$canvas type $item] [$canvas coords $item]"
      }
    }
  }
  join $result \n
}
===

<<categories>>Enter Category Here