1#!/usr/bin/env tclsh
2
3package require Tk 8.4
4set noimg [catch {package require img::png}] ; # for saving images
5
6# We are the main script being run - show ourselves
7wm withdraw .
8
9package require widget::screenruler
10set dlg [widget::screenruler .r -title "Screen Ruler" -width 250 -height 100]
11
12if {[tk windowingsystem] eq "aqua"} {
13    set CTRL    "Command-"
14    set CONTROL Command
15} else {
16    set CTRL    Ctrl+
17    set CONTROL Control
18}
19
20upvar \#0 [$dlg info vars reflect] reflect
21if {[lsearch -exact [image names] $reflect(image)] != -1} {
22    # We have a reflectable desktop
23
24    $dlg menu add separator
25    $dlg menu add command -label "Save Image" -accelerator ${CTRL}s \
26	-underline 0 -command [list save $dlg]
27    bind $dlg <$CONTROL-s> [list save $dlg]
28}
29
30if {[tk windowingsystem] eq "x11"} {
31    # Add hack to control overrideredirect as some wms (eg KDE) have focus
32    # issues on the overrideredirect window
33    set override [expr {![wm overrideredirect $dlg]}]
34    $dlg menu add separator
35    $dlg menu add checkbutton -label "Window Decoration" -variable ::override \
36	-command [list override $dlg]
37    proc override {w} {
38	wm withdraw $w
39	wm overrideredirect $w [expr {! $::override}]
40	wm deiconify $w
41    }
42    wm protocol $dlg WM_DELETE_WINDOW exit
43}
44
45$dlg menu add separator
46$dlg menu add command -label "Exit" \
47    -underline 1 -accelerator ${CTRL}q -command { exit }
48bind $dlg <$CONTROL-q> { exit }
49
50package require comm
51$dlg menu add separator
52$dlg menu add command -label "COMM: [comm::comm self]" -state disabled
53
54focus -force $dlg
55$dlg display
56$dlg configure -alpha 0.8
57
58if {$::argc} {
59    eval [linsert $argv 0 $dlg configure]
60}
61
62set LASTDIR  [pwd]
63
64proc save {dlg} {
65    global LASTDIR
66    variable [$dlg info vars reflect]
67    after cancel $reflect(id)
68
69    if {$::noimg} {
70	set filetypes {
71	    {"All Image Files" {.gif .ppm}}
72	}
73	set re {\.(gif|ppm)$}
74    } else {
75	set filetypes {
76	    {"All Image Files" {.gif .png .ppm}}
77	    {"PNG Images" .png}
78	}
79	set re {\.(gif|ppm|png)$}
80    }
81    lappend filetypes {"GIF Images" .gif} {"PPM Images" .ppm} {"All Files" *}
82    set file [tk_getSaveFile -parent $dlg -title "Save Image to File" \
83		  -initialdir $LASTDIR -filetypes $filetypes]
84
85    if {$file ne ""} {
86	set LASTDIR [file dirname $file]
87	if {![regexp -nocase $re $file -> ext]} {
88	    tk_messageBox -title "Unrecognized Extension" \
89		-parent $dlg -icon error -type ok \
90		-message "Unknown file type to save for file\
91		\"[file tail $file]\"\nPlease use .gif, .ppm or .png."
92	} elseif {[catch {$reflect(image) write $file \
93			      -format [string tolower $ext]} err]} {
94	    tk_messageBox -title "Error Writing File" \
95		-parent $dlg -icon error -type ok \
96		-message "Error writing to file \"$file\":\n$err"
97	}
98    }
99
100    $dlg configure -reflect [$dlg cget -reflect]
101}
102
103