SR Technology WTK Repo
Artifact [00ea2b4acd]
Not logged in

Artifact 00ea2b4acdab4e3c06f3a6b517468b7c2e7ff407:



# Canvas
snit::type canvas {
    typevariable itemtypes "line rectangle"
    typevariable opts.line {-fill strokeStyle -width lineWidth}
    typevariable opts.rectangle {-fill fillStyle -width lineWidth -outline strokeStyle}
    _wtkwidget
    _wtkoption -width 100 {$JS.width=$V;$JS.style.width='${V}px';}
    _wtkoption -height 100 {$JS.height=$V;$JS.style.height='${V}px';}
    _wtkoption -background "#ffffff" {$JS.style.background='$V';}

    variable mousedown 0
    variable nextid 1
    variable items
    method _createjs {} {return "wtk.createCanvas('[$self id]');"}
    method create {itemtype args} {
        if {$itemtype ni $itemtypes} {error "bad item type"}
        lassign [_parseCoordsAndOptions $args [set opts.$itemtype]] coords opts
        set cid $nextid; incr nextid
        set items($cid) [list type $itemtype coords $coords]
        wtk::toclient "wtk.objs\['[$self id]'\].createItem($cid,'$itemtype',\[[join $coords ,]\],$opts);"
        return $cid
    }
    method _event {which args} {; # todo - make generic
        if {$which=="mousedown"} {set mousedown 1; set subs [list %x [lindex $args 0] %y [lindex $args 1]]; $W _fireevent "<1>" $subs; if {[lindex $args 3]!=""} {$self _fireevent [lindex $args 3] "<1>" $subs}}
        if {$which=="mousemove"} {if {$mousedown} {set ev "<B1-Motion>"} else {set ev "<Motion>"}; $W _fireevent $ev [list %x [lindex $args 0] %y [lindex $args 1]]}
        if {$which=="mouseup"} {set mousedown 0; $W _fireevent "<B1-Release>" [list %x [lindex $args 0] %y [lindex $args 1]]}
    }
    proc _parseCoordsAndOptions {s optmap} {
        set coords ""; set inopts 0; set opts ""
        foreach {x y} [split $s] {
            if {!$inopts && [string is integer $x]} {
                if {![string is integer $y]} {error "odd number of coordinates"}
                lappend coords $x $y
            } else {
                set inopts 1
                if {![dict exists $optmap $x]} {error "bad option"}
                lappend opts "[dict get $optmap $x]:\"$y\""
            }
        }
        return [list $coords "\{[join $opts ,]\}"]
    }

    variable bindings
    method bind {id ev script} {set bindings(${id},$ev) $script}
    method _fireevent {id ev subs} {if {[info exists bindings(${id},$ev)]} {uplevel #0 [string map $subs $bindings(${id},$ev)]}}
}