# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: canvview.tcl,v 1.41 2006/01/28 19:16:59 jfontain Exp $


class canvas {                                                                                ;# note: already initialized in scwoop


    class viewer {                                                                                  ;# a viewer made of canvas items

        set (list) {}

        proc viewer {this parentPath tag} ::viewer {} {                                                        ;# parent is a canvas
            set ($this,canvas) $parentPath
            set ($this,tag) $tag
            # use an empty image as an origin marker with only 2 coordinates
            set ($this,origin) [$parentPath create image 0 0 -tags $tag]
            viewer::setupDropSite $this $parentPath                                                  ;# allow dropping of data cells
            switched::configure $viewer::($this,drop) -regioncommand "canvas::viewer::dropRegion $this"
            lappend (list) $this
        }

        proc ~viewer {this} {
            if {[info exists ($this,menu)]} {destroy $($this,menu)}
            $($this,canvas) delete $($this,tag)                                                             ;# delete all components
            ldelete (list) $this
        }

        proc supportedTypes {this} {
            return $global::dataTypes
        }

        proc validateDrag {canvas x y} {
            set drag $canvasWindowManager::($global::windowManager,drag)
            foreach viewer $(list) {
                if {[lsearch -exact [$canvas gettags current] $($viewer,tag)] >= 0} {                                ;# found viewer
                    if {$composite::($viewer,-draggable)} {
                        dragSite::provide $drag OBJECTS "canvas::viewer::dragData $viewer"
                        if {[llength [cells $viewer]] > 0} {                                            ;# there are monitored cells
                            dragSite::provide $drag DATACELLS "canvas::viewer::dragData $viewer"
                        }
                        dragSite::provide $drag CANVASVIEWER "canvas::viewer::dragData $viewer"
                        return 1
                    }
                }
            }
            return 0                                                                                              ;# not in a viewer
        }

        proc dragData {viewer format} {
            switch $format {
                CANVASVIEWER - OBJECTS {return $viewer}
                DATACELLS {return [dragCells $viewer]}
            }
        }

        proc dropRegion {this} {
            set canvas $($this,canvas)
            foreach {left top right bottom} [$canvas cget -scrollregion] {}
            set xOffset [expr {$left + round([lindex [$canvas xview] 0] * ($right - $left))}]
            set yOffset [expr {$top + round([lindex [$canvas yview] 0] * ($bottom - $top))}]
            foreach {left top right bottom} [$canvas bbox $($this,tag)] {}
            incr left -$xOffset; incr top -$yOffset; incr right -$xOffset; incr bottom -$yOffset
            set X [winfo rootx $canvas]; set Y [winfo rooty $canvas]
            return [list [incr left $X] [incr top $Y] [incr right $X] [incr bottom $Y]]                           ;# absolute region
        }

        virtual proc dragCells {this}

        virtual proc monitorCell {this array row column}

        virtual proc update {this array}

        virtual proc cells {this}

        proc manageable {this} {return 0}

        virtual proc initializationConfiguration {this} {
            return {}
        }

        virtual proc setCellColor {this cell color} {}

        virtual proc monitored {this cell}

        proc page {viewer} {
            if {[lsearch -exact $(list) $viewer] < 0} {return {}}                                             ;# not a canvas viewer
            return [pages::tagOrItemPage $($viewer,tag)]
        }

        proc moveAll {xMaximum} {
            foreach viewer $(list) {
                if {$composite::($viewer,-x) >= $xMaximum} {
                    composite::configure $viewer -x [expr {round($composite::($viewer,-x)) % $xMaximum}]
                }
            }
        }

        virtual proc flash {this}

        proc createPopupMenu {this} {
            set ($this,menu) [menu $($this,canvas).menu$this -tearoff 0]
            $($this,canvas) bind $($this,tag) <ButtonPress-3> "tk_popup $($this,menu) %X %Y"
        }

        virtual proc updateLabels {this}

    }


    class iconic {                                                                            ;# viewer made of an image and a label

        proc iconic {this parentPath args} composite {
            [new frame $parentPath -background {} -highlightthickness 0 -borderwidth 0 -width 0 -height 0] $args
        } canvas::viewer {$parentPath canvas::iconic($this)} {  ;# use an unused empty frame as base as a viewer must be a composite
            set tag $canvas::viewer::($this,tag)
            set ($this,image) [$parentPath create image 0 0 -anchor center -tags $tag]
            set ($this,text) [$parentPath create text 0 0 -font $font::(smallNormal) -justify center -anchor n -tags $tag]
            composite::complete $this
            set ($this,cell) {}                                                                                    ;# monitored cell
            if {!$global::readOnly} {
                canvas::viewer::createPopupMenu $this
                $canvas::viewer::($this,menu) add command -label [mc Image]... -command "canvas::iconic::changeImage $this"
            }
            if {!$composite::($this,-static)} {
                $parentPath bind $tag <ButtonPress-1> "canvas::iconic::select $this %x %y"
                $parentPath bind $tag <Button1-Motion> "canvas::iconic::moving $this %x %y"
                $parentPath bind $tag <ButtonRelease-1> "canvas::iconic::release $this"
            }
        }

        proc ~iconic {this} {                                ;# note: all data trace unregistering occurs in viewer layer destructor
            freeImage $this
            if {[string length $composite::($this,-deletecommand)] > 0} {
                uplevel #0 $composite::($this,-deletecommand)                               ;# always invoke command at global level
            }
        }

        proc freeImage {this} {
            if {[string length $composite::($this,-creationfile)] > 0} {
                images::release $composite::($this,-creationfile)                                             ;# free existing image
            }
        }

        proc iconData {} {
            return {
                R0lGODdhJAAkAOcAAAICAl2R2Iaz6PK2PvrcWk5Ohv6KCtLa0urWuv6AAv68UxISHu7ursqKKv7IZnp6emNjjWma4xJRtdK2koKKjqri/lJwsP7eqvKu
                NvTu2MWCJf7KdsLGwtbz/pqeriJeus6cOp7O+rrW/mKK0v7qZr56JqamunZ2fnZ6gp6+/uP0/NbW4rp6JLPO+V6GzrLK1iZiwnqKtgg+osDu/v6bGfX0
                226axvbevtLW3t7e7YqSiv765mqe1jJqurq+uv7ukn6Suv7osoaq0o7C8v7WcpK+6qamykpWmnp6lm6i3jZyyv7+s83N4n5+ntjq9sLC28Le9rS2zv7u
                pv724tLS5v6mGv7OTkF6x6CgwHFzm3Wk7GqCuv7mdpqatlpmoqLI6rnl/uLm4qeqxf7quJeYwVZamv766sjK2fKmJpKaktHR3v7utoSEoPrqzsre9P7W
                gvr++m1uqJam0v7yev7CQH6u4oey/np+ep+iuuru6pe6/kZ+zur0+urOov7mvu7uyO7ipoqLoXFypeLi7l5qsN7q/v72cr2+1f72usrSyoODpsju/v76
                7oqKtr7a9v6mKv768v7+n9Dm+/6aMnqq7vLy5vLksoqKut7u+v77hH5+gv7+zO7epv7mxzpeprLC1oKCsZKWrk5+uvb06np6rpaWthpClqKmoqaqvvy4
                SP6WBnJyraLO8mpqo/3alJC2/qjC8IaKpv7+/u7u9urq7v7qwqXJ+cLq/NLx/WRkqufp9PH09R5QokZ2xq7q/pi+/n5+t9HS4oq67oKu/qjR/l6a2vy6
                On2BmP7uzf7lrv7+ks7e/v6sOYaGtP7qnsLC0qquqgxGsP6iGJCQvP6TE1ZWlqGhx0qF0oGFgv6iJ5K67mJim3Km/rzQ/P6yNrfq/v7qzHys+4K66vfl
                xpbK9q2tzVxelo2Nr3qaysnZ+sDCzv7SfsbG3dLi/rq6zKvJ+ub6/vPdumZqirnd/tna54i2/nR2pH5+rI+6/mRmnXV2rfb2+qvO8+bm7pfC7t6+liwA
                AAAAJAAkAAAI/gDhCBwo8AHBgwYPDkxYUOC+fSbU7cOBh9YJE4f2BfOgZl8UPCd0lQrm0cNDSCf2wXn44KHAWIHcnYPW5RiemM3KnYvSaBqSaXjuRVml
                b+AdSAIhoSh4QhObZ7Rk0WOyLw+7frJyPNsH6QwVSIOsCUJxBwXZO2jvPHhwAg6jA+f2FVrWrm47unWX6XXjJl2hHKDoObwDz4zKtivhsDkjq0WKxyl+
                Rf5FWY/lV6/S7RMTRyUcg/Dg7FjqWV2gfe9+4fulh7UefK/xvbLzali3QaQ+MRK41GHvEydQKJr1rp5sfMhl15ttx86wcN2CxSGL4gHatWrvIFbkTpat
                esMo/mkZH65e82HPw4V7t6vLKoE17hBMyBVLKVnaBNhKVzcdLHTFJKFFONxEwA0sK+hDhmco7ACPg/KppNI0/RQiyYUX8vWJPltYQMgILhAiBxb56MJB
                LHDIEwgcqJiA2FpN3OcIPzSywg8x/NhiThleWLMjGfnk46MXjZjTSinmVAPBdSvFEoUs/HzxxTv+FDGENkKgA4osXHbpJSQP7cKEPSglBccugQwigo3E
                CCBAHZTYYM4hkHQCDjh24nnnnZ10Mos9sZC2UhSgQOIIMcQIk8SiSUTgBRmQ3ImMpHvaaSc9cRyC2Al3kMLOPvOEUEwxAZQagCgWABOppJPu2Won/kyU
                wal2btFzzyDzkHPNrrz2UsYzdY5zQzzjxHNDLX4kmywtoDSBmEo4gELLPBUM0cseVyihRA+egDLKODUwAskUoyCDQB/JJHPBBWfEEYZBEtrzxC5gVFCB
                LxUU88EHvBxhDSTIBCxwwOP848o6DtDTSjkJcYoEMIOA4Ysv33wjgAQYVxMFI8mMUcsY6SbjRzJvlJCKMbjJQxZifDRDzy0wL7IIK9FEI4MpoEwxxhhr
                XOCKK2+ss4EDxmhAxyH2wPEsJKuUQ4ski+DSwdS9yMCLxjs444zQGwytwNfMaDAAYLHAK1Apl+iyyNTw8KGCI/7cEsMlU/zgQCoKpJKK/jfeMOMNDWg0
                wMQ27CAGwOHbMOGECirwwccufLTzAhCNTDEHF8xko7nmj1ShShUsMFHAAocDsJYgwLBDxSBnsJPDCk+wo0Y1wYwzhyGZGDIJNQZQk4001NDAQg73QIAd
                NtgAo489cZARRxzNAJNFLtNsc4/tykSiTDYJGGAACTTQQUAD7CyJPDY66GBPEzo0YQ8FOqxijw7HxFEGFjVkv8QSCiSQgBUkUEUCMAACHLQiC/BLnw7S
                kIb0MbCBD0xDPrpQif1tYhNrmMQ6MsGMVBgABATAgSBO0EAdnOKEKEzhCT1wiljcIw81qEElKpGBP2SAAZxggCUmAAh25CMNwCiEximECA1UnMKIRhzi
                KarRimaw4xyXOAQoogiKabCDFF2Igj6qkYU0FNEHYAyjGMVYDXuwoQzNYEM1YkGKbYTCHmXoQhy24YFtxEEHYOSAOjiQRx9w4I+A3CM0oAFEVHiRkIPU
                wSCB+EA9JuKRkHwkByJJyUpaspIHSEQmM6nJR3IyETjoJChHSUocbBKSOBhEGFbJyla6kpWqfCUsXZmHPNDClrT4wy1pwcs/2LKWYfBlHsJwy1oO85jG
                5GVAAAA7
            }
        }

        proc options {this} {
            return [list\
                [list -creationfile {} {}]\
                [list -deletecommand {} {}]\
                [list -draggable 0 0]\
                [list -file {} {}]\
                [list -static 0 0]\
                [list -x 0 0] [list -y 0 0]\
            ]
        }

        proc set-deletecommand {this value} {}

        proc set-draggable {this value} {
            if {$composite::($this,complete)} {
                error {option -draggable cannot be set dynamically}
            }
        }

        proc set-static {this value} {
            if {$composite::($this,complete)} {
                error {option -static cannot be set dynamically}
            }
        }

        proc set-creationfile {this value} {
            # reference in images repository, also stored in save file, used by record layer to detect changes
            $canvas::viewer::($this,canvas) itemconfigure $($this,image) -image [images::use $value]
            refresh $this
        }

        proc set-file {this value} {
            freeImage $this
            # use full file path as key, as current directory may change during the lifetime of the application or the dashboard
            set value [file normalize $value]                             ;# note: image file validity must have been checked before
            images::load $value $value {}                                                             ;# load into images repository
            composite::configure $this -creationfile $value                                                        ;# then use image
            # for initial placement in upper left corner or in case image has grown
            fence $canvas::viewer::($this,canvas) $canvas::viewer::($this,tag)
            foreach {x y} [$canvas::viewer::($this,canvas) coords $canvas::viewer::($this,origin)] break
            composite::configure $this -x [expr {round($x)}] -y [expr {round($y)}]                    ;# synchronize composite layer
        }

        proc set-x {this value} {                                         ;# note: all canvas viewers must support -x and -y options
            set x [lindex [$canvas::viewer::($this,canvas) coords $canvas::viewer::($this,origin)] 0]
            $canvas::viewer::($this,canvas) move $canvas::viewer::($this,tag) [expr {$value - $x}] 0
        }
        proc set-y {this value} {
            set y [lindex [$canvas::viewer::($this,canvas) coords $canvas::viewer::($this,origin)] end]
            $canvas::viewer::($this,canvas) move $canvas::viewer::($this,tag) 0 [expr {$value - $y}]
        }

        proc monitorCell {this array row column} {
            set cell ${array}($row,$column)
            if {[string equal $cell $($this,cell)]} return                                                      ;# already monitored
            if {[string length $($this,cell)] > 0} {                                                 ;# a cell was already monitored
                viewer::parse $($this,cell) value ignore ignore ignore
                viewer::unregisterTrace $this $value                                                            ;# no longer monitor
            }
            set ($this,cell) $cell
            viewer::registerTrace $this $array
            set canvas $canvas::viewer::($this,canvas)
            foreach [list ($this,label) incomplete] [viewer::label $array $row $column] {}
            $canvas itemconfigure $($this,text) -text $($this,label)
            if {$incomplete} {set ($this,relabel) {}}                                              ;# label cannot be determined yet
        }

        proc update {this array}  {                                                                           ;# update data display
            set cell $($this,cell)
            if {[string first $array $cell] != 0} return                                 ;# check that cell belongs to updated array
            if {[info exists ($this,relabel)]} {                                           ;# if label is not yet defined, update it
                viewer::parse $cell ignore row column ignore
                foreach [list ($this,label) incomplete] [viewer::label $array $row $column] {}
                if {!$incomplete} {unset ($this,relabel)}                                            ;# label now completely defined
            }
            set value ?; catch {set value [set $cell]}                                                      ;# data cell may be void
            $canvas::viewer::($this,canvas) itemconfigure $($this,text) -text "$($this,label): $value"
        }

        proc cells {this} {
            if {[string length $($this,cell)] > 0} {
                return [list $($this,cell)]
            } else {
                return {}
            }
        }

        proc initializationConfiguration {this} {
            return [list -x $composite::($this,-x) -y $composite::($this,-y) -creationfile $composite::($this,-creationfile)]
        }

        proc monitored {this cell} {
            return [string equal $($this,cell) $cell]
        }

        proc refresh {this} {
            set canvas $canvas::viewer::($this,canvas)
            foreach {x y} [$canvas coords $canvas::viewer::($this,origin)] {}
            set image [$canvas itemcget $($this,image) -image]
            $canvas coords $($this,image) $x $y
            $canvas coords $($this,text) $x [expr {$y + ([image height $image] / 2.0) + 1}]
        }

        proc chooseFile {{current {}}} {
            if {[string length $current] == 0} {
                set directory .
            } else {
                set directory [file dirname $current]; set current [file tail $current]
            }
            set file [tk_getOpenFile\
                -title [mc {moodss: Icon image file}] -initialdir $directory -initialfile $current\
                -filetypes [list [list [mc {image files}] .gif]]\
            ]                                                                          ;# note: returns the full pathname or nothing
            if {[string length $file] > 0} {
                if {[catch {set image [image create photo -file $file]} message]} {
                    tk_messageBox -title [mc {moodss: Icon image file error}] -type ok -icon error -message $message
                    return {}
                }
            }
            return $file
        }

        proc select {this x y} {
            lifoLabel::push $global::messenger {}    ;# in case no other string is pushed before button release event pops messenger
            set canvas $canvas::viewer::($this,canvas)
            foreach {(xFrom) (yFrom)} [$canvas coords $canvas::viewer::($this,origin)] {}
            set (xLast) $x; set (yLast) $y
            set (cursor) [$canvas cget -cursor]
            $canvas configure -cursor fleur
        }

        proc moving {this x y} {
            set canvas $canvas::viewer::($this,canvas)
            $canvas move $canvas::viewer::($this,tag) [expr {$x - $(xLast)}] [expr {$y - $(yLast)}]
            set (xLast) $x; set (yLast) $y
            fence $canvas $canvas::viewer::($this,tag)
            foreach {x y} [$canvas coords $canvas::viewer::($this,origin)] break
            lifoLabel::pop $global::messenger                                                 ;# remove previous coordinates or size
            lifoLabel::push $global::messenger "[expr {round($x) - [lindex [$canvas cget -scrollregion] 0]}] [expr {round($y)}]"
        }

        proc release {this} {
            foreach {x y} [$canvas::viewer::($this,canvas) coords $canvas::viewer::($this,origin)] {}
            composite::configure $this -x [expr {round($x)}] -y [expr {round($y)}]                    ;# synchronize composite layer
            $canvas::viewer::($this,canvas) configure -cursor $(cursor)
            lifoLabel::pop $global::messenger
        }

        proc dragCells {this} {
            # save current location:
            foreach {(xLast) (yLast)} [$canvas::viewer::($this,canvas) coords $canvas::viewer::($this,origin)] {}
            # return to initial location when not destroyed
            composite::configure $this -x [expr {round($(xFrom))}] -y [expr {round($(yFrom))}]
            return [list $($this,cell)]
        }

        proc setCellColor {this cell color} {
            if {![string equal $cell $($this,cell)]} return                                                         ;# not monitored
            set canvas $canvas::viewer::($this,canvas)
            if {[string length $color] == 0} {
                if {[info exists ($this,background)]} {
                    $canvas delete $($this,background)
                    unset ($this,background)
                }
            } else {
                if {![info exists ($this,background)]} {
                    foreach {left top right bottom} [$canvas bbox $($this,image)] {}
                    # draw a filled rectangle with slightly rounded corners
                    set ($this,background) [$canvas create polygon\
                        [expr {$left - 2}] [expr {$top - 1}] [expr {$right + 1}] [expr {$top - 1}]\
                        [expr {$right + 2}] $top [expr {$right + 2}] [expr {$bottom - 1}]\
                        [expr {$right + 1}] $bottom [expr {$left - 2}] $bottom\
                        [expr {$left - 3}] [expr {$bottom - 1}] [expr {$left - 3}] $top\
                        -tags $canvas::viewer::($this,tag) -width 1\
                    ]
                    $canvas lower $($this,background) $($this,image)
                }
                $canvas itemconfigure $($this,background) -fill $color -outline $color
            }
        }

        proc flash {this {seconds 1}} {
            set canvas $canvas::viewer::($this,canvas)
            foreach {left top right bottom} [$canvas bbox $canvas::viewer::($this,tag)] {}
            set highlight [new highlighter]
            highlighter::show $highlight [expr {[winfo rootx $canvas] + $left}] [expr {[winfo rooty $canvas] + $top}]\
                [expr {$right - $left}] [expr {$bottom - $top}]
            after [expr {$seconds * 1000}] "delete $highlight"
        }

        proc changeImage {this} {
            if {[string length [set name [chooseFile $composite::($this,-creationfile)]]] > 0} {
                composite::configure $this -file $name
            }
        }

        proc updateLabels {this} {
            if {[string length $($this,cell)] == 0} return
            viewer::parse $($this,cell) array ignore ignore ignore
            set ($this,relabel) {}
            update $this $array
        }

    }


}
