canvas2mvg

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 ImageMagick 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.

License: 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}} then {
      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 line}} then {
      set joinstyle $canvas itemcget $item -joinstyle
      if {$mode(joinstyle) ne $joinstyle} then {
        set mode(joinstyle) $joinstyle
        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 '
        #
        # Workaround for bug at ImageMagick
        # with open line and joinstyle round.
        #
        # If bug is fixed by IM team,
        # replace by this line:
        # lappend result $line
        #
        if {$mode(joinstyle) ne "round" || 
            (lindex $coords 0 == lindex $coords end-1 &&
            lindex $coords 1 == lindex $coords end &&
            $canvas itemcget $item -arrow eq "none")} then {
          lappend result $line
        } else {
          # first store graphics settings
          lappend result list push graphic-context
          # then switch linejoin
          lappend result list stroke-linejoin bevel
          # now, line is not closed:
          lappend result $line
          lappend result list stroke none list fill $mode(stroke)
          set r expr {$mode(strokewidth) / 2.0}
          # finally add "round" join elements.
          if {string is false -strict $smooth} then {
            # -smooth no
            foreach {x y} lrange $coords 2 end-2 {
              lappend result list ellipse $x $y $r $r 0 360
            }
          } elseif {string is true -strict $smooth} then {
            # -smooth yes
            foreach\
              {x0 y0} lrange $coords 2 end-4\
              {x1 y1} lrange $coords 4 end-2 {
              lappend result [list ellipse\
                                expr {($x0+$x1)/2.0}\
                                expr {($y0+$y1)/2.0}\
                                $r $r 0 360]
            }
          } else {
            # -smooth raw
            foreach {- - - - x y} lrange $coords 2 end-6 {
              lappend result list ellipse $x $y $r $r 0 360
            }
          }
          # restore graphics settings
          lappend result list pop graphic-context
        }
      }
      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 result list push graphic-context
        lappend result list stroke-linejoin miter
        # lappend result list stroke-linejoin bevel
        # lappend result list stroke-linejoin round
        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 {($startx+$x)/2.0} expr {($starty+$y)/2.0}\
          $startx $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 $endx $endy
        # close path
        lappend line L $x $y Z
        append line '
        lappend result $line
        lappend result list pop graphic-context
      }
      rectangle {
        lappend result\
          list push graphic-context\
          list stroke-linejoin miter\
          concat rectangle $coords\
          list pop graphic-context
      }
      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 available. (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.

wdb (later): Currently, there is a bug in IM (just discovered): line objects where stroke-joinstyle is set to round are unwantedly always closed. Only work-around: avoid stroke-joinstyle round. Just have reported in IM forum; hopefully it will be fixed soon.

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.


AK - 2010-08-30 11:36:23

Just a quick note, the tklib modules/canvas directory now contains a package canvas::mvg which is derived from the code on this page. Currently only in CVS. It requires Tcl 8.5, using {*}-operator, lassign, and other such stuff. Cleaned the internals a bit.

wdb added workaround for IM bug: open line elements with joinstyle round aren't unwantedly closed anymore.