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
}