diff options
Diffstat (limited to 'vendor/x11iraf/guidemo')
29 files changed, 8197 insertions, 0 deletions
diff --git a/vendor/x11iraf/guidemo/Notes b/vendor/x11iraf/guidemo/Notes new file mode 100644 index 00000000..1f868e76 --- /dev/null +++ b/vendor/x11iraf/guidemo/Notes @@ -0,0 +1,41 @@ + GUIDEMO + Design Notes + + +IMBROWSE + + imageShell TopLevelShell + panel Paned + form Form + imageTitle AsciiText + imageCloseButton Command + imagewin Gterm + + + imbrowse ApplicationShell + panel Paned + form Form + dirSelect MenuButton + dirMenu MenuShell + dir-list SmeBSB (., .., subdirs) + dirName AsciiText + helpButton Command + quitButton Command + viewport Viewport + imageList List + form + helpText + filesLabel + filesText + nextButton + prevButton + headerButton + displayButton + headerText + form + sectionLabel + sectionText + + + + diff --git a/vendor/x11iraf/guidemo/README b/vendor/x11iraf/guidemo/README new file mode 100644 index 00000000..38d4cd8a --- /dev/null +++ b/vendor/x11iraf/guidemo/README @@ -0,0 +1,6 @@ +GUIDEMO -- Demo IRAF GUI applications. These applications demonstrate how to +use the prototype widget server (xgterm) to build GUIs for IRAF applications. + + imbrowse Graphical image browser. Can navigate a directory + tree and list, display, and otherwise examine the + images therein. diff --git a/vendor/x11iraf/guidemo/frame.gui b/vendor/x11iraf/guidemo/frame.gui new file mode 100644 index 00000000..c6561a7a --- /dev/null +++ b/vendor/x11iraf/guidemo/frame.gui @@ -0,0 +1,70 @@ +# FRAME.GUI -- Test GUI for the frame and layout widgets. +# This gui can be run as "cl> hello gui=frame.gui". + +reset-server +appInitialize frame Frame { + *objects:\ + toplevel Frame frame\ + frame Layout panel\ + panel Frame label1_frame\ + label1_frame Label label1\ + panel Frame label2_frame\ + label2_frame Label label2\ + panel Command button1\ + panel Command button2 + + *background: gray + *foreground: black + + *frame.highlightThickness: 0 + *frame.frameWidth: 4 + *frame.frameType: chiseled + *frame.innerOffset: 5 + *frame.outerOffset: 5 + + *panel.debug: True + *panel.borderWidth: 0 + + *panel.layout: vertical {\ + 5 < +inf - 5 > \ + horizontal { \ + -1 \ + label1_frame < +inf * +inf > \ + -1 \ + } \ + 5 < +inf - 5 > \ + horizontal { \ + -1 \ + label2_frame < +inf * +inf > \ + -1 \ + } \ + 5 < +inf - 5 > \ + horizontal {\ + -1 < +inf > \ + button1 \ + 5 < +inf -5 > \ + button2 \ + -1 < +inf > \ + }\ + 5 < +inf - 5 > \ + } + + *Label.borderWidth: 0 + *Label.background: gray60 + *label1*shadowWidth: 0 + *label1_frame.frameType: sunken + *label1_frame.frameWidth: 2 + *label2*shadowWidth: 0 + *label2_frame.frameType: sunken + *label2_frame.frameWidth: 2 + + *allowShellResize: true + *beNiceToColormap: False +} + +# Start up the GUI. +createObjects +activate + +proc quit args { send client gkey q; deactivate unmap } +send button1 addCallback quit diff --git a/vendor/x11iraf/guidemo/gtest.gui b/vendor/x11iraf/guidemo/gtest.gui new file mode 100644 index 00000000..27e94bc3 --- /dev/null +++ b/vendor/x11iraf/guidemo/gtest.gui @@ -0,0 +1,182 @@ +# GTEST.GUI -- Graphics user interface for the "hello world" demo task, +# as modified to test the class Gterm graphics primitives. + +reset-server +appInitialize hello Hello { +! +! Application defaults for the hello world program. +! + Hello*objects:\ + toplevel Form helloForm\ + helloForm Label helloLabel\ + helloForm Command quitButton\ + helloForm Command drawButton\ + helloForm Gterm plotwin + + + Hello*helloForm*background: bisque + Hello*helloForm*helloLabel.label: Hello, world! + Hello*helloForm*quitButton.fromHoriz: helloLabel + Hello*helloForm*quitButton.label: Quit + Hello*helloForm*drawButton.fromHoriz: quitButton + Hello*helloForm*drawButton.label: Draw + Hello*helloForm*plotwin.fromHoriz: drawButton +} + +createObjects +proc quit args { send client gkey q; deactivate unmap } + +# draw -- Graphics test procedure. +proc draw args { + global R1_width R1_height R1_depth R1_colors R1_pixels R1_encoding + global R2_width R2_height R2_depth R2_colors R2_pixels R2_encoding + global R3_width R3_height R3_depth R3_colors R3_pixels R3_encoding + + send plotwin queryRaster 0 wid ht type depth + print "raster query: wid=" $wid " ht=" $ht " type= " $type " depth=" $depth + + # Test pixel i/o. + send plotwin setPixel 0 10 10 1 + send plotwin setPixel 0 11 11 3 + send plotwin setPixel 0 12 12 4 + + # Test line drawing. + send plotwin { + setLineWidth 5 + setColorIndex blue + drawPolyline { {20 20} {100 100} {200 50} {300 350} {400 250} } + } + + # Test fill polygon. + send plotwin { + setFillType solid + setColorIndex green + drawPolygon { {105 115} {174 115} {174 183} {105 183} } + } + + # Test text drawing and area fills, show static colors. + send plotwin drawAlphaText 400 100 "Gterm Graphics Test" + for {set i 0} {$i < 10} {incr i 1} { + send plotwin setPixels 0 $i pixel [expr 370+($i*20)] 105 20 20 + } + + # Test basic image raster drawing. Image R1 has its own colormap, while + # R2 uses the static colors. + + set bias [send plotwin getBias] + send plotwin "\ + writeColormap 0 \{ $R1_colors \} $bias; \ + writePixels 0 \{ $R1_pixels \} $R1_encoding $R1_depth \ + 109 118 $R1_width $R1_height $bias; \ + writePixels 0 \{ $R2_pixels \} $R2_encoding $R2_depth \ + 560 400 $R2_width $R2_height" + + # Set up for test below; also test extending colormap. + set x 20 + set bias [expr $bias + [llength $R1_colors]] + send plotwin "\ + writeColormap 0 \{ $R3_colors \} $bias; \ + writePixels 0 \{ $R3_pixels \} $R3_encoding $R3_depth \ + $x 400 $R3_width $R3_height $bias" + + # Test various image encodings. + foreach encoding {numeric hex1 hex2 hex1-rle hex2-rle} { + set pixels [send plotwin \ + readPixels 0 $encoding $R3_depth 20 400 $R3_width $R3_height $bias] + send plotwin \ + writePixels 0 $pixels $encoding $R3_depth \ + $x 400 $R3_width $R3_height $bias + incr x 64 + } +} + +send quitButton addCallback quit +send drawButton addCallback draw + +activate + +# Raster "porsche". +set R1_width 64; set R1_height 64; set R1_depth 8 +set R1_colors { + {255 255 255} { 0 0 0} {106 90 205} {255 0 0} {255 255 0} +} +set R1_encoding "hex1-rle" +set R1_pixels { + 2%861@k2@E1@k2@E114@g112@E11441@2441@2441@2441@2441@2441441441@244112@E11 + 4414414414414414414414414414414414414414@3112@E114414414414414414414414@3 + 14@314414414@3112@E11441@2441441441114441@24414@31@2441@244112@E114414@31 + 4414414414@314414@314414414@3112@E114414@31441441441441441441441441441441 + 4@3112@E114414@31@2441441441@2441@2441441441@244112@E114@g112@E1@k2@E114@ + J1@N2@E114@414441444114@31@N2@E114@31444144414@21441@N2@E114@211441141@54 + 441@N2@E114441@64@41144113@J112@E11441@24@D113@J112@E1141114@F113@J112@E1 + 14@814414@5113@J112@E114@3144414414@6113@J112@E114@214441441441@U2@E114@2 + 141@74@C1@F2@E114441@24@51@U2@E11441114@714@C1@F2@E1141114@814441114@61@F + 2@E114@7144141441@34@51@F2@E114@3144144144144141114@31413@C112@E114@21441 + 44144114@21114@211413@C112@E114441141@5414@21114@211413@C112@E11441@34@41 + 14441@344414413@C112@E1141114@8141@94413@C112@E114@C14141@74413@C112@E1@F + 41414@21@2441@F2@E1@F44414@31414414@C112@E1@F4@6114114144414414@5112@F1@E + 4@614414414414414441444112@G1@E4@5144144414144144414@2112@G1@F4@A141@8444 + 112@H113@C14@81@24@6114112@I113@D14@61@24@A112@J113@D1@64@514414@2112@K11 + 3@G114@31444144144144112@L113@F114@21444144144144112@M113@F114441141@6444 + 112@N1@I4441@24@4114112@P1@H441114@912@Q1@H41114@9112@R1@G4@C112@T1@F4441 + 41414@3112@V1@E441414144144112@X113@911441@544112@Z113@81141114@214112@b1 + 13@7114114@4112@d1113@5114@51112@f1@23@3114@31@22@i1@2333114441@22@m1@231 + 141@22@q1@62@u1@22@x112%5D +} + +# Raster "nobozos". +set R2_width 64; set R2_height 64; set R2_depth 8 +set R2_colors { } +set R2_encoding "hex1-rle" +set R2_pixels { + 1%590@91@l0@H1@e0@N1@Z0@R1@V0@V1@S0@X1@P0@b1@M0@d1@K0@F1@70@F1@I0@C1@F0@C + 1@G0@B1@J0@B1@E0@A1@N0@A1@C0@C1@N0@A1@B0@D1@O0@81@A0@F1@O0@81@80@81110@41 + @P0@71@70@41@30110@41@M0101110@31@60@510111001@30001@K00111010@41@50@3111 + 0@2101010110001@F0101010@21110@21@40@311001010@2110010@21@D00110@21010011 + 0@21@30@3101010010100010110@21@C0100010100101010@21@300011100110010010@31 + 10@21@A0@31001001100111001@20@210010001010@3110011001@A00110@310100010010 + 001110@2110100010001010001001@20@31@4010001010001000101100011100011100010 + @610@41001@3001010@310@610001110011100010010@510@31010001@700101010@310@5 + 100100110@21101010001000100010@21@90@310001000100010101100010@31110010@21 + 00010@31@B010@2100010@21001110@210@310010@510@3101@D0010@310@510010@210@3 + 1101010001000101001110@21110@211100010100010001010110@210@411100010@61011 + 0011001001100110010@610001110@310@410010@31010@31101@20101@20110@41010@31 + 0010@310@4110101110@210001110100101010010111001010@2111010110@310@51@3001 + 01010001110100100010010111001010101001@30@410@61@30101@3011101110@3111011 + 101@40101@20@610@61@B01110@B11101@B0@610@61@B01@40@51@40101@80@7110@61@A0 + 1@40@51@401001@70@61110@61@A01@50@31@5010001@60@61110@61@A011100111000111 + 00111010@21@50@61110@71@A010@21@50@210110@31@30@71@20@61@A01001001@300100 + 1010@51@20@61@30@71@901100110@3110011010@6110@71@30@71@A011001@500110110@ + 710@71@40@71@A0110@7110110@H1@50@81@9001@90010@I1@60@71@A001@700110@H1@70 + @81@B001@3001110@I1@80@81@C0@31@50@F1@A0@81@O0@D1@B0@A1@N0@C1@C0@A1@N0@A1 + @E0@B1@J0@B1@G0@C1@F0@C1@I0@F1@70@F1@K0@d1@M0@b1@P0@X1@S0@V1@V0@R1@Z0@N1@ + e0@H1@l0@91@O +} + + +# Raster "city". +set R3_width 64; set R3_height 64; set R3_depth 8 +set R3_colors { { 0 191 255} { 178 34 34} {224 224 0} } +set R3_encoding "hex1-rle" +set R3_pixels { + 0%FF%FF%FF%E610@z10@z10@P1@30@S1110@O121110@S1110@O111210@R1@30@N1@30@R1@ + 30@N121110@P1@80@K111210@P10010010010@K1@30@P10010010010@D110@3112110@P1@ + 80@D110@31@30@P1001@20010@D110@3121110@P1001@20010@D110@31@30@91@20@A1@80 + 1@9000110@3111210@910010@21@30001@2001@2010121010011000110@31@30@91@20@21 + 21010001@2001@201@9000110@31@30@910010@2121010001@8010112110001000110@310 + 0010@91@20@21@30001001@501@9000110@31@30@910010@2121110001001@50100121001 + 21001@20@2111210@91@20@2121110001@200100101@90010010@21@30@91@20@21112100 + 01@2001001010121010001001@20@2112110@91@20@2111210001@801@90010010@21@80@ + 410010@21@30001@8011001211001001@20@21@3001110@41@20@21@30001@801@9001@20 + @21@50010@41@20@2111210001@8011001210001001@20@2121@60@410010@21112100010 + 01@200101@90010010@21@3001110@21@50001@30001001@2001010100100011001@20@21 + 121@50@210@3100011121@C01@90012110@21@50010@21@500011121@6001001010121100 + 121001@20@21112100111001@70001@421@300100101@90011210@21@80010@5100012101 + 21@A010121121011001@4001112111001001@700012101@3001@501@C00111001@3001110 + 01@70001@4211001@821110012101@40001@5001001@F21@M211001110011121@40010@51 + @321@8001@4001@2001121@500121@H211121@8001@H00101001@5001@20@51@521@E2101 + 121001@7001@3001@221@D21121@6001@C2101@5001@I21@321@7001@2211100121121@42 + 1@4001@I21@P2101@521@3001@20@5121@321121@600111211001@421@201121@821@8211 + 1211121@7001@821@3001@42111001@40@51@321@G0001@521@521@6001@J211001@H2110 + 0101@3001@521@20@211121@32111001@721@3001121@621@J21@U211001%BF +} diff --git a/vendor/x11iraf/guidemo/guidemo.cl b/vendor/x11iraf/guidemo/guidemo.cl new file mode 100644 index 00000000..f00e2182 --- /dev/null +++ b/vendor/x11iraf/guidemo/guidemo.cl @@ -0,0 +1,8 @@ +#{ GUIDEMO.CL -- Define the GUI tasks. + +package guidemo + +task hello, + imbrowse = "guidemo$xx_guidemo.e" + +clbye() diff --git a/vendor/x11iraf/guidemo/hello.gui b/vendor/x11iraf/guidemo/hello.gui new file mode 100644 index 00000000..5b5df35a --- /dev/null +++ b/vendor/x11iraf/guidemo/hello.gui @@ -0,0 +1,23 @@ +# HELLO.GUI -- Graphics user interface for the "hello world" demo task. + +reset-server +appInitialize hello Hello { +! +! Application defaults for the hello world program. +! + +Hello*objects:\ + toplevel Form helloForm\ + helloForm Label helloLabel\ + helloForm Command quitButton + +Hello*helloForm*background: bisque +Hello*helloForm*helloLabel.label: Hello, world! +Hello*helloForm*quitButton.fromHoriz: helloLabel +Hello*helloForm*quitButton.label: Quit +} + +createObjects +proc quit args { send client gkey q; deactivate unmap } +send quitButton addCallback quit +activate diff --git a/vendor/x11iraf/guidemo/hello.par b/vendor/x11iraf/guidemo/hello.par new file mode 100644 index 00000000..dbcba751 --- /dev/null +++ b/vendor/x11iraf/guidemo/hello.par @@ -0,0 +1,5 @@ +# Parameters for HELLO task. + +gui,f,h,"guidemo$hello.gui",,,user interface file +coords,*gcur,h,,,,graphics cursor input +device,s,h,"stdgraph",,,graphics device for plots diff --git a/vendor/x11iraf/guidemo/hello.x b/vendor/x11iraf/guidemo/hello.x new file mode 100644 index 00000000..4e519cf1 --- /dev/null +++ b/vendor/x11iraf/guidemo/hello.x @@ -0,0 +1,39 @@ +# HELLO.X -- GUI version of IRAF hello world. + +procedure t_hello() + +pointer gp +real x, y +int wcs, key +char strval[SZ_LINE] +char device[SZ_FNAME] +char guifile[SZ_FNAME] +int clgcur() +pointer gopenui() + +begin + call clgstr ("device", device, SZ_FNAME) + call clgstr ("gui", guifile, SZ_FNAME) + + gp = gopenui (device, NEW_FILE, guifile, STDGRAPH) + while (clgcur ("coords", x, y, wcs, key, strval, SZ_LINE) != EOF) + if (key == 'q' || key == 'Q') + break + else { + if (key == ':') { + call printf ("%g %g %d %c %s\n") + call pargr (x) + call pargr (y) + call pargi (wcs) + call pargi (key) + call pargstr (strval) + } else { + call printf ("%g %g %d %c\n") + call pargr (x) + call pargr (y) + call pargi (wcs) + call pargi (key) + } + } + call gclose (gp) +end diff --git a/vendor/x11iraf/guidemo/help.gui b/vendor/x11iraf/guidemo/help.gui new file mode 100644 index 00000000..0159dc2b --- /dev/null +++ b/vendor/x11iraf/guidemo/help.gui @@ -0,0 +1,301 @@ + +# HTML.GUI -- Test HTML widget. + +reset-server +appInitialize html HTML { + *objects:\ + toplevel Layout helpLayout \ + helpLayout Layout helpMenuLayout \ + helpLayout Layout helpInfoLayout \ +\ + helpMenuLayout Command helpBack \ + helpMenuLayout Command helpForward \ + helpMenuLayout Command helpHome \ + helpMenuLayout Command helpClose \ +\ + helpLayout Frame helpTextFrame\ + helpTextFrame HTML helpText \ +\ + helpInfoLayout Label helpIRAFLogo \ + helpInfoLayout Label helpInfo1 \ + helpInfoLayout Label helpInfo2 \ + helpInfoLayout Label helpInfo3 \ + helpInfoLayout Label helpNOAOLogo + + + *helpLayout*borderWidth: 0 + *helpLayout.background: gray + *helpLayout*Frame*frameType: sunken + *helpLayout*Frame*frameWidth: 2 + *helpLayout*Frame.background: gray + *helpLayout*Layout.background: gray + + *helpLayout.layout: vertical { \ + -1 \ + horizontal { \ + 0 < +0 -0 > \ + helpMenuLayout < +inf -inf * > \ + 0 < +0 -0 > \ + } \ + 0 < +0 -0 > \ + horizontal { \ + 0 < +0 -0 > \ + helpTextFrame < +inf -inf * +inf -inf > \ + 0 \ + } \ + 0 < +0 -0 > \ + horizontal { \ + 0 < +0 -0 > \ + helpInfoLayout < +inf -inf * > \ + 0 < +0 -0 > \ + } \ + -1 \ + } + *helptext*background: white + *helptext*foreground: black + + *helpMenuLayout*background: gray + *helpMenuLayout*Command.highlightThickness: 2 + *helpMenuLayout*Command.internalHeight: 2 + *helpMenuLayout*Command.font: -*-helvetica-bold-r-normal-*-12-*-*-* + *helpMenuLayout.layout: vertical { \ + 5 \ + horizontal { \ + 5 < +0 -5 > \ + helpBack \ + 2 < +0 -2 > \ + helpForward \ + 2 < +0 -2 > \ + helpHome \ + 2 < +inf -2 > \ + helpClose \ + 5 < +0 -5 > \ + } \ + 5 \ + } + *helpBack.label: Back + *helpBack.sensitive: False + *helpForward.label: Forward + *helpForward.sensitive: False + *helpHome.label: Home + *helpClose.label: Close + + *helpInfoLayout*background: gray + *helpInfoLayout*Label.justify: center + *helpInfoLayout*Label.internalHeight: 0 + *helpInfoLayout.layout: horizontal { \ + 2 < +0 -2 > \ + vertical { \ + 5 \ + helpIRAFLogo \ + 5 \ + } \ + 1 < +0 -1 > \ + vertical { \ + 5 \ + horizontal { \ + 0 < +inf -inf > \ + helpInfo1 \ + 0 < +inf -inf > \ + } \ + 0 < +inf -0 > \ + horizontal { \ + 0 < +inf -inf > \ + helpInfo2 \ + 0 < +inf -inf > \ + } \ + 0 < +inf -inf > \ + horizontal { \ + 0 < +inf -inf > \ + helpInfo3 \ + 0 < +inf -inf > \ + } \ + 5 \ + } \ + 1 < +0 -1 > \ + vertical { \ + 5 \ + helpNOAOLogo \ + 5 \ + } \ + 2 < +0 -2 > \ + } + *helpInfo1.label: XImtool V1.0 -- Released: 11/4/96 + *helpInfo2.label: iraf@noao.edu (520) 318-4160 + *helpInfo3.label: NOAO is operated by AURA under cooperative agreement with the NSF + *helpInfoLayout*helpInfo1.font: -*-helvetica-medium-r-normal-*-12-*-*-* + *helpInfoLayout*helpInfo2.font: -*-helvetica-medium-r-normal-*-12-*-*-* + *helpInfoLayout*helpInfo3.font: -*-helvetica-medium-r-normal-*-10-*-*-* + *helpInfoLayout.helpIRAFLogo.internalWidth: 0 + *helpInfoLayout.helpIRAFLogo.internalheight: 0 + *helpInfoLayout.helpIRAFLogo.foreground: steelblue + *helpInfoLayout.helpIRAFLogo.background: white + *helpInfoLayout.helpNOAOLogo.internalWidth: 0 + *helpInfoLayout.helpNOAOLogo.internalheight: 0 + *helpInfoLayout.helpNOAOLogo.foreground: steelblue + *helpInfoLayout.helpNOAOLogo.background: white + + *helpText.width: 450 + *helpText.height: 500 + *helpText.anchorUnderlines: 1 + *helpText.visitedAnchorUnderlines: 1 + *helpText.verticalScrollOnRight: true + *helpText.plainFont: 6x13 + +} + +createObjects +proc quit args { send client gkey q; deactivate unmap } +send helpClose addCallback quit +activate + +# Get list of viewable files in the current directory. +proc loadFile {filename} { + set fd [open $filename]; set text [read $fd]; close $fd + if {[file extension $filename] == ".html"} { + send helpText setText $text + } else { + send helpText setText "<plaintext>$text" + } + send helpText retestAnchors +} +# Load initial file. +loadFile [lindex [glob *.html] 0] + + +# Help Panel Bitmaps +#------------------- +createBitmap iraf_logo 45 45 { +0xff, 0x3f, 0xff, 0xff, 0xff, 0xff, 0xff, 0x3f, 0xff, 0xff, 0xff, 0xff, +0xff, 0x3f, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0xff, +0xff, 0x3f, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x3f, 0xf0, 0xff, 0xff, 0xff, +0xff, 0x3f, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x3f, 0xe0, 0xff, 0xff, 0xff, +0xff, 0x3f, 0xc0, 0xff, 0xff, 0xff, 0xff, 0x3f, 0xc0, 0xff, 0xff, 0xff, +0xff, 0x3f, 0x80, 0xff, 0xff, 0xff, 0xff, 0x3f, 0x80, 0xfc, 0xff, 0xff, +0xff, 0x3f, 0x84, 0xf8, 0xff, 0xff, 0xff, 0x1f, 0x84, 0xf4, 0xff, 0xff, +0xff, 0x1b, 0x04, 0x09, 0x00, 0xfc, 0xff, 0x11, 0x04, 0x11, 0xf8, 0xff, +0x7f, 0x10, 0x04, 0x21, 0xc0, 0xff, 0x1f, 0x10, 0x04, 0x41, 0xf0, 0xff, +0x00, 0x18, 0x04, 0x01, 0xe0, 0xff, 0x00, 0x18, 0x00, 0x81, 0xc0, 0xff, +0x00, 0x08, 0x00, 0x01, 0xe0, 0xff, 0x07, 0x08, 0x00, 0x01, 0xf1, 0xff, +0x1f, 0x08, 0x80, 0x21, 0xf0, 0xff, 0xff, 0x08, 0xc0, 0x41, 0xf4, 0xff, +0xff, 0x08, 0xc0, 0x41, 0xf8, 0xff, 0xff, 0x09, 0xc0, 0xc1, 0xf0, 0xff, +0xff, 0x0b, 0x80, 0xc1, 0xf1, 0xff, 0xff, 0x07, 0x80, 0x81, 0xe1, 0xff, +0xff, 0x07, 0x80, 0x01, 0xc1, 0xff, 0xff, 0x07, 0x00, 0x01, 0xc0, 0xff, +0xff, 0x07, 0xc2, 0x05, 0x81, 0xff, 0xff, 0x07, 0xf2, 0x07, 0x81, 0xff, +0xff, 0x07, 0xf2, 0x17, 0x03, 0xff, 0xff, 0x03, 0xfa, 0x7f, 0x02, 0xfe, +0xff, 0x03, 0xfe, 0xff, 0x02, 0xfe, 0xff, 0x03, 0xfe, 0xff, 0x03, 0xfc, +0xff, 0x03, 0xff, 0xff, 0x07, 0xfc, 0xff, 0x83, 0xff, 0xff, 0x0f, 0xf8, +0xff, 0xc1, 0xff, 0xff, 0x3f, 0xf0, 0xff, 0xe1, 0xff, 0xff, 0x7f, 0xf8, +0xff, 0xf1, 0xff, 0xff, 0xff, 0xf0, 0xff, 0xf8, 0xff, 0xff, 0xff, 0xe0, +0xff, 0xf8, 0xff, 0xff, 0xff, 0xe3, 0xff, 0xfc, 0xff, 0xff, 0xff, 0xe7, +0xff, 0xfc, 0xff, 0xff, 0xff, 0xef}; send helpIRAFLogo "set bitmap iraf_logo" + +createBitmap noao_logo 45 45 { +0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, +0xff, 0xff, 0xdf, 0xff, 0xff, 0xff, 0xff, 0xff, 0x03, 0xfe, 0xff, 0xff, +0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x00, 0xf8, 0xff, 0xff, +0xff, 0xff, 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x00, 0xf8, 0xff, 0xff, +0xff, 0x7f, 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0x00, 0xf8, 0xff, 0xff, +0xff, 0xff, 0x00, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x00, 0xf8, 0xff, 0xff, +0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x03, 0xfe, 0xff, 0xff, +0xff, 0xff, 0xdf, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, +0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xdf, 0xff, 0xff, 0xff, +0xff, 0xff, 0x8f, 0xff, 0xff, 0xff, 0xff, 0xff, 0x8f, 0xff, 0xff, 0xff, +0xff, 0xff, 0x07, 0xff, 0xff, 0xff, 0xff, 0xff, 0x07, 0xff, 0xff, 0xff, +0xff, 0xff, 0x03, 0xfe, 0xff, 0xff, 0xff, 0xff, 0x03, 0xfe, 0xff, 0xff, +0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, +0xff, 0xff, 0x00, 0xf8, 0xff, 0xff, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0xff, +0xff, 0x7f, 0x00, 0xf0, 0xff, 0xff, 0xff, 0x3f, 0x00, 0xe0, 0xff, 0xff, +0xff, 0x3f, 0x00, 0xe0, 0xff, 0xff, 0xff, 0x1f, 0x00, 0xc0, 0xff, 0xff, +0xff, 0x1f, 0x00, 0xc0, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x80, 0xff, 0xff, +0xff, 0x0f, 0x00, 0x80, 0xff, 0xff, 0xff, 0x07, 0x00, 0x00, 0xff, 0xff, +0xff, 0x03, 0x00, 0x00, 0xfe, 0xff, 0xff, 0x03, 0x00, 0x00, 0xfe, 0xff, +0xff, 0x01, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x01, 0x00, 0x00, 0xfc, 0xff, +0xff, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x00, 0x00, 0x00, 0xf8, 0xff, +0x7f, 0x00, 0x00, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0x00, 0x00, 0xf0, 0xff, +0x3f, 0x00, 0x00, 0x00, 0xe0, 0xff}; send helpNOAOLogo "set bitmap noao_logo" + + + +# Stuff for keeping track of visited anchors. +set links { 0 } +set linkIndex 0 +set visited(0) empty + +proc anchorSelected {widget cbtype event text href args} { + global visited links linkIndex + set anchID [send helpText anchorToId $href] + set visited($href) 1 + if {$linkIndex == 0} { + send helpBack set sensitive True + if {[lindex $links 1] != $anchID} { + set links { 0 } + send helpForward set sensitive False + } + } + if {$linkIndex > 0 && [lindex $links [expr $linkIndex + 1]] != $anchID} { + set links [lrange $links 0 $linkIndex] + } + if {[lindex $links [expr $linkIndex + 1]] != $anchID} { + lappend links $anchID + incr linkIndex + } else { + send helpForward set sensitive False + incr linkIndex + } + if {$linkIndex == [expr [llength $links] - 1]} { + send helpForward set sensitive False + } + send helpText gotoId $anchID + send helpText retestAnchors +}; send helpText addCallback anchorSelected anchor + +proc testAnchor {widget cbtype href} { + global visited + return [info exists visited($href)] +}; send helpText addCallback testAnchor testAnchor + + +# Callbacks to position forwards and backwards in link list. +proc hlpForward args { + global links linkIndex + incr linkIndex + if {$linkIndex <= [llength $links]} { + set anchID [lindex $links $linkIndex] + send helpText gotoId $anchID + send helpText retestAnchors + if {$linkIndex == [expr [llength $links] - 1]} { + send helpForward set sensitive False + send helpBack set sensitive True + } else { + send helpBack set sensitive True + } + } else { + incr linkIndex -1 + } +}; send helpForward addCallback hlpForward + +proc hlpBack args { + global links linkIndex + incr linkIndex -1 + if {$linkIndex >= 0} { + set anchID [lindex $links $linkIndex] + send helpText gotoId $anchID + send helpText retestAnchors + if {$linkIndex == 0} { send helpBack set sensitive False } + if {$linkIndex >= 0} { send helpForward set sensitive True } + } else { + incr linkIndex 1 + } +}; send helpBack addCallback hlpBack + +proc hlpHome args { + global links linkIndex + set links { 0 } + set linkIndex 0 + send helpText gotoId 0 + send helpForward set sensitive False + send helpBack set sensitive False + send helpText retestAnchors +}; send helpHome addCallback hlpHome + diff --git a/vendor/x11iraf/guidemo/html.gui b/vendor/x11iraf/guidemo/html.gui new file mode 100644 index 00000000..86e61dbc --- /dev/null +++ b/vendor/x11iraf/guidemo/html.gui @@ -0,0 +1,113 @@ +# HTML.GUI -- Test HTML widget. + +reset-server +appInitialize html HTML { + *objects:\ + toplevel Form helloForm\ + helloForm Label helloLabel\ + helloForm Command prevButton\ + helloForm Command nextButton\ + helloForm Command quitButton\ + helloForm HTML textwin\ + helloForm TextBox info + + + *helloForm.background: bisque + *helloForm.helloLabel.background: bisque + *helloForm.Command.background: bisque + *helloForm.info*background: bisque + *helloForm.textwin*background: gray81 + *beNiceToColormap: false + + *helloLabel.label: HTML widget demo + *prevButton.fromHoriz: helloLabel + *prevButton.label: Previous File + *nextButton.fromHoriz: prevButton + *nextButton.label: Next File + *quitButton.fromHoriz: nextButton + *quitButton.label: Quit + *textwin.fromVert: helloLabel + *info.fromVert: textwin + *info.width: 500 + *info.height: 20 + *info.frameWidth: 0 + *info.frameType: sunken + *info.borderWidth: 0 + *info.outerOffset: 0 + *info.innerOffset: 0 + + *textwin.width: 500 + *textwin.height: 800 + *textwin.anchorUnderlines: 1 + *textwin.visitedAnchorUnderlines: 1 + *textwin.dashedVisitedAnchorUnderlines: true + *textwin.plainFont: 6x13 +} + +createObjects +proc quit args { send client gkey q; deactivate unmap } +send quitButton addCallback quit +activate + +# Get list of viewable files in the current directory. +set files [glob *.html *.\[cfhlsxy\] *.notes \[A-Z\]* *.gui] +set fileIndex 0 +set html [lindex $files $fileIndex] + +proc loadFile {filename} { + set fd [open $filename]; set text [read $fd]; close $fd + if {[file extension $filename] == ".html"} { + send textwin setText $text + } else { + send textwin setText "<plaintext>$text" + } + send textwin retestAnchors +} + +# Load initial file. +loadFile [lindex $files $fileIndex] + +# Stuff for keeping track of visited anchors. +set url(0) empty +proc anchorSelected {widget cbtype event text href args} { + global url + set url($href) 1 + send textwin retestAnchors +} +proc testAnchor {widget cbtype href} { + global url + return [info exists url($href)] +} +proc anchorVisited {widget cbtype href} { + send info set label $href +} +send textwin addCallback anchorVisited pointerMotion +send textwin addCallback testAnchor testAnchor +send textwin addCallback anchorSelected anchor + +# Callbacks to position forwards and backwards in file list. +proc next args { + global files fileIndex + incr fileIndex + if {$fileIndex >= [llength $files]} { + set fileIndex 0 + } + loadFile [lindex $files $fileIndex] +} +proc prev args { + global files fileIndex + if {$fileIndex <= 0} { + set fileIndex [llength $files] + } + incr fileIndex -1 + loadFile [lindex $files $fileIndex] +} +send prevButton addCallback prev +send nextButton addCallback next + +# Test submit form callback. +proc submitFormCalled {widget cbtype event attrs href method args} { + print [format "\nSubmit Form to: %s\nMethod: %s\n%s\n" \ + $href $method $attrs] +} +send textwin addCallback submitFormCalled submitForm diff --git a/vendor/x11iraf/guidemo/imbrowse.gui b/vendor/x11iraf/guidemo/imbrowse.gui new file mode 100644 index 00000000..78b339b5 --- /dev/null +++ b/vendor/x11iraf/guidemo/imbrowse.gui @@ -0,0 +1,373 @@ +# IMBROWSE.GUI -- Image browser user interface. + +reset-server +appInitialize imbrowse Imbrowse { + *objects: \ + toplevel Paned panel \ +\ + panel Box statusBox \ + statusBox MenuButton dirSelect \ + statusBox AsciiText dirName \ + statusBox Command imageButton \ + statusBox Command helpButton \ + statusBox Command quitButton \ +\ + panel Viewport objView \ + objView List objList \ +\ + panel Form controlForm \ + controlForm Label buttonHelp \ + controlForm Label templateLabel \ + controlForm AsciiText templateText \ + controlForm Command prevButton \ + controlForm Command nextButton \ + controlForm Command headerButton \ + controlForm Command displayButton \ +\ + panel AsciiText headerText \ +\ + panel Box sectionBox \ + sectionBox Label sectionLabel \ + sectionBox AsciiText sectionText \ +\ + toplevel TopLevelShell imageShell \ + imageShell Form imageForm \ + imageForm Label imageTitle \ + imageForm Gterm imageWindow \ +\ + toplevel Parameter imbrowse \ + imbrowse Parameter template \ + imbrowse Parameter section \ + imbrowse Parameter directory \ + imbrowse Parameter subdirs \ + imbrowse Parameter files \ + imbrowse Parameter image_title \ + imbrowse Parameter header \ + imbrowse Parameter errormsg \ + + *panel.orientation: vertical + *displayCaret: false + + *background: LightSkyBlue + *shapeStyle: Rectangle + *beNiceToColormap: False + *Label*shadowWidth: 2 + + *statusBox.orientation: horizontal + *statusBox.showGrip: False + *statusBox.skipAdjust: True +! *statusBox.background: gray61 + *dirSelect.label: Directory: + *dirSelect.menuName: dirMenu + *dirName*background: #a7eeff + *dirName.width: 403 + *dirName*displayCaret: True + *dirName*editType: edit + *imageButton.label: Image + *helpButton.label: Help + *helpButton.sensitive: False + *quitButton.label: Quit + + *objView.allowHoriz: False + *objView.allowVert: True + *objView.forceBars: True + *objView.min: 60 + *objView*background: #a7eeff +! *objList*height: 100 + *objList*verticalList: True + + *controlForm.showGrip: True + *controlForm.skipAdjust: True + *buttonHelp.borderWidth: 0 + *buttonHelp.width: 613 + *templateLabel.label: Images: + *templateLabel.fromVert: buttonHelp + *templateLabel.borderWidth: 0 + *templateText*background: #a7eeff + *templateText*font: 7x13bold + *templateText*width: 230 + *templateText.fromHoriz: templateLabel + *templateText.fromVert: buttonHelp + *templateText*displayCaret: True + *templateText*editType: edit + *prevButton.label: PrevIm + *prevButton.fromHoriz: templateText + *prevButton.fromVert: buttonHelp + *nextButton.label: NextIm + *nextButton.fromHoriz: prevButton + *nextButton.fromVert: buttonHelp + *headerButton.label: Show Header + *headerButton.fromHoriz: nextButton + *headerButton.fromVert: buttonHelp + *displayButton.label: Display Image + *displayButton.fromHoriz: headerButton + *displayButton.fromVert: buttonHelp + + *headerText.showGrip: False + *headerText.skipAdjust: False + *headerText.min: 100 +! *headerText.height: 100 + *headerText.scrollVertical: always + *headerText.scrollHorizontal: whenNeeded + *headerText*font: 7x13 + *headerText*background: #a7eeff + + *sectionBox.orientation: horizontal + *sectionBox.showGrip: False + *sectionBox.skipAdjust: True + *sectionLabel.label: Display image section: + *sectionLabel.borderWidth: 0 + *sectionText*background: #a7eeff + *sectionText.width: 460 + *sectionText*font: 7x13bold + *sectionText*displayCaret: True + *sectionText*editType: edit + + *imageTitle.borderWidth: 0 + *imageTitle.width: 512 + *imageWindow.cmapName: image + *imageWindow.ginmodeCursor: circle + *imageWindow.width: 512 + *imageWindow.height: 512 + *imageWindow.fromVert: imageTitle + + *imageWindow.translations: \ + <Btn1Down>: m_create() \n\ + !Shift <Btn2Down>: crosshair(on) \n\ + !Shift <Btn2Motion>: crosshair(on) \n\ + <Btn2Up>: crosshair(off) \n\ + <Btn2Down>: call(zoom,$x,$y) \n\ + <Btn3Down>: call(windowColormap,$x,$y) \n\ + <Btn3Motion>: call(windowColormap,$x,$y) \n\ + <EnterWindow>: enter-window() \n\ + <LeaveWindow>: leave-window() \n\ + <KeyPress>: graphics-input() \n\ + <Motion>: track-cursor() +} + +# Start up the GUI. +createObjects +send imageShell realize +send imageWindow setGterm +activate + +# Global variables. +set version "Imbrowse 0.1 - Alpha Test Version" + +# Display the program version number on startup. +send buttonHelp set label $version + +#proc reactivate {} { +#}; send server postActivateCallback reactivate + + +# Callbacks for client state variables (UI parameter objects). When the +# client's state changes it updates a UI parameter to reflect the change. +# This produces a callback to one or more of the callbacks defined below, +# used to update the GUI to reflect the changing state of the client. + +proc setTemplate {param old new} { + send templateText set string $new +}; send template addCallback setTemplate + +proc setSection {param old new} { + send sectionText set string $new +}; send section addCallback setSection + +proc setDirectory {param old new} { + send dirName set string $new +}; send directory addCallback setDirectory + +proc setImageTitle {param old new} { + send imageTitle set label $new +}; send image_title addCallback setImageTitle + +proc setFiles {param old new} { + send objList setList $new resize +}; send files addCallback setFiles + +proc setSubdirs {param old new} { + foreach dir $new { + lappend itemList "$dir f.exec \{ send client gcmd chdir $dir \}" + } + createMenu dirMenu dirSelect $itemList +}; send subdirs addCallback setSubdirs + +proc setErrormsg {param old new} { + send buttonHelp set label $new +}; send errormsg addCallback setErrormsg + +proc setHeaderText {param old new} { + send headerText set string $new +}; send header addCallback setHeaderText + + +# List widget callback. +proc select {widget cbtype item index} { + set subdirs [send subdirs getValue] + if [expr [lsearch $subdirs $item] != -1] { + send client gcmd chdir $item + } +}; send objList addCallback select + + +# Command callbacks. + +proc image args {send imageShell map} +send imageButton addCallback image + +proc help args { } +send helpButton addCallback help + +proc quit args { + #send imageShell unmap; send client gkey q; deactivate unmap + send client gkey q; deactivate unmap +}; send quitButton addCallback quit + +proc next args { + send objList getItem itemno + if {$itemno == "none"} { + send objList highlight 0 + } else { + send objList highlight [expr "$itemno + 1"] + } +}; send nextButton addCallback next + +proc prev args { + send objList getItem itemno + if {$itemno == "none"} { + send objList highlight 0 + } else { + set itemno [expr "$itemno - 1"] + if {$itemno >= 0} { + send objList highlight $itemno + } + } +}; send prevButton addCallback prev + +proc headerCallback args { + set image [send objList getItem itemno] + if {$itemno != "none"} { + printHeader $image + } +}; send headerButton addCallback headerCallback + +proc printHeader {image} { + send client gcmd header $image +} + +proc displayCallback args { + set image [send objList getItem itemno] + if {$itemno != "none"} { + displayImage $image + } +}; send displayButton addCallback displayCallback + +proc displayImage {image} { + send imageShell map + send imageWindow setGterm + send client gcmd display $image +} + +proc directoryCallback {widget cbtype text} { + send client gcmd chdir $text +}; send dirName addCallback directoryCallback + + +proc templateCallback {widget cbtype text} { + send client gcmd template $text +}; send templateText addCallback templateCallback + +proc sectionCallback {widget cbtype text} { + send client gcmd section $text +}; send sectionText addCallback sectionCallback + + +# Window the displayed image. +proc windowColormap {x y} \ +{ + set winWidth [send imageWindow get width] + set winHeight [send imageWindow get height] + + send imageWindow loadColormap 1 \ + [expr "$x.0 / $winWidth"] \ + [expr "($y.0 - $winHeight / 2.0) / $winHeight * 10.0"] +} + +# ZOOM and PAN. +set xcen 0 +set ycen 0 + +# Zoom or pan image at given center. +proc zoom {x y} \ +{ + global xcen ycen + + # Convert raw screen coordinates to frame buffer raster coordinates. + send imageWindow unmapPixel $x $y raster rx ry + + # Select a pixel. + set rx [expr "int ($rx)"] + set ry [expr "int ($ry)"] + + # If the pointer did not move (much) zoom the image, otherwise + # pan it. + + if {sqrt(pow($rx-$xcen, 2) + pow($ry-$ycen, 2)) < 4} { + send client gkey Z + } else { + send client gkey M + } + + set xcen $rx + set ycen $ry +} + + +# Button help feature. + +set help(dirName) "current directory" +set help(dirSelect) "press to get directory selection menu" +set help(displayButton) "press to display currently selected image" +set help(templateLabel) "list of image file templates" +set help(templateText) "enter new list of image templates and press return" +set help(headerButton) "press to list header of currently selected image" +set help(headerText) "the image header is displayed here" +set help(helpButton) "press to get help for imbrowse" +set help(nextButton) "advance to next image" +set help(objList) "images in current directory are listed here" +set help(prevButton) "back up to previous image" +set help(quitButton) "press to exit the imbrowse application" +set help(sectionLabel) "image section for displaying image" +set help(sectionText) "enter new image section and press return" + +set widgets { + dirSelect dirName helpButton quitButton objList templateLabel + templateText nextButton prevButton headerButton displayButton + headerText sectionLabel sectionText +} + +proc helpCallback { widget event args } { + global help + if {$event == "enterNotify"} { + send buttonHelp set label $help($widget) + } +} + +foreach widget $widgets { + send $widget addEventHandler helpCallback enterWindowMask +} + +#set timerId 0 +#set timerState 0 +#proc timer args { +# global timerId timerState +# if {$timerState} { +# send quitButton set background red +# set timerState 0 +# } else { +# send quitButton set background blue +# set timerState 1 +# } +# set timerId [postTimedCallback timer 1000] +#}; set timerId [postTimedCallback timer 1000] diff --git a/vendor/x11iraf/guidemo/imbrowse.par b/vendor/x11iraf/guidemo/imbrowse.par new file mode 100644 index 00000000..5d238db2 --- /dev/null +++ b/vendor/x11iraf/guidemo/imbrowse.par @@ -0,0 +1,10 @@ +# Parameters for IMBROWSE task. + +directory,f,a,,,,directory to be listed +uifname,f,h,"guidemo$imbrowse.gui",,,user interface file +template,s,h,"*",,,image file template +section,s,h,"",,,default image section +contrast,r,h,0.25,,,contrast adjustment for zscale algorithm +nsample_lines,i,h,5,,,number of sample lines +coords,*gcur,h,,,,graphics cursor input +device,s,h,"stdgraph",,,graphics device for plots diff --git a/vendor/x11iraf/guidemo/imbrowse.x b/vendor/x11iraf/guidemo/imbrowse.x new file mode 100644 index 00000000..10110af0 --- /dev/null +++ b/vendor/x11iraf/guidemo/imbrowse.x @@ -0,0 +1,563 @@ +include <error.h> +include <diropen.h> +include <ctype.h> +include <finfo.h> +include <imhdr.h> +include <imio.h> +include <gset.h> +include <gim.h> + +define SZ_BIGBUF 16384 +define USER_AREA Memc[($1+IMU-1)*SZ_STRUCT + 1] +define SAMPLE_SIZE 600 +define NCOLORS 200 +define MAX_INTENSITY 255 +define SWATH 32 + + +# IMBROWSE -- Image browser GUI demo task. + +procedure t_imbrowse() + +pointer gp +real x, y +int wcs, key, ip, op +char directory[SZ_PATHNAME] +char buf[SZ_LINE], cmd[SZ_FNAME], args[SZ_LINE] +char device[SZ_FNAME], uifname[SZ_PATHNAME], template[SZ_LINE] +char section[SZ_LINE], strval[SZ_LINE], curdir[SZ_PATHNAME] + +bool streq() +pointer gopenui() +int clgcur(), clgeti() +int imb_isdirectory() + +begin + # Get the start directory. + if (clgeti ("$nargs") > 0) { + call clgstr ("directory", directory, SZ_PATHNAME) + if (imb_isdirectory (directory, curdir, SZ_PATHNAME) > 0) + call strcpy (curdir, directory, SZ_PATHNAME) + else + directory[1] = EOS + } else + directory[1] = EOS + + call clgstr ("device", device, SZ_FNAME) + call clgstr ("uifname", uifname, SZ_FNAME) + call clgstr ("template", template, SZ_LINE) + call clgstr ("section", section, SZ_LINE) + + gp = gopenui (device, NEW_FILE, uifname, STDGRAPH) + call gmsg (gp, "template", template) + call gmsg (gp, "section", section) + + call fpathname (directory, curdir, SZ_PATHNAME) + call imb_setdir (gp, curdir, ".", template) + + while (clgcur ("coords", x, y, wcs, key, strval, SZ_LINE) != EOF) { + switch (key) { + case 'q', 'Q': + break + + case ':': + for (ip=1; IS_WHITE(strval[ip]); ip=ip+1) + ; + op = 1 + while (strval[ip] != EOS && !IS_WHITE(strval[ip])) { + cmd[op] = strval[ip] + op = op + 1 + ip = ip + 1 + } + cmd[op] = EOS + for ( ; IS_WHITE(strval[ip]); ip=ip+1) + ; + call strcpy (strval[ip], args, SZ_LINE) + + if (streq (cmd, "chdir")) { + call imb_setdir (gp, curdir, args, template) + + } else if (streq (cmd, "template")) { + call strcpy (args, template, SZ_LINE) + call imb_setdir (gp, curdir, ".", template) + + } else if (streq (cmd, "section")) { + call strcpy (args, section, SZ_LINE) + + } else if (streq (cmd, "header")) { + call imb_pheader (gp, curdir, args, section) + + } else if (streq (cmd, "display")) { + call imb_display (gp, curdir, args, section) + + } else { + call sprintf (buf, SZ_LINE, "unrecognized command: `%s'\n") + call pargstr (strval) + call gmsg (gp, "errormsg", buf) + } + + default: + call sprintf (buf, SZ_LINE, + "unrecognized cursor command: key=%c strval=`%s'\n") + call pargi (key) + call pargstr (strval) + call gmsg (gp, "errormsg", buf) + } + } + + call gclose (gp) +end + + +# IMB_SETDIR -- Set the current directory. + +procedure imb_setdir (gp, curdir, newdir, template) + +pointer gp #I graphics descriptor +char curdir[ARB] #I current directory +char newdir[ARB] #I new directory or subdirectory +char template[ARB] #I filename template + +pointer s_op, f_op, pt +int fd, errcode, nchars +pointer sp, lbuf, fname, subdirs, files, dirpath, ftemp + +pointer pt_compile() +int errget(), gstrcpy(), imb_isdirectory(), imb_issubdir() +int diropen(), nowhite(), getline(), access(), pt_match() +errchk fchdir, fpathname, gmsg, diropen, getline, access, pt_compile +define error_ 91 + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + call salloc (ftemp, SZ_PATHNAME, TY_CHAR) + call salloc (subdirs, SZ_COMMAND, TY_CHAR) + call salloc (files, SZ_BIGBUF, TY_CHAR) + call salloc (dirpath, SZ_PATHNAME, TY_CHAR) + + s_op = subdirs + f_op = files + + # We should check for buffer overflow and realloc if it occurs, but + # we omit this at present in this demo program. + + iferr { + # Get pathname of new directory. + if (imb_issubdir (curdir, newdir) == YES) { + call strcpy (curdir, Memc[fname], SZ_PATHNAME) + call zfsubd (Memc[fname], SZ_PATHNAME, newdir, nchars) + } else if (imb_isdirectory(newdir,Memc[dirpath],SZ_PATHNAME) > 0) { + call fpathname (Memc[dirpath], Memc[fname], SZ_PATHNAME) + } else + call fpathname (newdir, Memc[fname], SZ_PATHNAME) + + # Read the directory and construct a list of subdirectories and + # a list of files matching the given template. + + fd = diropen (Memc[fname], PASS_HIDDEN_FILES) + call strcpy (Memc[fname], curdir, SZ_PATHNAME) + call gmsg (gp, "directory", Memc[fname]) + pt = pt_compile (template) + + s_op = s_op + gstrcpy ("/\n", Memc[s_op], ARB) + while (getline (fd, Memc[lbuf]) != EOF) { + if (nowhite (Memc[lbuf], Memc[ftemp], SZ_PATHNAME) <= 0) + next + call imb_mkfname (Memc[ftemp], curdir, Memc[fname], SZ_PATHNAME) + if (access (Memc[fname], 0, DIRECTORY_FILE) == YES) + s_op = s_op + gstrcpy (Memc[lbuf], Memc[s_op], ARB) + if (pt_match (pt, Memc[fname]) == YES) + f_op = f_op + gstrcpy (Memc[lbuf], Memc[f_op], ARB) + } + + call pt_free (pt) + call close (fd) + } then + goto error_ + + Memc[s_op] = EOS + Memc[f_op] = EOS + + call gmsg (gp, "subdirs", Memc[subdirs]) + call gmsg (gp, "files", Memc[files]) + + call sfree (sp) + return +error_ + errcode = errget (Memc[lbuf], SZ_LINE) + call gmsg (gp, "errormsg", Memc[lbuf]) + call sfree (sp) +end + + +# IMB_PHEADER -- Print an image header. + +procedure imb_pheader (gp, curdir, image, section) + +pointer gp #I graphics descriptor +char curdir[ARB] #I directory +char image[ARB] #I image name +char section[ARB] #I image section + +int in, min_lenuserarea +pointer sp, lbuf, hbuf, ip, op, im, fname +int stropen(), getline(), gstrcpy() +pointer immap() + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + call imb_mkfname (image, curdir, Memc[fname], SZ_PATHNAME) + iferr (im = immap (Memc[fname], READ_ONLY, 0)) { + call sprintf (Memc[lbuf], SZ_LINE, "cannot open image `%s'") + call pargstr (image) + call gmsg (gp, "errormsg", Memc[lbuf]) + call sfree (sp) + return + } + + call salloc (hbuf, IM_HDRLEN(im), TY_CHAR) + op = hbuf + + # Open user area in header. + min_lenuserarea = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1 + in = stropen (USER_AREA(im), min_lenuserarea, READ_ONLY) + + # Copy header records to the output, stripping any trailing + # whitespace and clipping at the right margin. + + while (getline (in, Memc[lbuf]) != EOF) { + for (ip=lbuf; Memc[ip] != EOS && Memc[ip] != '\n'; ip=ip+1) + ; + while (ip > lbuf && Memc[ip-1] == ' ') + ip = ip - 1 + Memc[ip] = '\n' + Memc[ip+1] = EOS + + op = op + gstrcpy (Memc[lbuf], Memc[op], ARB) + } + + call gmsg (gp, "image_title", IM_TITLE(im)) + call gmsg (gp, "header", Memc[hbuf]) + + call close (in) + call imunmap (im) + call sfree (sp) +end + + +# IMB_DISPLAY -- Display an image. + +procedure imb_display (gp, curdir, image, section) + +pointer gp #I graphics descriptor +char curdir[ARB] #I directory +char image[ARB] #I image name +char section[ARB] #I image section + +int ncols, nrows, i, v +real contrast, z1, z2, dz1, dz2 +int r[NCOLORS], g[NCOLORS], b[NCOLORS] +int nsample_lines, len_stdline, j1, j2, npix +pointer sp, im, fname, lbuf, in, out, pkras + +int clgeti() +real clgetr() +pointer immap(), imgs2r() +errchk gseti, gswind, clgeti, clgetr, zscale, malloc, imgs2r +errchk gim_createraster, gim_setmapping, gim_writecolormap, gim_writepixels + +begin + call smark (sp) + call salloc (lbuf, SZ_LINE, TY_CHAR) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + call imb_mkfname (image, curdir, Memc[fname], SZ_PATHNAME) + call strcat (section, Memc[fname], SZ_PATHNAME) + + iferr (im = immap (Memc[fname], READ_ONLY, 0)) { + call sprintf (Memc[lbuf], SZ_LINE, "cannot open image `%s%s'") + call pargstr (image) + call pargstr (section) + call gmsg (gp, "errormsg", Memc[lbuf]) + call sfree (sp) + return + } + + ncols = IM_LEN(im,1) + nrows = IM_LEN(im,2) + + call gmsg (gp, "image_title", IM_TITLE(im)) + + # Create raster to hold image. + call gim_createraster (gp, 1, 0, ncols, nrows, 8) + + # Associate a WCS with raster 1. + call gseti (gp, G_RASTER, 1) + call gswind (gp, 0.5, real(ncols) + 0.5, 0.5, real(nrows) + 0.5) + + # Set the primary raster to screen mapping. + call gim_setmapping (gp, 1, 0, + 1, CT_PIXEL, 0.0, 0.0, real(ncols), real(nrows), + 0, CT_NDC, 0.0, 0.0, 1.0, 1.0) + + # Write colormap. + do i = 1, NCOLORS { + v = MAX_INTENSITY * (real((i - 1)) / (NCOLORS - 1)) + r[i] = v; g[i] = v; b[i] = v + } + call gim_writecolormap (gp, 0, LAST_COLOR+1, NCOLORS, r, g, b) + call gim_writecolormap (gp, 1, LAST_COLOR+1, NCOLORS, r, g, b) + + contrast = clgetr ("contrast") + nsample_lines = clgeti ("nsample_lines") + len_stdline = SAMPLE_SIZE / nsample_lines + call zscale (im, z1, z2, contrast, SAMPLE_SIZE, len_stdline) + + dz1 = LAST_COLOR + 1 + dz2 = dz1 + NCOLORS - 1 + call malloc (out, ncols * SWATH, TY_REAL) + call malloc (pkras, ncols * SWATH, TY_CHAR) + + do j1 = 1, nrows, SWATH { + j2 = min (j1 + SWATH - 1, nrows) + npix = (j2 - j1 + 1) * ncols + in = imgs2r (im, 1, ncols, j1, j2) + call amapr (Memr[in], Memr[out], npix, z1, z2, dz1, dz2) + call achtrb (Memr[out], Memc[pkras], npix) + call gim_writepixels (gp, 1, + Memc[pkras], 8, 0, j1-1, ncols, j2-j1+1) + } + + call mfree (out, TY_REAL) + call mfree (pkras, TY_CHAR) + call imunmap (im) + call sfree (sp) +end + + +# IMB_MKFNAME -- Construct a filename given a directory name and the file +# name. + +procedure imb_mkfname (file, directory, fname, maxch) + +char file[ARB] #I input filename +char directory[ARB] #I directory file resides in +char fname[ARB] #O path to file +int maxch #I max chars out + +begin + call fdirname (directory, fname, maxch) + call strcat (file, fname, maxch) +end + + +# IMB_ISDIRECTORY -- Test whether the named file is a directory. Check first +# to see if it is a subdirectory of the current directory; otherwise look in +# the environment to see if it is a logical directory. If VFN is a directory, +# return the OS pathname of the directory in pathname, and the number of +# chars in the pathname as the function value. Otherwise return 0. + +int procedure imb_isdirectory (vfn, pathname, maxch) + +char vfn[ARB] # name to be tested +char pathname[ARB] # receives path of directory +int maxch # max chars out + +bool isdir +pointer sp, fname, op +int ip, fd, nchars, ch +long file_info[LEN_FINFO] +int finfo(), diropen(), gstrcpy(), strlen() +bool streq() + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + # Copy the VFN string, minus any whitespace on either end. + op = fname + for (ip=1; vfn[ip] != EOS; ip=ip+1) { + ch = vfn[ip] + if (!IS_WHITE (ch)) { + Memc[op] = ch + op = op + 1 + } + } + Memc[op] = EOS + + isdir = false + if (streq (vfn, ".") || streq (vfn, "..")) { + isdir = true + + } else if (finfo (Memc[fname], file_info) != ERR) { + isdir = (FI_TYPE(file_info) == FI_DIRECTORY) + + if (isdir) { + call fdirname (Memc[fname], pathname, maxch) + nchars = strlen (pathname) + } + + } else { + # If we get here, either VFN is a logical directory (with the + # $ omitted), or it is the name of a new file. + + Memc[op] = '$' + Memc[op+1] = EOS + ifnoerr (fd = diropen (Memc[fname], 0)) { + call close (fd) + isdir = true + } + + nchars = gstrcpy (Memc[fname], pathname, maxch) + } + + call sfree (sp) + if (isdir) + return (nchars) + else { + pathname[1] = EOS + return (0) + } +end + + +# IMB_ISSUBDIR -- Test whether the named file is a subdirectory of the +# current directory. + +int procedure imb_issubdir (curdir, newdir) + +char curdir[ARB] # current directory +char newdir[ARB] # subdir name to be tested + +bool subdir +pointer sp, fname +int root, extn, nchars +long file_info[LEN_FINFO] +int finfo(), btoi() +bool streq() + +begin + call smark (sp) + call salloc (fname, SZ_PATHNAME, TY_CHAR) + + subdir = false + if (streq (newdir, ".") || streq (newdir, "..")) { + subdir = true + + } else { + call zfnbrk (newdir, root, extn) + if (root == 1) { + call strcpy (curdir, Memc[fname], SZ_PATHNAME) + call zfsubd (Memc[fname], SZ_PATHNAME, newdir, nchars) + if (finfo (Memc[fname], file_info) != ERR) + subdir = (FI_TYPE(file_info) == FI_DIRECTORY) + } + } + + call sfree (sp) + return (btoi (subdir)) +end + + +# Pattern template matching utility. +# -------------------------------------- +define MAX_PATTERNS 64 +define SZ_PATBUF SZ_LINE + +define LEN_PATDES (10 + MAX_PATTERNS * SZ_PATBUF) +define PT_NPATTERNS Memi[$1] +define PT_PATBUF Memi[$1+10+(($2)-1)*SZ_PATBUF] + +# PT_COMPILE -- Compile a pattern template into the pattern descriptor. +# A pattern template is a comma delimited list of patterns, e.g., "*.x,*.y". + +pointer procedure pt_compile (template) + +char template[ARB] #I pattern template + +pointer sp, pattern, pt, op +int junk, npatterns, ip, pch, ch +int patmake() +errchk calloc + +begin + call smark (sp) + call salloc (pattern, SZ_LINE, TY_CHAR) + + call calloc (pt, LEN_PATDES, TY_STRUCT) + npatterns = 0 + + for (ip=1; template[ip] == ',' || IS_WHITE (template[ip]); ip=ip+1) + ; + + while (template[ip] != EOS) { + # Get the next pattern. + op = pattern + Memc[op] = '^'; op = op + 1 + + pch = 0 + ch = template[ip] + + while (ch != EOS && ch != ',' && !IS_WHITE(ch)) { + if (ch == '*' && pch != ']') { + Memc[op] = '?' + op = op + 1 + } + Memc[op] = ch + op = op + 1 + ip = ip + 1 + pch = ch + ch = template[ip] + } + + Memc[op] = '$'; op = op + 1 + Memc[op] = EOS + + # Encode the pattern. + npatterns = npatterns + 1 + junk = patmake (Memc[pattern], PT_PATBUF(pt,npatterns), SZ_PATBUF) + + while (template[ip] == ',' || IS_WHITE (template[ip])) + ip = ip + 1 + } + + PT_NPATTERNS(pt) = npatterns + call sfree (sp) + return (pt) +end + + +# PT_MATCH -- Test a string to see if it matches one of the patterns in the +# compiled pattern template. + +int procedure pt_match (pt, str) + +pointer pt #I pattern template descriptor +char str[ARB] #I string to be matched against template + +int i +int patmatch() + +begin + for (i=1; i <= PT_NPATTERNS(pt); i=i+1) + if (patmatch (str, PT_PATBUF(pt,i)) > 0) + return (YES) + + return (NO) +end + + +# PT_FREE -- Free a pattern template descriptor. + +procedure pt_free (pt) + +pointer pt #I pattern template descriptor + +begin + call mfree (pt, TY_STRUCT) +end diff --git a/vendor/x11iraf/guidemo/larrow2.xbm b/vendor/x11iraf/guidemo/larrow2.xbm new file mode 100644 index 00000000..68961766 --- /dev/null +++ b/vendor/x11iraf/guidemo/larrow2.xbm @@ -0,0 +1,6 @@ +#define larrow2_width 16 +#define larrow2_height 16 +static char larrow2_bits[] = { + 0x00, 0x00, 0x00, 0x03, 0x80, 0x03, 0xc0, 0x03, 0xe0, 0x1e, 0x70, 0x1e, + 0x38, 0x18, 0x1c, 0x18, 0x1c, 0x18, 0x38, 0x18, 0x70, 0x1e, 0xe0, 0x1e, + 0xc0, 0x03, 0x80, 0x03, 0x00, 0x03, 0x00, 0x00}; diff --git a/vendor/x11iraf/guidemo/login.cl b/vendor/x11iraf/guidemo/login.cl new file mode 100644 index 00000000..98ffbdfa --- /dev/null +++ b/vendor/x11iraf/guidemo/login.cl @@ -0,0 +1,99 @@ +# LOGIN.CL -- User login file for the IRAF command language. + +# Identify login.cl version (checked in images.cl). +if (defpar ("logver")) + logver = "IRAF V2.11 May 1997" + +set home = "/u3/iraf/x11iraf.develop/guidemo/" +set imdir = "tucana!/d0/iraf/fitz/" +set uparm = "home$uparm/" +set userid = "fitz" + +# Set the terminal type. +if (envget("TERM") == "sun") { + if (!access (".hushiraf")) + print "setting terminal type to gterm..." + stty gterm +} else { + if (!access (".hushiraf")) + print "setting terminal type to xgterm..." + stty xgterm +} + +# Uncomment and edit to change the defaults. +#set editor = vi +#set printer = lw +#set stdimage = imt800 +#set stdimcur = stdimage +#set stdplot = lw +#set clobber = no +#set filewait = yes +#set cmbuflen = 512000 +#set min_lenuserarea = 64000 +#set imtype = "imh" + +# IMTOOL/XIMAGE stuff. Set node to the name of your workstation to +# enable remote image display. The trailing "!" is required. +#set node = "my_workstation!" + +# CL parameters you mighth want to change. +#ehinit = "nostandout eol noverify" +#epinit = "standout showall" +showtype = yes + +# Default USER package; extend or modify as you wish. Note that this can +# be used to call FORTRAN programs from IRAF. + +package user + +task $adb $bc $cal $cat $comm $cp $csh $date $dbx $df $diff = "$foreign" +task $du $find $finger $ftp $grep $lpq $lprm $ls $mail $make = "$foreign" +task $man $mon $mv $nm $od $ps $rcp $rlogin $rsh $ruptime = "$foreign" +task $rwho $sh $spell $sps $strings $su $telnet $tip $top = "$foreign" +task $touch $vi $emacs $w $wc $less $rusers $sync $pwd $gdb = "$foreign" + +task $xc $mkpkg $generic $rtar $wtar $buglog = "$foreign" +#task $fc = "$xc -h $* -limfort -lsys -lvops -los" +task $fc = ("$" // envget("iraf") // "unix/hlib/fc.csh" // + " -h $* -limfort -lsys -lvops -los") +task $nbugs = ("$(setenv EDITOR 'buglog -e';" // + "less -Cqm +G " // envget ("iraf") // "local/bugs.*)") +task $cls = "$clear;ls" + +if (access ("home$loginuser.cl")) + cl < "home$loginuser.cl" +; + +keep; clpackage + +prcache directory +cache directory page type help + +# Print the message of the day. +if (access (".hushiraf")) + menus = no +else { + clear; type hlib$motd +} + +# Delete any old MTIO lock (magtape position) files. +if (deftask ("mtclean")) + mtclean +else + delete uparm$mt?.lok,uparm$*.wcs verify- + +# List any packages you want loaded at login time, ONE PER LINE. +images # general image operators +plot # graphics tasks +dataio # data conversions, import export +lists # list processing + +# The if(deftask...) is needed for V2.9 compatibility. +if (deftask ("proto")) + proto # prototype or ad hoc tasks + +tv # image display +utilities # miscellaneous utilities +noao # optical astronomy packages + +keep diff --git a/vendor/x11iraf/guidemo/loginuser.cl b/vendor/x11iraf/guidemo/loginuser.cl new file mode 100644 index 00000000..8c3e34c3 --- /dev/null +++ b/vendor/x11iraf/guidemo/loginuser.cl @@ -0,0 +1,6 @@ +# Define the guidemo package. + +set guidemo = "/iraf/x11iraf/guidemo/" +task $guidemo.pkg = guidemo$guidemo.cl + +keep diff --git a/vendor/x11iraf/guidemo/ltree.gui b/vendor/x11iraf/guidemo/ltree.gui new file mode 100644 index 00000000..67c5dbf0 --- /dev/null +++ b/vendor/x11iraf/guidemo/ltree.gui @@ -0,0 +1,33 @@ +# LTREE.GUI -- Test the ListTree widget. + +reset-server +appInitialize lTree LTree { + +LTree*objects:\ + toplevel Form helloForm\ + helloForm ListTree list\ + + *background: ivory3 + *list.width: 300 + *list.height: 300 + *list.font: -*-helvetica-bold-r-normal-*-14-*-iso8859-1 + *list.horizontalSpacing: 10 +} + +createObjects + +send list setListTree {a1 { b1 { {a2 {a3 b3 c3 d3}} { b2 {z1 z2}} } } c1} +#send list setListTree {{x1 {y1 y2}} {z2 {a b c d}}} append +#send list setListTree {{x1 {y1 y2}} {z2 {a b c d}}} + +# a1 +# b1 +# a2 +# a3 +# b3 +# b2 +# c1 + +activate + +proc foo { args } { print $args } ; send list addCallback foo diff --git a/vendor/x11iraf/guidemo/marker.gui b/vendor/x11iraf/guidemo/marker.gui new file mode 100644 index 00000000..bb0fd489 --- /dev/null +++ b/vendor/x11iraf/guidemo/marker.gui @@ -0,0 +1,314 @@ +# MTEST.GUI -- + +reset-server +appInitialize mtest Mtest { +! +! Application defaults for the hello world program. +! + +Mtest*objects:\ + toplevel Layout imgLayout \ + imgLayout Frame imviewFrame \ + imviewFrame Gterm gterm \ + imgLayout Layout tclLayout\ + tclLayout Group tclCmdGroup\ + tclLayout Frame tclFrame\ + tclFrame AsciiText tclEntry\ + tclCmdGroup Layout tclCmd\ + tclCmd Command tclClear\ + tclCmd Command tclExecute\ + tclCmd Command quitButton\ + + + *shrinkToFit: True + + *imgLayout*borderWidth: 0 + *imgLayout*highlightThickness: 0 + *imgLayout*background: ivory3 + *imgLayout*Frame*background: ivory3 + *imgLayout*Frame*frameWidth: 2 + *imgLayout*Command.highlightThickness: 2 + + *imgLayout.layout: vertical { \ + imviewFrame < +inf -inf * +inf -inf > \ + tclLayout < +inf -inf * +inf -inf > \ + } + + *imgLayout*imviewFrame.outerOffset: 5 + *imgLayout*imviewFrame.innerOffset: 0 + *imgLayout*imviewFrame.frameWidth: 3 + *imgLayout*imviewFrame.frameType: sunken + *gterm.cmapName: image + *gterm.width: 400 + *gterm.height: 300 + *gterm.borderColor: black + *gterm.resizable: True + *gterm.copyOnResize: False + *gterm.ginmodeCursor: circle + *gterm.dialogBgColor: cyan + *gterm.dialogFgColor: black + *gterm.crosshairCursorColor: cyan + *gterm.translations: \ + <Btn1Down>: call(polyMarker, $x, $y) \n\ + <EnterWindow>: enter-window() \n\ + <LeaveWindow>: leave-window() \n\ + <KeyPress>: graphics-input() \n\ + <Motion>: track-cursor() call(wcsUpdate,$x,$y) + + + ! Define a Debug Tcl shell. + !-------------------------- + *tclLayout*borderWidth: 0 + *tclLayout*Frame.frameType: sunken + *tclLayout*Frame.frameWidth: 2 + *tclLayout*Frame.outerOffset: 5 + *imgLayout*tclLayout*Text*foreground: wheat2 + *imgLayout*tclLayout*Text*background: gray35 + *tclLayout*Text*height: 90 + *tclLayout*Text*editType: edit + *tclLayout.layout: vertical { \ + tclFrame < +inf -inf * > \ + tclCmdGroup < +inf -inf * > \ + } + + ! Do the command bar group resources. + !------------------------------------ + *tclCmdGroup.width: 300 + *tclCmdGroup.height: 40 + *tclCmdGroup.label: + *tclCmdGroup.outerOffset: 0 + *tclCmdGroup.innerOffset: 5 + *tclCmdGroup*Command.background: ivory3 + *tclCmd.layout: horizontal { \ + 5 \ + tclClear tclExecute \ + 50 < +inf -inf > \ + quitButton \ + 5 \ + } + *tclClear.label: Clear + *tclExecute.label: Execute + *quitButton.label: Quit +} + +createObjects +activate + +proc Quit args { + send client gkey q ; deactivate unmap +}; send quitButton addCallback Quit + + + +# Define some TCL debug procedures + +send tclClear addCallback "send tclEntry set string \"\"" + +proc tclExec args { + send server [send tclEntry get string] +} ; send tclExecute addCallback tclExec + + +# Define a WCS box to track coords + +proc makeWCSMarker { args } { + send gterm createMarker wcsbox { + type text + createMode noninteractive + width 20ch + height 1ch + lineWidth 0 + imageText true + textBgColor black + textColor yellow + visible false + } + + set box_width [send wcsbox get width] + set box_height [send wcsbox get height] + set defGeom [format "%sx%s-5-5" $box_width $box_height] + send gterm parseGeometry "-5-5" $defGeom x y width height + + send wcsbox setAttributes \ + x $x \ + y $y \ + activated true \ + visible true \ + sensitive true + +} ; makeWCSMarker + + +proc wcsUpdate {x y} \ +{ + # Update coords box. + set text [ format " %7.2f %7.2f " $x $y ] + send wcsbox "set text \{$text\}; redraw noerase" +} + + +createMenu markerMenu toplevel { + { "Marker Type" f.title } + { f.dblline } + { "Box" f.exec "set_mtype box" } + { "Circle" f.exec "set_mtype circle" } + { "Ellipse" f.exec "set_mtype ellipse" } + { "Polygon" f.exec "set_poly polygon" } + { "Rectangle" f.exec "set_mtype rectangle" } + { "Text" f.exec "set_mtype text" } + { f.dblline } + { "Print geometry" f.exec "print [send objmarker getRegion]" } + +} + +proc set_mtype { type } { send objmarker "markpos; set type $type; redraw" } +proc set_poly args { + send objmarker getAttributes x xcur y ycur + set poly "{ { [expr "$xcur+00"] [expr "$ycur+00"] } \ + { [expr "$xcur-50"] [expr "$ycur+20"] } \ + { [expr "$xcur-50"] [expr "$ycur-30"] } \ + { [expr "$xcur+00"] [expr "$ycur-50"] } \ + { [expr "$xcur+50"] [expr "$ycur-30"] } \ + { [expr "$xcur+50"] [expr "$ycur+20"] } }" + + send objmarker "markpos; set type polygon; redraw" + #print "input vertices=" $poly + #send objmarker setVertices $poly + #send objmarker getVertices tpoly + #print "output vertices=" $tpoly + + send objmarker getAttributes x x y y width w height h type t rotangle r +} + + +# Translations when pointer is inside a marker. Notice I have turned of +# all resizeing and rotating options +set objmarkerTranslations { \ + !Shift <Btn1Motion>: m_rotateResize() + <Btn1Motion>: m_moveResize() + !Shift <Btn1Down>: m_raise() m_markpos() + <Btn1Down>: m_raise() m_markposAdd() + <Btn1Up>: m_redraw() m_destroyNull() + <Btn2Down>: m_lower() + <Btn3Down>: popup(markerMenu) + <Btn3Up>: popdown(markerMenu) + <Key>BackSpace: m_deleteDestroy() + <Key>Delete: m_deleteDestroy() + <KeyPress>: m_input() + <Motion>: track-cursor() +} + + +set mtype ellipse +set mtype text +set mtype rectangle +set mtype polygon +set mtype box +set mtype circle + +proc polyMarker { xcur ycur } { + + global objmarkerTranslations mtype + + print "marker type=" $mtype + print "position =" $xcur " " $ycur + + set posangle 0 + send gterm createMarker objmarker \ + type $mtype \ + createMode noninteractive \ + translations $objmarkerTranslations \ + lineColor red \ + knotSize 1 \ + knotColor yellow \ + x [expr $xcur + 000] \ + y [expr $ycur + 000] \ + width 50 \ + height 50 \ + rotangle $posangle \ + rotIndicator True \ + highlightColor green \ + textBgColor black \ + imageText True \ + activated True \ + visible False \ + sensitive True + + # Closed polygon. + set poly "{ { [expr "$xcur+00"] [expr "$ycur+00"] } \ + { [expr "$xcur-50"] [expr "$ycur+20"] } \ + { [expr "$xcur-50"] [expr "$ycur-30"] } \ + { [expr "$xcur+00"] [expr "$ycur-50"] } \ + { [expr "$xcur+50"] [expr "$ycur-30"] } \ + { [expr "$xcur+50"] [expr "$ycur+20"] } \ + { [expr "$xcur+00"] [expr "$ycur+00"] } }" + + # Unclosed polygon. + set poly "{ { [expr "$xcur+00"] [expr "$ycur+00"] } \ + { [expr "$xcur-50"] [expr "$ycur+20"] } \ + { [expr "$xcur-50"] [expr "$ycur-30"] } \ + { [expr "$xcur+00"] [expr "$ycur-50"] } \ + { [expr "$xcur+50"] [expr "$ycur-30"] } \ + { [expr "$xcur+50"] [expr "$ycur+20"] } }" + + if { $mtype == "polygon" } { + print "input vertices=" $poly + + # Note a setVertices resets the initial rotation angle to 0.0 + send objmarker setVertices $poly + send objmarker setAttribute rotangle $posangle + send objmarker setAttributes x $xcur y $ycur + send objmarker getVertices tpoly + print "output vertices=" $tpoly + print [send objmarker getRegion] + } + + send objmarker getAttributes x x y y width w height h type t rotangle r + print "initial attributes " $x $y $w $h $t $r + + #send objmarker addCallback markerConstraint constraint + + if { $mtype == "text" } { + set text "This is a test string" + send objmarker "set text \{$text\}; redraw noerase" + } + + send objmarker set visible True + print "AFter visible - " + print "getRegions= " [send objmarker getRegion] + send objmarker getVertices tpoly + print "getVertices= " $tpoly + + send objmarker getAttributes x x y y width w height h type t rotangle r + print "visible attributes " $x $y $w $h $t $r +} + +proc markerConstraint { marker event attributes } { + set constraints [ ] + + #print $marker $event $attributes + + # Constrain X and Y to not move. + foreach i $attributes { + set old [lindex $i 1] + set new [lindex $i 2] + switch [lindex $i 0] { + x { if {[send $marker get type] == "rectangle "} { + lappend constraints "x $old" + } else { + lappend constraints "x $new" + } + } + y { if {[send $marker get type] == "rectangle "} { + lappend constraints "y $old" + } else { + lappend constraints "y $new" + } + } + width { lappend constraints "width $new" } + height { lappend constraints "height $new" } + rotangle { lappend constraints "rotangle $new" } + } + } + return $constraints +} diff --git a/vendor/x11iraf/guidemo/mkpkg b/vendor/x11iraf/guidemo/mkpkg new file mode 100644 index 00000000..ac2bc171 --- /dev/null +++ b/vendor/x11iraf/guidemo/mkpkg @@ -0,0 +1,30 @@ +# Make the GUIDEMO package. + +$call relink +$exit + +update: + $call relink + $call install + ; + +relink: + $set LIBS = "" + + $update libpkg.a + $omake x_guidemo.x + $link x_guidemo.o libpkg.a $(LIBS) -o xx_guidemo.e + ; + +install: + $move xx_guidemo.e bin$x_guidemo.e + ; + +libpkg.a: + $set XFLAGS = "-cqfx" + + hello.x + imbrowse.x <finfo.h> <ctype.h> <diropen.h> <error.h> <gim.h>\ + <gset.h> <imhdr.h> <imio.h> + zscale.x <imhdr.h> + ; diff --git a/vendor/x11iraf/guidemo/panel.gui b/vendor/x11iraf/guidemo/panel.gui new file mode 100644 index 00000000..7e521dad --- /dev/null +++ b/vendor/x11iraf/guidemo/panel.gui @@ -0,0 +1,94 @@ +# PANEL.GUI -- Test GUI for the frame and layout widgets. +# This gui can be run as "cl> hello gui=panel.gui". + +reset-server +appInitialize panel Panel { + *objects:\ + toplevel Frame frame\ + frame Layout panel\ + panel Frame label1F\ + label1F Label label1\ + panel Frame label2F\ + label2F Label label2\ + panel Command button1\ + panel Command button2\ + panel RadioGroup color + + *background: gray + *foreground: black + + *frame.highlightThickness: 0 + *frame.frameWidth: 2 + *frame.frameType: chiseled + *frame.innerOffset: 5 + *frame.outerOffset: 5 + + *panel.debug: False + *panel.borderWidth: 0 + + *panel.layout: horizontal { \ + 0 < +inf > \ + vertical { \ + 5 < +inf -5 > \ + horizontal { \ + -1 \ + label1F < +inf * +inf > \ + -1 \ + } \ + 5 < +inf -5 > \ + horizontal { \ + -1 \ + label2F < +inf * +inf > \ + -1 \ + } \ + 5 < +inf -5 > \ + horizontal {\ + -1 < +inf > \ + button1 < +inf * +inf > \ + 5 < +inf -5 > \ + button2 < +inf * +inf > \ + -1 < +inf > \ + }\ + 5 < +inf -5 > \ + } \ + 0 < +inf > \ + color < +inf * +inf > \ + 0 < +inf > \ + } + + *Command.highlightThickness: 0 + *Label.borderWidth: 0 + *Label.background: gray60 + *label1*shadowWidth: 0 + *label1F.frameType: sunken + *label1F.frameWidth: 2 + *label2*shadowWidth: 0 + *label2F.frameType: sunken + *label2F.frameWidth: 2 + + *color.location: 0 0 100 0 + *color.shrinkToFit: True + *color.outerOffset: 5 + *color.innerOffset: 5 + *color.frameWidth: 2 + *color*offIcon: diamond0s + *color*onIcon: diamond1s + *color.red.highlightColor: red + *color.green.highlightColor: green + *color.blue.highlightColor: blue + *color.yellow.highlightColor: yellow + *color.label: Color: + *color.labels: |red|green|blue|yellow + *color.selectionStyle: multi + *color.selection: 0 + + *allowShellResize: true + *beNiceToColormap: False +} + +# Start up the GUI. +createObjects +activate + +proc quit args { send client gkey q; deactivate unmap } +send button1 addCallback quit diff --git a/vendor/x11iraf/guidemo/panel2.gui b/vendor/x11iraf/guidemo/panel2.gui new file mode 100644 index 00000000..a4c997c3 --- /dev/null +++ b/vendor/x11iraf/guidemo/panel2.gui @@ -0,0 +1,820 @@ +# PANEL.GUI -- Test GUI for the frame and layout widgets. +# This gui can be run as "cl> hello gui=panel.gui". + +reset-server + +appInitialize panel2 Panel2 { + *objects:\ + toplevel Layout panel \ + panel Group viewBox \ + panel Group enhancementBox \ + panel Group blinkBox \ + panel Group optionsBox \ + panel Frame controlBox \ +\ + viewBox Layout view \ + view Group frameSelect \ + frameSelect Layout frame \ + frame TextToggle frame1 \ + frame TextToggle frame2 \ + frame TextToggle frame3 \ + frame TextToggle frame4 \ + frame Command prevFrame \ + frame Command nextFrame \ + view Frame frameDataBox \ + frameDataBox TextBox frameData \ + view Group zoomBox \ + zoomBox Layout zoom \ + zoom TextButton toggleZoom \ + zoom TextButton zoomIn \ + zoom Command x1 \ + zoom Command z2 \ + zoom Command z3 \ + zoom Command z4 \ + zoom Command z5 \ + zoom Command z8 \ + zoom TextButton zoomOut \ + zoom TextButton centerFrame \ + zoom Command d2 \ + zoom Command d3 \ + zoom Command d4 \ + zoom Command d5 \ + zoom Command d8 \ + view Layout viewButtons \ + viewButtons Command clearFrame \ + viewButtons Command flipX \ + viewButtons Command flipY \ + viewButtons Command flipXY \ + viewButtons Command fitFrame \ +\ + enhancementBox Layout enhancement \ + enhancement Scrollbar2 colorlistScroll \ + enhancement Frame colorlistFrame \ + colorlistFrame Porthole colorlistPort \ + colorlistPort MultiList colorlist \ + enhancement Frame colordataFrame \ + colordataFrame TextBox colordata \ + enhancement Label contrastLabel \ + enhancement Slider2d contrastSlider \ + enhancement Label brightnessLabel \ + enhancement Slider2d brightnessSlider \ + enhancement Command invertButton \ + enhancement Command optimizeButton \ +\ + blinkBox Layout blink \ + blink Label blinkFramesLabel \ + blink Command blinkFrame1 \ + blink Command blinkFrame2 \ + blink Command blinkFrame3 \ + blink Command blinkFrame4 \ + blink Command blinkReset \ + blink Label blinkRateLabel \ + blink Frame BRframe \ + BRframe Layout BRlayout \ + BRlayout Arrow BRdecrease \ + BRlayout TextBox BRtext \ + BRlayout Arrow BRincrease \ + blink Command registerButton \ + blink Command matchButton \ + blink Toggle blinkButton \ +\ + optionsBox TextToggle pannerButton \ + optionsBox TextToggle coordsBoxButton \ + optionsBox TextToggle autoscaleButton \ + optionsBox TextToggle antialiasButton \ + optionsBox TextToggle tileFramesButton \ + optionsBox TextToggle warningsButton \ +\ + controlBox Layout control \ + control Command initializeButton \ + control Command normalizeButton \ + control Command doneButton \ +\ + toplevel TransientShell warning \ + warning Layout warn \ + warn Frame warnFrame \ + warnFrame Layout WFlayout \ + WFlayout Icon warnIcon \ + WFlayout TextBox warnText \ + warn TextButton warnOk \ + warn TextButton warnCancel \ + warn TextButton warnHelp + + *background: gray + *foreground: black + *TextBox.background: gray60 + *internalWidth: 0 + *borderWidth: 0 + *Command.highlightThickness: 0 + + *TextBox.font: 7x13bold + *TextToggle.font: -adobe-times-medium-r-normal-*-12-*-*-*-*-*-iso8859-1 + *Command.font: -adobe-times-medium-r-normal-*-12-*-*-*-*-*-iso8859-1 + *Toggle.font: -adobe-times-medium-r-normal-*-12-*-*-*-*-*-iso8859-1 + *Label.font: -*-helvetica-medium-r-normal-*-12-*-iso8859-1 + *MultiList.font: -adobe-times-medium-r-normal-*-12-*-*-*-*-*-iso8859-1 + *toggleZoom.font: -*-helvetica-medium-r-normal-*-12-*-iso8859-1 + *centerFrame.font: -*-helvetica-medium-r-normal-*-12-*-iso8859-1 + *zoom*Command.font: 7x13bold + *blinkFrame1.font: 7x13bold + *blinkFrame2.font: 7x13bold + *blinkFrame3.font: 7x13bold + *blinkFrame4.font: 7x13bold + + *panel.debug: False + *panel.layout: vertical { \ + 5 < -5 > \ + horizontal { \ + -1 \ + viewBox < +inf -inf * > \ + -1 \ + } \ + 5 < -5 > \ + horizontal { \ + -1 \ + enhancementBox < +inf -inf * +inf -inf > \ + -1 \ + vertical { \ + -1 \ + blinkBox < * +inf -inf > \ + -1 \ + optionsBox < * +inf -inf > \ + -1 \ + } \ + -1 \ + } \ + controlBox < +inf * > \ + } + + ! VIEW + ! ------------------ + *viewBox.label: View + *viewBox.location: 0 0 400 0 + *viewBox.shrinkToFit: True + *viewBox.outerOffset: 5 + + *view.debug: False + *view.layout: vertical { \ + 5 < +inf -5 > \ + horizontal { \ + -1 \ + frameSelect \ + -1 \ + vertical { \ + 5 < -5 > \ + frameDataBox < +inff -100% * +inff -100% > \ + 5 < -5 > \ + } \ + -1 \ + zoomBox \ + -1 \ + } \ + 1 < +inf > \ + viewButtons < +inf -inf * +inf -inf > \ + 5 < +inf -5 > \ + } + + *frameDataBox.frameType: sunken + *frameDataBox.frameWidth: 2 + *frameData.width: 130 + *frameData.height: 50 + *frameData.label:\ + -- Frame 1 --\nX center: 123.45\nY center: 345.67\nX scale: 4\nY scale: 4 + + *frameSelect.location: 0 0 72 0 + *frameSelect.shrinkToFit: True + *frameSelect.outerOffset: 5 + *frameSelect.innerOffset: 5 + *frameSelect.frameWidth: 2 + *frameSelect*offIcon: diamond0s + *frameSelect*onIcon: diamond1s + *frameSelect*highlightColor: blue + *frameSelect.label: Frame: + + *frame.debug: False + *frame.layout: vertical { \ + frame1 < +inf * > \ + frame2 < +inf * > \ + frame3 < +inf * > \ + frame4 < +inf * > \ + 10 < +inf -10 > \ + horizontal { \ + -1 \ + prevFrame \ + 10 < +inf -5 > \ + nextFrame \ + -1 \ + } \ + -1 \ + } + + *frame*location: 0 0 10 20 + *frame*alignment: left + *frame*frameWidth: 0 + *frame*highlightThickness: 0 + *frame*frame1.label: \ 1\ \ + *frame*frame2.label: \ 2\ \ + *frame*frame3.label: \ 3\ \ + *frame*frame4.label: \ 4\ \ + *frame*Command.width: 24 + *frame*prevFrame.label: xx + *frame*nextFrame.label: xx + + *zoomBox.label: Zoom: + *zoomBox.location: 0 0 160 127 + *zoomBox.outerOffset: 5 + *zoomBox.shrinkToFit: True + + *zoom.debug: False + *zoom*internalWidth: 4 + *zoom.layout: vertical { \ + space = ((50% of width zoom) - (50% of width z5)) \ + 1 < +inf > \ + horizontal { \ + vertical { \ + toggleZoom < +inf * +inf > \ + 2 \ + } \ + 2 \ + vertical { \ + 2 < +inf > \ + z5 \ + 1 < +inf > \ + z3 \ + 0 < +inf > \ + } \ + 2 \ + vertical { \ + zoomIn < +inf * +inf > \ + 2 \ + } \ + } \ + 1 < +inf > \ + horizontal { \ + 2 < +inf > \ + d8 d4 d2 x1 z2 z4 z8 \ + 2 < +inf > \ + } \ + 1 < +inf > \ + horizontal { \ + vertical { \ + 2 \ + zoomOut < +inf * +inf > \ + } \ + 2 \ + vertical { \ + 0 < +inf > \ + d3 \ + 1 < +inf > \ + d5 \ + 2 < +inf > \ + } \ + 2 \ + vertical { \ + 2 \ + centerFrame < +inf * +inf > \ + } \ + } \ + 1 < +inf > \ + } + + *toggleZoom.label: Toggle\nZoom + *toggleZoom.outerOffset: 0 + *toggleZoom.width: 30 + *toggleZoom.height: 25 + + *zoomIn.label: Zoom\nIn + *zoomIn.outerOffset: 0 + *zoomIn.width: 30 + *zoomIn.height: 25 + + *x1.label: 1 + *z2.label: 2 + *z3.label: 3 + *z4.label: 4 + *z5.label: 5 + *z8.label: 8 + + *zoomIn.foreground: royalBlue3 + *z4.foreground: royalBlue3 + *z5.foreground: royalBlue3 + *z8.foreground: royalBlue3 + *z2.foreground: royalBlue3 + *z3.foreground: royalBlue3 + + *zoomOut.label: Zoom\nOut + *zoomOut.outerOffset: 0 + *zoomOut.width: 30 + *zoomOut.height: 25 + + *centerFrame.label: Center + *centerFrame.outerOffset: 0 + *centerFrame.width: 30 + *centerFrame.height: 25 + + *d2.label: 2 + *d3.label: 3 + *d4.label: 4 + *d5.label: 5 + *d8.label: 8 + + *zoomOut.foreground: mediumVioletRed + *d2.foreground: mediumVioletRed + *d3.foreground: mediumVioletRed + *d4.foreground: mediumVioletRed + *d5.foreground: mediumVioletRed + *d8.foreground: mediumVioletRed + + *viewButtons.location: 0 0 100 80 + *viewButtons.debug: False + *viewButtons.layout: horizontal { \ + 5 < -2 > \ + flipX < +inf * > \ + 5 < -2 > \ + flipY < +inf * > \ + 5 < -2 > \ + flipXY < +inf * > \ + 5 < -2 > \ + clearFrame < +inf * > \ + 5 < -2 > \ + fitFrame < +inf * > \ + 5 < -2 > \ + } + + *nextFrame.label: Next Frame + *prevFrame.label: Previous Frame + *fitFrame.label: Fit Frame + *clearFrame.label: Clear Frame + *flipX.label: Flip X + *flipY.label: Flip Y + *flipXY.label: Flip XY + + + ! ENHANCEMENT + ! ------------------ + *enhancementBox.label: Enhancement + *enhancementBox.location: 0 0 100 0 + *enhancementBox.shrinkToFit: True + *enhancementBox.outerOffset: 5 + + *enhancement.debug: False + *enhancement.layout: vertical { \ + 3 < -3 > \ + horizontal { \ + 2 < -2 > \ + colorlistScroll < * +inf -inf > \ + -1 \ + colorlistFrame < +inf -inf * +inf -inf > \ + 2 < -2 > \ + } \ + -1 \ + horizontal { \ + 2 < -2 > \ + colordataFrame < +inf -inf * +inf -inf > \ + 2 < -2 > \ + } \ + 5 < -5 > \ + horizontal { \ + 2 < -2 > \ + vertical { \ + -1 \ + contrastLabel \ + 3 < -3 > \ + brightnessLabel \ + -1 \ + } \ + 3 < -3 > \ + vertical { \ + -1 \ + contrastSlider < +inf -inf * > \ + 3 < -3 > \ + brightnessSlider < +inf -inf * > \ + -1 \ + } \ + 2 < -2 > \ + } \ + 5 < -5 > \ + horizontal { \ + 3 < -3 > \ + invertButton < +inf -inf * > \ + 5 < -5 > \ + optimizeButton < +inf -inf * > \ + 3 < -3 > \ + } \ + 3 < -3 > \ + } + + *enhancement*Minsize: 20 + *enhancement*FrameType: sunken + *enhancement*FrameWidth: 2 + *enhancement*BorderWidth: 0 + *enhancement*Label.ShadowWidth: 0 + *enhancement*thumbColor: gray + + *colorlistScroll.location: 0 0 20 10 + *colorlistScroll.vertical: True + *colorlist.width: 100 + *colorlist.height: 78 + *colordata.width: 100 + *colordata.height: 45 + *enhancement*colordata.frameWidth: 0 + *contrastLabel.label: x + *contrastSlider.location: 0 0 100 20 + *brightnessLabel.label: x + *brightnessSlider.location: 0 0 100 20 + *invertButton.label: Invert + *optimizeButton.label: Optimize + + ! BLINK + ! --------------------- + *blinkBox.label: Blink + *blinkBox.location: 0 0 230 0 + *blinkBox.shrinkToFit: False + *blinkBox.outerOffset: 5 + + + *blink.debug: False + *blink.layout: vertical { \ + space = (width blinkFramesLabel - width blinkRateLabel) \ + 3 < -3 > \ + horizontal { \ + 0 \ + blinkFramesLabel \ + 3 < +inf > \ + blinkFrame1 < -50% * > \ + blinkFrame2 < -50% * > \ + blinkFrame3 < -50% * > \ + blinkFrame4 < -50% * > \ + 4 < +inf > \ + blinkReset \ + 2 \ + } \ + 5 < -5 > \ + horizontal { \ + $space \ + blinkRateLabel \ + 2 \ + BRframe < +inf * > \ + } \ + 10 < +inf -100% > \ + horizontal { \ + 3 \ + registerButton < +inf * > \ + 5 < -5 > \ + matchButton < +inf * > \ + 5 < -5 > \ + blinkButton < +inf * > \ + 2 \ + } \ + 3 < -3 > \ + } + + *BRlayout.layout: horizontal { \ + BRdecrease \ + BRtext < +inf -100% * > \ + BRincrease \ + } + + *blink.Label.borderWidth: 0 + *blink.Label.shadowWidth: 0 + *blink*internalWidth: 4 + *blink*Arrow.background: gray60 + *blink*Arrow.foreground: gray + *blink*Arrow.width: 16 + *blink*Arrow.height: 25 + + *blinkFramesLabel.label: Blink Frames: + *blinkFrame1.label: 1 + *blinkFrame2.label: 2 + *blinkFrame3.label: 3 + *blinkFrame4.label: 4 + *blinkReset.label: Reset + + *blinkRateLabel.label: Blink Rate: + *BRframe.frameType: sunken + *BRframe.frameWidth: 2 + *BRtext.width: 40 + *BRtext.height: 25 + *BRdecrease.direction: left + *BRincrease.direction: right + *registerButton.label: Register + *matchButton.label: Match LUTs + *blinkButton.label: Blink + + ! OPTIONS + ! --------------------- + *optionsBox.label: Options + *optionsBox.location: 0 0 220 0 + *optionsBox.shrinkToFit: False + *optionsBox.outerOffset: 5 + *optionsBox*offIcon: square0s + *optionsBox*onIcon: square1s + *optionsBox*selectionStyle: multi + *optionsBox*highlightColor: yellow + *optionsBox.TextToggle.location: 0 0 102 25 + *optionsBox.TextToggle.frameWidth: 0 + *optionsBox*alignment: left + + *pannerButton.label: Panner + *coordsBoxButton.label: Coords Box + *autoscaleButton.label: Autoscale + *antialiasButton.label: Antialias + *tileFramesButton.label: Tile Frames + *warningsButton.label: Warnings + + ! CONTROL + ! ---------------------- + *controlBox.frameType: chiseled + *controlBox.frameWidth: 2 + *controlBox.outerOffset: 5 + *controlBox.innerOffset: 5 + *controlBox.height: 30 + + *control.debug: False + *control.layout: horizontal { \ + 1 \ + initializeButton < +inf * > \ + 5 < -5 > \ + normalizeButton < +inf * > \ + 80 < +inf -100% > \ + doneButton < +inf * > \ + 1 \ + } + + *initializeButton.label: Initialize + *normalizeButton.label: Normalize + *doneButton.label: Done + + ! WARNING dialog. + ! --------------------- + *warning.geometry: +400+300 + *warning*Layout.debug: False + *warning*TextBox.frameWidth: 0 + *warning*TextBox.background: gray + *warning*TextButton.frameWidth: 2 + *warning*TextButton.width: 40 + *warning*TextButton.height: 25 + + *warn.layout: vertical { \ + 5 < -5 > \ + horizontal { \ + 5 < -5 > \ + warnFrame < +inf * +inf > \ + 5 < -5 > \ + } \ + 1 < -1 > \ + horizontal { \ + 5 < -5 > \ + warnOk < +inf * > \ + 5 < +inf -5 > \ + warnCancel < +inf * > \ + 5 < +inf -5 > \ + warnHelp < +inf * > \ + 5 < -5 > \ + } \ + 1 < -1 > \ + } + + *WFlayout.layout: horizontal { \ + 5 < -5 > \ + vertical { \ + 5 < +inf -5 > \ + warnIcon \ + 5 < +inf -5 > \ + } \ + 5 < -5 > \ + warnText < +inf -inf * +inf -inf > \ + 5 < -5 > \ + } + + *warnLabel.label: Warning + *warnLabel.width: 280 + *warnLabel.height: 20 + *warnFrame.frameType: sunken + *warnFrame.frameWidth: 2 + *warnIcon.location: 0 0 40 40 + *warnIcon.image: WARNING + *warnText.label: generic warning text + *warnText.width: 250 + *warnText.height: 60 + *warnOk.label: OK + *warnCancel.label: Cancel + *warnHelp.label: Help + *warnHelp.sensitive: False + + *allowShellResize: true + *beNiceToColormap: False +} + +# Start up the GUI. +createObjects +activate + +proc quit args { send client gkey q; deactivate unmap } +send doneButton addCallback quit + +# Initialize icons. +createBitmap larrow 16 16 { + 0x00, 0x00, 0x00, 0x03, 0x80, 0x03, 0xc0, 0x03, 0xe0, 0x1e, 0x70, 0x1e, + 0x38, 0x18, 0x1c, 0x18, 0x1c, 0x18, 0x38, 0x18, 0x70, 0x1e, 0xe0, 0x1e, + 0xc0, 0x03, 0x80, 0x03, 0x00, 0x03, 0x00, 0x00}; + +createBitmap rarrow 16 16 { + 0x00, 0x00, 0xc0, 0x00, 0xc0, 0x01, 0xc0, 0x03, 0x78, 0x07, 0x78, 0x0e, + 0x18, 0x1c, 0x18, 0x38, 0x18, 0x38, 0x18, 0x1c, 0x78, 0x0e, 0x78, 0x07, + 0xc0, 0x03, 0xc0, 0x01, 0xc0, 0x00, 0x00, 0x00}; + +createBitmap brightness 15 15 { + 0x00, 0x00, 0x80, 0x00, 0x84, 0x10, 0xe8, 0x0b, 0x10, 0x04, 0x08, 0x08, + 0x08, 0x08, 0x0e, 0x38, 0x08, 0x08, 0x08, 0x08, 0x10, 0x04, 0xe8, 0x0b, + 0x84, 0x10, 0x80, 0x00, 0x00, 0x00}; + +createBitmap contrast 15 15 { + 0x00, 0x00, 0x00, 0x00, 0xc0, 0x01, 0x30, 0x07, 0x08, 0x0f, 0x08, 0x0f, + 0x04, 0x1f, 0x04, 0x1f, 0x04, 0x1f, 0x08, 0x0f, 0x08, 0x0f, 0x30, 0x07, + 0xc0, 0x01, 0x00, 0x00, 0x00, 0x00}; + +send prevFrame set bitmap larrow +send nextFrame set bitmap rarrow +send contrastLabel set bitmap contrast +send brightnessLabel set bitmap brightness + +# Initialize sliders. +send contrastSlider resizeThumb 0.1 1.0 +send brightnessSlider resizeThumb 0.1 1.0 +send colorlistScroll setScrollbar 0.5 0.1 + + +# The following code doesn't do anything useful, but helps demonstrate the +# GUI and tests various callbacks and other capabilities. + +# Frame selection. +set frame 1 + +proc setFrame {widget args} { + global frame + send frame$frame set on 0 + set frame [expr [send $widget get label] + 1 - 1] + send frame$frame set on 1 +} +proc nextFrame args { + global frame + send frame$frame set on 0 + incr frame; if {$frame > 4} {set frame 1} + send frame$frame set on 1 +} +proc prevFrame args { + global frame + send frame$frame set on 0 + set frame [expr $frame - 1] + if {$frame < 1} {set frame 4} + send frame$frame set on 1 +} + +proc clearFrame args { + global warnings + if {$warnings} { + send warnText set label \ + "Clearing the frame will destroy\n\ + all data in the frame" + send warning map + } +} +proc warnDone args { + send warning unmap +} + +send prevFrame addCallback prevFrame +send nextFrame addCallback nextFrame +send clearFrame addCallback clearFrame +foreach w {warnOk warnCancel} { send $w addCallback warnDone } +foreach i {1 2 3 4} { send frame$i addCallback setFrame } +send frame1 set on 1 + + +# Enhancement stuff. +set scrollHeight 0 +set colortable Grayscale +set contrast 0 +set brightness 0 + +proc resizeScrollbar {widget cbtype flags x y w h cw ch} { + global scrollHeight + set newHeight [expr $ch - $h] + if {$newHeight != $scrollHeight} { + send colorlistScroll setScrollbar 0.0 [expr double($h) / $ch] + set scrollHeight $newHeight + } +}; send colorlistPort addCallback resizeScrollbar + +proc scrollColorlist {widget cbtype pos} { + global scrollHeight + send colorlist set y [expr -int($scrollHeight * $pos)] +}; send colorlistScroll addCallback scrollColorlist scroll + +proc selectColor {widget cbtype selections indices} { + global colortable + foreach selection $selections { + set colortable $selection; updateColordata + } +}; send colorlist addCallback selectColor + +proc scrollContrast {widget cbtype x y} { + global contrast; set contrast $x; updateColordata +}; send contrastSlider addCallback scrollContrast + +proc scrollBrightness {widget cbtype x y} { + global brightness; set brightness $x; updateColordata +}; send brightnessSlider addCallback scrollBrightness + +proc updateColordata args { + global colortable contrast brightness + send colordata set label [format "-- %s --\nCon %4.2f Brt %4.2f" \ + $colortable $contrast $brightness] +} + +set colortables { + "Grayscale" + "Heat" + "Halley" + "Spectrum" + "Random" + "Ramp1" + "Ramp2" +} +send colorlist setList $colortables resize +updateColordata + + +# Blink stuff. +set blinkRate 2.0 + +proc setBlinkRate {widget args} { + global blinkRate + if {$widget == "BRincrease"} { + if {$blinkRate < 0.01} { + set blinkRate 0.125 + } else { + set blinkRate [expr $blinkRate * 2.0] + } + } else { + set blinkRate [expr $blinkRate / 2.0] + if {$blinkRate < 0.01} { + set blinkRate 0 + } + } + send BRtext set label $blinkRate +} +foreach widget {BRincrease BRdecrease} { + send $widget addCallback setBlinkRate +} + +proc setBlinkFrame {widget args} { + set frame [send $widget get label] + if {$frame == " "} { + set frame 1 + } else { + incr frame + if {$frame > 4} { + set frame " " + } + } + send $widget set label $frame +} +foreach i {1 2 3 4} { + send blinkFrame$i addCallback setBlinkFrame +} + +proc toggleBlink {widget args} { + global blinkRate + if {$blinkRate < 0.01} { + send $widget set state 0 + } +} + +proc resetBlink args { + global blinkRate + foreach i {1 2 3 4} { + send blinkFrame$i set label " " + } + set blinkRate 2.0 + send BRtext set label $blinkRate +} + +send blinkButton addCallback toggleBlink +send blinkReset addCallback resetBlink +send BRtext set label 2.0 + + +# Options stuff. +set warnings 1 + +proc setWarnings args { + global warnings + set warnings [send warningsButton get on] +} + +send warningsButton addCallback setWarnings +send warningsButton set on 1 +send coordsBoxButton set on 1 +send autoscaleButton set on 1 diff --git a/vendor/x11iraf/guidemo/rarrow2.xbm b/vendor/x11iraf/guidemo/rarrow2.xbm new file mode 100644 index 00000000..fb9f7b80 --- /dev/null +++ b/vendor/x11iraf/guidemo/rarrow2.xbm @@ -0,0 +1,6 @@ +#define rarrow2_width 16 +#define rarrow2_height 16 +static char rarrow2_bits[] = { + 0x00, 0x00, 0xc0, 0x00, 0xc0, 0x01, 0xc0, 0x03, 0x78, 0x07, 0x78, 0x0e, + 0x18, 0x1c, 0x18, 0x38, 0x18, 0x38, 0x18, 0x1c, 0x78, 0x0e, 0x78, 0x07, + 0xc0, 0x03, 0xc0, 0x01, 0xc0, 0x00, 0x00, 0x00}; diff --git a/vendor/x11iraf/guidemo/region.gui b/vendor/x11iraf/guidemo/region.gui new file mode 100644 index 00000000..4013c890 --- /dev/null +++ b/vendor/x11iraf/guidemo/region.gui @@ -0,0 +1,197 @@ +# REGION.GUI -- Demo the use of region markers. +# This GUI can be run as "cl> hello gui=region.gui". + +reset-server +appInitialize regions Regions { + *objects:\ + toplevel Paned panel\ + panel Box control\ + panel Gterm graphics\ + panel AsciiText output\ + control Command quitButton\ + control Command measureButton\ + control Toggle skyButton + + *background: gray + *foreground: black + *menubar.showGrip: False + *menubar.skipAdjust: True + *menubar.width: 480 + *skyButton.label: Annulus + *measureButton.label: Measure + *quitButton.label: Quit + + *graphics.resizable: true + *graphics.ginmodeCursor: circle + *graphics.width: 640 + *graphics.height: 480 + + *output.width: 480 + + *graphics.translations: \ + <Btn1Down>: call(makeMarker,$name,$x,$y) m_create() \n\ + !Shift <Btn2Down>: crosshair(on) \n\ + !Shift <Btn2Motion>: crosshair(on) \n\ + <Btn2Up>: crosshair(off) \n\ + <EnterWindow>: enter-window() \n\ + <LeaveWindow>: leave-window() \n\ + <KeyPress>: graphics-input() \n\ + <Motion>: track-cursor() + + *allowShellResize: true + *shapeStyle: Rectangle + *beNiceToColormap: False + *Label*shadowWidth: 2 +} + +# Start up the GUI. +createObjects +send graphics setGterm +activate + +# Global variables +set marker objMarker ;# only one marker currently +set skyGap 10 ;# gap to sky annulus +set skyWidth 15 ;# width of sky annulus + + +# Procedures. +# ------------------------- + +proc quit args { send client gkey q; deactivate unmap } +send quitButton addCallback quit + +# Get a description of the region and print it in the output window. +proc measure args { + global marker + + # getRegion unmap will reverse any mappings and return raster coords. + set region [send $marker getRegion unmap] + send output set string $region + +}; send measureButton addCallback measure + + +# Draw/erase sky annulus. Once created these are not tied to the object +# region and the user is expected to toggle the skyButton to erase and +# redraw the annulus markers if the object marker is moved. If we wanted +# to be fancier about this we could register a move callback with the object +# marker and redraw the annulus markers at the new location if the object +# marker is moved. Currently there is no way to group markers so that they +# behave as one object. + +proc annulus args { + global skyGap skyWidth + global marker + + # In this case we use getRegion with no args, which returns window coords. + set region [send $marker getRegion] + + if [send skyButton get state] { + set x [lindex $region 2] + set y [lindex $region 3] + set width [lindex $region 4] + set height [lindex $region 5] + set rotangle [lindex $region 6] + + # Create a marker outlining the inner boundary of the annulus region. + # See obm/ObmW/Gterm.h for a list of marker attributes. + + send graphics createMarker sky1 \ + type ellipse \ + createMode noninteractive \ + lineColor blue \ + highlightColor blue \ + x $x \ + y $y \ + width [expr "$width + $skyGap"] \ + height [expr "$height + $skyGap"] \ + rotangle $rotangle \ + activated True \ + visible True \ + sensitive False + + # Create a marker outlining the outer boundary of the annulus region. + send graphics createMarker sky2 \ + type ellipse \ + createMode noninteractive \ + lineColor blue \ + highlightColor blue \ + x $x \ + y $y \ + width [expr "$width + $skyGap + $skyWidth"] \ + height [expr "$height + $skyGap + $skyWidth"] \ + rotangle $rotangle \ + activated True \ + visible True \ + sensitive False + + send sky1 "redraw noerase; lower" + send sky2 "redraw noerase; lower" + + } else { + send sky1 destroy + send sky2 destroy + } + +}; send skyButton addCallback annulus + + +# Support routines. +# ------------------------- + +# Create marker action. Makes a new marker. +proc makeMarker { parent x y } \ +{ + global markerTranslations marker + + send $parent createMarker $marker \ + type ellipse \ + createMode interactive \ + translations $markerTranslations \ + lineColor green \ + x $x \ + y $y + + send $marker addCallback moveResize moveResize +} + +proc moveResize args { + print "moveResize called: $args" +} + + +# Translations when pointer is inside a marker. +set markerTranslations { \ + !Shift <Btn1Motion>: m_rotateResize() + <Btn1Motion>: m_moveResize() + !Shift <Btn1Down>: m_raise() m_markpos() + <Btn1Down>: m_raise() m_markposAdd() + <Btn1Up>: m_redraw() m_destroyNull() + <Btn2Down>: m_lower() + <Btn3Down>: popup(markerMenu) + <Btn3Up>: popdown(markerMenu) + <Key>BackSpace: m_deleteDestroy() + <Key>Delete: m_deleteDestroy() + <KeyPress>: m_input() + <Motion>: track-cursor() +} + +# Popup menu in effect when inside marker. +createMenu markerMenu graphics { + { Object f.title } + { f.dblline } + { Measure f.exec { + measure + } } + { Dummy1 f.exec { + print dummy1 ;# (replace by real code) + } } + { Dummy2 f.exec { + print dummy2 ;# (replace by real code) + } } + { f.line } + { Destroy f.exec { + send $marker destroy + } } +} diff --git a/vendor/x11iraf/guidemo/table.gui b/vendor/x11iraf/guidemo/table.gui new file mode 100644 index 00000000..68d71df9 --- /dev/null +++ b/vendor/x11iraf/guidemo/table.gui @@ -0,0 +1,1958 @@ +# TABDEMO.GUI -- Test the Table widget. + +reset-server +appInitialize tabdemo Tabdemo { + + *demoObjects:\ + toplevel Layout panel \ + panel Frame panelMenuFrame \ + panelMenuFrame Layout panelMenuBar \ + panelMenuBar Command newCol \ + panelMenuBar Command newRow \ + panelMenuBar Command newTable \ + panelMenuBar Command tclShell \ + panelMenuBar Command quitButton + + + Tabdemo*background: grey + *Tabdemo.geometry: +0+0 + + *Group.shrinkToFit: True + *Command.height: 28 + *Command.shadowWidth: 1 + *Frame.frameWidth: 1 + *Frame.innerOffset: 4 + *Frame.highlightThickness: 0 + *borderWidth: 0 + *Scrollbar2.location: 0 0 17 17 + *Scrollbar.beNiceToColormap: False + + *panel.width: 600 + *panel.height: 350 + *panel.layout: vertical { \ + panelMenuFrame < +inf -inf * > \ + 5 < +inf > horizontal { 5 < +inf > }\ + } + + *panelMenuBar.layout: horizontal { \ + 2 newRow 1 newCol 1 newTable 1 tclShell 2 < +inf > quitButton 2 \ + } + *newCol.label: New Col + *newRow.label: New Row + *newTable.label: New Table + *tclShell.label: TclShell + *quitButton.label: Quit + +} ; createObjects demoObjects + +send quitButton addCallback "send client gkey q ; deactivate unmap" + +# Utility procedure to test True/False strings in resources. +proc true {v} {expr {$v == "true" || $v == "True" || $v == "TRUE"}} + +# Utility functions. +proc min {a b} { expr {($a < $b) ? $a : $b} } +proc max {a b} { expr {($a > $b) ? $a : $b} } + +# Create the Table objects in the OBM. + +set tabnumber 0 ;# initialize table counter + +proc doTable args { + global tabnumber + + set tab [ format "tab%d" $tabnumber ] + set objs [ tableBuildObjects panel $tab ] + +# tableSetOption $tab DefLabels no +# tableSetOption $tab RowLabels no +# tableSetOption $tab ColLabels no +# tableSetOption $tab Tracking no +# tableSetOption $tab RowScroll no +# tableSetOption $tab ColScroll no +# tableSetOption $tab DefaultTranslations no + tableSetOption $tab RowMultiSelect no + tableSetOption $tab ColMultiSelect no +# tableSetOption $tab RowLabelCols 2 +# tableSetOption $tab ColLabelRows 2 + tableSetOption $tab Background bisque3 + + # Now create the new objects. + appExtend $objs + createObjects ${tab}Objects + + # Now construct a layout for the new object. + set new "" + set panStart "vertical \{ panelMenuFrame < +inf -inf * > 5 < -5 >" + for {set i 0} {$i <= $tabnumber} {incr i} { + + # Send the existing table a small height so they'll ajust to + # fit the new table. + if {$i < $tabnumber} { send tab${i}TableFrame set height 10 } + + # Append a layout spec for the table. + set new \ + [format "%s tab%dTableFrame < +inf -inf * +inf -inf > 5 < -5 >" \ + $new $i] + } + set panEnd "\}" + set panelLayout [format "%s %s %s" $panStart $new $panEnd] + + # Send the panel the new layout incorporating the newly created Table. + send panel set layout $panelLayout + + # Now create the table itself, it should appear as if by magic. + tableCreate $tab 12 30 { } + + # Apply some default test callbacks for selection/edit events. + tableAddSelectCallback $tab Row demoSelCB + tableAddSelectCallback $tab Col demoSelCB + tableAddSelectCallback $tab Cell demoSelCB + tableAddUnSelectCallback $tab Row demoUnSelCB + tableAddUnSelectCallback $tab Col demoUnSelCB + tableAddUnSelectCallback $tab Cell demoUnSelCB + tableAddEditCallback $tab demoEditCB + + # Increment the global table counter. + incr tabnumber + +} ; send newTable addCallback doTable + +proc demoSelCB { name row col x y args } { + print "demoSelCB: name=$name r=$row c=$col x=$x y=$y args='$args'" +} + +proc demoUnSelCB { name row col x y args } { + print "demoUnSelCB: name=$name r=$row c=$col x=$x y=$y args='$args'" +} + +proc demoEditCB { name row col str args } { + print "demoEditCB: name=$name row=$row col=$col str='$str' args='$args'" +} + + +################################################################################ + +################################################################################ +# +# TABLE WIDGET PROCEDURES -- This interface provides simple access to a +# named instance of a Table "meta-widget". The "widget" is actually a +# number of widgets (Table, Scrollbars, etc) in a common layout to provide +# row/col headings, scrollable data tables, and callbacks for [gs]etting +# attributes. The meta-widget is created on-the-fly with a given named +# and parent object, it is the callers responsibility to adjust the layout +# of the parent to incorporate the new objects. +# +# The Table widget itself has various quirks and non-standard implem- +# entations so features such as editing cells or access to certain callbacks +# are not fully implemented in the OBM and hidden here. Most of what's +# needed can be handled by these procedures, however these routines may be +# used to manage multiple named tables in a GUI. +# +# +# tableBuildObjects parent tab +# tableSetOption tab option value +# tableAddSelectCallback tab type cbname +# tableAddEditCallback tab cbname +# tableDestroyObjects tab +# +# tableCreate tab nrows ncols data +# tableSetData tab data +# tableSetColumnLabels tab labels +# tableSetRowLabels tab labels +# +# tableSelectRow tab [ rownum | "all" ] +# tableUnSelectRow tab [ rownum | "all" ] +# tableSelectCol tab [ colnum | "all" ] +# tableUnSelectCol tab [ colnum | "all" ] +# tableSelectCell tab x y +# tableUnSelectCell tab x y +# list = tableGetSelected tab type +# +# tableSetRowLabelsAttr tab attr value +# value = tableGetRowLabelsAttr tab attr +# tableSetColLabelsAttr tab attr value +# value = tableGetColLabelsAttr tab attr +# tableSetRowLabelAttr tab row attr value +# value = tableGetRowLabelAttr tab row attr +# tableSetColLabelAttr tab col attr value +# value = tableGetColLabelAttr tab col attr +# +# attr = tableGetCelllAttr tab row col attr +# tableSetCelllAttr tab row col attr value +# value = tableGetRowAttr tab row attr +# tableSetRowAttr tab row attr value +# value = tableGetColAttr tab col attr +# tableSetColAttr tab col attr value +# +# tableDeleteCol tab col +# tableDeleteRow tab row +# tableAddCol tab col width [where] +# tableAddRow tab row [where] +# +# nrows = tableGetNrows tab +# ncols = tableGetNcols tab +# height = tableGetHeight tab +# width = tableGetWidth tab +# +# See obm$widget.c for a complete list of the OBM commands available +# for this widget, and procedure header comments for details about the +# interface here. +# +################################################################################ + +set tabNrows(name) 0 +set tabNcols(name) 0 +set tabData(name) 0 +set tabColLabs(name) 0 +set tabRowHeights(name,j) 0 +set tabColWidths(name,i) 0 + +set tabHeight(name) 0 +set tabWidth(name) 0 +set tabScrollSize(name,type) 0 +set tabScrollPos(name,type) 0 + +# Meta-widget options, should be set before the tableCreate call. +set tabOption(name,RowLabels) yes +set tabOption(name,ColLabels) yes +set tabOption(name,DefLabels) yes +set tabOption(name,Tracking) yes +set tabOption(name,RowScroll) yes +set tabOption(name,ColScroll) yes +set tabOption(name,Editable) yes +set tabOption(name,RowSelect) yes +set tabOption(name,ColSelect) no +set tabOption(name,CellSelect) no +set tabOption(name,DefaultTranslations) yes +set tabOption(name,Background) grey +set tabOption(name,Foreground) black +set tabOption(name,HighlightColor) grey90 +set tabOption(name,RowLabelCols) 1 +set tabOption(name,ColLabelRows) 1 + +# Selection lists. +set tabSelected(name,Row) {} +set tabSelected(name,Col) {} +set tabSelected(name,Cell) {} +set tabSelectionCB(name,Row) {} +set tabSelectionCB(name,Col) {} +set tabSelectionCB(name,Cell) {} +set tabUnSelectionCB(name,Row) {} +set tabUnSelectionCB(name,Col) {} +set tabUnSelectionCB(name,Cell) {} +set tabEditCB(name) {} + + +# TABLEBUILDOBJECTS -- Utility routine to build the object list for the meta- +# widget. +# +# Usage: +# tableBuildObjects <parent> <tab> + +proc tableBuildObjects { parent tab } { + + set objDef { + *TABObjects: \ + PARENT Frame TABTableFrame \ + TABTableFrame Layout TABFrameLayout \ + TABFrameLayout Layout TABTableLayout \ + TABTableLayout Viewport TABTabView \ + TABTabView Table TABTab \ + TABTableLayout Label TABSpacer1 \ + TABTableLayout Viewport TABRowTabView \ + TABRowTabView Table TABRowTab \ + TABTableLayout Viewport TABColTabView \ + TABColTabView Table TABColTab \ + TABFrameLayout Label TABLabel \ + TABFrameLayout Label TABSpacer2 \ + TABFrameLayout Scrollbar TABColScroll \ + TABFrameLayout Scrollbar TABRowScroll \ +\ + toplevel TopLevelShell TABEditShell \ + TABEditShell Layout TABEditLayout \ + TABEditLayout Frame TABEditMenuFrame\ + TABEditMenuFrame Layout TABEditMenuBar \ + TABEditMenuBar Command TABEditApply \ + TABEditMenuBar Command TABEditClear \ + TABEditMenuBar Command TABEditCancel \ + TABEditLayout Frame TABEditFrame \ + TABEditFrame AsciiText TABEditText \ + + + + + ! Global Table widget resources. + *Table.literalWidth: 20 + *Table.rowHeight: 18 + *Table.shadowWidth: 2 + *Table.labelShadowWidth: 1 + *Table.tableMargin: 0 + *Table.columnMargin: 0 + *Table.rowMargin: 0 + *Table.internalHeight: 0 + *Table.internalWidth: 0 + *Table*font: 7x13bold + + *TABTableFrame*Group.shrinkToFit: True + *TABTableFrame*Command.height: 28 + *TABTableFrame*Command.shadowWidth: 1 + *TABTableFrame*Frame.frameWidth: 1 + *TABTableFrame*Frame.innerOffset: 4 + *TABTableFrame*Frame.highlightThickness: 0 + *TABTableFrame*Frame.borderWidth: 0 + *TABTableFrame*Frame.shrinkToFit: True + *TABTableFrame*Table.borderWidth: 1 + *TABTableFrame*Scrollbar.beNiceToColormap: False + + *TABTableFrame.height: 10 + *TABTableFrame.width: 10 + *TABTableFrame*Layout.height: 10 + *TABTableFrame*Layout.width: 10 + *TABTableFrame*Label.height: 12 + *TABTableFrame*Label.label: + *TABTableFrame*Label.font: 6x12 + + *TABFrameLayout.TABTableLayout.height: 10 + *TABFrameLayout.TABTableLayout.width: 10 + *TABFrameLayout.TABTableLayout*Layout.height: 10 + *TABFrameLayout.TABTableLayout*Layout.width: 10 + *TABFrameLayout.TABTableLayout*Viewport.height: 20 + *TABFrameLayout.TABTableLayout*Viewport.width: 20 + *TABFrameLayout.TABTableLayout*Table.height: 20 + *TABFrameLayout.TABTableLayout*Table.width: 20 + + + ! The following resources enable the scrollbars on the Viewport + ! widget but effectively hide them from display. This allows us + ! to control the viewport manually from the Table code, e.g. to + ! scroll both the column headings and data table. + *TABFrameLayout.TABTableLayout*Viewport.allowVert: True + *TABFrameLayout.TABTableLayout*Viewport.allowHoriz: True + *TABFrameLayout.TABTableLayout*Viewport.forceBars: True + *TABFrameLayout.TABTableLayout*Viewport.useBottom: True + *TABFrameLayout.TABTableLayout*Viewport.useRight: True + *TABFrameLayout.TABTableLayout*Viewport.borderWidth: 1 + + *TABTableLayout*TABRowTabView*vertical.thickness: 1 + *TABTableLayout*TABRowTabView*horizontal.thickness: 1 + *TABTableLayout*TABColTabView*vertical.thickness: 1 + *TABTableLayout*TABColTabView*horizontal.thickness: 1 + *TABTableLayout*TABTabView*vertical.thickness: 1 + *TABTableLayout*TABTabView*horizontal.thickness: 1 + + *TABTableFrame.TABFrameLayout.TABRowScroll.thickness: 12 + *TABTableFrame.TABFrameLayout.TABRowScroll.width: 12 + *TABTableFrame.TABFrameLayout.TABRowScroll.height: 12 + *TABTableFrame.TABFrameLayout.TABRowScroll.orientation: Vertical + + *TABTableFrame.TABFrameLayout.TABColScroll.thickness: 12 + *TABTableFrame.TABFrameLayout.TABColScroll.width: 12 + *TABTableFrame.TABFrameLayout.TABColScroll.height: 12 + *TABTableFrame.TABFrameLayout.TABColScroll.orientation: Horizontal + + *TABFrameLayout.layout: horizontal { \ + vertical { \ + 2 < -2 > \ + TABTableLayout < +inf -inf * +inf -inf > \ + 2 < -2 > \ + horizontal { \ + TABLabel 1 < -1 > TABColScroll < +inf -inf * > \ + } \ + } \ + vertical { \ + TABSpacer2 1 < -1 > TABRowScroll < * +inf -inf > 22 < -22 > \ + } \ + } + *TABTableFrame.TABFrameLayout.TABLabel.label: ( 0, 0) + *TABTableFrame.TABFrameLayout.TABLabel.font: 6x12 + *TABTableFrame.TABFrameLayout.TABLabel.width: 80 + *TABTableFrame.TABFrameLayout.TABLabel.height: 12 + *TABTableFrame.TABFrameLayout*TABColScroll.height: 12 + *TABTableFrame.TABFrameLayout.TABSpacer2.height: 27 + *TABTableFrame.TABFrameLayout.TABSpacer2.shadowWidth: 0 + + *TABTableLayout.layout: horizontal { \ + vertical { \ + TABSpacer1 1 < -1 > TABRowTabView < * +inf -inf > \ + } \ + 3 < -3 > \ + vertical { \ + TABColTabView < +inf -inf * > \ + 3 < -3 > \ + TABTabView < +inf -inf * +inf -inf > \ + } \ + 3 < -3 > \ + } + *TABTableLayout.TABSpacer1.height: 27 + *TABTableLayout.TABSpacer1.shadowWidth: 0 + + !---------------------------+ + ! Set the editor resources. | + !---------------------------+ + *TABEditShell.title: Table Value Editor + *TABEditShell.width: 275 + *TABEditShell.height: 80 + *TABEditLayout*borderWidth: 0 + *TABEditLayout.layout: vertical { \ + TABEditFrame < +inf -inf * +inf -inf > \ + -2 \ + TABEditMenuFrame < +inf -inf * > \ + -2 \ + } + + *TABEditMenuBar.layout: horizontal { \ + TABEditApply 5 \ + 10 < +inf -inf > \ + TABEditClear 5 \ + 10 < +inf -inf > \ + TABEditCancel 5 \ + } + *TABEditMenuFrame.height: 80 + *TABEditMenuFrame.outerOffset: 0 + *TABEditMenuFrame.innerOffset: 5 + *TABEditMenuFrame.frameType: chiseled + *TABEditMenuFrame.frameWidth: 2 + *TABEditFrame.frameType: sunken + *TABEditFrame.frameWidth: 2 + *TABEditFrame.outerOffset: 5 + *TABEditText*scrollVertical: never + *TABEditText*scrollHorizontal: whenNeeded + *TABEditText*font: 7x13 + *TABEditText*editType: edit + *TABEditApply.label: Apply + *TABEditApply.width: 150 + *TABEditClear.label: Clear + *TABEditClear.width: 150 + *TABEditCancel.label: Cancel + *TABEditCancel.width: 150 + + } + + regsub -all TAB $objDef $tab tmp1 + regsub -all PARENT $tmp1 $parent objs + set objs [format "{ %s }" $objs] + + return $objs +} + + +# TABLEDESTROYOBJECTS -- Destroy the specified table and all it's objects. +# +# Usage: +# tableDestroyObjects <tab> + +proc tableDestroyObjects { tab } { + destroyObject ${tab}TableFrame +} + + +# TABESETOPTION -- Set an option for the Table meta-widget. +# +# Usage: +# tableSetOption <tab> <option> [yes|no] +# +# where <tab> is the table name given when the meta-widget was created, and +# <option> is one of: +# +# +# Option Name Type Default Description +# ----------- ---- ------- ----------- +# RowLabels bool yes display a row label table +# ColLabels bool yes display a column label table +# DefLabels bool yes do default labels of rows/cols +# Tracking bool yes do coord tracking in data table +# RowScroll bool yes display row scrollbar +# ColScroll bool yes display column scrollbar +# Editable bool yes table is editable +# RowSelect bool yes rows are selectable +# ColSelect bool yes cols are selectable +# CellSelect bool yes cells are selectable +# RowMultiSelect bool yes multiple rows may be selected +# ColMultiSelect bool yes multiple cols may be selected +# CellMultiSelect bool yes multiple cells may be selected +# DefaultTranslations bool yes use default table translations +# Foreground color black meta-widget foreground color +# Background color grey meta-widget background color +# HighlightColor color grey90 selected item highlight color +# RowLabelCols int 1 number of columns in row labels +# ColLabelRows int 1 number of rows in column labels +# + +proc tableSetOption { tab option value } { + global tabOption + set tabOption(${tab},${option}) $value + + # Now handle the special cases where one option may disable some other. +} + + +# TABLEADDSELECTCALLBACK -- Add a user-defined callback to be executed +# when there is a row, column, or cell selection event occurs. +# +# Usage: +# tableAddSelectCallback <tab> <type> <cbname> +# +# where <type> is "Row", "Col", or "Cell" and <cbname> specifies a procedure +# to be called whenever the specified <type> is selected. Procedures are +# called as +# <cbname> name row col x y +# +# where 'name' is the table name, 'row' and 'col' are the coordinates of the +# selection and 'x' and 'y' are the raw event coordinates. Registered proc- +# edures are required to declare all these arguments but do not need to use +# them. + +proc tableAddSelectCallback { tab type cbname } { + global tabSelectionCB + lappend tabSelectionCB(${tab},${type}) $cbname +} + + +# TABLEADDUNSELECTCALLBACK -- Add a user-defined callback to be executed +# when there is a row, column, or cell un-selection event occurs. +# +# Usage: +# tableAddUnSelectCallback <tab> <type> <cbname> +# +# where <type> is "Row", "Col", or "Cell" and <cbname> specifies a procedure +# to be called whenever the specified <type> is selected. Procedures are +# called as +# <cbname> name row col x y state +# +# where 'name' is the table name, 'row' and 'col' are the coordinates of the +# selection and 'x' and 'y' are the raw event coordinates. Registered proc- +# edures are required to declare all these arguments but do not need to use +# them. + +proc tableAddUnSelectCallback { tab type cbname } { + global tabUnSelectionCB + lappend tabUnSelectionCB(${tab},${type}) $cbname +} + + + +# TABLEADDEDITCALLBACK -- Add a user-defined callback to be executed +# when there is an edit event. +# +# Usage: +# tableAddEditCallback <tab> <cbname> +# +# <cbname> specifies a procedure to be called whenever the table editor +# Apply button has been pressed. Procedures are called as +# +# <cbname> name row col new_string +# +# where 'name' is the table name, 'row' and 'col' are the coordinates of the +# edited cell and 'new_string' is the new value inserted in the table. Reg- +# istered procedures are required to declare all these arguments but do not +# need to use them. + +proc tableAddEditCallback { tab cbname } { + global tabEditCB + lappend tabEditCB(${tab}) $cbname +} + + +# TABLECREATE -- Create a named instance of the Table meta-widget. The +# individual objects in the meta-widget are created dynamically and the +# entire thing is created as a child of the named parent object. The +# standard callbacks are assigned and the table is initialized, however +# it is the callers responsibility to adjust the parent's layout to make +# the meta-widget visible and assign any constraint callbacks. +# +# Usage: +# tableCreate <tab> <nrows> <ncols> <data> +# +# The <data> is specified as a Tcl list of the form: +# +# { {r1c1 r1c2 ... r1cN} +# {r2c1 r2c2 ... r2cN} +# : +# {rNc1 rNc2 ... rNcN} } +# +# String values must be quoted, rows/cols will be truncated or cleared if +# the specified table size does not agree with the size of the data table +# being loaded. + +set tabBGWidgets { \ + TABTab TABRowTab TABColTab TABLabel TABColScroll \ + TABRowScroll TABEditApply TABEditClear TABEditCancel \ + TABEditApply TABEditClear TABEditCancel TABEditText \ + TABEditFrame TABEditMenuBar TABEditMenuFrame \ +} +set tabFGWidgets { \ + TABTab TABRowTab TABColTab TABLabel TABColScroll \ + TABRowScroll TABEditApply TABEditClear TABEditCancel \ + TABEditApply TABEditClear TABEditCancel TABEditText \ +} + +proc tableCreate { tab nrows ncols data } { + global tabNrows tabNcols tabRowHeights tabColWidths + global tabHeight tabWidth tabDebug tabOption + global tabEditCB tabSelectionCB tabUnSelectionCB + global tabSelected tabBGWidgets tabFGWidgets + + set err "" + catch { + if { ![info exists tabOption(${tab},RowLabelCols)] } { + set tabOption(${tab},RowLabelCols) $tabOption(name,RowLabelCols) + } + } err + if {$err != ""} { + set tabOption(${tab},RowLabelCols) $tabOption(name,RowLabelCols) + } + set err "" + catch { + if { ![info exists tabOption(${tab},ColLabelRows)] } { + set tabOption(${tab},ColLabelRows) $tabOption(name,ColLabelRows) + } + } err + if {$err != ""} { + set tabOption(${tab},ColLabelRows) $tabOption(name,ColLabelRows) + } + + + set tabNrows(${tab},data) $nrows + set tabNcols(${tab},data) $ncols + set tabNrows(${tab},rows) $nrows + set tabNcols(${tab},rows) $tabOption(${tab},RowLabelCols) + set tabNrows(${tab},cols) $tabOption(${tab},ColLabelRows) + set tabNcols(${tab},cols) $ncols + set tabData($tab) $data + + # Initialize with a default row height. + set rh [send ${tab}Tab get rowHeight] + set tabRowHeights($tab,default) $rh + for {set i 1} {$i <= $nrows} {incr i} { + set tabRowHeights($tab,$i) $rh + } + + # Initialize with a default column width. + set cw [send ${tab}Tab get defaultWidth] + for {set i 1} {$i <= $ncols} {incr i} { + set tabColWidths($tab,$i) $cw + } + + # Initialize the table. + send ${tab}Tab setTable $nrows $ncols $data + + # Initialize the labels. + tableSetDefaultLabels $tab + + # Save the table dimensions. + set tabHeight($tab) [ tableGetHeight $tab ] + set tabWidth($tab) [ tableGetWidth $tab ] + + # Set the default table translations. + tableSetDefaultTranslations $tab + + # Attach the default-callbacks to the new Table. + tableAddCallbacks $tab + + # Set Default Scrollbars for the table. + tableSetDefaultScrollbars $tab yes + + # Default the colors. + set err "" + catch { + if { ![info exists tabOption(${tab},HighlightColor)] != 0 } { + set tabOption(${tab},HighlightColor) $tabOption(name,HighlightColor) + } + } err + if {$err != ""} { + set tabOption(${tab},HighlightColor) $tabOption(name,HighlightColor) + } + set err "" + catch { + if { ![info exists tabOption(${tab},Background)] != 0 } { + set tabOption(${tab},Background) $tabOption(name,Background) + } + } err + if {$err != ""} { + set tabOption(${tab},Background) $tabOption(name,Background) + } + set err "" + catch { + if { ![info exists tabOption(${tab},Foreground)] != 0 } { + set tabOption(${tab},Foreground) $tabOption(name,Foreground) + } + } err + if {$err != ""} { + set tabOption(${tab},Foreground) $tabOption(name,Foreground) + } + + regsub -all TAB $tabBGWidgets $tab bgwidgets + foreach w $bgwidgets { + send $w set background $tabOption(${tab},Background) + } + regsub -all TAB $tabFGWidgets $tab fgwidgets + foreach w $fgwidgets { + send $w set foreground $tabOption(${tab},Foreground) + } + + # Default selections. + set tabSelected(${tab},Row) {} + set tabSelected(${tab},Col) {} + set tabSelected(${tab},Cell) {} + + set tabSelectionCB(${tab},Row) {} + set tabSelectionCB(${tab},Col) {} + set tabSelectionCB(${tab},Cell) {} + set tabUnSelectionCB(${tab},Row) {} + set tabUnSelectionCB(${tab},Col) {} + set tabUnSelectionCB(${tab},Cell) {} + set tabEditCB(${tab}) {} +} + + +# TABLESETDATA -- Set the data elements of a table meta-widget. +# +# Usage: +# tableSetData <tab> <data> +# +# where <tab> is the table name given when the meta-widget was created, and +# <data> is of the form: +# +# { {r1c1 r1c2 ... r1cN} +# {r2c1 r2c2 ... r2cN} +# : +# {rNc1 rNc2 ... rNcN} } + +proc tableSetData { tab data } { + global tabNrows tabNcols + + send ${tab}Tab setTable $tabNrows(${tab},data) $tabNcols(${tab},data) $data + +# send ${tab}Tab setTable \ +# [expr ($tabNrows(${tab},data) + 20)] \ +# [expr ($tabNcols(${tab},data) + 20)] \ +# $data +} + + +# TABLESETSIZE -- Set the size of a table meta-widget. +# +# Usage: +# tableSetSize <tab> <nrows> <ncols> +# + +proc tableSetSize { tab nrows ncols } { + global tabNrows tabNcols tabOption + global tabHeight tabWidth tabRowHeights + + set tabNrows(${tab},data) $nrows + set tabNcols(${tab},data) $ncols + + set tabNrows(${tab},rows) $nrows + set tabNcols(${tab},rows) $tabOption(${tab},RowLabelCols) + set tabNrows(${tab},cols) $tabOption(${tab},ColLabelRows) + set tabNcols(${tab},cols) $ncols + + send ${tab}Tab setTableSize $nrows $ncols + send ${tab}RowTab setTableSize $tabNrows(${tab},rows) $tabNcols(${tab},rows) + send ${tab}ColTab setTableSize $tabNrows(${tab},cols) $tabNcols(${tab},cols) + + set rh [send ${tab}Tab get rowHeight] + set tabRowHeights($tab,default) $rh + for {set i 1} {$i <= $nrows} {incr i} { + set tabRowHeights($tab,$i) $rh + } + + # Save the table dimensions. + set tabHeight($tab) [ tableGetHeight $tab ] + set tabWidth($tab) [ tableGetWidth $tab ] + + #tableSetDefaultScrollbars $tab yes +} + + +# TABLESETCOLUMNLABELS -- Set the column header labels for a table. +# meta-widget. +# +# Usage: +# tableSetColumnLabels <tab> <column_labs> +# +# where <tab> is the table name given when the meta-widget was created, and +# <data> is of the form: +# +# { { r1c1 } { r1c2 } ... { r1cN } } + +proc tableSetColumnLabels { tab col_labs } { + global tabNrows tabNcols + send ${tab}ColTab \ + setTable $tabNrows(${tab},cols) $tabNcols(${tab},cols) $col_labs +} + + +# TABLESETROWLABELS -- Set the row header labels for a table. +# meta-widget. +# +# Usage: +# tableSetColumnLabels <tab> <row_labs> +# +# where <tab> is the table name given when the meta-widget was created, and +# <data> is of the form: +# +# { {r1c1 r1c2 ... r1cN} } + +proc tableSetRowLabels { tab row_labs } { + global tabNrows tabNcols + send ${tab}RowTab \ + setTable $tabNrows(${tab},rows) $tabNcols(${tab},rows) $row_labs +} + + +# TABLESETCOLLABELSATTR -- Set the column header labels for a table +# meta-widget. +# +# Usage: +# tableSetColumnLabels <tab> <attr> <value> [<row>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableSetColLabelsAttr { tab attr value args } { + if {$args != ""} { + send ${tab}ColTab setRowAttr $args $attr $value + } else { + send ${tab}ColTab setRowAttr 1 $attr $value + } +} + + +# TABLESETROWLABELSATTR -- Set the row header labels for a table meta-widget. +# +# Usage: +# tableSetRowLabelsAttr <tab> <attr> <value> [<col>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableSetRowLabelsAttr { tab attr value args } { + if {$args != ""} { + send ${tab}RowTab setColAttr $args $attr $value + } else { + send ${tab}RowTab setColAttr 1 $attr $value + } +} + + +# TABLEGETROWLABELSATTR -- Get the row header labels for a table meta-widget. +# +# Usage: +# value = tableGetRowLabelsAttr <tab> <attr> [<col>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableGetRowLabelsAttr { tab attr args } { + if {$args != ""} { + return [ send ${tab}RowTab getColAttr $args $attr ] + } else { + return [ send ${tab}RowTab getColAttr 1 $attr ] + } +} + + +# TABLEGETCOLLABELSATTR -- Get the column header labels for a table. +# meta-widget. +# +# Usage: +# value = tableGetColLabelsAttr <tab> <attr> [<row>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableGetColLabelsAttr { tab attr args } { + if {$args != ""} { + return [ send ${tab}ColTab getRowAttr $args $attr ] + } else { + return [ send ${tab}ColTab getRowAttr 1 $attr ] + } +} + + +# TABLESETROWLABELATTR -- Set the specified attribute for the row label table. +# +# Usage: +# tableSetRowLabelAttr <tab> <row> <attr> <value> [<row>] +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableSetRowLabelAttr { tab row attr value args } { + if {$args != ""} { + send ${tab}RowTab setCellAttr $row $args $attr $value + } else { + send ${tab}RowTab setCellAttr $row 1 $attr $value + } +} + + +# TABLESETCOLLABELATTR -- Get the specified attribute for the col label table. +# +# Usage: +# value = tableSetColLabelAttr <tab> <col> <attr> <value> [<row>] +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableSetColLabelAttr { tab col attr value args } { + if {$args != ""} { + send ${tab}ColTab setCellAttr $args $col $attr $value + } else { + send ${tab}ColTab setCellAttr 1 $col $attr $value + } +} + + +# TABLEGETCELLATTR -- Get the specified attribute for the cell. +# +# Usage: +# value = tableGetCellAttr <tab> <row> <col> <attr> +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableGetCellAttr { tab row col attr } { + return [ send ${tab}Tab getCellAttr $row $col $attr ] +} + + +# TABLESETCELLATTR -- Set the specified attribute for the cell. +# +# Usage: +# tableSetCellAttr <tab> <row> <col> <attr> <value> +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableSetCellAttr { tab row col attr value } { + send ${tab}Tab setCellAttr $row $col $attr $value +} + + +# TABLEGETROWATTR -- Get the specified attribute for the row. +# +# Usage: +# value = tableGetCellAttr <tab> <row> <attr> +# +# The row position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a row include: +# +# background background color +# foreground foreground color + +proc tableGetRowAttr { tab row attr } { + return [ send ${tab}Tab getRowAttr $row $attr ] +} + + +# TABLESETROWATTR -- Set the specified attribute for the row. +# +# Usage: +# tableSetRowAttr <tab> <row> <attr> <value> +# +# The row position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a row include: +# +# background background color +# foreground foreground color + +proc tableSetRowAttr { tab row attr value } { + send ${tab}Tab setRowAttr $row $attr $value +} + + +# TABLEGETCOLATTR -- Get the specified attribute for the column. +# +# Usage: +# value = tableGetColAttr <tab> <col> <attr> +# +# The column position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a column include: +# +# width column width (pixels) +# background background color (string) +# foreground foreground color (string) +# justify text justification (string) + +proc tableGetColAttr { tab col attr } { + return [ send ${tab}Tab getColAttr $col $attr ] +} + + +# TABLESETCOLATTR -- Set the specified attribute for the column. +# +# Usage: +# tableSetColAttr <tab> <col> <attr> <value> +# +# The column position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a column include: +# +# width column width (pixels) +# background background color (string) +# foreground foreground color (string) +# justify text justification (string) + +proc tableSetColAttr { tab col attr value } { + global tabColWidths tabNcols + + send ${tab}Tab setColAttr $col $attr $value + if {$attr == "width"} { + set tabColWidths(${tab},$col) $value + } +} + + +# TABLEDELETECOL -- Delete the specified column from the named table. +# +# Usage: +# tableDeleteCol <tab> <col> + +proc tableDeleteCol { tab col } { + global tabColWidths tabNcols + + send ${tab}Tab deleteCol $col + send ${tab}ColTab deleteCol $col + incr tabNcols(${tab},data) -1 + catch { unset tabColWidths(${tab},$col) } err +} + + +# TABLEDELETEROW -- Delete the specified row from the named table. +# +# Usage: +# tableDeleteRow <tab> <row> + +proc tableDeleteRow { tab row } { + global tabRowHeights tabNrows + + send ${tab}Tab deleteRow $row + send ${tab}RowTab deleteRow $row + incr tabNrows(${tab},data) -1 + catch { unset tabRowHeights(${tab},$row) } err +} + + +# TABLEDADDCOL -- Add a column to the named table at the specified position. +# +# Usage: +# tableAddCol <tab> <col> <width> + +proc tableAddCol { tab col width args} { + global tabColWidths tabNcols + + send ${tab}Tab addCol $col $width $args + send ${tab}ColTab addCol $col $width $args + incr tabNcols(${tab},data) + + set ncols $tabNcols(${tab},data) + if {$col == "first"} { + set colnum 1 + } elseif {$col == "last"} { + set colnum $tabNcols(${tab},data) + } else { + set colnum $col + } + + # Update the column widths. + for {set c $ncols} {$c > $colnum} {incr c -1} { + set tabColWidths(${tab},$c) $tabColWidths(${tab},[expr ($c - 1)]) + } + set tabColWidths(${tab},$colnum) $width +} + + +# TABLEADDROW -- Add a rows to the named table at the specified position. +# +# Usage: +# tableAddRow <tab> <row> + +proc tableAddRow { tab row args } { + global tabRowHeights tabNrows + + send ${tab}Tab addRow $row $args + send ${tab}RowTab addRow $row $args + incr tabNrows(${tab},data) + set tabRowHeights(${tab},$row) $tabRowHeights(${tab},default) +} + + +# TABLEGETNROWS -- Return the number of rows in a named table. +# +# Usage: +# nrows = tableGetNrows <tab> + +proc tableGetNrows { tab } { + global tabNrows + return $tabNrows(${tab},data) +} + + +# TABLEGETNCOLS -- Return the number of columns in a named table. +# +# Usage: +# ncols = tableGetNcols <tab> + +proc tableGetNcols { tab } { + global tabNcols + return $tabNcols(${tab},data) +} + + +# TABLEGETHEIGHT -- Compute the height of the table given varying row heights. +# +# Usage: +# height = tableGetHeight <tab> + +proc tableGetHeight { tab } { + return [ send ${tab}Tab get height ] +} + + +# TABLEGETWIDTH -- Compute the width of the table given varying column widths. +# +# Usage: +# width = tableGetWidth <tab> + +proc tableGetWidth { tab } { + return [ send ${tab}Tab get width ] +} + + +# TABLEGETSELECTED -- Return a list of the selected items. +# +# Usage: list = tableGetSelected tab type +# +# where <type> is 'Row', 'Col', or 'Cell'. + +proc tableGetSelected { tab type } { + global tabSelected + return $tabSelected(${tab},${type}) +} + + + +# TABLESELECTROW -- User-selectable row procedure. Row may be the string +# "all" in which case we select all rows in the table, otherwise may sure +# selection is unique. + +proc tableSelectRow { tab row } { + global tabSelected tabOption tabNrows + + set color $tabOption(${tab},HighlightColor) + if {$row == "all"} { + for {set i 0} {$i < $tabNrows(${tab},data)} {incr i} { + set index [lsearch $tabSelected(${tab},Row) $row ] + if {$index < 0} { + lappend tabSelected(${tab},Row) $i + tableSetRowAttr ${tab} $i background $color + tableSetRowAttr ${tab}Row $i background $color + } + } + } else { + set index [lsearch $tabSelected(${tab},Row) $row ] + if {$index < 0} { + lappend tabSelected(${tab},Row) $row + tableSetRowAttr ${tab} $row background $color + tableSetRowAttr ${tab}Row $row background $color + } + } +} + + +# TABLESELECTCOL -- User-selectable column procedure. Col may be the string +# "all" in which case we select all cols in the table, otherwise may sure +# selection is unique. + +proc tableSelectCol { tab col } { + global tabSelected tabOption tabNcols + + set color $tabOption(${tab},HighlightColor) + if {$col == "all"} { + for {set i 0} {$i < $tabNcols(${tab},data)} {incr i} { + set index [lsearch $tabSelected(${tab},Col) $col ] + if {$index < 0} { + lappend tabSelected(${tab},Col) $i + tableSetColAttr ${tab} $i background $color + tableSetColAttr ${tab}Col $i background $color + } + } + } else { + set index [lsearch $tabSelected(${tab},Col) $col ] + if {$index < 0} { + lappend tabSelected(${tab},Col) $col + tableSetRowAttr ${tab} $col background $color + tableSetRowAttr ${tab}Col $col background $color + } + } +} + + +# TABLESELECTCELL -- User-callable cell selection procedure + +proc tableSelectCell { tab col row } { + global tabSelected tabOption + + set color $tabOption(${tab},HighlightColor) + set index [lsearch $tabSelected(${tab},Col) [list $row $col] ] + if {$index < 0} { + lappend tabSelected(${tab},Cell) [list $row $col] + tableSetCellAttr ${tab} $row $col background $color + } +} + + +# TABLEUNSELECTROW -- Deselect the specified row. + +proc tableUnSelectRow { tab row } { + global tabSelected tabOption tabNrows + + set color $tabOption(${tab},Background) + if {$row == "all"} { + for {set i 0} {$i < $tabNrows(${tab},data)} {incr i} { + set index [lsearch $tabSelected(${tab},Row) $i ] + if {$index >= 0} { + set tabSelected(${tab},Row) \ + [ lreplace $tabSelected(${tab},Row) $index $index ] + tableSetRowAttr ${tab} $i background $color + tableSetRowAttr ${tab}Row $i background $color + } + } + } else { + # Delete it from the list. + set index [lsearch $tabSelected(${tab},Row) $row ] + if {$index >= 0} { + set tabSelected(${tab},Row) \ + [ lreplace $tabSelected(${tab},Row) $index $index ] + tableSetRowAttr ${tab} $row background $color + tableSetRowAttr ${tab}Row $row background $color + } + } +} + + +# TABLEUNSELECTCOL -- Deselect the specified col. + +proc tableUnSelectCol { tab col } { + global tabSelected tabOption tabNrows + + set color $tabOption(${tab},Background) + if {$col == "all"} { + for {set i 0} {$i < $tabNcols(${tab},data)} {incr i} { + set index [lsearch $tabSelected(${tab},Col) $i ] + if {$index >= 0} { + set tabSelected(${tab},Col) \ + [ lreplace $tabSelected(${tab},Col) $index $index ] + tableSetColAttr ${tab} $i background $color + tableSetColAttr ${tab}Col $i background $color + } + } + } else { + # Delete it from the list. + set index [lsearch $tabSelected(${tab},Col) $col ] + if {$index >= 0} { + set tabSelected(${tab},Col) \ + [ lreplace $tabSelected(${tab},Col) $index $index ] + tableSetColAttr ${tab} $col background $color + tableSetColAttr ${tab}Col $col background $color + } + } +} + + +# TABLEUNSELECTCELL -- Deselect the specified cell. + +proc tableUnSelectCell { tab col row } { + global tabSelected tabOption + + set val [list $row $col] + set index [lsearch $tabSelected(${tab},Cell) $val ] + set color $tabOption(${tab},Background) + + # Delete it from the list. + if {$index >= 0} { + set tabSelected(${tab},Cell) \ + [ lreplace $tabSelected(${tab},Cell) $index $index ] + tableSetCellAttr ${tab} $row $col background $color + } +} + + + +#============================================================================== +# TABLEDIT -- Enable the cell editor +#============================================================================== + +set tabEditRow 0 +set tabEditCol 0 +set tabEditValue "" + +set tableEditorUp 0 + +proc tableEdit { name x y } { + global tabEditValue tabEditRow tabEditCol tableEditCB, tableEditorUp + + regsub Tab $name "" tab + + set ry [tablePos2CellY $tab $y] + set rx [tablePos2CellX $tab $x] + + if {$rx < 0 || $ry < 0} \ + return + + set newcell 0 + if {$tabEditRow != $rx || $tabEditCol != $ry} { + set newcell 1 + } + + set tabEditCol [tablePos2CellX $tab $x] + set tabEditRow [tablePos2CellY $tab $y] + set tabEditValue [tableGetCellAttr $tab $tabEditRow $tabEditCol label] + + if {$tableEditorUp == 0 || $newcell == 1} { + send ${tab}EditApply addCallback tableEditApply + send ${tab}EditCancel addCallback tableEditCancel + send ${tab}EditClear addCallback tableEditClear + send ${tab}EditText addCallback tableEditLoad + send ${tab}EditText set string $tabEditValue + send ${tab}EditShell move $x [expr ($y + 50)] + send ${tab}EditShell map + set tableEditorUp 1 + } else { + send ${tab}EditApply deleteCallback tableEditApply + send ${tab}EditCancel deleteCallback tableEditCancel + send ${tab}EditClear deleteCallback tableEditClear + send ${tab}EditText deleteCallback tableEditLoad + send ${tab}EditShell unmap + set tableEditorUp 0 + } +} + +proc tableEditApply { button args } { + global tabEditValue tabEditRow tabEditCol tabEditCB tabEditorUp + regsub EditApply $button "" tab + + set str [send ${tab}EditText get string] + + tableSetCellAttr $tab $tabEditRow $tabEditCol label $str + set tabEditValue $str + + # Now do the user-defined selection callbacks. + if { [llength $tabEditCB(${tab})] > 0} { + foreach cb $tabEditCB(${tab}) {$cb $tab $tabEditRow $tabEditCol "$str"} + } + + # Close the window. + send ${tab}EditApply deleteCallback tableEditApply + send ${tab}EditCancel deleteCallback tableEditCancel + send ${tab}EditClear deleteCallback tableEditClear + send ${tab}EditText deleteCallback tableEditLoad + send ${tab}EditShell unmap + set tableEditorUp 0 +} + +proc tableEditLoad { widget mode pattern args } { + regsub EditText $widget "" tab + tableEditApply ${tab}EditApply +} + +proc tableEditClear { button args } { + global tabEditValue + + regsub EditClear $button "" tab + send ${tab}EditText set string "" +} + +proc tableEditCancel { button args } { + global tableEditValue tableEditorUp + + regsub EditCancel $button "" tab + send ${tab}EditShell unmap + send ${tab}EditApply deleteCallback tableEditApply + send ${tab}EditCancel deleteCallback tableEditCancel + send ${tab}EditClear deleteCallback tableEditClear + send ${tab}EditText deleteCallback tableEditLoad + set tableEditorUp 0 +} + + +############################################################################### +# +# Private Procedures +# +############################################################################### + + +# TABLEADDCALLBACKS -- Add the default widget callbacks. + +proc tableAddCallbacks { tab } { + + # Attach the scrollbars actions. + if {[ tableOption $tab RowScroll] == "yes"} { + send ${tab}RowScroll addCallback tableJumpScroll + } else { + send ${tab}RowScroll "unmap ; set width 0" + } + + if {[ tableOption $tab ColScroll] == "yes"} { + send ${tab}ColScroll addCallback tableJumpScroll + } else { + send ${tab}Label set height 0 + send ${tab}ColScroll "unmap ; set height 0" + } + + if {[tableOption $tab Tracking] == "no"} { + send ${tab}Label set label "" + send ${tab}Label set width 50 + } + + # Setup a resize handler that will adjust the scrollbars/viewports. + send ${tab}TableFrame addEventHandler tableResizeHandler structureNotifyMask +} + + +# TABLERESIZEHANDLER -- Resize callbacks, called as an eventHandler when +# the parent window or the table meta-widget changes size. All we need to +# do here is reset the scrollbars to reflect the new size. + +proc tableResizeHandler { table args } { + regsub TableFrame $table "" tab + #tableSetDefaultScrollbars $tab no + tableSetDefaultScrollbars $tab yes +} + + +# TABLETRACK -- Track the motion in the table. + +proc tableTrack { name x y } { + regsub Tab $name "" tab + if {[ tableOption $tab Tracking] == "no"} { + return + } + + set nr [tableGetNrows $tab] + set nc [tableGetNcols $tab] + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + if {$col < 0 || $row < 0} { + send ${tab}Label set label " " + } else { + send ${tab}Label set label [ format "(%3d,%3d)" $row $col ] + } +} + + +# TABLESELECT -- Do the default selection callback which applies to rows, +# columns and cells. + +proc tableSelect { name type x y } { + global tabOption tabSelected tabSelectionCB tabUnSelectionCB + + + regsub Row $name "" rc + regsub Col $name "" cc + + if {$type == "Row"} { + if {$rc == $name || [ tableOption $name RowSelect ] == "no"} \ + return + regsub ${type}Tab $name "" tab + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + set val $row + } elseif {$type == "Col"} { + if {$cc == $name || [ tableOption $name ColSelect ] == "no"} \ + return + regsub ${type}Tab $name "" tab + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + set val $col + } elseif {$type == "Cell"} { + if {$rc != $name && $cc != $name} \ + return + if {[ tableOption $name CellSelect ] == "no"} \ + return + regsub Tab $name "" tab + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + set val [list $row $col] + } + + if {$col < 0 || $row < 0} \ + return + + set index [ lsearch $tabSelected(${tab},${type}) $val ] + set color $tabOption(${tab},HighlightColor) + + # If we're doing a radio selection, turn off anything already selected. + + if {[ tableOption $tab ${type}MultiSelect] == "no"} { + if { [llength $tabSelected(${tab},${type})] == 1} { + tableSet${type}Attr ${tab} \ + [lindex $tabSelected(${tab},${type}) 0] \ + background $tabOption(${tab},Background) + tableSet${type}Attr ${tab}${type} \ + [lindex $tabSelected(${tab},${type}) 0] \ + background $tabOption(${tab},Background) + + # Now do the user-defined un-selection callbacks. + if { [llength $tabUnSelectionCB(${tab},${type})] > 0} { + foreach cb $tabUnSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 0 + } + } + + set tabSelected(${tab},${type}) [list $val ] + + if {$type == "Row"} { + foreach c $tabSelected(${tab},Col) { + tableSetColAttr ${tab} $c background $color + } + } elseif {$type == "Col"} { + foreach c $tabSelected(${tab},Row) { + tableSetRowAttr ${tab} $c background $color + } + } + } else { + lappend tabSelected(${tab},${type}) $val + } + } else { + if { $index < 0} { + lappend tabSelected(${tab},${type}) $val + } + } + + # If this has already been selected, toggle it. + if { $index >= 0} { + if {$type != "Cell"} { + tableSet${type}Attr ${tab} \ + [lindex $tabSelected(${tab},${type}) $index] \ + background $tabOption(${tab},Background) + tableSet${type}Attr ${tab}${type} \ + [lindex $tabSelected(${tab},${type}) $index] \ + background $tabOption(${tab},Background) + + # Now do the user-defined un-selection callbacks. + if { [llength $tabUnSelectionCB(${tab},${type})] > 0} { + foreach cb $tabUnSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 0 + } + } + + } else { + tableSet${type}Attr ${tab} \ + $row $col background $tabOption(${tab},Background) + + # Now do the user-defined selection callbacks. + if { [llength $tabUnSelectionCB(${tab},${type})] > 0} { + foreach cb $tabUnSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 0 + } + } + } + + # Delete it from the list + set tabSelected(${tab},${type}) \ + [ lreplace $tabSelected(${tab},${type}) $index $index ] + + # Go back and re-select the row/col intersection but don't + # generate an event for it, purely cosmetic. + if {$type == "Row"} { + foreach c $tabSelected(${tab},Col) { + tableSetColAttr ${tab} $c background $color + } + } elseif {$type == "Col"} { + foreach c $tabSelected(${tab},Row) { + tableSetRowAttr ${tab} $c background $color + } + } + + } else { + + # Highlight the selected item. + if {$type != "Cell"} { + tableSet${type}Attr ${tab} $val background $color + tableSet${type}Attr ${tab}${type} $val background $color + } else { + tableSet${type}Attr ${tab} $row $col background $color + } + + # Now do the user-defined selection callbacks. + if { [llength $tabSelectionCB(${tab},${type})] > 0} { + foreach cb $tabSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 1 + } + } + } +} + + +# TABLESETDEFAULTLABELS -- Set the default labels for the table, i.e. letters +# for columns headings and numbers for the row labels. +# +# Usage: +# tableSetDefaultLabels <tab> + +proc tableSetDefaultLabels { tab } { + # Set the default Row labels, i.e numbers + tableSetDefaultRowLabels $tab + + # Now set the default Column Labels, i.e. letters + tableSetDefaultColLabels $tab +} + + +# TABLESETDEFAULTTRANSLATIONS -- Set the default translations for the widget. + +proc tableSetDefaultTranslations { tab } { + + if {[ tableOption $tab DefaultTranslations ] == "no"} { + return + } + + # Set the coord tracking translations. + set trans1 "" + if {[ tableOption $tab Tracking ] == "yes"} { + set trans1 { \ + <Motion>:call(tableTrack,$name,$x,$y) + } + } + + set trans2 "" + if {[ tableOption $tab CellSelect ] == "yes"} { + set trans2 { \ + <Btn1Down>:call(tableSelect,$name,Cell,$x,$y) + } + } + + set trans3 "" + if {[ tableOption $tab Editable ] == "yes"} { + set trans3 { \ + <Btn3Down>:call(tableEdit,$name,$x,$y) + } + } + set trans "$trans1 $trans2 $trans3" + send ${tab}Tab set translations $trans + + + # Set the row-selectable translations. + if {[ tableOption $tab RowSelect ] == "yes"} { + send ${tab}RowTab set translations \ + "<Btn1Down>: call(tableSelect,\$name,Row,\$x,\$y)" + } + + # Set the col-selectable translations. + if {[ tableOption $tab ColSelect ] == "yes"} { + send ${tab}ColTab set translations \ + "<Btn1Down>: call(tableSelect,\$name,Col,\$x,\$y)" + } +} + + +# TABLESETDEFAULTSCROLLBARS -- Set the default scrollbar position and size +# in the meta-widget. + +proc tableSetDefaultScrollbars { tab init } { + global tabHeight tabWidth tabScrollSize tabScrollPos tabDebug + global tabNcols tabNrows tabColWidths + + + set visW [ send ${tab}TabView get width] + set visH [ send ${tab}TabView get height] + set rh [ send ${tab}Tab get rowHeight] + set sw [ send ${tab}Tab get shadowWidth] + set th [expr ($tabNrows(${tab},data) * ($rh + (2 * $sw)) )] + set tw 0 + for {set i 1} {$i <= $tabNcols(${tab},data)} {incr i} { + set w $tabColWidths(${tab},$i) + set tw [ expr ($tw + $w + (2 * $sw)) ] + } + set rowS [max 0.0 [min 1.0 [expr (double($visH)/double($th)) ]]] + set colS [max 0.0 [min 1.0 [expr (double($visW)/double($tw)) ]]] +#print "defScroll: data visW=$visW visH=$visH th=$th tw=$tw" +#print "defScroll: ($tab,$init) rowS = $rowS colS = $colS" + + set tabScrollSize($tab,row) $rowS + set tabScrollSize($tab,col) $colS + set tabScrollPos($tab,row) 0.0 + set tabScrollPos($tab,col) 0.0 + + if {[ tableOption $tab RowScroll] == "yes"} { + send ${tab}RowScroll setScrollbar 0.0 $tabScrollSize($tab,row) + } + if {[ tableOption $tab ColScroll] == "yes"} { + send ${tab}ColScroll setScrollbar 0.0 $tabScrollSize($tab,col) + } + + if {$init == "yes"} { + send ${tab}TabView setLocation 0.0 0.0 + send ${tab}ColTabView setLocation 0.0 0.0 + send ${tab}RowTabView setLocation 0.0 0.0 + } +} + + +# TABLEJUMPSCROLL -- Scroll the specified table. This scrolls both the +# data and row/column label tables. + +proc tableJumpScroll { widget cbtype pos } { + global scrollHeight tabWidth tabHeight tabDebug + global tabScrollSize tabScrollPos tabDebug + + if {$pos < 0.01} { + set pos 0.0 + } + + if { [string match *ColScroll $widget] } { + regsub ColScroll $widget "" tab + set y $tabScrollPos($tab,row) + send ${tab}TabView setLocation $pos $y + send ${tab}ColTabView setLocation $pos 0.0 + set tabScrollPos($tab,col) $pos + + } elseif { [string match *RowScroll $widget] } { + regsub RowScroll $widget "" tab + set x $tabScrollPos($tab,col) + send ${tab}TabView setLocation $x $pos + send ${tab}RowTabView setLocation 0.0 $pos + set tabScrollPos($tab,row) $pos + } +} + + +# TABLEOPTION -- Return any defined table option. + +proc tableOption { tab option } { + global tabOption + + set val yes + catch { + if {[info exists tabOption(${tab},${option}) ]} { + if { $tabOption(${tab},${option}) } { + set val yes + } else { + set val no + } + } + } err + + return $val +} + + +# TABLEPOS2CELLX -- Convert a widget position to a cell column number. + +proc tablePos2CellX { tab x } { + global tabColWidths tabNcols + + set nc [ tableGetNcols $tab ] + set cellX 1 + for {set w 0} {$w < $x && $cellX <= $nc} {incr cellX} { + set w [ expr ($w + $tabColWidths($tab,$cellX) + 3) ] + } + if {$x > $w} { + return -1 + } else { + return [ min [incr cellX -1] $tabNcols(${tab},data) ] + } +} + +# TABLEPOS2CELLY -- Convert a widget position to a cell row number. + +proc tablePos2CellY { tab y } { + global tabRowHeights tabNrows + + set nr [ tableGetNrows $tab ] + set cellY 1 + for {set h 0} {$h < $y && $cellY <= $nr} {incr cellY} { + set h [ expr ($h + $tabRowHeights($tab,$cellY)) + 2 ] + } + if {$y > $h} { + return -1 + } else { + return [ min [incr cellY -1] $tabNrows(${tab},data) ] + } +} + + +# TABLESETDEFAULTROWLABELS -- Utility to set the default row labels. + +proc tableSetDefaultRowLabels { tab args } { + global tabNrows tabOption + + # Set the default Row labels, i.e numbers + set rowlabs {} + for {set i 1} {$i <= $tabNrows(${tab},data)} {incr i} { + if {[ tableOption $tab DefLabels ] == "yes"} { + lappend rowlabs $i + } else { + lappend rowlabs {} + } + } + if {[ tableOption $tab RowLabels ] == "yes"} { + send ${tab}RowTab setTable $tabNrows(${tab},data) \ + $tabOption(${tab},RowLabelCols) $rowlabs + set cw [send ${tab}RowTab get defaultWidth] + send ${tab}RowTabView set width \ + [expr ($tabOption(${tab},RowLabelCols) * $cw)] + } else { + send ${tab}RowTab set width 0 + } +} + + +# TABLESETDEFAULTCOLLABELS -- Utility to set the default columns labels. + +proc tableSetDefaultColLabels { tab args } { + global tabNcols tabOption + + # Now set the default Column Labels, i.e. letters + set collabs "" + set j 65 + for {set i 1} {$i <= $tabNcols(${tab},data)} {incr i} { + if {[ tableOption $tab DefLabels ] == "yes"} { + if {$j > 90} { + set j 97 + set collabs [ format "%s { %c } " $collabs $j ] + } elseif {$j > 122} { + set j 1 + set collabs [ format "%s { %d } " $collabs $j ] + } else { + set collabs [ format "%s { %c } " $collabs $j ] + } + incr j + } else { + lappend collabs {} + } + } + if {[ tableOption $tab ColLabels ] == "yes"} { + send ${tab}ColTab setTable $tabOption(${tab},ColLabelRows) \ + $tabNcols(${tab},data) [ list $collabs ] + send ${tab}ColTabView set height \ + [expr ($tabOption(${tab},ColLabelRows) * 21)] + send ${tab}Spacer1 set height \ + [expr ($tabOption(${tab},ColLabelRows) * 24)] + send ${tab}Spacer2 set height \ + [expr ($tabOption(${tab},ColLabelRows) * 24)] + } else { + send ${tab}ColTab set height 0 + } +} + + +################################################################################ + + +################################################################################ + + + +activate + + +appExtend { + *tclObjects:\ + toplevel TopLevelShell tcl_panel\ + tcl_panel Layout tclLayout\ + tclLayout Group tclCmdGroup\ + tclCmdGroup Layout tclCmd\ + tclCmd Command tclClear\ + tclCmd Command tclExecute\ + tclCmd Command tclDismiss\ + tclLayout Frame tclFrame\ + tclFrame AsciiText tclEntry + + + !-------------------------------- + ! Define a debug Tcl shell. + !-------------------------------- + *tcl_panel.width: 550 + *tcl_panel.height: 180 + *tcl_panel.title: Debug TCL Command Entry + *tclLayout*borderWidth: 0 + *tclLayout*shrinkToFit: True + *tclLayout*Frame.frameType: sunken + *tclLayout*Frame.frameWidth: 2 + *tclLayout.layout: vertical { \ + tclCmdGroup < +inf -inf * > \ + tclFrame < +inf -inf * +inf -inf> \ + } + *tclEntry*foreground: black + *tclEntry*editType: edit + *tclEntry*type: string + *tclEntry*font: 7x13 + *tclEntry*scrollVertical: Always + *tclEntry*scrollHorizontal: whenNeeded + + *tclCmdGroup.label: + *tclCmdGroup.outerOffset: 0 + *tclCmdGroup.innerOffset: 0 + *tclCmd.layout: vertical { \ + 5 \ + horizontal { 5 tclClear 3 tclExecute 10 < +inf -10> tclDismiss 5 } \ + 5 \ + } + *tclClear.label: Clear + *tclExecute.label: Execute + *tclDismiss.label: Dismiss + +} ; createObjects tclObjects + + + +################################################ +# Define some TCL debug procedures. +################################################ + +proc tclCommandClear {widget args} { + send tclEntry set string "" +} ; send tclClear addCallback tclCommandClear + +proc tclCommandExecute {widget args} { + send server [send tclEntry {get string}] +} ; send tclExecute addCallback tclCommandExecute + +proc tclCommand {widget mode command args} { + send server $command +} ; send tclEntry addCallback tclCommand + +proc tclClose {widget args} { + send tcl_panel unmap +} ; send tclDismiss addCallback tclClose + +send tclShell addCallback "send tcl_panel map" + diff --git a/vendor/x11iraf/guidemo/table.gui.bak b/vendor/x11iraf/guidemo/table.gui.bak new file mode 100644 index 00000000..825582d5 --- /dev/null +++ b/vendor/x11iraf/guidemo/table.gui.bak @@ -0,0 +1,1682 @@ +# TABDEMO.GUI -- Test the Table widget. + +reset-server +appInitialize tabdemo Tabdemo { + + *demoObjects:\ + toplevel Layout panel \ + panel Frame panelMenuFrame \ + panelMenuFrame Layout panelMenuBar \ + panelMenuBar Command newCol \ + panelMenuBar Command newRow \ + panelMenuBar Command newTable \ + panelMenuBar Command tclShell \ + panelMenuBar Command quitButton + + + Tabdemo*background: grey + *Tabdemo.geometry: +0+0 + + *Group.shrinkToFit: True + *Command.height: 28 + *Command.shadowWidth: 1 + *Frame.frameWidth: 1 + *Frame.innerOffset: 4 + *Frame.highlightThickness: 0 + *borderWidth: 0 + *Scrollbar2.location: 0 0 17 17 + *Scrollbar.beNiceToColormap: False + + *panel.width: 600 + *panel.height: 350 + *panel.layout: vertical { \ + panelMenuFrame < +inf -inf * > \ + 5 < +inf > horizontal { 5 < +inf > }\ + } + + *panelMenuBar.layout: horizontal { \ + 2 newRow 1 newCol 1 newTable 1 tclShell 2 < +inf > quitButton 2 \ + } + *newCol.label: New Col + *newRow.label: New Row + *newTable.label: New Table + *tclShell.label: TclShell + *quitButton.label: Quit + +} ; createObjects demoObjects + +send quitButton addCallback "send client gkey q ; deactivate unmap" + +# Utility procedure to test True/False strings in resources. +proc true {v} {expr {$v == "true" || $v == "True" || $v == "TRUE"}} + +# Utility functions. +proc min {a b} { expr {($a < $b) ? $a : $b} } +proc max {a b} { expr {($a > $b) ? $a : $b} } + +# Create the Table objects in the OBM. + +set tabnumber 0 ;# initialize table counter + +proc doTable args { + global tabnumber + + set tab [ format "tab%d" $tabnumber ] + set objs [ tableBuildObjects panel $tab ] + +# tableSetOption $tab DefLabels no +# tableSetOption $tab RowLabels no +# tableSetOption $tab ColLabels no +# tableSetOption $tab Tracking no +# tableSetOption $tab RowScroll no +# tableSetOption $tab ColScroll no +# tableSetOption $tab DefaultTranslations no + tableSetOption $tab RowMultiSelect no + tableSetOption $tab ColMultiSelect no +# tableSetOption $tab RowLabelCols 2 +# tableSetOption $tab ColLabelRows 2 + tableSetOption $tab Background bisque3 + + # Now create the new objects. + appExtend $objs + createObjects ${tab}Objects + + # Now construct a layout for the new object. + set new "" + set panStart "vertical \{ panelMenuFrame < +inf -inf * > 5 < -5 >" + for {set i 0} {$i <= $tabnumber} {incr i} { + + # Send the existing table a small height so they'll ajust to + # fit the new table. + if {$i < $tabnumber} { send tab${i}TableFrame set height 10 } + + # Append a layout spec for the table. + set new \ + [format "%s tab%dTableFrame < +inf -inf * +inf -inf > 5 < -5 >" \ + $new $i] + } + set panEnd "\}" + set panelLayout [format "%s %s %s" $panStart $new $panEnd] + + # Send the panel the new layout incorporating the newly created Table. + send panel set layout $panelLayout + + # Now create the table itself, it should appear as if by magic. + tableCreate $tab 12 30 { } + + # Apply some default test callbacks for selection/edit events. + tableAddSelectCallback $tab Row demoSelCB + tableAddSelectCallback $tab Col demoSelCB + tableAddSelectCallback $tab Cell demoSelCB + tableAddUnSelectCallback $tab Row demoUnSelCB + tableAddUnSelectCallback $tab Col demoUnSelCB + tableAddUnSelectCallback $tab Cell demoUnSelCB + tableAddEditCallback $tab demoEditCB + + # Increment the global table counter. + incr tabnumber + +} ; send newTable addCallback doTable + +proc demoSelCB { name row col x y args } { + print "demoSelCB: name=$name r=$row c=$col x=$x y=$y args='$args'" +} + +proc demoUnSelCB { name row col x y args } { + print "demoUnSelCB: name=$name r=$row c=$col x=$x y=$y args='$args'" +} + +proc demoEditCB { name row col str args } { + print "demoEditCB: name=$name row=$row col=$col str='$str' args='$args'" +} + + +################################################################################ + + +################################################################################ +# +# TABLE WIDGET PROCEDURES -- This interface provides simple access to a +# named instance of a Table "meta-widget". The "widget" is actually a +# number of widgets (Table, Scrollbars, etc) in a common layout to provide +# row/col headings, scrollable data tables, and callbacks for [gs]etting +# attributes. The meta-widget is created on-the-fly with a given named +# and parent object, it is the callers responsibility to adjust the layout +# of the parent to incorporate the new objects. +# +# The Table widget itself has various quirks and non-standard implem- +# entations so features such as editing cells or access to certain callbacks +# are not fully implemented in the OBM and hidden here. Most of what's +# needed can be handled by these procedures, however these routines may be +# used to manage multiple named tables in a GUI. +# +# +# tableBuildObjects parent tab +# tableSetOption tab option value +# tableAddSelectCallback tab type cbname +# tableAddEditCallback tab cbname +# tableDestroyObjects tab +# +# tableCreate tab nrows ncols data +# tableSetData tab data +# tableSetColumnLabels tab labels +# tableSetRowLabels tab labels +# +# list = tableGetSelected tab type +# +# tableSetRowLabelsAttr tab attr value +# value = tableGetRowLabelsAttr tab attr +# tableSetColLabelsAttr tab attr value +# value = tableGetColLabelsAttr tab attr +# tableSetRowLabelAttr tab row attr value +# value = tableGetRowLabelAttr tab row attr +# tableSetColLabelAttr tab col attr value +# value = tableGetColLabelAttr tab col attr +# +# attr = tableGetCelllAttr tab row col attr +# tableSetCelllAttr tab row col attr value +# value = tableGetRowAttr tab row attr +# tableSetRowAttr tab row attr value +# value = tableGetColAttr tab col attr +# tableSetColAttr tab col attr value +# +# tableDeleteCol tab col +# tableDeleteRow tab row +# tableAddCol tab col width [where] +# tableAddRow tab row [where] +# +# nrows = tableGetNrows tab +# ncols = tableGetNcols tab +# height = tableGetHeight tab +# width = tableGetWidth tab +# +# See obm$widget.c for a complete list of the OBM commands available +# for this widget, and procedure header comments for details about the +# interface here. +# +################################################################################ + +set tabNrows(nmname 0 +set tabNcols(name) 0 +set tabData(name) 0 +set tabColLabs(name) 0 +set tabRowHeights(name,j) 0 +set tabColWidths(name,i) 0 + +set tabHeight(name) 0 +set tabWidth(name) 0 +set tabScrollSize(name,type) 0 +set tabScrollPos(name,type) 0 + +# Meta-widget options, should be set before the tableCreate call. +set tabOption(name,RowLabels) yes +set tabOption(name,ColLabels) yes +set tabOption(name,DefLabels) yes +set tabOption(name,Tracking) yes +set tabOption(name,RowScroll) yes +set tabOption(name,ColScroll) yes +set tabOption(name,Editable) yes +set tabOption(name,RowSelect) yes +set tabOption(name,ColSelect) no +set tabOption(name,CellSelect) no +set tabOption(name,DefaultTranslations) yes +set tabOption(name,Background) grey +set tabOption(name,Foreground) black +set tabOption(name,HighlightColor) grey90 +set tabOption(name,RowLabelCols) 1 +set tabOption(name,ColLabelRows) 1 + +# Selection lists. +set tabSelected(name,Row) {} +set tabSelected(name,Col) {} +set tabSelected(name,Cell) {} +set tabSelectionCB(name,Row) {} +set tabSelectionCB(name,Col) {} +set tabSelectionCB(name,Cell) {} +set tabUnSelectionCB(name,Row) {} +set tabUnSelectionCB(name,Col) {} +set tabUnSelectionCB(name,Cell) {} +set tabEditCB(name) {} + + +# TABLEBUILDOBJECTS -- Utility routine to build the object list for the meta- +# widget. +# +# Usage: +# tableBuildObjects <parent> <tab> + +proc tableBuildObjects { parent tab } { + + set objDef { + *TABObjects: \ + PARENT Frame TABTableFrame \ + TABTableFrame Layout TABFrameLayout \ + TABFrameLayout Layout TABTableLayout \ + TABTableLayout Viewport TABTabView \ + TABTabView Table TABTab \ + TABTableLayout Label TABSpacer \ + TABTableLayout Viewport TABRowTabView \ + TABRowTabView Table TABRowTab \ + TABTableLayout Viewport TABColTabView \ + TABColTabView Table TABColTab \ + TABFrameLayout Label TABLabel \ + TABFrameLayout Scrollbar TABColScroll \ + TABFrameLayout Scrollbar TABRowScroll \ +\ + toplevel TopLevelShell TABEditShell \ + TABEditShell Layout TABEditLayout \ + TABEditLayout Frame TABEditMenuFrame\ + TABEditMenuFrame Layout TABEditMenuBar \ + TABEditMenuBar Command TABEditApply \ + TABEditMenuBar Command TABEditClear \ + TABEditMenuBar Command TABEditCancel \ + TABEditLayout Frame TABEditFrame \ + TABEditFrame AsciiText TABEditText \ + + + + + ! Global Table widget resources. + *Table.literalWidth: 20 + *Table.rowHeight: 20 + *Table.shadowWidth: 1 + *Table.labelShadowWidth: 1 + *Table.tableMargin: 0 + *Table.columnMargin: 0 + *Table.rowMargin: 0 + *Table.internalHeight: 1 + *Table.internalWidth: 1 + + *TABTableFrame*Group.shrinkToFit: True + *TABTableFrame*Command.height: 28 + *TABTableFrame*Command.shadowWidth: 1 + *TABTableFrame*Frame.frameWidth: 1 + *TABTableFrame*Frame.innerOffset: 4 + *TABTableFrame*Frame.highlightThickness: 0 + *TABTableFrame*Frame.borderWidth: 0 + *TABTableFrame*Frame.shrinkToFit: True + *TABTableFrame*Table.borderWidth: 1 + *TABTableFrame*Scrollbar.beNiceToColormap: False + + *TABTableFrame.height: 10 + *TABTableFrame.width: 10 + *TABTableFrame*Layout.height: 10 + *TABTableFrame*Layout.width: 10 + *TABTableFrame*Label.height: 15 + *TABTableFrame*Label.label: + + *TABFrameLayout.TABTableLayout.height: 10 + *TABFrameLayout.TABTableLayout.width: 10 + *TABFrameLayout.TABTableLayout*Layout.height: 10 + *TABFrameLayout.TABTableLayout*Layout.width: 10 + *TABFrameLayout.TABTableLayout*Viewport.height: 20 + *TABFrameLayout.TABTableLayout*Viewport.width: 20 + *TABFrameLayout.TABTableLayout*Table.height: 20 + *TABFrameLayout.TABTableLayout*Table.width: 20 + + + ! The following resources enable the scrollbars on the Viewport + ! widget but effectively hide them from display. This allows us + ! to control the viewport manually from the Table code, e.g. to + ! scroll both the column headings and data table. + *TABFrameLayout.TABTableLayout*Viewport.allowVert: True + *TABFrameLayout.TABTableLayout*Viewport.allowHoriz: True + *TABFrameLayout.TABTableLayout*Viewport.forceBars: True + *TABFrameLayout.TABTableLayout*Viewport.useBottom: True + *TABFrameLayout.TABTableLayout*Viewport.useRight: True + *TABFrameLayout.TABTableLayout*Viewport.borderWidth: 1 + + *TABTableLayout*TABRowTabView*vertical.thickness: 1 + *TABTableLayout*TABRowTabView*horizontal.thickness: 1 + *TABTableLayout*TABColTabView*vertical.thickness: 1 + *TABTableLayout*TABColTabView*horizontal.thickness: 1 + *TABTableLayout*TABTabView*vertical.thickness: 1 + *TABTableLayout*TABTabView*horizontal.thickness: 1 + + *TABTableFrame.TABFrameLayout.TABRowScroll.thickness: 15 + *TABTableFrame.TABFrameLayout.TABRowScroll.width: 15 + *TABTableFrame.TABFrameLayout.TABRowScroll.height: 15 + *TABTableFrame.TABFrameLayout.TABRowScroll.orientation: Vertical + + *TABTableFrame.TABFrameLayout.TABColScroll.thickness: 15 + *TABTableFrame.TABFrameLayout.TABColScroll.width: 15 + *TABTableFrame.TABFrameLayout.TABColScroll.height: 15 + *TABTableFrame.TABFrameLayout.TABColScroll.orientation: Horizontal + + *TABFrameLayout.layout: horizontal { \ + vertical { \ + 2 < -2 > \ + TABTableLayout < +inf -inf * +inf -inf > \ + 2 < -2 > \ + horizontal { \ + TABLabel 1 < -1 > TABColScroll < +inf -inf * > \ + } \ + } \ + vertical { \ + 27 < -27 > TABRowScroll < * +inf -inf > 20 < -20 > \ + } \ + } + *TABTableFrame.TABFrameLayout.TABLabel.label: ( 0, 0) + *TABTableFrame.TABFrameLayout.TABLabel.width: 80 + + *TABTableLayout.layout: horizontal { \ + vertical { \ + TABSpacer 1 < -1 > TABRowTabView < * +inf -inf > \ + } \ + 3 < -3 > \ + vertical { \ + TABColTabView < +inf -inf * > \ + 3 < -3 > \ + TABTabView < +inf -inf * +inf -inf > \ + } \ + 3 < -3 > \ + } + *TABSpacer.height: 24 + + !---------------------------+ + ! Set the editor resources. | + !---------------------------+ + *TABEditShell.title: Table Value Editor + *TABEditShell.width: 275 + *TABEditShell.height: 80 + *TABEditLayout*borderWidth: 0 + *TABEditLayout.layout: vertical { \ + TABEditFrame < +inf -inf * +inf -inf > \ + -2 \ + TABEditMenuFrame < +inf -inf * > \ + -2 \ + } + + *TABEditMenuBar.layout: horizontal { \ + TABEditApply 5 \ + 10 < +inf -inf > \ + TABEditClear 5 \ + 10 < +inf -inf > \ + TABEditCancel 5 \ + } + *TABEditMenuFrame.height: 80 + *TABEditMenuFrame.outerOffset: 0 + *TABEditMenuFrame.innerOffset: 5 + *TABEditMenuFrame.frameType: chiseled + *TABEditMenuFrame.frameWidth: 2 + *TABEditFrame.frameType: sunken + *TABEditFrame.frameWidth: 2 + *TABEditFrame.outerOffset: 5 + *TABEditText*scrollVertical: never + *TABEditText*scrollHorizontal: whenNeeded + *TABEditText*font: 7x13 + *TABEditText*editType: edit + *TABEditApply.label: Apply + *TABEditApply.width: 150 + *TABEditClear.label: Clear + *TABEditClear.width: 150 + *TABEditCancel.label: Cancel + *TABEditCancel.width: 150 + + } + + regsub -all TAB $objDef $tab tmp1 + regsub -all PARENT $tmp1 $parent objs + set objs [format "{ %s }" $objs] + + return $objs +} + + +# TABLEDESTROYOBJECTS -- Destroy the specified table and all it's objects. +# +# Usage: +# tableDestroyObjects <tab> + +proc tableDestroyObjects { tab } { + destroyObject ${tab}TableFrame +} + + +# TABESETOPTION -- Set an option for the Table meta-widget. +# +# Usage: +# tableSetOption <tab> <option> [yes|no] +# +# where <tab> is the table name given when the meta-widget was created, and +# <option> is one of: +# +# +# Option Name Type Default Description +# ----------- ---- ------- ----------- +# RowLabels bool yes display a row label table +# ColLabels bool yes display a column label table +# DefLabels bool yes do default labels of rows/cols +# Tracking bool yes do coord tracking in data table +# RowScroll bool yes display row scrollbar +# ColScroll bool yes display column scrollbar +# Editable bool yes table is editable +# RowSelect bool yes rows are selectable +# ColSelect bool yes cols are selectable +# CellSelect bool yes cells are selectable +# RowMultiSelect bool yes multiple rows may be selected +# ColMultiSelect bool yes multiple cols may be selected +# CellMultiSelect bool yes multiple cells may be selected +# DefaultTranslations bool yes use default table translations +# Foreground color black meta-widget foreground color +# Background color grey meta-widget background color +# HighlightColor color grey90 selected item highlight color +# RowLabelCols int 1 number of columns in row labels +# ColLabelRows int 1 number of rows in column labels +# + +proc tableSetOption { tab option value } { + global tabOption + set tabOption(${tab},${option}) $value +} + + +# TABLEADDSELECTCALLBACK -- Add a user-defined callback to be executed +# when there is a row, column, or cell selection event occurs. +# +# Usage: +# tableAddSelectCallback <tab> <type> <cbname> +# +# where <type> is "Row", "Col", or "Cell" and <cbname> specifies a procedure +# to be called whenever the specified <type> is selected. Procedures are +# called as +# <cbname> name row col x y +# +# where 'name' is the table name, 'row' and 'col' are the coordinates of the +# selection and 'x' and 'y' are the raw event coordinates. Registered proc- +# edures are required to declare all these arguments but do not need to use +# them. + +proc tableAddSelectCallback { tab type cbname } { + global tabSelectionCB + lappend tabSelectionCB(${tab},${type}) $cbname +} + + +# TABLEADDUNSELECTCALLBACK -- Add a user-defined callback to be executed +# when there is a row, column, or cell un-selection event occurs. +# +# Usage: +# tableAddUnSelectCallback <tab> <type> <cbname> +# +# where <type> is "Row", "Col", or "Cell" and <cbname> specifies a procedure +# to be called whenever the specified <type> is selected. Procedures are +# called as +# <cbname> name row col x y state +# +# where 'name' is the table name, 'row' and 'col' are the coordinates of the +# selection and 'x' and 'y' are the raw event coordinates. Registered proc- +# edures are required to declare all these arguments but do not need to use +# them. + +proc tableAddUnSelectCallback { tab type cbname } { + global tabUnSelectionCB + lappend tabUnSelectionCB(${tab},${type}) $cbname +} + + + +# TABLEADDEDITCALLBACK -- Add a user-defined callback to be executed +# when there is an edit event. +# +# Usage: +# tableAddEditCallback <tab> <cbname> +# +# <cbname> specifies a procedure to be called whenever the table editor +# Apply button has been pressed. Procedures are called as +# +# <cbname> name row col new_string +# +# where 'name' is the table name, 'row' and 'col' are the coordinates of the +# edited cell and 'new_string' is the new value inserted in the table. Reg- +# istered procedures are required to declare all these arguments but do not +# need to use them. + +proc tableAddEditCallback { tab cbname } { + global tabEditCB + lappend tabEditCB(${tab}) $cbname +} + + +# TABLECREATE -- Create a named instance of the Table meta-widget. The +# individual objects in the meta-widget are created dynamically and the +# entire thing is created as a child of the named parent object. The +# standard callbacks are assigned and the table is initialized, however +# it is the callers responsibility to adjust the parent's layout to make +# the meta-widget visible and assign any constraint callbacks. +# +# Usage: +# tableCreate <tab> <nrows> <ncols> <data> +# +# The <data> is specified as a Tcl list of the form: +# +# { {r1c1 r1c2 ... r1cN} +# {r2c1 r2c2 ... r2cN} +# : +# {rNc1 rNc2 ... rNcN} } +# +# String values must be quoted, rows/cols will be truncated or cleared if +# the specified table size does not agree with the size of the data table +# being loaded. + +set tabBGWidgets { \ + TABTab TABRowTab TABColTab TABLabel TABColScroll \ + TABRowScroll TABEditApply TABEditClear TABEditCancel \ + TABEditApply TABEditClear TABEditCancel TABEditText \ + TABEditFrame TABEditMenuBar TABEditMenuFrame \ +} +set tabFGWidgets { \ + TABTab TABRowTab TABColTab TABLabel TABColScroll \ + TABRowScroll TABEditApply TABEditClear TABEditCancel \ + TABEditApply TABEditClear TABEditCancel TABEditText \ +} + +proc tableCreate { tab nrows ncols data } { + global tabNrows tabNcols tabRowHeights tabColWidths + global tabHeight tabWidth tabDebug tabOption + global tabEditCB tabSelectionCB tabUnSelectionCB + global tabSelected tabBGWidgets tabFGWidgets + + set err "" + catch { + if { ![info exists tabOption(${tab},RowLabelCols)] } { + set tabOption(${tab},RowLabelCols) $tabOption(name,RowLabelCols) + } + } err + if {$err != ""} { + set tabOption(${tab},RowLabelCols) $tabOption(name,RowLabelCols) + } + set err "" + catch { + if { ![info exists tabOption(${tab},ColLabelRows)] } { + set tabOption(${tab},ColLabelRows) $tabOption(name,ColLabelRows) + } + } err + if {$err != ""} { + set tabOption(${tab},ColLabelRows) $tabOption(name,ColLabelRows) + } + + + set tabNrows(${tab}.data) $nrows + set tabNcols(${tab}.data) $ncols + set tabNrows(${tab}.rows) $nrows + set tabNcols(${tab}.rows) $tabOption(${tab},RowLabelCols) + set tabNrows(${tab}.cols) $tabOption(${tab},ColLabelRows) + set tabNcols(${tab}.cols) $ncols + set tabData($tab) $data + + # Initialize with a default row height. + set rh [send ${tab}Tab get rowHeight] + for {set i 1} {$i <= $nrows} {incr i} { set tabRowHeights($tab,$i) $rh } + + # Initialize with a default column width. + set cw [send ${tab}Tab get defaultWidth] + for {set i 1} {$i <= $ncols} {incr i} { set tabColWidths($tab,$i) $cw } + + # Initialize the table. + send ${tab}Tab setTable $nrows $ncols $data + + # Initialize the labels. + tableSetDefaultLabels $tab + + # Save the table dimesnions. + set tabHeight($tab) [ tableGetHeight $tab ] + set tabWidth($tab) [ tableGetWidth $tab ] + + # Set the default table translations. + tableSetDefaultTranslations $tab + + # Set Default Scrollbars for the table. + tableSetDefaultScrollbars $tab + + # Attach the default-callbacks to the new Table. + tableAddCallbacks $tab + + # Default the colors. + set err "" + catch { + if { ![info exists tabOption(${tab},HighlightColor)] != 0 } { + set tabOption(${tab},HighlightColor) $tabOption(name,HighlightColor) + } + } err + if {$err != ""} { + set tabOption(${tab},HighlightColor) $tabOption(name,HighlightColor) + } + set err "" + catch { + if { ![info exists tabOption(${tab},Background)] != 0 } { + set tabOption(${tab},Background) $tabOption(name,Background) + } + } err + if {$err != ""} { + set tabOption(${tab},Background) $tabOption(name,Background) + } + set err "" + catch { + if { ![info exists tabOption(${tab},Foreground)] != 0 } { + set tabOption(${tab},Foreground) $tabOption(name,Foreground) + } + } err + if {$err != ""} { + set tabOption(${tab},Foreground) $tabOption(name,Foreground) + } + + regsub -all TAB $tabBGWidgets $tab bgwidgets + foreach w $bgwidgets { + send $w set background $tabOption(${tab},Background) + } + regsub -all TAB $tabFGWidgets $tab fgwidgets + foreach w $fgwidgets { + send $w set foreground $tabOption(${tab},Foreground) + } + + # Default selections. + set tabSelected(${tab},Row) {} + set tabSelected(${tab},Col) {} + set tabSelected(${tab},Cell) {} + + set tabSelectionCB(${tab},Row) {} + set tabSelectionCB(${tab},Col) {} + set tabSelectionCB(${tab},Cell) {} + set tabUnSelectionCB(${tab},Row) {} + set tabUnSelectionCB(${tab},Col) {} + set tabUnSelectionCB(${tab},Cell) {} + set tabEditCB(${tab}) {} +} + + +# TABLESETDATA -- Set the data elements of a table meta-widget. +# +# Usage: +# tableSetData <tab> <data> +# +# where <tab> is the table name given when the meta-widget was created, and +# <data> is of the form: +# +# { {r1c1 r1c2 ... r1cN} +# {r2c1 r2c2 ... r2cN} +# : +# {rNc1 rNc2 ... rNcN} } + +proc tableSetData { tab data } { + global tabNrows tabNcols + send ${tab}Tab setTable $tabNrows(${tab}.data) $tabNcols(${tab}.data) $data +} + + +# TABLESETCOLUMNLABELS -- Set the column header labels for a table. +# meta-widget. +# +# Usage: +# tableSetColumnLabels <tab> <column_labs> +# +# where <tab> is the table name given when the meta-widget was created, and +# <data> is of the form: +# +# { { r1c1 } { r1c2 } ... { r1cN } } + +proc tableSetColumnLabels { tab col_labs } { + global tabNrows tabNcols + send ${tab}ColTab \ + setTable $tabNrows(${tab}.cols) $tabNcols(${tab}.cols) $col_labs +} + + +# TABLESETROWLABELS -- Set the row header labels for a table. +# meta-widget. +# +# Usage: +# tableSetColumnLabels <tab> <row_labs> +# +# where <tab> is the table name given when the meta-widget was created, and +# <data> is of the form: +# +# { {r1c1 r1c2 ... r1cN} } + +proc tableSetRowLabels { tab row_labs } { + global tabNrows tabNcols + send ${tab}RowTab \ + setTable $tabNrows(${tab}.rows) $tabNcols(${tab}.rows) $row_labs +} + + +# TABLESETCOLLABELSATTR -- Set the column header labels for a table +# meta-widget. +# +# Usage: +# tableSetColumnLabels <tab> <attr> <value> [<row>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableSetColLabelsAttr { tab attr value args } { + if {$args != ""} { + send ${tab}ColTab setRowAttr $args $attr $value + } else { + send ${tab}ColTab setRowAttr 1 $attr $value + } +} + + +# TABLESETROWLABELSATTR -- Set the row header labels for a table meta-widget. +# +# Usage: +# tableSetRowLabelsAttr <tab> <attr> <value> [<col>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableSetRowLabelsAttr { tab attr value args } { + if {$args != ""} { + send ${tab}RowTab setColAttr $args $attr $value + } else { + send ${tab}RowTab setColAttr 1 $attr $value + } +} + + +# TABLEGETROWLABELSATTR -- Get the row header labels for a table meta-widget. +# +# Usage: +# value = tableGetRowLabelsAttr <tab> <attr> [<col>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableGetRowLabelsAttr { tab attr args } { + if {$args != ""} { + return [ send ${tab}RowTab getColAttr $args $attr ] + } else { + return [ send ${tab}RowTab getColAttr 1 $attr ] + } +} + + +# TABLEGETCOLLABELSATTR -- Get the column header labels for a table. +# meta-widget. +# +# Usage: +# value = tableGetColLabelsAttr <tab> <attr> [<row>] +# +# where <attr> is one of +# +# background background color +# foreground foreground color +# width column width +# justify label justification + +proc tableGetColLabelsAttr { tab attr args } { + if {$args != ""} { + return [ send ${tab}ColTab getRowAttr $args $attr ] + } else { + return [ send ${tab}ColTab getRowAttr 1 $attr ] + } +} + + +# TABLESETROWLABELATTR -- Set the specified attribute for the row label table. +# +# Usage: +# tableSetRowLabelAttr <tab> <row> <attr> <value> [<row>] +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableSetRowLabelAttr { tab row attr value args } { + if {$args != ""} { + send ${tab}RowTab setCellAttr $row $args $attr $value + } else { + send ${tab}RowTab setCellAttr $row 1 $attr $value + } +} + + +# TABLESETCOLLABELATTR -- Get the specified attribute for the col label table. +# +# Usage: +# value = tableSetColLabelAttr <tab> <col> <attr> <value> [<row>] +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableSetColLabelAttr { tab col attr value args } { + if {$args != ""} { + send ${tab}ColTab setCellAttr $args $col $attr $value + } else { + send ${tab}ColTab setCellAttr 1 $col $attr $value + } +} + + +# TABLEGETCELLATTR -- Get the specified attribute for the cell. +# +# Usage: +# value = tableGetCellAttr <tab> <row> <col> <attr> +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableGetCellAttr { tab row col attr } { + return [ send ${tab}Tab getCellAttr $row $col $attr ] +} + + +# TABLESETCELLATTR -- Set the specified attribute for the cell. +# +# Usage: +# tableSetCellAttr <tab> <row> <col> <attr> <value> +# +# The cell position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a cell include: +# +# label label text (string) +# background background color (string) +# foreground foreground color (string) + +proc tableSetCellAttr { tab row col attr value } { + send ${tab}Tab setCellAttr $row $col $attr $value +} + + +# TABLEGETROWATTR -- Get the specified attribute for the row. +# +# Usage: +# value = tableGetCellAttr <tab> <row> <attr> +# +# The row position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a row include: +# +# background background color +# foreground foreground color + +proc tableGetRowAttr { tab row attr } { + return [ send ${tab}Tab getRowAttr $row $attr ] +} + + +# TABLESETROWATTR -- Set the specified attribute for the row. +# +# Usage: +# tableSetRowAttr <tab> <row> <attr> <value> +# +# The row position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a row include: +# +# background background color +# foreground foreground color + +proc tableSetRowAttr { tab row attr value } { + send ${tab}Tab setRowAttr $row $attr $value +} + + +# TABLEGETCOLATTR -- Get the specified attribute for the column. +# +# Usage: +# value = tableGetColAttr <tab> <col> <attr> +# +# The column position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a column include: +# +# width column width (pixels) +# background background color (string) +# foreground foreground color (string) +# justify text justification (string) + +proc tableGetColAttr { tab col attr } { + return [ send ${tab}Tab getColAttr $col $attr ] +} + + +# TABLESETCOLATTR -- Set the specified attribute for the column. +# +# Usage: +# tableSetColAttr <tab> <col> <attr> <value> +# +# The column position is given as a 1-indexed array element where the UL +# of the table is cell (1,1). Allowed attributes for a column include: +# +# width column width (pixels) +# background background color (string) +# foreground foreground color (string) +# justify text justification (string) + +proc tableSetColAttr { tab col attr value } { + send ${tab}Tab setColAttr $col $attr $value +} + + +# TABLEDELETECOL -- Delete the specified column from the named table. +# +# Usage: +# tableDeleteCol <tab> <col> + +proc tableDeleteCol { tab col } { + global tabColWidths tabNcols + + send ${tab}Tab deleteCol $col + send ${tab}ColTab deleteCol $col + incr tabNcols(${tab}.data) -1 + unset tabColWidths(${tab},$col) +} + + +# TABLEDELETEROW -- Delete the specified row from the named table. +# +# Usage: +# tableDeleteRow <tab> <row> + +proc tableDeleteRow { tab row } { + global tabRowHeights tabNrows + + send ${tab}Tab deleteRow $row + send ${tab}RowTab deleteRow $row + incr tabNrows(${tab}.data) -1 + unset tabRowHeights(${tab},$row) +} + + +# TABLEDADDCOL -- Add a column to the named table at the specified position. +# +# Usage: +# tableAddCol <tab> <col> <width> + +proc tableAddCol { tab col width args} { + global tabColWidths tabNcols + + send ${tab}Tab addCol $col $width $args + send ${tab}ColTab addCol $col $width $args + incr tabNcols(${tab}.data) + + set ncols $tabNcols(${tab}.data) + if {$col == "first"} { + set colnum 1 + } elseif {$col == "last"} { + set colnum $tabNcols(${tab}.data) + } else { + set colnum $col + } + + # Update the column widths. + for {set c $ncols} {$c > $colnum} {incr c -1} { + set tabColWidths(${tab},$c) $tabColWidths(${tab},[expr ($c - 1)]) + } + set tabColWidths(${tab},$colnum) $width +} + + +# TABLEADDROW -- Add a rows to the named table at the specified position. +# +# Usage: +# tableDeleteCol <tab> <row> + +proc tableAddRow { tab row args } { + global tabRowHeights tabNrows + + send ${tab}Tab addRow $row $args + send ${tab}RowTab addRow $row $args + incr tabNrows(${tab}.data) + set tabRowHeights(${tab},$row) $tabRowHeight(${tab},1) +} + + +# TABLEGETNROWS -- Return the number of rows in a named table. +# +# Usage: +# nrows = tableGetNrows <tab> + +proc tableGetNrows { tab } { + global tabNrows + return $tabNrows(${tab}.data) +} + + +# TABLEGETNCOLS -- Return the number of columns in a named table. +# +# Usage: +# ncols = tableGetNcols <tab> + +proc tableGetNcols { tab } { + global tabNcols + return $tabNcols(${tab}.data) +} + + +# TABLEGETHEIGHT -- Compute the height of the table given varying row heights. +# +# Usage: +# height = tableGetHeight <tab> + +proc tableGetHeight { tab } { + return [ send ${tab}Tab get height ] +} + + +# TABLEGETWIDTH -- Compute the width of the table given varying column widths. +# +# Usage: +# width = tableGetWidth <tab> + +proc tableGetWidth { tab } { + return [ send ${tab}Tab get width ] +} + + +# TABLEGETSELECTED -- Return a list of the selected items. +# +# Usage: list = tableGetSelected tab type +# +# where <type> is 'Row', 'Col', or 'Cell'. + +proc tableGetSelectedRows { tab type } { + global tabSelected + return $tablSelected(${tab},${type}) +} + + +# TABLEDIT -- Enable the cell editor + +set tabEditRow 0 +set tabEditCol 0 +set tabEditValue "" + +set tableEditorUp 0 + +proc tableEdit { name x y } { + global tabEditValue tabEditRow tabEditCol tableEditCB, tableEditorUp + + regsub Tab $name "" tab + + set ry [tablePos2CellY $tab $y] + set rx [tablePos2CellX $tab $x] + + if {$rx < 0 || $ry < 0} \ + return + + set newcell 0 + if {$tabEditRow != $rx || $tabEditCol != $ry} { + set newcell 1 + } + + set tabEditCol [tablePos2CellX $tab $x] + set tabEditRow [tablePos2CellY $tab $y] + set tabEditValue [tableGetCellAttr $tab $tabEditRow $tabEditCol label] + + if {$tableEditorUp == 0 || $newcell == 1} { + send ${tab}EditApply addCallback tableEditApply + send ${tab}EditCancel addCallback tableEditCancel + send ${tab}EditClear addCallback tableEditClear + send ${tab}EditText addCallback tableEditLoad + send ${tab}EditText set string $tabEditValue + send ${tab}EditShell move $x [expr ($y + 50)] + send ${tab}EditShell map + set tableEditorUp 1 + } else { + send ${tab}EditApply deleteCallback tableEditApply + send ${tab}EditCancel deleteCallback tableEditCancel + send ${tab}EditClear deleteCallback tableEditClear + send ${tab}EditText deleteCallback tableEditLoad + send ${tab}EditShell unmap + set tableEditorUp 0 + } +} + +proc tableEditApply { button args } { + global tabEditValue tabEditRow tabEditCol tabEditCB tabEditorUp + regsub EditApply $button "" tab + + set str [send ${tab}EditText get string] + + tableSetCellAttr $tab $tabEditRow $tabEditCol label $str + set tabEditValue $str + + # Now do the user-defined selection callbacks. + if { [llength $tabEditCB(${tab})] > 0} { + foreach cb $tabEditCB(${tab}) {$cb $tab $tabEditRow $tabEditCol "$str"} + } + + # Close the window. + send ${tab}EditApply deleteCallback tableEditApply + send ${tab}EditCancel deleteCallback tableEditCancel + send ${tab}EditClear deleteCallback tableEditClear + send ${tab}EditText deleteCallback tableEditLoad + send ${tab}EditShell unmap + set tableEditorUp 0 +} + +proc tableEditLoad { widget mode pattern args } { + regsub EditText $widget "" tab + tableEditApply ${tab}EditApply +} + +proc tableEditClear { button args } { + global tabEditValue + + regsub EditClear $button "" tab + send ${tab}EditText set string "" +} + +proc tableEditCancel { button args } { + global tableEditValue tableEditorUp + + regsub EditCancel $button "" tab + send ${tab}EditShell unmap + send ${tab}EditApply deleteCallback tableEditApply + send ${tab}EditCancel deleteCallback tableEditCancel + send ${tab}EditClear deleteCallback tableEditClear + send ${tab}EditText deleteCallback tableEditLoad + set tableEditorUp 0 +} + + +############################################################################### +# +# Private Procedures +# +############################################################################### + + +# TABLEADDCALLBACKS -- Add the default widget callbacks. + +proc tableAddCallbacks { tab } { + + # Attach the scrollbars actions. + if {[ tableOption $tab RowScroll] == "yes"} { + send ${tab}RowScroll addCallback tableJumpScroll + } else { + send ${tab}RowScroll "set width 0 ; unmap" + } + + if {[ tableOption $tab ColScroll] == "yes"} { + send ${tab}ColScroll addCallback tableJumpScroll + } else { + send ${tab}Label set height 0 + send ${tab}ColScroll "set height 0 ; unmap" + } + + if {[tableOption $tab Tracking] == "no"} { + send ${tab}Label set label "" + send ${tab}Label set width 30 + } + + # Setup a resize handler that will adjust the scrollbars/viewports. + send ${tab}TableFrame addEventHandler tableResizeHandler structureNotifyMask +} + + +# TABLERESIZEHANDLER -- Resize callbacks, called as an eventHandler when +# the parent window or the table meta-widget changes size. All we need to +# do here is reset the scrollbars to reflect the new size. + +proc tableResizeHandler { table args } { + regsub TableFrame $table "" tab + tableSetDefaultScrollbars $tab +} + + +# TABLETRACK -- Track the motion in the table. + +proc tableTrack { name x y } { + regsub Tab $name "" tab + if {[ tableOption $tab Tracking] == "no"} { + return + } + + set nr [tableGetNrows $tab] + set nc [tableGetNcols $tab] + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + if {$col < 0 || $row < 0} { + send ${tab}Label set label " " + } else { + send ${tab}Label set label [ format "(%3d,%3d)" $row $col ] + } +} + + +# TABLESELECT -- Do the default selection callback which applies to rows, +# columns and cells. + +proc tableSelect { name type x y } { + global tabOption tabSelected tabSelectionCB tabUnSelectionCB + + if {$type == "Row"} { + regsub ${type}Tab $name "" tab + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + set val $row + } elseif {$type == "Col"} { + regsub ${type}Tab $name "" tab + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + set val $col + } elseif {$type == "Cell"} { + regsub Tab $name "" tab + set col [tablePos2CellX $tab $x] + set row [tablePos2CellY $tab $y] + set val [list $row $col] + } + + if {$col < 0 || $row < 0} \ + return + + set index [ lsearch $tabSelected(${tab},${type}) $val ] + set color $tabOption(${tab},HighlightColor) + + # If we're doing a radio selection, turn off anything already selected. + + if {[ tableOption $tab ${type}MultiSelect] == "no"} { + if { [llength $tabSelected(${tab},${type})] == 1} { + tableSet${type}Attr ${tab} \ + [lindex $tabSelected(${tab},${type}) 0] \ + background $tabOption(${tab},Background) + tableSet${type}Attr ${tab}${type} \ + [lindex $tabSelected(${tab},${type}) 0] \ + background $tabOption(${tab},Background) + + # Now do the user-defined un-selection callbacks. + if { [llength $tabUnSelectionCB(${tab},${type})] > 0} { + foreach cb $tabUnSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 0 + } + } + + set tabSelected(${tab},${type}) [list $val ] + + if {$type == "Row"} { + foreach c $tabSelected(${tab},Col) { + tableSetColAttr ${tab} $c background $color + } + } elseif {$type == "Col"} { + foreach c $tabSelected(${tab},Row) { + tableSetRowAttr ${tab} $c background $color + } + } + } else { + lappend tabSelected(${tab},${type}) $val + } + } else { + if { $index < 0} { + lappend tabSelected(${tab},${type}) $val + } + } + + # If this has already been selected, toggle it. + if { $index >= 0} { + if {$type != "Cell"} { + tableSet${type}Attr ${tab} \ + [lindex $tabSelected(${tab},${type}) $index] \ + background $tabOption(${tab},Background) + tableSet${type}Attr ${tab}${type} \ + [lindex $tabSelected(${tab},${type}) $index] \ + background $tabOption(${tab},Background) + + # Now do the user-defined un-selection callbacks. + if { [llength $tabUnSelectionCB(${tab},${type})] > 0} { + foreach cb $tabUnSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 0 + } + } + + } else { + tableSet${type}Attr ${tab} \ + $row $col background $tabOption(${tab},Background) + + # Now do the user-defined selection callbacks. + if { [llength $tabUnSelectionCB(${tab},${type})] > 0} { + foreach cb $tabUnSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 0 + } + } + } + + # Delete it from the list + set tabSelected(${tab},${type}) \ + [ lreplace $tabSelected(${tab},${type}) $index $index ] + + # Go back and re-select the row/col intersection but don't + # generate an event for it, purely cosmetic. + if {$type == "Row"} { + foreach c $tabSelected(${tab},Col) { + tableSetColAttr ${tab} $c background $color + } + } elseif {$type == "Col"} { + foreach c $tabSelected(${tab},Row) { + tableSetRowAttr ${tab} $c background $color + } + } + + } else { + + # Highlight the selected item. + if {$type != "Cell"} { + tableSet${type}Attr ${tab} $val background $color + tableSet${type}Attr ${tab}${type} $val background $color + } else { + tableSet${type}Attr ${tab} $row $col background $color + } + + # Now do the user-defined selection callbacks. + if { [llength $tabSelectionCB(${tab},${type})] > 0} { + foreach cb $tabSelectionCB(${tab},${type}) { + $cb $tab $row $col $x $y 1 + } + } + } +} + + +# TABLESETDEFAULTLABELS -- Set the default labels for the table, i.e. letters +# for columns headings and numbers for the row labels. +# +# Usage: +# tableSetDefaultLabels <tab> + +proc tableSetDefaultLabels { tab } { + global tabNrows tabNcols tabOption + + + # Set the default Row labels, i.e numbers + set rowlabs {} + for {set i 1} {$i <= $tabNrows(${tab}.data)} {incr i} { + if {[ tableOption $tab DefLabels ] == "yes"} { + lappend rowlabs $i + } else { + lappend rowlabs {} + } + } + if {[ tableOption $tab RowLabels ] == "yes"} { + send ${tab}RowTab setTable $tabNrows(${tab}.data) \ + $tabOption(${tab},RowLabelCols) $rowlabs + set cw [send ${tab}RowTab get defaultWidth] + send ${tab}RowTabView set width \ + [expr ($tabOption(${tab},RowLabelCols) * $cw)] + } else { + send ${tab}RowTab set width 0 + } + + # Now set the default Column Labels, i.e. letters + set collabs "" + set j 65 + for {set i 1} {$i <= $tabNcols(${tab}.data)} {incr i} { + if {[ tableOption $tab DefLabels ] == "yes"} { + if {$j > 90} { + set j 97 + set collabs [ format "%s { %c } " $collabs $j ] + } elseif {$j > 122} { + set j 1 + set collabs [ format "%s { %d } " $collabs $j ] + } else { + set collabs [ format "%s { %c } " $collabs $j ] + } + incr j + } else { + lappend rowlabs {} + } + } + if {[ tableOption $tab ColLabels ] == "yes"} { + send ${tab}ColTab setTable $tabOption(${tab},ColLabelRows) \ + $tabNcols(${tab}.data) [ list $collabs ] + send ${tab}ColTabView set height \ + [expr ($tabOption(${tab},ColLabelRows) * 22)] + send ${tab}Spacer set height \ + [expr ($tabOption(${tab},ColLabelRows) * 24)] + } else { + send ${tab}ColTab set height 0 + } +} + + +# TABLESETDEFAULTTRANSLATIONS -- Set the default translations for the widget. + +proc tableSetDefaultTranslations { tab } { + + if {[ tableOption $tab DefaultTranslations ] == "no"} { + return + } + + # Set the coord tracking translations. + set trans1 "" + if {[ tableOption $tab Tracking ] == "yes"} { + set trans1 { \ + <Motion>:call(tableTrack,$name,$x,$y) + } + } + + set trans2 "" + if {[ tableOption $tab CellSelect ] == "yes"} { + set trans2 { \ + <Btn1Down>:call(tableSelect,$name,Cell,$x,$y) + } + } + + set trans3 "" + if {[ tableOption $tab Editable ] == "yes"} { + set trans3 { \ + <Btn3Down>:call(tableEdit,$name,$x,$y) + } + } + set trans "$trans1 $trans2 $trans3" + send ${tab}Tab set translations $trans + + + # Set the row-selectable translations. + if {[ tableOption $tab RowSelect ] == "yes"} { + send ${tab}RowTab set translations \ + "<Btn1Down>: call(tableSelect,\$name,Row,\$x,\$y)" + } + + # Set the col-selectable translations. + if {[ tableOption $tab ColSelect ] == "yes"} { + send ${tab}ColTab set translations \ + "<Btn1Down>: call(tableSelect,\$name,Col,\$x,\$y)" + } +} + + +# TABLESETDEFAULTSCROLLBARS -- Set the default scrollbar position and size +# in the meta-widget. + +proc tableSetDefaultScrollbars { tab } { + global tabHeight tabWidth tabScrollSize tabScrollPos tabDebug + + set visW [ send ${tab}TabView get width] + set visH [ send ${tab}TabView get height] + set th $tabHeight($tab) + set tw $tabWidth($tab) + + set rowS [max 0.0 [min 1.0 [expr (double($visH)/double($tabHeight($tab)))]]] + set colS [max 0.0 [min 1.0 [expr (double($visW)/double($tabWidth($tab))) ]]] + + set tabScrollSize($tab,row) $rowS + set tabScrollSize($tab,col) $colS + set tabScrollPos($tab,row) 0.0 + set tabScrollPos($tab,col) 0.0 + + send ${tab}RowScroll setScrollbar 0.0 $tabScrollSize($tab,row) + send ${tab}ColScroll setScrollbar 0.0 $tabScrollSize($tab,col) +} + + +# TABLEJUMPSCROLL -- Scroll the specified table. This scrolls both the +# data and row/column label tables. + +proc tableJumpScroll { widget cbtype pos } { + global scrollHeight tabWidth tabHeight tabDebug + global tabScrollSize tabScrollPos tabDebug + + if {$pos < 0.01} { set pos 0.0 } + + if { [string match *ColScroll $widget] } { + regsub ColScroll $widget "" tab + set y $tabScrollPos($tab,row) + send ${tab}TabView setLocation $pos $y + send ${tab}ColTabView setLocation $pos 0.0 + + } elseif { [string match *RowScroll $widget] } { + regsub RowScroll $widget "" tab + set x $tabScrollPos($tab,col) + send ${tab}TabView setLocation $x $pos + send ${tab}RowTabView setLocation 0.0 $pos + } +} + + +# TABLEOPTION -- Return any defined table option. + +proc tableOption { tab option } { + global tabOption + + set val yes + catch { + if {[info exists tabOption(${tab},${option}) ]} { + if { $tabOption(${tab},${option}) } { + set val yes + } else { + set val no + } + } + } err + + return $val +} + + +# TABLEPOS2CELLX -- Convert a widget position to a cell column number. + +proc tablePos2CellX { tab x } { + global tabColWidths tabNcols + + set nc [ tableGetNcols $tab ] + set cellX 1 + for {set w 0} {$w < $x && $cellX <= $nc} {incr cellX} { + set w [ expr ($w + $tabColWidths($tab,$cellX) + 3) ] + } + if {$x > $w} { + return -1 + } else { + return [ min [incr cellX -1] $tabNcols(${tab}.data) ] + } +} + +# TABLEPOS2CELLY -- Convert a widget position to a cell row number. + +proc tablePos2CellY { tab y } { + global tabRowHeights tabNrows + + set nr [ tableGetNrows $tab ] + set cellY 1 + for {set h 0} {$h < $y && $cellY <= $nr} {incr cellY} { + set h [ expr ($h + $tabRowHeights($tab,$cellY)) + 3 ] + } + if {$y > $h} { + return -1 + } else { + return [ min [incr cellY -1] $tabNrows(${tab}.data) ] + } +} + + +################################################################################ + + + +activate + + +appExtend { + *tclObjects:\ + toplevel TopLevelShell tcl_panel\ + tcl_panel Layout tclLayout\ + tclLayout Group tclCmdGroup\ + tclCmdGroup Layout tclCmd\ + tclCmd Command tclClear\ + tclCmd Command tclExecute\ + tclCmd Command tclDismiss\ + tclLayout Frame tclFrame\ + tclFrame AsciiText tclEntry + + + !-------------------------------- + ! Define a debug Tcl shell. + !-------------------------------- + *tcl_panel.width: 550 + *tcl_panel.height: 180 + *tcl_panel.title: Debug TCL Command Entry + *tclLayout*borderWidth: 0 + *tclLayout*shrinkToFit: True + *tclLayout*Frame.frameType: sunken + *tclLayout*Frame.frameWidth: 2 + *tclLayout.layout: vertical { \ + tclCmdGroup < +inf -inf * > \ + tclFrame < +inf -inf * +inf -inf> \ + } + *tclEntry*foreground: black + *tclEntry*editType: edit + *tclEntry*type: string + *tclEntry*font: 7x13 + *tclEntry*scrollVertical: Always + *tclEntry*scrollHorizontal: whenNeeded + + *tclCmdGroup.label: + *tclCmdGroup.outerOffset: 0 + *tclCmdGroup.innerOffset: 0 + *tclCmd.layout: vertical { \ + 5 \ + horizontal { 5 tclClear 3 tclExecute 10 < +inf -10> tclDismiss 5 } \ + 5 \ + } + *tclClear.label: Clear + *tclExecute.label: Execute + *tclDismiss.label: Dismiss + +} ; createObjects tclObjects + + + +################################################ +# Define some TCL debug procedures. +################################################ + +proc tclCommandClear {widget args} { + send tclEntry set string "" +} ; send tclClear addCallback tclCommandClear + +proc tclCommandExecute {widget args} { + send server [send tclEntry {get string}] +} ; send tclExecute addCallback tclCommandExecute + +proc tclCommand {widget mode command args} { + send server $command +} ; send tclEntry addCallback tclCommand + +proc tclClose {widget args} { + send tcl_panel unmap +} ; send tclDismiss addCallback tclClose + +send tclShell addCallback "send tcl_panel map" + diff --git a/vendor/x11iraf/guidemo/tabs.gui b/vendor/x11iraf/guidemo/tabs.gui new file mode 100644 index 00000000..74359ec3 --- /dev/null +++ b/vendor/x11iraf/guidemo/tabs.gui @@ -0,0 +1,103 @@ +# PANEL.GUI -- Test GUI for the Tabs widget. + +reset-server +appInitialize panel Panel { + *objects:\ + toplevel Frame frame\ + frame Tabs panelTabs\ +\ + panelTabs Layout panel\ + panel Frame label1F\ + label1F Label label1\ + panel Frame label2F\ + label2F Label label2\ + panel Command button1\ + panel Command button2\ + panel RadioGroup color\ +\ + panelTabs Frame gtermFrame\ + gtermFrame Gterm gterm + + + *background: gray + *foreground: black + + *frame.highlightThickness: 0 + *frame.frameWidth: 3 + *frame.frameType: raised + *frame.innerOffset: 5 + *frame.outerOffset: 1 + + *panel.debug: False + *panel.borderWidth: 0 + *panel.tabLabel: Panel + + *gtermFrame.tabLabel: Gterm Widget + *gtermFrame.outerOffset: 7 + *gtermFrame.frameWidth: 3 + *gtermFrame.frameType: sunken + *gterm.width: 100 + *gterm.height: 100 + *gterm.maxColors: 5 + *gterm.cmapInitialize: True + + *panel.layout: horizontal { \ + vertical { \ + 5 < +inf -5 > \ + horizontal { \ + label1F < +inf * +inf > \ + } \ + 5 < +inf -5 > \ + horizontal { \ + label2F < +inf * +inf > \ + } \ + 5 < +inf -5 > \ + horizontal {\ + button1 < +inf * +inf > \ + 5 < +inf -5 > \ + button2 < +inf * +inf > \ + }\ + 5 < +inf -5 > \ + } \ + vertical { \ + 5 < +inf -5 > \ + color < +inf * +inf > \ + } \ + } + + *Command.highlightThickness: 0 + *Label.borderWidth: 0 + *Label.background: gray60 + *label1*shadowWidth: 0 + *label1F.frameType: sunken + *label1F.frameWidth: 2 + *label2*shadowWidth: 0 + *label2F.frameType: sunken + *label2F.frameWidth: 2 + + *color.location: 0 0 100 0 + *color.shrinkToFit: True + *color.outerOffset: 10 + *color.innerOffset: 5 + *color.frameWidth: 2 + *color*offIcon: diamond0s + *color*onIcon: diamond1s + *color.red.highlightColor: red + *color.green.highlightColor: green + *color.blue.highlightColor: blue + *color.yellow.highlightColor: yellow + *color.label: Color: + *color.labels: |red|green|blue|yellow + *color.selectionStyle: multi + *color.selection: 0 + + *allowShellResize: true + *beNiceToColormap: False +} + +# Start up the GUI. +createObjects +activate + +proc quit args { send client gkey q; deactivate unmap } +send button1 addCallback quit diff --git a/vendor/x11iraf/guidemo/x_guidemo.x b/vendor/x11iraf/guidemo/x_guidemo.x new file mode 100644 index 00000000..661cb0b1 --- /dev/null +++ b/vendor/x11iraf/guidemo/x_guidemo.x @@ -0,0 +1,4 @@ +# GUIDEMO package. + +task hello = t_hello, + imbrowse = t_imbrowse diff --git a/vendor/x11iraf/guidemo/ximtool.html b/vendor/x11iraf/guidemo/ximtool.html new file mode 100644 index 00000000..434edcc7 --- /dev/null +++ b/vendor/x11iraf/guidemo/ximtool.html @@ -0,0 +1,674 @@ +<HTML> <HEAD> +<TITLE>XImtool On-Line Help Summary</TITLE> +</HEAD> <BODY> +<H2>Welcome to XImtool V1.1</H2> + +XImtool is an image display server developed by the IRAF Project at the +National Optical Astronomy Observatories. To view images you need +client software (such as IRAF) to load images into the display, or it can +load images directly when run as a standalone task. XImtool is +interchangeable with older display servers such as <I>SAOimage</I> / +<I>IMTOOL</I> and with newer servers like <I>SAOtng</I>, but offers many new +features not available elsewhere. +<P> +More <a href=#toc>detailed help</a> is available on the following topics: +<DL><DL> +<DT>Basic Usage:</DT> +<UL> +<LI><A HREF="#basic">Getting Started</A> -- The basics. </LI> +<LI><A HREF="#gui">GUI Overview</A> -- What it looks like. </LI> +<LI><A HREF="#mouse">Mouse Operations</A> -- Doing stuff. </LI> +<LI><A HREF="#keystroke">Keystroke Accelerators</A> -- Keystroke summary.</LI> +<LI><A HREF="#markers">Markers</A> -- Panner/WCS markers, general markers.</LI> +<LI><A HREF="#control">Control Panel</A> -- Operating the Control panel.</LI> +<LI><A HREF="#load">Load Panel</A> -- Load panel operation and options.</LI> +<LI><A HREF="#save">Save Panel</A> -- Save panel operation and options.</LI> +<LI><A HREF="#print">Print Panel</A> -- Print panel operation and options.</LI> +<LI><A HREF="#info">Info Panel</A> -- Information panel.</LI> +</UL></DL></DL> +<DL><DL> +<DT>Advanced Features:</DT> +<UL> +<LI><A HREF="#comline">Command-line Options</A> -- Startup flags. </LI> +<LI><A HREF="#client">Client Connections</A> -- Use as a display server. </LI> +<LI><A HREF="#framebuf">Frame Buffers</A> -- Explanation of Frame buffers. </LI> +<LI><A HREF="#pprinter">Printer Configurations</A> -- Configuring output devices. </LI> +<LI><A HREF="#tclshell">TclShell</A> -- Expert-mode interactive shell.</LI> +</UL></DL></DL> +<P> +Please contact <I>iraf@noao.edu</I> with comments, bugs, or suggestions. +<P> +<HR></P> + +<a name=#toc> <h2>Table of Contents:</h2> </a> +<PRE> + <A HREF="#basic">Getting Started</A> + <A HREF="#gui">GUI Overview</A> + <A HREF="#mouse">Mouse Operations</A> + <A HREF="#keystroke">Keystroke Accelerators</A> + <A HREF="#comline">Command-line Options</A> + <A HREF="#client">Client Connections</A> + <A HREF="#framebuf">Frame Buffers</A> + <A HREF="#markers">Markers</A> + <A HREF="#panner">Panner Marker</A> + <A HREF="#coords">Coords Box Marker</A> + <A HREF="#genmark">General Markers</A> + <A HREF="#markmenu">Menu Options</A> + <A HREF="#control">Control Panel</A> + <A HREF="#cview">View Controls</A> + <A HREF="#cenhance">Enhancement Controls</A> + <A HREF="#cblink">Blink Controls</A> + <A HREF="#copts">Options:</A> + <A HREF="#cautoscale">Autoscale</A> + <A HREF="#cantialias">Antialiasing</A> + <A HREF="#ctile">Tile Frames</A> + <A HREF="#cwarnings">Warnings</A> + <A HREF="#ccmap">Colormap Selection</A> + <A HREF="#cbltin">Builtin Colormaps</A> + <A HREF="#cuser">User-defined Colormaps</A> + <A HREF="#load">Load Panel</A> + <A HREF="#lbrowse">Directory browsing</A> + <A HREF="#lpattern">File Patterns</A> + <A HREF="#lload">Direct File Load</A> + <A HREF="#lframe">Frame Selections</A> + <A HREF="#save">Save Panel</A> + <A HREF="#sfname">File Name</A> + <A HREF="#sformat">Format</A> + <A HREF="#scolor">Color</A> + <A HREF="#print">Print Panel</A> + <A HREF="#popts">Postscript Options</A> + <A HREF="#pcolors">Color Options</A> + <A HREF="#pproc">Processing Options</A> + <A HREF="#pprinter">Printer selection</A> + <A HREF="#info">Info Panel</A> + <A HREF="#tclshell">TclShell</A> +</PRE> +<P> +<HR> +<h2><a name=#basic>Getting Started</a></h2> +As a display server, XImtool is started as a separate process from client +software such as IRAF. Once it is running it will accept +<a href=#client>client connections</a> simultaneously on fifo pipes, unix +domain sockets, or inet sockets. A display client like the IRAF DISPLAY +task makes a connection and sends the image across using an IIS protocol +(other/different protocols may be supported in the future). Once the image +is loaded in the display buffer it may be <a href=#cenhance>enhanced</a>, +<a href=#save>saved to a disk file</a> in a number of different formats, or +<a href=#print>printed</a> as Encapsulated Postscript to a printer or disk file. +<P> +When run in standalone mode, images may be loaded on the +<a href=#comline>command line</a> or by using the <a href=#load>Load Panel</a>. +This allows you to browse images and perform the same manipulations as if +they had been displayed by a client. +<hr> + +<h2><a name=#gui>GUI Overview</a></h2> +<p> +The GUI consists of a large image display window and a number of smaller +pannels that control various specific functions such as image +<a href=#load>Load</a>, <a href=#save>Save</a> and <a href=#print>Print</a> +as well as a general purpose <a href=#control>Control Panel</a>. The main +window menubar has several menu buttons to the left: the <I>Files</I> menu +is used to load/save/print an image as well as quit the task. The <I>View</I> +menu let's you select the image orientation, zoom, colormap or frame. The +<I>Options</I> menu allows you to call up control panels, toggle markers +or blinking etc. Some of this functionality is duplicated elsewhere in +the GUI. The right side of the menubar contains command buttons to flip the +image as well as buttons for frame selection and the help button. +<p> +For more detailed information on the operation of the control panels please +see the on-line help (i.e. use the '?' button or Alt-h keystroke in the +main image window). + +<h2><a name=#mouse>Mouse Operations</a></h2> +Clicking and dragging MB1 (mouse button 1) in the main image +window creates a rectangular region <a href=#markers>marker</a>, used +to select a region of the image. If you do this accidentally and don't +want the marker, put the pointer in the marker and type DELETE or +BACKSPACE to delete the marker. With the pointer in the marker, +MB3 will call up a <a href=#markmenu>marker menu</a> listing some things + you can do with the marker, like zoom the outlined region. MB1 can be used +to drag or resize the marker. <a href=#markers>See below</a> for more +information on markers. +<p> +Clicking on MB2 in the main image window pans (one click) or zooms (two +clicks) the image. Further clicks cycle through the builtin zoom factors. +Moving the pointer to a new location and clicking moves the feature under +the pointer to the center of the display window. Holding down the Shift +key while clicking MB2 will cause a full-screen crosshair cursor to appear +until the button is released, this can be useful for fine positioning of the +cursor. +<p> +MB3 is used to adjust the contrast and brightness of the displayed image. +The position of the pointer within the display window determines the +contrast and brightness values. Click once to set the values corresponding +to the pointer location, or click and drag to continuously adjust the display. +<hr> + +<h2><a name=#keystroke>Keystroke Accelerators</a></h2> + The following keystrokes are currently defined in the GUI: +<pre> + +Ctrl-b Backward frame Alt-b Blink frames (toggle) +Ctrl-c Center frame? Alt-c Control panel +Ctrl-f Forward frame Alt-h Help +Ctrl-i Invert? Alt-i Info box popup +Ctrl-m Match LUTs Alt-l Load file popup +Ctrl-n Normalize Alt-p Print popup +Ctrl-p Print Alt-s Save popup +Ctrl-r Register Alt-t TclShell popup +Ctrl-t Tile frames toggle +Ctrl-u Unzoom (zoom=1) +Ctrl-x Flip X Ctrl-Alt-q Quit +Ctrl-y Flip Y Ctrl-Alt-f Fitframe + +Ctrl-= Print +Ctrl-< Decrease blink rate Ctrl-+ Zoom in +Ctrl-> Increase blink rate Ctrl-- Zoom out + +Alt-1 thru Alt-4 Set frame displayed +Ctrl-1 thru Ctrl-9 Set integer zoom factor +</pre> +NOTE: These keystrokes only work with the cursor in the main image window, +not on the subwindows or in markers. +<hr> + +<h2><a name=#client>Client Connections</a></h2> +Ximtool allows clients to connect in any of the following ways: +</DL> +<DT><B>fifo pipes</B></DT> +<DD>The traditional approach. The default, global /dev/imt1[io] pipes may +be used, or a private set of fifos.</DD> +<DT><B>tcp/ip socket</B></DT> +<DD>Clients connect via a tcp/ip socket. There is a default port, or a +custom port may be specified. This permits connecting to the server over a +remote network connection anywhere on the Internet.</DD> +<DT><B>unix domain socket</B></DT> +<DD> Like a tcp/ip socket, but limited to a single host system. Usually +faster than a tcp/ip socket, and comparable to a fifo. By default each user +gets their own unix domain socket, so this option allows multiple users +to run ximtools on the same host without having to customize things.</DD> +</DL> +By default ximtool listens simultaneously for client connctions on all three +types of ports. Clients communicate with XImtool using the IIS protocol, +other protocols may be supported in the future. +<hr> + +<h2><a name=#framebuf>Frame Buffers</a></h2> +XImtool starts up using default frame buffer of 512x512 pixels. When loading +disk images the frame buffer configuration file will be searched for a +defined frame buffer that is the same size or larger than the current image, +when used as a display server the frame buffer configuration number is passed +in by the client. The default file used is /usr/local/lib/imtoolrc, this can +be overridden by defining a <b>IMTOOLRC</b> environment variable naming the +file to be used, or by creating a <b>.imtoolrc</b> file in your home +directory. +<P> +The format of the frame buffer configuration file is +<pre> + configno nframes width height [extra fields] +e.g. + 1 2 512 512 + 2 2 800 800 + 3 1 1024 1024 # comment +</pre> +At most 128 frame buffer sizes may be defined. +<hr> + +<h2><a name=#comline>Command-line Options</a></h2> + The following command-line options are currently recognized: +<pre> + -basePixel < num > Base colormap pixel number + -cmap1 < file > User cmap 1 + -cmap2 < file > User cmap 2 + -cmapDir1 < dir > User cmapDir 1 + -cmapDir1 < dir > User cmapDir 2 + -cmapInitialize < bool > Initialize colormap at startup + -cmapName < name > Private colormap name + -config < num > Initial config number + -defgui Print default GUI to stdout + -displayPanner < bool > Display panner box + -displayCoords < bool > Display wcs coords box + -fifo < pipe > Fifo pipe to use + -fifo_only Use fifo pipes only + -gui < file > GUI file to use + -help Print command-line summary + -imtoolrc < file > Frame buffer configuration file + -inet_only Use inet sockets only + -invert Invert colormap on startup? + -maxColors < num > Number of colors + -memModel < type > Memory model (fast,small,beNiceToServer) + -nframes < num > Number of frames at startup + -port < num > Inet port to use + -printConfig < file > Printer configuration file + -port_only Use inet sockets only + -tile Tile frames on startup? + -unix < name > Unix socket to use + -unix_only Use unix sockets only + < file > File to load on startup +</pre> +<hr> +<h2><a name=#markers>Markers</a></h2> +<h3><a name=#panner>Panner Marker</a></h3> +<P> +The panner window always displays the full frame buffer. Try setting the +frame buffer configuration to a nonsquare frame buffer (e.g. imtcryo) and +then displaying a square image (e.g. dev$pix) and the panner will show you +exactly where the image has been loaded into the frame. +<P> +The panner window uses two markers, one for the window border and one to +mark the displayed region of the frame. Most of the usual marker keystrokes +mentioned <a href=#genmark>below</a> apply to these markers as well, e.g. +you can use MB1 to reposition on the panner window within the main image +display window, or to drag the region marker within the panner (pan the +image). Resizing the region marker zooms the image; this is a non-aspect +constrained zoom. The panner window itself can be resized by dragging a +corner with MB1. Typing delete or backspace anywhere in the panner window +deletes the panner. +<P> +A special case is MB2. Hitting MB2 anywhere in the panner window pans the +image to that point. This is analogous to typing MB2 in the main display +window to pan the image. + +<h3><a name=#coords>Coords Box Marker</a></h3> +<P> +Ximtool provides a limited notion of world coordinates, allowing frame +buffer pixel coordinates and pixel values to be converted to some arbitrary +client defined coordinate system. The coords box feature is used to display +these world coordinates as the pointer is moved about in the image window. +<P> +The quantities displayed in the coords box are X, Y, and Z: the X,Y world +coordinates of the pointer, and Z, the world equivalent of the pixel value +under the pointer. All coordinate systems are linear. The precision of a +displayed quantity is limited by the range of values of the associated raw +frame buffer value. For example, if the display window is 512x512 only 512 +coordinate values are possible in either axis (the positional precision can +be increased however by zooming the image). More seriously, at most about +200 pixel values can be displayed since this is the limit on the range of +pixel values loaded into the frame buffer. If a display pixel is saturated +a "+" will be displayed after the intensity value. +<P> +The coords box is a marker (text marker) and it can be moved and resized +with the pointer like any other marker. + +<h3><a name=#genmark>General Markers</a></h3> +Although ximtool doesn't do much with markers currently, they are a general +feature of the Gterm widget and are used more extensively in other programs +(e.g. the prototype IRAF science GUI applications). Ximtool uses markers +for the marker zoom feature discussed above, and also for the +<a href=#panner>panner</a> and the <a href=#coords>coords box</a>. All +markers share some of the same characteristics, so it is worthwhile learning +basic marker manipulation keystrokes. +<UL> +<LI> MB1 anywhere inside a marker may be used to drag the marker. +<LI> MB1 near a marker corner or edge, depending on the type of marker, +resizes the marker. +<LI> Shift-MB1 on the corner of most markers will rotate the marker. +<LI> Markers stack, if you have several markers and you put one on top +of the other. The active marker is highlighted to tell you which of the +stacked markers is active. If the markers overlap, this will be marker +"on top" in the stacking order. +<LI> MB2 in the body of a marker "lowers" the marker, i.e. moves it to +the bottom of the stacking order. +<LI> Delete or backspace in a marker deletes it. +<LI> Markers have their own translation resources and so the default +<a href=#keystroke>keystroke commands</a> will not be recognized when the +cursor is in a marker. +</UL> +For example, try placing the pointer anywhere in the coords box, then press +MB1 and hold it down, and drag the coords box marker somewhere else on the +screen. You can also resize the coords box by dragging a corner, or delete +it with the delete or backspace key. (The Initialize button will get the +original coords box back if you delete it). +<P> +<h4><a name=#markmenu>Marker Menu Options</a></h4> +<UL> +<LI> MB3 (mouse button 3) calls up the marker menu (by default). +<LI> <B>Zoom</B> does an equal aspect zoom of the region outlined by the marker. +In this way you can mark a region of the image and zoom it up. +<LI> <B>Fill</B> exactly zooms the area outlined by the marker, making it fill +the display window. Since the marker is not likely to be exactly square, +the aspect ratio of the resultant image will not be unitary. +<LI> <B>Print</B> prints the region outlined by the marker to the printer or +file currently configured by the <a href=#print>Print Panel</a>. +<LI> <B>Save</B> saves the region outlined by the marker to the file currently +configured by the <a href=#save>Save Panel</a>. +<LI> <B>Info</B> prints a description of the marked region. The text is +printed in the <a href=#info>Info Panel</a>. +<LI> <B>Unrotate</B> unrotates a rotated marker. +<LI> <B>Color</B> is a menu of possible marker colors. +<LI> <B>Type</B> is a menu of possible marker types. This is still a little +buggy and it isn't very useful, but you can use it to play with different +types of markers. +<LI> <B>Destroy</B> destroys the marker. You can also hit the delete or +backspace key in a marker to destroy the marker. +</UL> + +<hr> +<h2><a name=#control>Control Panel</a></h2> +<h3><a name=#cview>View Controls</a></h3> +<P> The <b>Frame</b> box will list only the frame buffers you currently have +defined. Currently, the only way to destroy a frame buffer is to change the +frame buffer configuration, new frame buffers (up to 4) will be created +automatically if requested by the client. +<P> The <b>text display window</b> gives the field X,Y center, X,Y scale +factors, and the X,Y zoom factors. The scale factor and the zoom factor +will be the same unless autoscale is enabled. The scale is in units of +display pixels per frame buffer pixel, and is an absolute measure (it doesn't +matter whether or not <a href=#cautoscale>autoscale</a> is enabled). Zoom is +relative to the autoscale factor, which is 1.0 if autoscaling is disabled. +This information is also presented in the <a href=#info>Info panel</a>. +<P> The numbers in the <b>Zoom</b> box are zoom factors. Blue numbers zoom, +red numbers dezoom. <b>Zoom In</b> and <b>Zoom Out</b> may be used to go to +larger or smaller zoom factors, e.g. "Ctrl-5" followed by "Zoom In" will get you +to zoom factor 10. Specific zoom factors may also be accessed directly as +Control <a href=#keystrokes>keystrokes</a>, e.g. Ctrl-5 will set zoom factor 5. +<b>Center</b> centers the field. <b>Toggle Zoom</b> toggles between the +current zoom/center values, and the unzoomed image. +<P> <b>Aspect</b> recomputes the view so that the aspect ratio is 1.0. +Aspect also integerizes the zoom factor (use the version in the View menu +if you don't want integerization). +<P> <b>Fit Frame</b> makes the display window the same size as the frame +buffer. Note that <a href=#cautoscale>autoscale</a> has much the same effect, +and allows you to resize the display window to any size you want, or view +images to large to fit on the screen. + +<h3><a name=#cenhance>Enhancement Controls</a></h3> + +<P> At the top is a scrolled list of all the <a href=#cbltin>available +colormaps</a>. Click on the one you want to load it. You can add your own +<a href=#cuser>colormaps</a> to this list. +<P> The two sliders adjust the <b>contrast</b> (upper slider) and +<b>brightness</b> (lower slider) of the display. The <b>Invert</b> button +inverts the colormap (multiples the contrast by -1.0). Note that due to the +use of the private colormap the sliders are a bit sluggish when dragged to +window the display. If this is annoying, using MB3 in the display window is +faster. +<P>The <b>Normalize</b> button (on the bottom of the control panel) will +normalize the enhancement, i.e. set the contrast and brightness to the default +one-to-one values (1.0, 0.5). This is the preferred setting for many of the +pseudocolor colortables and for private colormaps loaded from disk images. + +<h3><a name=#cblink>Blink Controls</a></h3> +<UL> +<LI> <b>Blink frames</b> is the list of frames to be blinked. When blink +mode is in effect ximtool just cycles through these frames endlessly, pausing +"blink rate" seconds between each frame. The same frame can be entered in +the list more than once. To program an arbitrary list of blink frames, hit +the <b>Reset</b> button and click on each blink frame button until it is set +to the desired frame number. +<LI> The <b>Blink Rate</b> can be adjusted as slow or as fast as you want +using the arrow buttons. If you set the blink rate small enough it will go +to zero, enabling single step mode (see below). +<LI> The <b>Register</b> button registers all the blink frames with the current +display frame. Frames not in the blink list are not affected. +<LI> The <b>Match LUTs</b> button sets the enhancement of all blink frames to +the same values as the display frame. Frames not in the blink list are not +affected. +<LI> The <b>Blink</b> button turns blink on and off. When the blink rate is +set to zero the Blink button will single step through the blink frames, one +frame per button press. +</UL> +<P> +NOTE: you can blink no matter what ximtool options are in effect, but many +of these will slow blink down. To get the fastest blink you may want to +turn off the panner and coords box, and match the LUTs of all the blink +frames. All the ximtool controls are fully active during blink mode, plus +you can load frames etc. + + +<h3><a name=#copts>Options:</a></h3> +<DL> +<DT><b><a name=#cautoscale>Autoscale</a></b></DT> +<DD> If autoscale is enabled then at zoom=1, the frame buffer will be +automatically scaled to fit within the display window. With autoscale +disabled (the default), the image scale is more predictable, but the image +may be clipped by the display window, or may not fill the display window.</DD> + +<DT><b><a name=#cantialias>Antialiasing</a></b></DT> +<DD> When dezooming an image, i.e., displaying a large image in a smaller +display window, antialiasing causes all the data to be used to compute the +displayed image. If antialiasing is disabled then image is subsampled to +compute the displayed image. Antialiasing can prevent subsampling from +omitting image features that don't fall in the sample grid, but it is +significantly slower than dezooming via subsampling. The default is no +antialising. </DD> + +<DT><b><a name=#ctile>Tile Frames</a></b></DT> +<DD> The default display mode is to view one frame at a time. In tile frames +mode, 2 or 4 frames may be viewed simultaneously in the display window. All +the usual operations (zoom and pan, colortable enhancement, cursor readback, +etc.) still work for each frame even when in tile frames mode. </DD> + +<DT><b><a name=#cwarnings>Warnings</a></b></DT> +<DD> The warnings options toggles whether you see warning dialog boxes in +situations like overwriting an existing file, clearing the frame buffer, etc. +</DD> +</DL> + +<h3><a name=#ccmap>Colormap Selection</a></h3> +By default XImtool will display images using either a grayscale colormap +if loaded by a client, or a private colormap when loading an image from +disk that contains a colormap. Each frame defines its own colormap so +you can define different colormaps or enhancements for each frame, they +will change automatically as you cycle through the frames. + +<h4><a name=#cbltin>Builtin Colormaps</a></h4> +Once loaded, the colormap may either be changed using the builtin colormap +menu under the <b>View</b> menu button on the main window, or from the +<a href=#cenhance>Enhancement</a> box on the <a href=#control>control panel</a>. Ximtool has about a dozen colormap +options builtin, other <a href=#cuser>user-defined colormaps</a> may +optionally be loaded. + +<h4><a name=#cuser>User-defined Colormaps</a></h4> +The cmap[12] and cmapDir[12] resources (or <a href=#comline>command line +arguments</a> are used to tell ximtool which specific colormaps to make +available or where to look for colortables respectively. The colortables +are loaded when ximtool starts up, or when it is reinitialized (e.g. by +pressing the <b>Initialize</b> button in the <a href=#control>control +panel</a>). Ximtool will ignore any files in the colormap directory +which do not look like colortables. New colortables will also be added +for each images loaded from disk. +<P> +The format of a user lookup table is very simple: each row defines one +colortable entry, and consists of three columns defining the red, green, +and blue values scaled to the range 0.0 (off) to 1.0 (full intensity). +<PRE> + R G B + R G B + (etc.) +</PRE> +Blank lines and comment lines (# ...) are ignored. +<P> +Usually 256 rows are provided, but the number may actually be anything in +the range 1 to 256. Ximtool will interpolate the table as necessary to +compute the colortable values used in Ximtool. Ximtool uses at most 201 +colors to render pixel data, so it is usually necessary to interpolate the +table when it is loaded. +<P> +The name of the colortable as it will appear in the Ximtool control panel +is the root name of the file, e.g., if the file is "rainbow.lut" the +colortable name will be "rainbow". Lower case names are suggested to avoid +name collisions with the builtin colortables. Private colormaps for disk +images will be have the same name as the image loaded. If the same colortable +file appears in multiple user colortable directories, the first one will be +used. +<P> +The directory "luts" in the ximtool source directory contains a sample set +of colortable files. This can be installed as /usr/local/lib/imtoolcmap +when ximtool is installed. +<hr> + +<h2><a name=#load>Load Panel</a></h2> +The Load Panel allows you load images from disk directly to the frame buffer, +this is analogous to loading an image on the command line except that +browsing is possible. At present recognized formats include IRAF OIF format +(i.e. .imh extension), simple FITS files, GIF, and Sun rasterfiles. The +task will automatically sense the format of the image and load it +appropriately. Images with private colormaps (such as GIF) will be loaded +using the private colormap by default (meaning that changing the +brightness/contrast enhancements will render a random-colored image). If +the <b>Grayscale</b> button is enabled the image will be converted to +grayscale and loaded with the standard grayscale colormap. +<P> +When loading new images the frame buffer configuration table +(<em>imtoolrc</em>) will be searched for a frame buffer that is the same size +or larger than the new image size, if no frame buffer can be found a custom +buffer exactly the size of the image will be created. This means that the +image may not fill the display window when loaded, or you may see a subsection +of the image in the main display window. Setting the +<a href=#cautoscale>autoscale</a> option will scale the entire image to fit +the main display window. +<P> +Images with more colors than can be displayed will automatically be quantized +to the number of available colors before display. Formats which allow more +than 8-bit pixels will be sampled to determine an optimal range in the data +to be used to compute the transformation to the number of display colors. +This is the same transformation used by the IRAF DISPLAY task. + +<DL> +<DT><B><a name=#lbrowse>Directory browsing</a></B></DT> +<DD> +The load panel contains a list of files in the current directory that may +be selected for loading by selecting with left mouse button. If the file +is a directory the contents of the new directory will be loaded, if it's +a plain file an attempt will be made to load it as an image. Directories +in the list are identified with a trailing '/' character, you will always +see any directories available even if a <a href=#lpattern>filter</a> is +specified. +<P> +The <b>Root</b> button will reset the current directory to the system root +directory. The <b>Home</b> button will reset the current directory to the +user's login directory, the <b>Up</b> button moves up one directory level, +and <b>Rescan</b> reloads the file list by rescanning the directory. The +current working directory is given below the file selection window.</DD> + +<DT><B><a name=#lpattern>File Patterns</a></B></DT> +<DD> By default all files and directories will be listed. You may specify a +filter to e.g. select only those files with a given extension like "*.fits" +to list only files with a ".fits" extension. Directories will always be seen +in the list and are identified with a trailing '/' character. Any valid +unix pattern matching string will be recognized.</DD> +<DT><B><a name=#lload>Direct File Load</a></B></DT> +<DD> If you know exactly which file you wish to load, you may enter its name +in the <b>Load File</b> text box and either hit <cr> or the Load button to +load it. An absolute or relative path name may be given, if a simple filename +is specified it will be searched for in the current working directory.</DD> +<DT><B><a name=#lframe>Frame Selections</a></B></DT> +<DD> By default images will be loaded into frame number 1, you may select a +different frame using the <b>Frame</b> menu button.</DD> +</DL> +<hr> + +<h2><a name=#save>Save Panel</a></h2> +The Save Panel lets you save the current contents of the main display window +to a disk file (including the Panner/Coords markers, any general graphics +markers, or overlay graphics displayed by the client program). Presently, +only the contents of the main display window may be saved, there is no +facility for saving the undisplayed contents of the entire frame buffer +other than to enable the <a href=#cautoscale>autoscale</a> feature. A limited +number of formats are currently available, others will be added in future +versions. +<DL> +<DT><b><a name=#sfname>File Name</a></b></DT> +<DD> The <b>File Name</b> text box allows you to enter the file name of the +saved file. A "%d" anywhere in the name will be replaced by a sequence number +allowing multiple frames to be saved with unique names. </DD> +<DT><b><a name=#sformat>Format</a></b></DT> +<DD> The <B>Format</B> box allows you to choose the format of the image to be +created. Not all formats are currently implemented. </DD> +<DT><b><a name=#scolor>Color</a></b></DT> +<DD> The <b>Color</b> box lets you choose the color type of the image to be +created. The options will change depending on the format, e.g. FITS doesn't +allow color so no color options will be allowed. Formats which allow 24-bit +images will be written using the current colormap after converting to a 24-bit +image, pseudocolor images will be written with the current colormap. </DD> +</DL> +<hr> + +<h2><a name=#print>Print Panel</a></h2> +The Print Panel allows you dump the contents of the main display window as +Enacpsulated Postscript to either a named printer device or to a disk file. +The <b>Print To</b> selects the type of output, the <b>Print Command</b> +box will adjust accordingly, either as a Unix printer command or as a file +name. A "%d" anywhere in the name for disk output will be replaced by a +sequence number allowing multiple frames to be saved with unique names. +<a href=#pprinter>Selecting printers</a> from the installed list will +automatically change the command to be used to generate the output. This +command does not necessarily need to be a printer command, the +<a href=#pprinter>printer configuration file</a> lets you define any command +string to process the image. +<h3><a name=#pcolors>Color Options</a></h3> +The <b>Color</b> box lets you choose the color type of the image to be created. +PseudoColor or 24-bit postscript will be created using the current colormap. +<h3><a name=#popts>Postscript Options</a></h3> +<DL> +<DT>Orientation</DT> +<DD> Set the page orientation. +<DT>Paper Size</DT> +<DD> Select the paper size to be used. +<DT>Image Scale</DT> +<DD> Set the scale factor used to compute the final image size. +</DL> +<h3><a name=#pproc>Processing Options</a></h3> +<DL> +<DT>Auto Scale</DT> +<DD> The auto scale toggles whether or not the image is automatically scaled +to fit the page. If not enabled, the <b>image scale</b> will be used to +dtermine the output image size. +<DT>Auto Rotate</DT> +<DD> Auto rotate determines whether or not the image will be rotated to fit +on the page. When set, an image larger than the current orientation will be +rotated and possibly scaled to fit the page. +<DT>Max Aspect</DT> +<DD> Max Aspect takes images smaller than the page and automatically increases +the scale so the image fills the page in the current orientation. +<DT>Annotate</DT> +<DD> The annotate option toggles whether or not the final file includes +annotation such as the image title, a colorbar, and axis labels. +</DL> +<h3><a name=#pprinter>Printer selection</a></h3> +The printer selection list lets choose the printer to be used. The printer +configuration file is /usr/local/lib/ximprint.cfg by default or may be reset +using the <em>printConfig</em> resource. The format of the file is simply +<pre> + <b>name</b> < tab > <em>command</em> +</pre> +The <b>name</b> value is what appears in the selection list and may be more +than a single word, the <em>command</em> can be any command that accepts EPS +input from a pipe, the two fields must be separated by a tab character. +Normally the command will be +a simple 'lpr -Pfoo' or some such, but can also include converters or +previewers. At most 128 printer commands may be used. +<hr> + +<h2><a name=#info>Info Panel</a></h2> + The information panel is underused at present but is meant to provide +basic information about the frame being displayed. It is updated to be +current while changing enhancements, pan/zoom regions, or frame selection. +In cases where the image title string is truncated in the main display window, +the user can always pop up the info window to see the full title. +<hr> + +<h2><a name=#tclshell>TclShell</a></h2> + The <em>TclShell</em> is mostly used as a development or debugging +tool for the GUI. It allows the user to type commands directly to the +TCL interpreter letting you send messages to the object manager or execute +specific procedures in the TCL code that makes up the GUI. Most users will +never need this, but for an example of what it does, bring it up and type a +command such as +<pre> + send helpButton set background red +</pre> +Cool, huh. +<hr> + +<h2><a name=#acknowledgements>Acknowledgements</a></h2> + <I>XImtool</I> was developed by the IRAF Group at the National Optical +Astronomy Observatories in Tucson, AZ. For further information or to report +problems please contact <I>iraf@noao.edu</I> +<hr> +This document was last updated 11/6/96. + +</BODY> +</HTML> diff --git a/vendor/x11iraf/guidemo/zscale.x b/vendor/x11iraf/guidemo/zscale.x new file mode 100644 index 00000000..d447f446 --- /dev/null +++ b/vendor/x11iraf/guidemo/zscale.x @@ -0,0 +1,437 @@ +# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + +include <imhdr.h> + +.help zscale +.nf ___________________________________________________________________________ +ZSCALE -- Compute the optimal Z1, Z2 (range of greyscale values to be +displayed) of an image. For efficiency a statistical subsample of an image +is used. The pixel sample evenly subsamples the image in x and y. The entire +image is used if the number of pixels in the image is smaller than the desired +sample. + +The sample is accumulated in a buffer and sorted by greyscale value. +The median value is the central value of the sorted array. The slope of a +straight line fitted to the sorted sample is a measure of the standard +deviation of the sample about the median value. Our algorithm is to sort +the sample and perform an iterative fit of a straight line to the sample, +using pixel rejection to omit gross deviants near the endpoints. The fitted +straight line is the transfer function used to map image Z into display Z. +If more than half the pixels are rejected the full range is used. The slope +of the fitted line is divided by the user-supplied contrast factor and the +final Z1 and Z2 are computed, taking the origin of the fitted line at the +median value. +.endhelp ______________________________________________________________________ + +define MIN_NPIXELS 5 # smallest permissible sample +define MAX_REJECT 0.5 # max frac. of pixels to be rejected +define GOOD_PIXEL 0 # use pixel in fit +define BAD_PIXEL 1 # ignore pixel in all computations +define REJECT_PIXEL 2 # reject pixel after a bit +define KREJ 2.5 # k-sigma pixel rejection factor +define MAX_ITERATIONS 5 # maximum number of fitline iterations + + +# ZSCALE -- Sample the image and compute Z1 and Z2. + +procedure zscale (im, z1, z2, contrast, optimal_sample_size, len_stdline) + +pointer im # image to be sampled +real z1, z2 # output min and max greyscale values +real contrast # adj. to slope of transfer function +int optimal_sample_size # desired number of pixels in sample +int len_stdline # optimal number of pixels per line + +int npix, minpix, ngoodpix, center_pixel, ngrow +real zmin, zmax, median +real zstart, zslope +pointer sample, left +int zsc_sample_image(), zsc_fit_line() + +begin + # Subsample the image. + npix = zsc_sample_image (im, sample, optimal_sample_size, len_stdline) + center_pixel = max (1, (npix + 1) / 2) + + # Sort the sample, compute the minimum, maximum, and median pixel + # values. + + call asrtr (Memr[sample], Memr[sample], npix) + zmin = Memr[sample] + zmax = Memr[sample+npix-1] + + # The median value is the average of the two central values if there + # are an even number of pixels in the sample. + + left = sample + center_pixel - 1 + if (mod (npix, 2) == 1 || center_pixel >= npix) + median = Memr[left] + else + median = (Memr[left] + Memr[left+1]) / 2 + + # Fit a line to the sorted sample vector. If more than half of the + # pixels in the sample are rejected give up and return the full range. + # If the user-supplied contrast factor is not 1.0 adjust the scale + # accordingly and compute Z1 and Z2, the y intercepts at indices 1 and + # npix. + + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + ngrow = max (1, nint (npix * .01)) + ngoodpix = zsc_fit_line (Memr[sample], npix, zstart, zslope, + KREJ, ngrow, MAX_ITERATIONS) + + if (ngoodpix < minpix) { + z1 = zmin + z2 = zmax + } else { + if (contrast > 0) + zslope = zslope / contrast + z1 = max (zmin, median - (center_pixel - 1) * zslope) + z2 = min (zmax, median + (npix - center_pixel) * zslope) + } + + call mfree (sample, TY_REAL) +end + + +# ZSC_SAMPLE_IMAGE -- Extract an evenly gridded subsample of the pixels from +# a two-dimensional image into a one-dimensional vector. + +int procedure zsc_sample_image (im, sample, optimal_sample_size, len_stdline) + +pointer im # image to be sampled +pointer sample # output vector containing the sample +int optimal_sample_size # desired number of pixels in sample +int len_stdline # optimal number of pixels per line + +int ncols, nlines, col_step, line_step, maxpix, line +int opt_npix_per_line, npix_per_line +int opt_nlines_in_sample, min_nlines_in_sample, max_nlines_in_sample +pointer op +pointer imgl2r() + +begin + ncols = IM_LEN(im,1) + nlines = IM_LEN(im,2) + + # Compute the number of pixels each line will contribute to the sample, + # and the subsampling step size for a line. The sampling grid must + # span the whole line on a uniform grid. + + opt_npix_per_line = max (1, min (ncols, len_stdline)) + col_step = max (1, (ncols + opt_npix_per_line-1) / opt_npix_per_line) + npix_per_line = max (1, (ncols + col_step-1) / col_step) + + # Compute the number of lines to sample and the spacing between lines. + # We must ensure that the image is adequately sampled despite its + # size, hence there is a lower limit on the number of lines in the + # sample. We also want to minimize the number of lines accessed when + # accessing a large image, because each disk seek and read is expensive. + # The number of lines extracted will be roughly the sample size divided + # by len_stdline, possibly more if the lines are very short. + + min_nlines_in_sample = max (1, optimal_sample_size / len_stdline) + opt_nlines_in_sample = max(min_nlines_in_sample, min(nlines, + (optimal_sample_size + npix_per_line-1) / npix_per_line)) + line_step = max (1, nlines / (opt_nlines_in_sample)) + max_nlines_in_sample = (nlines + line_step-1) / line_step + + # Allocate space for the output vector. Buffer must be freed by our + # caller. + + maxpix = npix_per_line * max_nlines_in_sample + call malloc (sample, maxpix, TY_REAL) + + # Extract the vector. + op = sample + do line = (line_step + 1) / 2, nlines, line_step { + call zsc_subsample (Memr[imgl2r(im,line)], Memr[op], + npix_per_line, col_step) + op = op + npix_per_line + if (op - sample + npix_per_line > maxpix) + break + } + + return (op - sample) +end + + +# ZSC_SUBSAMPLE -- Subsample an image line. Extract the first pixel and +# every "step"th pixel thereafter for a total of npix pixels. + +procedure zsc_subsample (a, b, npix, step) + +real a[ARB] +real b[npix] +int npix, step +int ip, i + +begin + if (step <= 1) + call amovr (a, b, npix) + else { + ip = 1 + do i = 1, npix { + b[i] = a[ip] + ip = ip + step + } + } +end + + +# ZSC_FIT_LINE -- Fit a straight line to a data array of type real. This is +# an iterative fitting algorithm, wherein points further than ksigma from the +# current fit are excluded from the next fit. Convergence occurs when the +# next iteration does not decrease the number of pixels in the fit, or when +# there are no pixels left. The number of pixels left after pixel rejection +# is returned as the function value. + +int procedure zsc_fit_line (data, npix, zstart, zslope, krej, ngrow, maxiter) + +real data[npix] # data to be fitted +int npix # number of pixels before rejection +real zstart # Z-value of pixel data[1] (output) +real zslope # dz/pixel (output) +real krej # k-sigma pixel rejection factor +int ngrow # number of pixels of growing +int maxiter # max iterations + +int i, ngoodpix, last_ngoodpix, minpix, niter +real xscale, z0, dz, x, z, mean, sigma, threshold +double sumxsqr, sumxz, sumz, sumx, rowrat +pointer sp, flat, badpix, normx +int zsc_reject_pixels(), zsc_compute_sigma() + +begin + call smark (sp) + + if (npix <= 0) + return (0) + else if (npix == 1) { + zstart = data[1] + zslope = 0.0 + return (1) + } else + xscale = 2.0 / (npix - 1) + + # Allocate a buffer for data minus fitted curve, another for the + # normalized X values, and another to flag rejected pixels. + + call salloc (flat, npix, TY_REAL) + call salloc (normx, npix, TY_REAL) + call salloc (badpix, npix, TY_SHORT) + call aclrs (Mems[badpix], npix) + + # Compute normalized X vector. The data X values [1:npix] are + # normalized to the range [-1:1]. This diagonalizes the lsq matrix + # and reduces its condition number. + + do i = 0, npix - 1 + Memr[normx+i] = i * xscale - 1.0 + + # Fit a line with no pixel rejection. Accumulate the elements of the + # matrix and data vector. The matrix M is diagonal with + # M[1,1] = sum x**2 and M[2,2] = ngoodpix. The data vector is + # DV[1] = sum (data[i] * x[i]) and DV[2] = sum (data[i]). + + sumxsqr = 0 + sumxz = 0 + sumx = 0 + sumz = 0 + + do i = 1, npix { + x = Memr[normx+i-1] + z = data[i] + sumxsqr = sumxsqr + (x ** 2) + sumxz = sumxz + z * x + sumz = sumz + z + } + + # Solve for the coefficients of the fitted line. + z0 = sumz / npix + dz = sumxz / sumxsqr + + # Iterate, fitting a new line in each iteration. Compute the flattened + # data vector and the sigma of the flat vector. Compute the lower and + # upper k-sigma pixel rejection thresholds. Run down the flat array + # and detect pixels to be rejected from the fit. Reject pixels from + # the fit by subtracting their contributions from the matrix sums and + # marking the pixel as rejected. + + ngoodpix = npix + minpix = max (MIN_NPIXELS, int (npix * MAX_REJECT)) + + for (niter=1; niter <= maxiter; niter=niter+1) { + last_ngoodpix = ngoodpix + + # Subtract the fitted line from the data array. + call zsc_flatten_data (data, Memr[flat], Memr[normx], npix, z0, dz) + + # Compute the k-sigma rejection threshold. In principle this + # could be more efficiently computed using the matrix sums + # accumulated when the line was fitted, but there are problems with + # numerical stability with that approach. + + ngoodpix = zsc_compute_sigma (Memr[flat], Mems[badpix], npix, + mean, sigma) + threshold = sigma * krej + + # Detect and reject pixels further than ksigma from the fitted + # line. + ngoodpix = zsc_reject_pixels (data, Memr[flat], Memr[normx], + Mems[badpix], npix, sumxsqr, sumxz, sumx, sumz, threshold, + ngrow) + + # Solve for the coefficients of the fitted line. Note that after + # pixel rejection the sum of the X values need no longer be zero. + + if (ngoodpix > 0) { + rowrat = sumx / sumxsqr + z0 = (sumz - rowrat * sumxz) / (ngoodpix - rowrat * sumx) + dz = (sumxz - z0 * sumx) / sumxsqr + } + + if (ngoodpix >= last_ngoodpix || ngoodpix < minpix) + break + } + + # Transform the line coefficients back to the X range [1:npix]. + zstart = z0 - dz + zslope = dz * xscale + + call sfree (sp) + return (ngoodpix) +end + + +# ZSC_FLATTEN_DATA -- Compute and subtract the fitted line from the data array, +# returned the flattened data in FLAT. + +procedure zsc_flatten_data (data, flat, x, npix, z0, dz) + +real data[npix] # raw data array +real flat[npix] # flattened data (output) +real x[npix] # x value of each pixel +int npix # number of pixels +real z0, dz # z-intercept, dz/dx of fitted line +int i + +begin + do i = 1, npix + flat[i] = data[i] - (x[i] * dz + z0) +end + + +# ZSC_COMPUTE_SIGMA -- Compute the root mean square deviation from the +# mean of a flattened array. Ignore rejected pixels. + +int procedure zsc_compute_sigma (a, badpix, npix, mean, sigma) + +real a[npix] # flattened data array +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +real mean, sigma # (output) + +real pixval +int i, ngoodpix +double sum, sumsq, temp + +begin + sum = 0 + sumsq = 0 + ngoodpix = 0 + + # Accumulate sum and sum of squares. + do i = 1, npix + if (badpix[i] == GOOD_PIXEL) { + pixval = a[i] + ngoodpix = ngoodpix + 1 + sum = sum + pixval + sumsq = sumsq + pixval ** 2 + } + + # Compute mean and sigma. + switch (ngoodpix) { + case 0: + mean = INDEF + sigma = INDEF + case 1: + mean = sum + sigma = INDEF + default: + mean = sum / ngoodpix + temp = sumsq / (ngoodpix - 1) - sum**2 / (ngoodpix * (ngoodpix - 1)) + if (temp < 0) # possible with roundoff error + sigma = 0.0 + else + sigma = sqrt (temp) + } + + return (ngoodpix) +end + + +# ZSC_REJECT_PIXELS -- Detect and reject pixels more than "threshold" greyscale +# units from the fitted line. The residuals about the fitted line are given +# by the "flat" array, while the raw data is in "data". Each time a pixel +# is rejected subtract its contributions from the matrix sums and flag the +# pixel as rejected. When a pixel is rejected reject its neighbors out to +# a specified radius as well. This speeds up convergence considerably and +# produces a more stringent rejection criteria which takes advantage of the +# fact that bad pixels tend to be clumped. The number of pixels left in the +# fit is returned as the function value. + +int procedure zsc_reject_pixels (data, flat, normx, badpix, npix, + sumxsqr, sumxz, sumx, sumz, threshold, ngrow) + +real data[npix] # raw data array +real flat[npix] # flattened data array +real normx[npix] # normalized x values of pixels +short badpix[npix] # bad pixel flags (!= 0 if bad pixel) +int npix +double sumxsqr,sumxz,sumx,sumz # matrix sums +real threshold # threshold for pixel rejection +int ngrow # number of pixels of growing + +int ngoodpix, i, j +real residual, lcut, hcut +double x, z + +begin + ngoodpix = npix + lcut = -threshold + hcut = threshold + + do i = 1, npix + if (badpix[i] == BAD_PIXEL) + ngoodpix = ngoodpix - 1 + else { + residual = flat[i] + if (residual < lcut || residual > hcut) { + # Reject the pixel and its neighbors out to the growing + # radius. We must be careful how we do this to avoid + # directional effects. Do not turn off thresholding on + # pixels in the forward direction; mark them for rejection + # but do not reject until they have been thresholded. + # If this is not done growing will not be symmetric. + + do j = max(1,i-ngrow), min(npix,i+ngrow) { + if (badpix[j] != BAD_PIXEL) { + if (j <= i) { + x = normx[j] + z = data[j] + sumxsqr = sumxsqr - (x ** 2) + sumxz = sumxz - z * x + sumx = sumx - x + sumz = sumz - z + badpix[j] = BAD_PIXEL + ngoodpix = ngoodpix - 1 + } else + badpix[j] = REJECT_PIXEL + } + } + } + } + + return (ngoodpix) +end |