Posted to tcl by hypnotoad at Fri Apr 24 15:16:29 GMT 2020view raw
- method stencil_render {sn image_zoom} {
- my variable stendat stencil_alpha stencil_alpha_mode stencil_zoom
- if {[info exists stencil_zoom($sn)]} {
- if { $stencil_zoom($sn) eq $image_zoom } {
- if {![catch {image height stencil.$sn}]} {
- ###
- # If the image exists at the same magnification, return it
- ###
- return stencil.$sn
- }
- }
- }
- set scaley 1.0
- set info [my stencil_info $sn]
- dict with info {}
- set file [my stencil_file $sn]
- if {![file exists $file]} {
- set file [tk_getOpenFile -parent . -filetypes [irm::image_types]]
- if {$file==""} {
- return
- }
- irm::image_package $file
- if {[catch {image create photo stencil -file $file} err]} {
- taotk::dialog -icon error -type ok -parent . -message $err
- return
- }
- }
- if { $image_zoom > 4.0 } {
- ###
- # Crop image
- ###
- set ans [::taotk::dialog -type okcancel -message "
- Stencil $sn is zoomed in to a factor of $image_zoom : 1.
- This may tie up a lot of system memory.
- Press cancel to abort."]
- if { $ans == "cancel" } {
- puts "Stencil magnification exceeded ($image_zoom)"
- ###
- # Clip a window
- ###
- return {}
- }
- }
- image create photo stencil.raw -file $file
- image create photo stencil.$sn
- set wid [image width stencil.raw]
- set hgt [image height stencil.raw]
- set newwid [expr {int($wid * $image_zoom)}]
- set newhgt [expr {int($hgt * $image_zoom * $scaley)}]
- set stendat($sn) [list wid $wid hgt $hgt zoom $image_zoom scale $image_zoom]
- # Alpha blending is slow on most platforms
- if {[my cget stencil_alpha_mode]} {
- ::shapes::image_scale stencil.raw $newwid $newhgt stencil.$sn [my cget stencil_alpha]
- } else {
- ::shapes::image_desat_scale stencil.raw $newwid $newhgt stencil.$sn [my cget stencil_alpha]
- }
- image delete stencil.raw
- set stencil_zoom($sn) $image_zoom
- return stencil.$sn
- }