#!/usr/bin/wishx

namespace eval svg {}


proc svg::load_file {c filename} {
    set f [open $filename]
    set file [read $f]
    close $f

    set parser [jlib::wrapper:new "#" "#" \
		    [list svg::parse_file $c]]
    jlib::wrapper:elementstart $parser stream:stream {} {}
    jlib::wrapper:parser $parser parse $file
    jlib::wrapper:parser $parser configure -final 0
}

proc svg::parse_file {c xmldata} {
    jlib::wrapper:splitxml $xmldata tag vars isempty chdata children
    #puts $xmldata

    if {$tag != "svg"} {
	#puts "Not SVG file"
	return
    }

    foreach child $children {
	parse_svg_item $c $child
    }
}

proc svg::parse_svg_item {c item} {
    jlib::wrapper:splitxml $item tag vars isempty chdata children

    #set transform [parse_transform [jlib::wrapper:getattr $vars transform]]
    #set transform {{scale 500}}
    set transform {}
    switch -- $tag {
	rect {
	    return [parse_rect $c $transform $vars $item]
	}
	line {
	    return [parse_line $c $transform {} $item]
	}
	polyline {
	    return [parse_polyline $c $transform $item]
	}
	polygon {
	    return [parse_polygon $c $transform $item]
	}
	circle {
	    return [parse_circle $c $transform $item]
	}
	text {
	    return [parse_text $c $transform $item]
	}
	g {
	    parse_g $c $transform $vars $children
	    # TODO
	    return ""
	}
	default {
	    #puts "Unknown svg tag '$tag'"
	    return ""
	}
    }
}

proc svg::parse_g {c transform vars items} {
    set transform [eval lreplace [list $transform] -1 -1 \
		       [parse_transform [jlib::wrapper:getattr \
					     $vars transform]]]

    foreach item $items {
	jlib::wrapper:splitxml $item tag vars1 isempty chdata children
	switch -- $tag {
	    rect {
		parse_rect $c $transform $vars $item
	    }
	    line {
		parse_line $c $transform $vars $item
	    }
	    polyline {
		parse_polyline $c $transform $item
	    }
	    polygon {
		parse_polygon $c $transform $item
	    }
	    circle {
		parse_circle $c $transform $item
	    }
	    text {
		parse_text $c $transform $item
	    }
	    default {
		#puts "Unknown g tag '$tag'"
	    }
	}
	#update
    }
}

proc svg::transform_points {transform raw_points} {
    # SVG spec says coordinate points can be separated by comma or
    # white space or comma-with-white-space
    # string map...    convert , to space
    # regsub...        condense multiple whitespaces to single space
    regsub -all {\s\s*} [string map {, { }} [string trim $raw_points]] { } points_str

    set p {}
    foreach {x y} [split $points_str] {
	eval lappend p [transform_coord $transform $x $y]
    }
    return $p
}

proc svg::parse_polygon {c transform item} {
    jlib::wrapper:splitxml $item tag vars isempty chdata children

    set transform [eval lreplace [list $transform] -1 -1 \
		       [parse_transform [jlib::wrapper:getattr \
					     $vars transform]]]

    set p [transform_points $transform [jlib::wrapper:getattr $vars points]]

    array set attrs $vars
    set styles [split [jlib::wrapper:getattr $vars style] \;]
    set drawitem line

    foreach s $styles {
	lassign [split $s :] attr val
	switch -- $attr {
	    "" {}
	    fill {set attrs(fill) $val}
	    stroke {set attrs(stroke) $val}
	    stroke-width {set attrs(stroke-width) $val}
	    default {
		#puts "Unknown style attr '$attr'"
	    }
	}
    }

    if {[info exists attrs(fill)]} {
	set opts [polygon_opts]
	set drawitem polygon
    } else {
	set opts [line_opts]
	set drawitem line
	lappend p [lindex $p 0] [lindex $p 1]
    }

    #puts "$c create $drawitem $p $opts"
    eval $c create $drawitem $p $opts
}

proc svg::parse_circle {c transform item} {
    jlib::wrapper:splitxml $item tag vars isempty chdata children

    array set attrs $vars
    set styles [split [jlib::wrapper:getattr $vars style] \;]
    set drawitem circle

    foreach s $styles {
	lassign [split $s :] attr val
	switch -- $attr {
	    "" {}
	    cx {set attrs(cx) $val}
	    cy {set attrs(cy) $val}
	    r {set attrs(r) $val}
	    fill {set attrs(fill) $val}
	    stroke {set attrs(stroke) $val}
	    stroke-width {set attrs(stroke-width) $val}
	    default {
		#puts "Unknown style attr '$attr'"
	    }
	}
    }

    set opts [circle_opts]

    set x1 [expr $attrs(cx)-$attrs(r)]
    set x2 [expr $attrs(cx)+$attrs(r)]
    set y1 [expr $attrs(cy)-$attrs(r)]
    set y2 [expr $attrs(cy)+$attrs(r)]
	
    eval $c create oval $x1 $y1 $x2 $y2 $opts
}

proc svg::parse_line {c transform style item} {
    jlib::wrapper:splitxml $item tag vars isempty chdata children

    set transform [eval lreplace [list $transform] -1 -1 \
		       [parse_transform [jlib::wrapper:getattr \
					     $vars transform]]]

    set x1 [jlib::wrapper:getattr $vars x1]
    set y1 [jlib::wrapper:getattr $vars y1]
    set x2 [jlib::wrapper:getattr $vars x2]
    set y2 [jlib::wrapper:getattr $vars y2]

    lassign [transform_coord $transform $x1 $y1] x1 y1
    lassign [transform_coord $transform $x2 $y2] x2 y2

    #puts $style
    array set attrs $style
    array set attrs $vars
    #puts [array get attrs]
    set styles [split [jlib::wrapper:getattr $vars style] \;]
    set drawitem line

    foreach s $styles {
	lassign [split $s :] attr val
	switch -- $attr {
	    "" {}
	    stroke {set attrs(stroke) $val}
	    stroke-width {set attrs(stroke-width) $val}
	    default {
		#puts "Unknown style attr '$attr'"
	    }
	}
    }

    set opts [line_opts]

    #puts "$c create line $x1 $y1 $x2 $y2 $opts"
    eval $c create line $x1 $y1 $x2 $y2 $opts
}

proc svg::parse_rect {c transform style item} {
    jlib::wrapper:splitxml $item tag vars isempty chdata children

    set transform [eval lreplace [list $transform] -1 -1 \
		       [parse_transform [jlib::wrapper:getattr \
					     $vars transform]]]
    
    set x      [jlib::wrapper:getattr $vars x]
    set y      [jlib::wrapper:getattr $vars y]
    set width  [jlib::wrapper:getattr $vars width]
    set height [jlib::wrapper:getattr $vars height]

    lassign [transform_coord $transform $x $y] x y
    #lassign [transform_coord $transform $x2 $y2] x2 y2

    #puts $style
    array set attrs $style
    array set attrs $vars
    #puts [array get attrs]
    set styles [split [jlib::wrapper:getattr $vars style] \;]
    set drawitem line

    foreach s $styles {
	lassign [split $s :] attr val
	switch -- $attr {
	    "" {}
	    stroke {set attrs(stroke) $val}
	    stroke-width {set attrs(stroke-width) $val}
	    default {
		#puts "Unknown style attr '$attr'"
	    }
	}
    }

    set opts [rect_opts]

    #puts "$c create rect $x $y [expr {$x + $width}] [expr {$y + $height}] $opts"
    eval $c create rect $x $y [expr {$x + $width}] [expr {$y + $height}] $opts
}

proc svg::parse_polyline {c transform item} {
    jlib::wrapper:splitxml $item tag vars isempty chdata children

    set p [transform_points $transform [jlib::wrapper:getattr $vars points]]

    array set attrs $vars
    set styles [split [jlib::wrapper:getattr $vars style] \;]
    set drawitem line

    foreach s $styles {
	lassign [split $s :] attr val
	switch -- $attr {
	    "" {}
	    fill {set attrs(fill) $val}
	    stroke {set attrs(stroke) $val}
	    stroke-width {set attrs(stroke-width) $val}
	    default {
		#puts "Unknown style attr '$attr'"
	    }
	}
    }

    set opts [line_opts]

    #puts "$c create line $p $opts"
    eval $c create line $p $opts
}



proc svg::line_opts {} {
    upvar attrs attrs
    upvar c c
    set opts {-joinstyle miter}
    foreach {attr val} [array get attrs] {
	switch -- $attr {
	    "" {}
	    stroke {lappend opts -fill [color $c $val]}
	    stroke-width {lappend opts -width $val}
	    id {lappend opts -tags [list id$val]}
	}
    }
    return $opts
}

proc svg::rect_opts {} {
    upvar attrs attrs
    upvar c c
    set opts {}
    foreach {attr val} [array get attrs] {
	switch -- $attr {
	    "" {}
	    fill {
		if {$val != "" && $val != "none"} {
		    lappend opts -fill [color $c $val]
		}
	    }
	    stroke {
		if {$val != "" && $val != "none"} {
		    lappend opts -outline [color $c $val]
		}
	    }
	    stroke-width {lappend opts -width $val}
	    id {lappend opts -tags [list id$val]}
	}
    }
    return $opts
}

proc svg::circle_opts {} {
    upvar attrs attrs
    upvar c c
    set opts {}
    foreach {attr val} [array get attrs] {
	switch -- $attr {
	    "" {}
	    fill {lappend opts -fill [color $c $val]}
	    stroke {lappend opts -outline [color $c $val]}
	    stroke-width {lappend opts -width $val}
	    id {lappend opts -tags [list id$val]}
	}
    }
    return $opts
}

proc svg::polygon_opts {} {
    upvar attrs attrs
    upvar c c
    set opts {-joinstyle miter}
    foreach {attr val} [array get attrs] {
	switch -- $attr {
	    "" {}
	    fill {lappend opts -fill [color $c $val]}
	    stroke {lappend opts -outline [color $c $val]}
	    stroke-width {lappend opts -width $val}
	    id {lappend opts -tags [list id$val]}
	}
    }
    return $opts
}

proc svg::text_opts {} {
    upvar attrs attrs
    upvar c c
    set opts {-anchor w}
    set fontopts {}
    foreach {attr val} [array get attrs] {
	switch -- $attr {
	    "" {}
	    fill {lappend opts -fill [color $c $val]}
	    font-family      {lappend fontopts -family $val}
	    font-size        {lappend fontopts -size $val}
	    font-size-adjust { # How to do this in Tk? }
	    font-stretch     { # How to do this in Tk? }
	    font-style       {	if {[string equal $val italic]
	    			 || [string equal $val oblique]} {
			       	   lappend fontopts -slant italic
			        }
			     }
	    font-variant     { # How to do this in Tk? }
	    font-weight      {	if {[string match bold* $val]} {
			       	   lappend fontopts -weight bold
			        }
			     }
	    text-decoration  {	foreach subval $val {
				    switch -- $subval {
					underline {
					    lappend fontopts -underline on
					}
					line-through {
					    lappend fontopts -overstrike on
					}
				    }
				 }
			     }
	    dx   { # How to do this in Tk? }
	    dy   { # How to do this in Tk? }
	    id {lappend opts -tags [list id$val]}
	}
    }
    return [list $opts $fontopts]
}


proc svg::parse_text {c transform item} {
    jlib::wrapper:splitxml $item tag vars isempty chdata children

    set transform [eval lreplace [list $transform] -1 -1 \
		       [parse_transform [jlib::wrapper:getattr \
					     $vars transform]]]

    set x  [jlib::wrapper:getattr $vars x]
    set y  [jlib::wrapper:getattr $vars y]

    if {$x == ""} {set x 0}
    if {$y == ""} {set y 0}

    lassign [transform_coord $transform $x $y] x y

    array set attrs $vars
    set allopts [text_opts]
    set opts [lindex $allopts 0]
    set fontopts [lindex $allopts 1]
    if {$fontopts != ""} {
	variable app_font
	set fontname [list font $fontopts]
	if {![info exists app_font($fontname)]} {
	    # create a font to match the settings
	    set app_font($fontname) [eval font create [list $fontname] $fontopts]
	}
	lappend opts -font $app_font($fontname)
    }

    #puts "eval $c create text $x $y -text [list $chdata] $opts"
    eval $c create text $x $y -text [list $chdata] $opts
}

proc svg::parse_transform {s} {
    set t {}
    while {[regexp {(\w+)\s*\(([^\)]*)\)(.*)} $s temp transform param s]} {
	lappend t [list $transform [split $param ", "]]
    }
    #puts $t
    return $t
}

proc svg::transform_coord {transform x y} {
    #puts $transform
    #puts "$x $y"
    foreach t $transform {
	lassign $t op param
	#puts $t
	switch -- $op {
	    translate {
		lassign $param dx dy
		set x [expr {$x + $dx}]
		set y [expr {$y + $dy}]
	    }
	    scale {
		lassign $param sx sy
		if {$sy == ""} {set sy $sx}
		set x [expr {$x * $sx}]
		set y [expr {$y * $sy}]
	    }
	}
    }
    #puts "$x $y"
    return [list $x $y]
}

proc svg::color {c color} {
    if {[catch {$c create line 0 0 0 0 -fill $color -width 0} id]} {
	return black
    } else {
	$c delete $id
	return $color
    }
}

