pdtk_drawimage.tcl

#todo: rename img to imgprefix

# package provide pdtk_drawimage 0.1
# package require tkpng

namespace eval ::pdtk_drawimage:: {
    namespace export pdtk_drawimage_new
    namespace export pdtk_drawimage_vis
}

# Some GUI procs for [drawimage] and [drawsprite]

# Draw an image
proc pdtk_drawimage_new {obj path canvasdir flags} {
    set drawsprite 1
    set image_seq [expr {$flags & $drawsprite}]
    # obj  - .x%lx name for [drawimage] instance
    # path - this is absolute or relative
    #        for [drawsprite] this is the directory of the image sequence
    #        for [drawimage] this is the file path of the image
    # canvasdir - relative paths should be relative to this
    #        (any other possibilities?)
    set i 0
    set matchchar *
    # this will discard $canvasdir for absolute paths, which is nice
    set path [file normalize [file join $canvasdir $path]]
    if {[file isdir $path]} {
        # put a final directory separator for a dir
        set path [string trimright [file join $path { }]]
    } else {
        # if it's a file we don't want a wildcard character
        set matchchar {}
    }
    if {![file exists $path]} {
        pdtk_post "drawimage: warning: path doesn't exist: $path\n"
        pd [concat $obj size 1 1 \;]
        return
    }
    foreach filename [lsort -dictionary [glob -nocomplain -type {f r} \
        -path $path $matchchar]] {
        if {[file extension $filename] eq ".gif" ||
            [file extension $filename] eq ".png"} {
            image create photo ::drawimage_${obj}$i -file "$filename"
            #pdtk_post "image is ::drawimage_${obj}$i\n"
            incr i
        }
        if {$i > 1000 || !$image_seq} {break}
    }
    pdtk_post "no of files: $i\n"
    # we bound a symbol to $img in drawimage_new, so we
    # can send back a message with the image dimensions
    # to be used for the selection bbox. This is dumb--
    # pd has no business handling a gui issue like size
    # of a selection rectangle.  That's what Tk is for.
    # But that's a bigger issue to be dealt with later.
    if {$i > 0} {
    pdtk_post "image width is [image width ::drawimage_${obj}0]\n"
    pdtk_post "image height is [image height ::drawimage_${obj}0]\n"
    #pdtk_post "obj is $obj\n"
        pd [concat $obj size [image width ::drawimage_${obj}0] \
            [image height ::drawimage_${obj}0] \;]
    } else {
        pdtk_post "drawimage: warning: no images loaded"
    }
}

proc pdtk_drawimage_vis {c x y obj tag seqno l2orktag1 l2orktag2 tag3 drawtag} {
    set img ::drawimage_${obj}
    set len [llength [lsearch -glob -all [image names] ${img}*]]
    if {$len < 1} {return}
    if {$seqno >= $len || $seqno < 0} {set seqno [expr {$seqno % $len}]}
    $c create pimage $x $y -image ${img}$seqno -tags [list $tag $l2orktag1 $l2orktag2 $drawtag] -parent $tag3
}

proc pdtk_drawimage_index {c obj drawtag index} {
    set img ::drawimage_${obj}
    $c itemconfigure $drawtag -image ${img}$index
}

proc pdtk_drawimage_unvis {c tag} {
    $c delete $tag
}

proc pdtk_drawimage_free {img} {
#    image delete [lsearch -glob -all -inline [image names] ::drawimage_${img}*]

    foreach globalimage [image names] {
        if {[lsearch -glob $globalimage ::drawimage_${img}*] != -1} {
            image delete $globalimage
            pdtk_post "Deleted $globalimage\n"
        }
    }
}