::aloupeTop

The aloupe is a Tcl/Tk small widget / utility allowing to view the screen through a loupe.

It allows also

  • to make screenshots of magnified images
  • to pick a color from the images.

It is inspired by the Tcl/Tk wiki pages:

A little magnifying glass

A Screenshot Widget implemented with TclOO

It looks like this:


Usagealoupe, Top

The aloupe utility runs with the command:


tclsh aloupe.tcl ?option value ...?

where option may be -size, -zoom, -alpha, -background, -geometry, -ontop.

The Img and treectrl packages have to be installed to run it. In Debian Linux the packages are titled libtk-img and tktreectrl. If aloupe is run by a tclkit that doesn't provide these packages, define an environment variable TCLLIBPATH before running aloupe so that TCLLIBPATH be a list of pathes to the packages.

There are also stand-alone aloupe executables for Linux / Windows.

The executables are started as simply as:


aloupe ?option value ...? aloupe.exe ?option value ...?

After the start, two windows would be displayed: a moveable loupe (at the mouse pointer) and a displaying window.

The loupe is moved by drag-and-drop. At dropping the loupe, its underlying image is magnified in the displaying window.

To change a size/zoom of the loupe, use the appropriate spinboxes. After changing them, just click the loupe to update the windows.

To save the magnified image, use Save button.

The To clipboard button displays a current pixel's color at clicking the image. When hit, the button puts the color into the clipboard.

The -command option may be passed to ::aloupe::run which will run the passed command at pressing the To clipboard button. The command may contain %c wildcard meaning the color value. Just to test, try and set -command "puts %c" option.


Optionsaloupe, Top

The aloupe can be run with the options:

  • -size - a size of the loupe's box (8 .. 256)
  • -zoom - a zoom factor (2 .. 32)
  • -alpha - an opacity of the loupe (0.0 .. 1.0)
  • -background - a background color of the loupe
  • -geometry - a displaying window's geometry set as +X+Y
  • -ontop - if yes (default), sets the displaying window above others
  • -save - if yes (default), saves/restores the appearance settings
  • -inifile - a file to save the settings (~/.config/aloupe.conf by default)
  • -locale - a preferable locale (e.g., ru, ua, cz)

Some options can be used at running aloupe from a Tcl code:

  • -exit - is false which means "don't finish Tcl/Tk session, just close the loupe"
  • -command - a command to be run at pressing the To clipboard button
  • -commandname - a label instead of To clipboard; when set it means also "no copy to clipboard"
  • -parent - a parent window's path (when the parent closes, its aloupe children do too)

From a Tcl code, aloupe widget is called this way:


package require aloupe ::aloupe::run ?option value ...?

Linksaloupe, Top


Licensealoupe, Top

MIT.


Commandsaloupe, Top




FindPackages [::aloupe]aloupe, Top

Tries to find required packages in an upper bin directory.

FindPackages

proc ::aloupe::FindPackages {} { # Tries to find required packages in an upper bin directory. set dirs [file split [file dirname [file normalize $::aloupe::aloupescript]]] while 1 { set dir [file join {*}$dirs bin] if {[file exists $dir]} { if {![set ::aloupe::starterr [::aloupe::GetPackages $dir]]} { return yes } } if {[set dirs [lreplace $dirs end end]] eq {}} break } return no }




GetPackages [::aloupe]aloupe, Top

Gets required packages.

GetPackages ?dir?
Parameters
dirsupposed directory of packages; optional, default .

proc ::aloupe::GetPackages {{dir .}} { # Gets required packages. # dir - supposed directory of packages set dir [file normalize $dir] set dir1 [lindex [glob -nocomplain [file join $dir treectrl*]] 0] if {[info exists ::auto_path] && $dir1 ne {}} { set dir2 [lindex [glob -nocomplain [file join $dir Img1.*]] 0] if {$dir2 ne {}} {lappend ::auto_path $dir1 $dir2} } return [catch {package require treectrl; package require Img} ::aloupe::runerr] }




option [::aloupe]aloupe, Top

Returns a value of aloupe option.

option opt
Parameters
optthe option's name
Return value

Returns a value of aloupe option.


proc ::aloupe::option {opt} { # Returns a value of aloupe option. # opt - the option's name variable data return $data($opt) }




run [::aloupe]aloupe, Top

Runs the loupe.

run ?args?
Parameters
argsoptions of the loupe

proc ::aloupe::run {args} { # Runs the loupe. # args - options of the loupe if {$::aloupe::starterr} { RunSolo return } variable my::data variable my::size variable my::zoom # save the default settings of aloupe set data(-commandname) "" if {![info exists my::data(DEFAULTS)]} { set defar ::aloupe::_DEFAULTS_ array set $defar [array get my::data] set my::data(DEFAULTS) $defar } catch {set my::data(-inifile) [dict get $args -inifile]} catch { if {([dict exists $args -save] && [dict get $args -save]) || (![dict exists $args -save] && $my::data(-save))} { my::RestoreOptions } } # restore the default settings of aloupe (for a 2nd/3rd... run) set svd $my::data(DEFAULTS) foreach an [array names $svd] { set my::data($an) [set ${svd}($an)] ;# "by variable address" } foreach {a v} $args { if {($v ne "" || $a in {-geometry -fcgeom}) && [info exists my::data($a)] && [string is lower [string index $a 1]]} { set my::data($a) $v } else { puts "Bad option: $a \"$v\"" my::Synopsis } } if {$my::data(-locale) ne {}} { catch { ::msgcat::mcload [file join [file dirname [info script]] msgs] ::msgcat::mclocale $my::data(-locale) } } catch {::apave::obj untouchWidgets "*_a_loupe_loup*"} ;# don't theme the loupe set my::size [set my::data(PREVSIZE) $my::data(-size)] set my::zoom [set my::data(PREVZOOM) $my::data(-zoom)] set my::pause $my::data(-pause) set my::data(WDISP) "$data(-parent)._a_loupe_disp" set my::data(WLOUP) "$data(-parent)._a_loupe_loup" set my::data(LABEL) "$data(WDISP).label" set my::data(COLOR) [set data(CAPTURE) ""] my::Theme my::Create yes }




RunSolo [::aloupe]aloupe, Top

Runs aloupe as a sole Tcl script. When aloupe runs from tclkit, it may fail. So try it with tclsh deployed.

RunSolo

proc ::aloupe::RunSolo {} { # Runs aloupe as a sole Tcl script. # When aloupe runs from tclkit, it may fail. So try it with tclsh deployed. set tclsh [auto_execok tclsh] set tclexe [info nameofexecutable] # tclsh may be sort of "tcl.sh" to run a tclkit if {[file exists $tclsh] && [file size $tclsh]>1024 && $tclsh ne $tclexe} { if {$::aloupe::solo} {set aar $::argv} {set aar {}} exec -- $tclsh $::aloupe::aloupescript {*}$aar & } else { puts "aloupe: $::aloupe::runerr" } }



::aloupe::myTop

The ::aloupe::my namespace contains procedures for the "internal" usage by aloupe package.

All of them are upper-cased, in contrast with the UI procedures of aloupe namespace.


Commandsmy, Top




Button2Click [::aloupe::my]my, Top

Processes the click on 'Clipboard' button.

Button2Click

proc ::aloupe::my::Button2Click {} { # Processes the click on 'Clipboard' button. variable data if {$data(COLOR) ne ""} { StyleButton2 -background $data(INVCOLOR) -foreground $data(COLOR) update idletasks after 60 ;# just to make the click visible } if {[HandleColor] && !$data(-exit) && $data(-command) ne ""} { SaveGeometry {*}[string map [list %c $data(COLOR)] $data(-command)] } }




ColorButton2 [::aloupe::my]my, Top

Colorizes color ("to clipboard") button.

ColorButton2

proc ::aloupe::my::ColorButton2 {} { # Colorizes color ("to clipboard") button. variable data if {$data(COLOR) ne ""} { StyleButton2 -background $data(COLOR) -foreground $data(INVCOLOR) -text $data(COLOR) } }




CountDownPause [::aloupe::my]my, Top

Counts down a pause.

CountDownPause pause p
Parameters
pauseseconds to count down
premaining seconds to count down

proc ::aloupe::my::CountDownPause {pause p} { # Counts down a pause. # pause - seconds to count down # p - remaining seconds to count down variable data if {$p} { set ::aloupe::my::pause [incr p -1] ;# shows remaining seconds set msec [expr {$p ? 1000 : 200}] after $msec [list ::aloupe::my::CountDownPause $pause $p] } else { set ::aloupe::my::pause $pause } }




Create [::aloupe::my]my, Top

Initializes and creates the utility's windows.

Create start
Parameters
startyes, if called at start

proc ::aloupe::my::Create {start} { # Initializes and creates the utility's windows. # start - yes, if called at start variable data catch {destroy $data(WLOUP)} catch {destroy $data(WDISP)} catch {image delete $data(IMAGE)} if {[set wgr [grab current]] ne ""} {grab release $wgr} CreateDisplay $start CreateLoupe set data(PREVZOOM) $data(-zoom) set data(PREVSIZE) $data(-size) focus $data(WDISP) }




CreateDisplay [::aloupe::my]my, Top

Creates the displaying window.

CreateDisplay start
Parameters
startyes, if called at start

proc ::aloupe::my::CreateDisplay {start} { # Creates the displaying window. # start - yes, if called at start variable data set sZ [expr {2*$data(-size)*$data(-zoom)}] set data(IMAGE) [image create photo -width $sZ -height $sZ] toplevel $data(WDISP) wm title $data(WDISP) [::msgcat::mc Loupe] set fg [ttk::style configure . -foreground] set bg [ttk::style configure . -background] set opts [ttk::style config TButton] catch {set fg [dict get $opts -foreground]} catch {set bg [dict get $opts -background]} $data(WDISP) configure -background $bg grid [label $data(WDISP).l -fg $fg -bg $bg] -row 0 -columnspan 3 -sticky we pack [label $data(WDISP).l.lab1 -text " [::msgcat::mc Size]" -fg $fg -bg $bg] -side left -anchor e -expand 1 pack [ttk::spinbox $data(WDISP).l.sp1 -from 8 -to 500 -justify center -width 4 -textvariable ::aloupe::my::size -command ::aloupe::my::ShowLoupe -validate focus -validatecommand {::aloupe::my::Valid size 8 500 25}] -side left pack [label $data(WDISP).l.lab2 -text " [::msgcat::mc Zoom]" -fg $fg -bg $bg] -side left -anchor e -expand 1 pack [ttk::spinbox $data(WDISP).l.sp2 -from 1 -to 50 -justify center -width 2 -textvariable ::aloupe::my::zoom -validate focus -validatecommand {::aloupe::my::Valid zoom 1 50 10}] -side left pack [label $data(WDISP).l.lab3 -text " [::msgcat::mc Pause]" -fg $fg -bg $bg] -side left -anchor e -expand 1 pack [ttk::spinbox $data(WDISP).l.sp3 -from 0 -to 60 -justify center -width 2 -textvariable ::aloupe::my::pause -validate focus -validatecommand {::aloupe::my::Valid pause 0 60 0}] -side left grid [ttk::separator $data(WDISP).sep1 -orient horizontal] -row 1 -columnspan 3 -sticky we -pady 2 grid [ttk::label $data(LABEL) -image $data(IMAGE) -relief flat] -row 2 -columnspan 3 -padx 2 set data(BUT0) $data(WDISP).but0 set data(BUT1) $data(WDISP).but1 set data(BUT2) $data(WDISP).but2 if {[set but1text $data(-commandname)] eq ""} { set but1text [::msgcat::mc "To clipboard"] } grid [button $data(BUT0) -text [::msgcat::mc "Refresh"] -command ::aloupe::my::Refresh -fg $fg -bg $bg -font TkFixedFont] -row 3 -column 0 -sticky ew grid [button $data(BUT1) -text $but1text -command ::aloupe::my::Button2Click -font TkFixedFont] -row 3 -column 1 -sticky ew grid [button $data(BUT2) -text [::msgcat::mc Save] -command ::aloupe::my::Save -fg $fg -bg $bg -font TkFixedFont] -row 3 -column 2 -sticky ew set data(-geometry) [regexp -inline \\+.* $data(-geometry)] if {$data(-geometry) ne ""} { wm geometry $data(WDISP) $data(-geometry) } elseif {$data(-parent) ne ""} { ::tk::PlaceWindow $data(WDISP) widget $data(-parent) } else { ::tk::PlaceWindow $data(WDISP) } if {$start} { set defargs [list -foreground $fg -background $bg] set data(BUTCFG) [StyleButton2 {*}$defargs] lappend data(BUTCFG) {*}$defargs -text $but1text } foreach w {BUT0 BUT1 BUT2} { set w $data($w) foreach k {<Up> <Left>} { bind $w $k " if {{$::tcl_platform(platform)} eq {windows}} { event generate $w <Shift-Tab> } else { event generate $w <Key> -keysym ISO_Left_Tab }" } foreach k {<Down> <Right>} { bind $w $k "event generate $w <Key> -keysym Tab" } foreach k {<Return> <KP_Enter>} { bind $w $k "event generate $w <Key> -keysym space" } } bind $data(LABEL) <ButtonPress-1> {::aloupe::my::PickColor %W %X %Y} bind $data(WDISP) <Escape> ::aloupe::my::Exit wm resizable $data(WDISP) 0 0 wm protocol $data(WDISP) WM_DELETE_WINDOW ::aloupe::my::Exit if {$data(-ontop)} {wm attributes $data(WDISP) -topmost 1} }




CreateLoupe [::aloupe::my]my, Top

Creates the loupe window.

CreateLoupe ?geom?
Parameters
geomthe predefined geometry; optional, default ""

proc ::aloupe::my::CreateLoupe {{geom {}}} { # Creates the loupe window. # geom - the predefined geometry variable data frame $data(WLOUP) wm manage $data(WLOUP) wm withdraw $data(WLOUP) wm overrideredirect $data(WLOUP) 1 set canvas $data(WLOUP).c canvas $canvas -width 100 -height 100 -background $data(-background) -relief flat -bd 0 -highlightthickness 1 -highlightbackground red pack $canvas -fill both -expand true bind $canvas <ButtonPress-1> {::aloupe::my::DragStart %W %X %Y %x %y} bind $canvas <B1-Motion> {::aloupe::my::Drag %W %X %Y} bind $canvas <ButtonRelease-1> {::aloupe::my::DragEnd %W} bind $canvas <Escape> {::aloupe::my::Exit} after 50 " ::aloupe::my::InitGeometry $geom wm deiconify $data(WLOUP) wm attributes $data(WLOUP) -topmost 1 -alpha $data(-alpha) " }




DisplayImage [::aloupe::my]my, Top

Ends the frag-and-drop of the loupe and displays its magnified image.

DisplayImage w
Parameters
wthe loupe window's path

proc ::aloupe::my::DisplayImage {w} { # Ends the frag-and-drop of the loupe and displays its magnified image. # w - the loupe window's path variable data if {![info exists data(dragX)]} return wm attributes $data(WLOUP) -topmost 1 -alpha 0.0 wm attributes $data(WDISP) -alpha 0.0 wm withdraw $data(WLOUP) wm withdraw $data(WDISP) set curX [winfo rootx $w] set curY [winfo rooty $w] set curW [winfo width $w] set curH [winfo height $w] catch {image delete $data(CAPTURE)} set sz [expr {2*$data(-size)}] set sZ [expr {$sz*$data(-zoom)}] set data(CAPTURE) [image create photo -width $sz -height $sz] set loupe_x [expr {$curX + $sz/2}] set loupe_y [expr {$curY + $sz/2}] after 40 "loupe $data(CAPTURE) $loupe_x $loupe_y $sz $sz 1" after 50 update ;# enough time to hide the window and capture the image after 50 catch { $data(IMAGE) copy $data(CAPTURE) -from 0 0 $sz $sz -to 0 0 $sZ $sZ -zoom $data(-zoom) } wm deiconify $data(WDISP) wm deiconify $data(WLOUP) after idle " wm attributes $data(WLOUP) -topmost 1 -alpha $data(-alpha); wm attributes $data(WDISP) -alpha 1.0" focus -force $data(BUT0) }




Drag [::aloupe::my]my, Top

Performs the frag-and-drop of the loupe.

Drag w X Y
Parameters
wthe loupe window's path
XX-coordinate of the mouse pointer
YY-coordinate of the mouse pointer

proc ::aloupe::my::Drag {w X Y} { # Performs the frag-and-drop of the loupe. # w - the loupe window's path # X - X-coordinate of the mouse pointer # Y - Y-coordinate of the mouse pointer variable data if {![info exists data(dragX)]} return set dx [expr {$X - $data(dragX)}] set dy [expr {$Y - $data(dragY)}] wm geometry $data(WLOUP) +$dx+$dy }




DragEnd [::aloupe::my]my, Top

Ends the frag-and-drop of the loupe and displays its magnified image.

DragEnd w
Parameters
wthe loupe window's path

proc ::aloupe::my::DragEnd {w} { # Ends the frag-and-drop of the loupe and displays its magnified image. # w - the loupe window's path variable pause if {$pause} { after 1000 [list ::aloupe::my::CountDownPause $pause $pause] after [expr {$pause*1000}] [list ::aloupe::my::DisplayImage $w] } else { ::aloupe::my::DisplayImage $w } }




DragStart [::aloupe::my]my, Top

Initializes the frag-and-drop of the loupe.

DragStart w X Y x y
Parameters
wthe loupe window's path
XX-coordinate of the mouse pointer
YY-coordinate of the mouse pointer
xX-coordinate inside the loupe
yY-coordinate inside the loupe

proc ::aloupe::my::DragStart {w X Y x y} { # Initializes the frag-and-drop of the loupe. # w - the loupe window's path # X - X-coordinate of the mouse pointer # Y - Y-coordinate of the mouse pointer # x - X-coordinate inside the loupe # y - Y-coordinate inside the loupe variable data variable size variable zoom set data(FOCUS) [focus] focus -force $data(WDISP) set data(-size) $size set data(-zoom) $zoom if {$data(PREVZOOM) != $data(-zoom) || $data(PREVSIZE) != $data(-size)} { SaveGeometry Create no catch {unset data(dragX)} ;# no drag-n-drop, update the loupe only update return } InitButton2 set data(x) $x set data(y) $y InitGeometry update set data(dragX) [expr {$X - [winfo rootx $w]}] set data(dragY) [expr {$Y - [winfo rooty $w]}] }




Exit [::aloupe::my]my, Top

Clears all and exits.

Exit

proc ::aloupe::my::Exit {} { # Clears all and exits. variable data SaveOptions if {$data(-exit)} exit SaveGeometry catch {image delete $data(IMAGE)} catch {image delete $data(CAPTURE)} catch {destroy $data(WDISP)} catch { wm withdraw $data(WLOUP) destroy $data(WLOUP) } }




HandleColor [::aloupe::my]my, Top

Processes the image color under the mouse pointer, optionally saving it to the clipboard.

HandleColor ?doclb?
Parameters
doclbif 'yes', means "put the color into the clipboard" optional, default yes
Return value

Returns 'yes' if the color was chosen.


proc ::aloupe::my::HandleColor {{doclb yes}} { # Processes the image color under the mouse pointer, # optionally saving it to the clipboard. # doclb - if 'yes', means "put the color into the clipboard" # Returns 'yes' if the color was chosen. variable data set res no if {[IsCapture]} { if {$data(COLOR) eq ""} { Message -title [msgcat::mc {Color of Image}] -icon warning -message [msgcat::mc "Click the magnified image\nto get a pixel's color.\n\nThen hit this button."] } else { if {$doclb && $data(-commandname) eq ""} { clipboard clear clipboard append -type STRING $data(COLOR) } ColorButton2 set res yes } } return $res }




InitButton2 [::aloupe::my]my, Top

Initializes color ("to clipboard") button.

InitButton2

proc ::aloupe::my::InitButton2 {} { # Initializes color ("to clipboard") button. variable data set data(COLOR) [set data(CAPTURE) ""] StyleButton2 {*}$data(BUTCFG) }




InitGeometry [::aloupe::my]my, Top

Gets and sets the geometry of the loupe window, based on the image label's sizes and the zoom factor.

InitGeometry ?geom?
Parameters
geomthe predefined geometry; optional, default ""

proc ::aloupe::my::InitGeometry {{geom {}}} { # Gets and sets the geometry of the loupe window, # based on the image label's sizes and the zoom factor. # geom - the predefined geometry variable data if {$geom eq ""} { set sz [expr {2*$data(-size)}] lassign [winfo pointerxy .] x y if {[info exists data(x)]} {set dx $data(x)} {set dx $sz/2} if {[info exists data(y)]} {set dy $data(y)} {set dy $sz/2} set x [expr $x-$dx] set y [expr $y-$dy] set geom ${sz}x${sz}+$x+$y } wm geometry $data(WLOUP) $geom }




InvertBg [::aloupe::my]my, Top

Gets fg color (white/black) for a bg color.

InvertBg color
Parameters
colorbg color

proc ::aloupe::my::InvertBg {color} { # Gets fg color (white/black) for a bg color. # color - bg color lassign [winfo rgb . $color] r g b if {($r%256+$b%256)<15 && ($g%256)>180} { set res black } elseif {$r+1.5*$g+0.5*$b > 100000} { set res black } else { set res white } return $res }




IsCapture [::aloupe::my]my, Top

Checks if the image was captured.

IsCapture

proc ::aloupe::my::IsCapture {} { # Checks if the image was captured. variable data if {$data(CAPTURE) eq ""} { Message -title [msgcat::mc {Color of Image}] -icon warning -message [msgcat::mc "Click, then drag and drop\nthe loupe to get the image."] return no } return yes }




Message [::aloupe::my]my, Top

Displays a message, with the loupe hidden.

Message ?args?
Parameters
argsOptional arguments.

proc ::aloupe::my::Message {args} { # Displays a message, with the loupe hidden. variable data wm withdraw $data(WLOUP) tk_messageBox -parent $data(WDISP) -type ok {*}$args wm deiconify $data(WLOUP) }




PickColor [::aloupe::my]my, Top

Gets the image color under the mouse pointer.

PickColor w X Y
Parameters
wthe image label's path
XX-coordinate of the mouse pointer
YY-coordinate of the mouse pointer

proc ::aloupe::my::PickColor {w X Y} { # Gets the image color under the mouse pointer. # w - the image label's path # X - X-coordinate of the mouse pointer # Y - Y-coordinate of the mouse pointer variable data if {![IsCapture]} return set x [expr {max(($X - [winfo rootx $w] -4),0)}] set y [expr {max(($Y - [winfo rooty $w] -4),0)}] catch { lassign [$data(IMAGE) get $x $y] r g b set data(COLOR) [format "#%02x%02x%02x" $r $g $b] set data(INVCOLOR) [InvertBg $data(COLOR)] HandleColor no set msec [clock milliseconds] if {[info exists data(MSEC)] && [expr {($msec-$data(MSEC))<400}]} { Button2Click } set data(MSEC) $msec } }




Refresh [::aloupe::my]my, Top

Refreshes the loupe image without mouse click.

Refresh

proc ::aloupe::my::Refresh {} { # Refreshes the loupe image without mouse click. variable data InitButton2 DragEnd $data(WLOUP) }




RestoreOptions [::aloupe::my]my, Top

Restores options of appearance from a file.

RestoreOptions

proc ::aloupe::my::RestoreOptions {} { # Restores options of appearance from a file. variable data if {!$data(-save)} return if {![file exists $data(-inifile)]} return set chan [open $data(-inifile)] set data(CONFIG) [read $chan] close $chan set svd $data(DEFAULTS) foreach line [split $data(CONFIG) \n] { if {[string match "*=*" $line]} { set opt -[string range $line 0 [string first = $line]-1] set val [string range $line [string length $opt] end] set ${svd}($opt) [set data($opt) $val] } } }




Save [::aloupe::my]my, Top

Saves the magnified image to a file.

Save

proc ::aloupe::my::Save {} { # Saves the magnified image to a file. variable data if {![IsCapture]} return wm withdraw $data(WLOUP) set filetypes { {"PNG Images" .png} {"All Image Files" {.png .gif}} } set file [file tail $::aloupe::filename] set argl [list -parent $data(WDISP) -title [::msgcat::mc "Save the Loupe"] -filetypes $filetypes -defaultextension .png -initialfile $file] if {$data(-fcgeom) ne {}} { set file [::apave::obj chooser tk_getSaveFile ::aloupe::filename {*}$argl] } else { catch {::apave::obj themeExternal "$data(WLOUP)*"} ;# theme the file chooser set file [tk_getSaveFile {*}$argl] } if {$file ne ""} { set ::aloupe::filename $file if {![regexp -nocase {\.(png|gif)$} $file -> ext]} { set ext "png" append file ".${ext}" } if {[catch {$data(IMAGE) write $file -format [string tolower $ext]} err]} { Message -title "Error Writing File" -icon error -message "Error writing to file \"$file\":\n$err" } } ShowLoupe }




SaveGeometry [::aloupe::my]my, Top

Saves the displaying window's geometry.

SaveGeometry

proc ::aloupe::my::SaveGeometry {} { # Saves the displaying window's geometry. variable data set data(-geometry) "" catch {set data(-geometry) [wm geometry $data(WDISP)]} }




SaveOptions [::aloupe::my]my, Top

Saves options of appearance to a file.

SaveOptions

proc ::aloupe::my::SaveOptions {} { # Saves options of appearance to a file. variable data variable size variable zoom variable pause if {!$data(-save)} return set data(-size) $size set data(-zoom) $zoom set data(-pause) $pause set w $data(WDISP) catch {file mkdir [file dirname $data(-inifile)]} catch { append opts {[options]} \n foreach opt [array names data] { if {$opt in {-size -geometry -background -zoom -pause -alpha -ontop}} { if {$opt eq "-geometry"} { set val [wm geometry $w] } else { set val $data($opt) } append opts "[string range $opt 1 end]=$val" \n } } set chan [open $data(-inifile) w] puts -nonewline $chan $opts close $chan } }




ShowLoupe [::aloupe::my]my, Top

Re-displays the loupe at changing its size.

ShowLoupe

proc ::aloupe::my::ShowLoupe {} { # Re-displays the loupe at changing its size. variable data variable size set data(-size) $size lassign [split [wm geometry $data(WLOUP)] +] -> x y set sz [expr {2*$size}] destroy $data(WLOUP) CreateLoupe ${sz}x${sz}+$x+$y ColorButton2 }




StyleButton2 [::aloupe::my]my, Top

Makes a style for Tbutton.

StyleButton2 ?args?
Parameters
argsoptions ("name value" pairs)
Return value

Returns the TButton's configuration options.


proc ::aloupe::my::StyleButton2 {args} { # Makes a style for Tbutton. # args - options ("name value" pairs) # Returns the TButton's configuration options. variable data if {[dict exists $args -text]} { $data(BUT1) configure -text [dict get $args -text] set args [dict remove $args -text] } set fg [dict get $args -foreground] set bg [dict get $args -background] $data(BUT1) configure -foreground $fg -background $bg return {} }




Synopsis [::aloupe::my]my, Top

Short info about usage.

Synopsis

proc ::aloupe::my::Synopsis {} { # Short info about usage. variable data puts " Syntax: tclsh aloupe.tcl ?option value ...? where 'option' may be [array names $data(DEFAULTS)]. " exit }




Theme [::aloupe::my]my, Top

Themes the utility

Theme

proc ::aloupe::my::Theme {} { # Themes the utility variable data if {$data(-apavedir) eq {}} return source [file join $data(-apavedir) apave.tcl] ::apave::initWM -cs $data(-cs) -theme alt if {$data(-fcgeom) ne {}} { ::apave::obj chooserGeomVars {} ::aloupe::my::data(-fcgeom) } }




Valid [::aloupe::my]my, Top

Validates spinbox's value.

Valid vnam val1 val2 valdef
Parameters
vnamvariable name
val1"from" value
val2"to" value
valdefdefault value

proc ::aloupe::my::Valid {vnam val1 val2 valdef} { # Validates spinbox's value. # vnam - variable name # val1 - "from" value # val2 - "to" value # valdef - default value set vnam ::aloupe::my::$vnam set val [set $vnam] if {$val<$val1 || $val>$val2} { set $vnam $valdef } return 1 }

Document generated by Ruff!