path: root/vendor/x11iraf/ximtool/gui/toolbars.tcl

################################################################################
#
#  XIMTOOL-ALT -- Procedures and declarations for the ALT GUI.
#
################################################################################

# Creat the bitmaps needed for the alternate optional bars.

createBitmap tools 16 16 {
   0xff, 0xff, 0xff, 0xff, 0x03, 0xc0, 0xf3, 0xcf, 0xf3, 0xcf, 0xf3, 0xcf,
   0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1,
   0x83, 0xc1, 0x03, 0xc0, 0xff, 0xff, 0xff, 0xff};

createBitmap control 16 16 {
   0xff, 0xff, 0xff, 0xff, 0x03, 0xc0, 0xe3, 0xc7, 0xe3, 0xcf, 0x33, 0xcc,
   0x33, 0xc0, 0x1b, 0xc0, 0x1b, 0xc0, 0x1b, 0xc0, 0x33, 0xcc, 0xf3, 0xcf,
   0xe3, 0xc7, 0x03, 0xc0, 0xff, 0xff, 0xff, 0xff};

createBitmap tile 16 16 {
   0xff, 0xff, 0xff, 0xff, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1,
   0x83, 0xc1, 0xff, 0xff, 0xff, 0xff, 0x83, 0xc1, 0x83, 0xc1, 0x83, 0xc1,
   0x83, 0xc1, 0x83, 0xc1, 0xff, 0xff, 0xff, 0xff};

createBitmap compass 16 16 {
   0x00, 0x00, 0x00, 0x02, 0x00, 0x07, 0x80, 0x0f, 0xc0, 0x1f, 0x00, 0x07,
   0x00, 0x07, 0x00, 0x07, 0x00, 0x07, 0x00, 0x07, 0x00, 0x07, 0xfc, 0x07,
   0xfc, 0x07, 0xfc, 0x07, 0x00, 0x00, 0x00, 0x00}

createBitmap plus 11 11 {
   0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe, 0x03, 0xfe, 0x03,
   0xfe, 0x03, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x00, 0x00};

createBitmap minus 11 11 {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, 0xfe, 0x03,
   0xfe, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};

createBitmap disk 16 16 {
 0xfe,0x1f,0x11,0x25,0x11,0x45,0x11,0x44,0xf1,0x47,0x01,0x40,0x01,0x40,0xf9,
 0x4f,0x05,0x50,0x05,0x50,0x05,0x50,0x05,0x50,0x05,0x50,0x05,0x50,0xff,0x7f,
 0x00,0x00};

createBitmap printer 32 16 {
   0x00, 0xfe, 0x07, 0x00, 0x00, 0x02, 0x0a, 0x00, 0x00, 0x02, 0x12, 0x00,
   0x00, 0x02, 0x22, 0x00, 0x00, 0x02, 0x3e, 0x00, 0x00, 0x02, 0x20, 0x00,
   0x00, 0x02, 0x20, 0x00, 0xe0, 0x03, 0xe0, 0x03, 0x10, 0x03, 0xe0, 0x06,
   0x08, 0xff, 0x7f, 0x09, 0x04, 0x00, 0x00, 0x10, 0xfc, 0xff, 0xff, 0x1f,
   0x04, 0x00, 0x00, 0x10, 0xfc, 0xff, 0xff, 0x1f, 0x08, 0x00, 0x00, 0x08,
   0xf8, 0xff, 0xff, 0x0f};


send tbBlinkDec   "set bitmap larrow" 	;# Assign the bitmaps to the buttons.
send tbBlinkInc   "set bitmap rarrow"
send tbZoomIn     "set bitmap plus"
send tbZoomOut    "set bitmap minus"
send tbTile       "set bitmap tile"
send tbCompass    "set bitmap compass;  addCallback toggleCompass"
#send helpButton   "set bitmap qmark;    addCallback Help"
send mXflipButton "set bitmap xflip;    addCallback xflip"
send mYflipButton "set bitmap yflip;    addCallback yflip"
send mNextButton  "set bitmap rarrow;   addCallback nextFrame"
send mPrevButton  "set bitmap larrow;   addCallback prevFrame"


# toolBox -- Toggle the toolbox and panelbar display.

set toolbox_up [ true $showToolBar ]
set panelbar_up [ true $showPanelBar ]

proc toolBoxToggle args \
{
    global toolbox_up 

    set w  [send display get width]  ; set h  [send display get height]
    set iw [send imagewin get width] ; set ih [send imagewin get height]

    if {$toolbox_up} {
	send toolbar set height 0
	send toolButton set state 0
        send imagewin "set width $iw; set height $ih"
	set nh [expr $h - 25]
	send display "set width $w; set height $nh"
	set toolbox_up 0
	send mXflipButton map
	send mYflipButton map
	send mPrevButton map
	send mFrameButton map
	send mNextButton map
    } else {
	send toolbar set height 25
	send toolButton set state 1
        send imagewin "set width $iw; set height $ih"
	set nh [expr $h + 25]
	send display "set width $w ; set height $nh"
	set toolbox_up 1
	send mXflipButton unmap
	send mYflipButton unmap
	send mPrevButton unmap
	send mFrameButton unmap
	send mNextButton unmap
    }
}

proc panelBarToggle args \
{
    global panelbar_up

    set w  [send display get width]  ; set h  [send display get height]
    set iw [send imagewin get width] ; set ih [send imagewin get height]

    if {$panelbar_up} {
	send panelbar set height 0
	send panelButton set state 0
        send imagewin "set width $iw; set height $ih"
	set nh [expr $h - 25]
	send display "set width $w ; set height $nh"
	set panelbar_up 0
    } else {
	send panelbar set height 25
	send panelButton set state 1
        send imagewin "set width $iw; set height $ih"
	set nh [expr $h + 25]
	send display "set width $w ; set height $nh"
	set panelbar_up 1
    }
}



# Initialize the bars to be displayed if the resource was set.

send toolButton   "set bitmap tools;    addCallback toolBoxToggle"
if { ! [ true $showToolBar ] } {
    send display set height [expr [send display get height] - 25]
    send toolbar set height 0
    send toolButton set state 0
} else {
    send toolButton set state 1
    send mXflipButton unmap
    send mYflipButton unmap
    send mPrevButton unmap
    send mFrameButton unmap
    send mNextButton unmap
}

send panelButton  "deleteCallback panel"
send panelButton  "set bitmap control;  addCallback panelBarToggle"

if { ! [ true $showPanelBar ] } {
    send display set height [expr [send display get height] - 25]
    send panelbar set height 0
    send panelButton set state 0
} else {
    send panelButton set state 1
}


##############################################
# Panelbar callbacks.
##############################################

send pbQuit  addCallback Quit
send helpClose addCallback "send helpButton set state 0"


# Control Panel.
#------------------------------------------------------
proc pbToggleControl {name element op} \
{
    upvar $name panel_up
    send pbDisplayP set state [expr !($panel_up)]
} ; #trace variable panel_up w pbToggleControl

proc pbResetPanel {param old new} \
{
    global displayPanner displayMagnifier displayCoords
    switch $new {
    done	{ send pbPanM set state [true $displayPanner]
		  send pbMagM set state [true $displayMagnifier]
		  send pbWcsM set state [true $displayCoords]
		}
    }
} ; send initialize addCallback pbResetPanel

set WidgetToTab(pbDisplayP)	display_panel
set WidgetToTab(pbInfoP)	info_panel
set WidgetToTab(pbLoadP)	load_panel
set WidgetToTab(pbPrintP)	print_panel
set WidgetToTab(pbSaveP)	save_panel
set WidgetToTab(pbTileP)	tile_panel
set WidgetToTab(pbCoordP)	wcs_panel

set TabToWidget(display_panel)	pbDisplayP
set TabToWidget(print_panel)	pbPrintP
set TabToWidget(load_panel)	pbLoadP
set TabToWidget(save_panel)	pbSaveP
set TabToWidget(info_panel)	pbInfoP
set TabToWidget(tile_panel)	pbTileP
set TabToWidget(wcs_panel)	pbCoordP

set pbTabTop	"pbDisplayP"

proc pbPanelDismiss args \
{
    global tabTop TabToWidget WidgetToTab
    set panel $TabToWidget($tabTop)
    send $panel set state 0
} ; send panelClose addCallback pbPanelDismiss

proc pbResizeCB {widget event a b c d e args} \
{
    global pbTabTop TabToWidget WidgetToTab
    if { $a == 0 && $b == 0 && $c == 0 && $d == 0 && $e == 0 } {
	send $pbTabTop set state 0
	set new $TabToWidget($widget)
	send $new set state 1
	set pbTabTop $new
    }
} ; foreach w $cpTabs {send $w addEventHandler pbResizeCB exposureMask}

proc pbPanelTabs { widget type state args } \
{
    global pbTabTop tabTop panel_up
    global TabToWidget WidgetToTab

    set panel $WidgetToTab($widget)
    if {$tabTop == $panel && $panel_up} {
        send panelShell unmap
        send $widget set state 0
        set panel_up 0
        return
    }

    send $TabToWidget($tabTop) set state 0
    set tabTop $panel
    set pbTabTop $TabToWidget($panel)
    send panelTabs setTop $panel

    # Now fire it up if it's not already open.
    if {$panel_up == 0} {
        send $widget set state 1
        send panelShell map
        set panel_up 1
    }
}
foreach w { pbDisplayP pbInfoP pbLoadP pbPrintP pbSaveP pbTileP pbCoordP } {
        send $w addCallback pbPanelTabs
}



# Load Panel.  (Really need to clean this up.)
#------------------------------------------------------
proc pbDoLoadOptions { param old new } \
{
    set val     [ join [lrange $new 1 end] " " ]
    switch [lindex $new 0] {
    newfile     { send fnameText set string $val }
    }
} ; send loadOptions addCallback pbDoLoadOptions

proc pbFileLoad { widget mode fname args } \
{
    set fpath [format "%s/%s" \
        [string range [send dirLabel get label] 12 end] $fname ]
    send imagewin setCursorType idle
} ; send fnameText addCallback pbFileLoad

proc pbflSelectPrint {widget cbtype selections args} \
{
    foreach selection $selections {
	;
    }
}; #send imageList addCallback pbflSelectPrint

proc pbFileLoadB args \
{
    set fname [send fnameText get string]
    if {$fname != ""} {
        set fpath [format "%s/%s" \
            [string range [send dirLabel get label] 12 end] $fname ]
    }
} ; send filesLoadButton addCallback pbFileLoadB


# Panner Marker.
#------------------------------------------------------
proc pbTracePanner {name element op} \
{
    global last_compass

    catch {
        upvar $name panner_enable
        send pbPanM set state $panner_enable

	if { $panner_enable } {
	    send tbCompass "setSensitive True  ; set state $last_compass"
	    drawCompass
	} else {
	    send tbCompass "setSensitive False ; set state False"
	    eraseCompass
	}
    }
} ; trace variable panner_enable w pbTracePanner

proc pannerPanel args \
{
    global panner_enable displayPanner

    setPanner [expr !$panner_enable]
    send pannerButton set on [expr $panner_enable]
}; send pbPanM  addCallback pannerPanel


# Magnifier Marker.
#------------------------------------------------------
proc pbTraceMagnifier {name element op} \
{
    upvar $name magnifier_enable
    send pbMagM set state $magnifier_enable
} ; trace variable magnifier_enable w pbTraceMagnifier

proc magnifierPanel args \
{
    global magnifier_enable displayMagnifier
    setMagnifier [expr !$magnifier_enable]
    send magnifierButton set on  [expr $magnifier_enable]
}; send pbMagM addCallback magnifierPanel


# CoordsBox Marker.
#------------------------------------------------------
proc pbTraceCoordsBox {name element op} \
{
    upvar $name track_enable
    send pbWcsM set state $track_enable
} ; trace variable track_enable w pbTraceCoordsBox

proc wcsPanel args \
{
    global track_enable
    setTrack [expr !$track_enable]
}; send pbWcsM  addCallback wcsPanel



# WPIX ISM Callbacks.
#------------------------------------------------------

proc altIsmToggle { widget type state args } \
{
    ismToggle pbIsm junk $state
} ; send pbIsm addCallback altIsmToggle

proc pbTraceIsm {name element op} \
{
    upvar $name ism_enable
    send pbIsm set state $ism_enable
} ; trace variable ism_enable w pbTraceIsm


proc altIsmMsgCB { param old new } \
{
    set cmd  [lindex $new 0]                            ;# command name
    set ism  [lindex $new 1]                            ;# determine ISM name
    set argv [lrange $new 2 end]                        ;# get args
    set argc [llength $argv]

    switch  $cmd {
    deliver  { ${ism}_alt_msg $argc $argv           }
    }
} ; send ism_msg addCallback altIsmMsgCB


proc wcspix_alt_msg { argc argv } \
{
    set arg [string trimleft [ string trimright [lindex $argv 0] ] ]
    set cmd [lindex $arg 0]
    switch $cmd {
    startup	{ }
    shutdown	{ }
    disable	{ send pbIsm "set state False ; setSensitive False" }
    capable	{ send pbIsm "setSensitive True" }
    }
}



##############################################
# Toolbar callbacks.
##############################################

send tbNormalize	addCallback normalize
send tbInvert		addCallback cpInvert
send tbRegister		addCallback cpRegisterFrames
send tbMatchLUT		addCallback cpMatchFrames


# Frame Selection.
#------------------
createMenu mFrameMenu mFrameButton $frameMenuDescription

proc altFrameChanged {param old new} \
{
    send mFrameButton set label $new
} ; send frame addCallback altFrameChanged


# Image Flipping.
#------------------------------------------------------
proc tbSetFlip {param old new} \
{
    if {$param == "xflip"} {
        send mXflipButton set state [true $new]
    } else {
        send mYflipButton set state [true $new]
    }
}; foreach i {xflip yflip} { send $i addCallback tbSetFlip }


# Zoom/Pan buttons.
#------------------------------------------------------
proc tbZoomAction { widget args } \
{
    global frameWidth frameHeight

    switch $widget {
    tbZoom0   { cpZoom 1 1 fixed }
    tbZoomIn  { cpZoom 2.0 2.0 relative }
    tbZoomOut { cpZoom 0.5 0.5 relative }
    tbCenter  { send client pan [expr $frameWidth/2.0] [expr $frameHeight/2.0] }
    }
}
foreach widget { tbCenter tbZoomIn tbZoom0 tbZoomOut } {
    send $widget addCallback tbZoomAction
}


# Frame Blink.
#------------------------------------------------------
proc tbSetBlinkRate {w args} \
{
    if {$w == "tbBlinkInc"} {
	cpSetBlinkRate BRincrease
    } else {
	cpSetBlinkRate BRdeccrease
    }
}
foreach w  {tbBlinkDec tbBlinkInc} { send $w addCallback tbSetBlinkRate }

proc tbBlink { widget args } \
{
    global blinkRate blinkId

    if {$blinkRate < 0.01} {
	send tbBlink set state 0
    } else {
        if {$widget != "tbBlink"} {
            if {($blinkId != 0) != [send $widget get on]} {
                toggleBlink
            }
        } else {
            if {($blinkId != 0) != [send $widget get state]} {
                toggleBlink
            }
        }
    }
} ; send tbBlink addCallback tbBlink

proc tbTraceBlink {name element op} \
{
    upvar $name blinkId
    send tbBlink set state [expr $blinkId != 0]
} ; trace variable blinkId w tbTraceBlink


# Auto-register.
#------------------------------------------------------
proc tbAutoRegister { widget type state args } \
{
    send tbAutoReg set state $state
}
foreach w {autoregButton brAregButton tbAutoReg} {
    send $w addCallback cpAutoRegister
}

proc tbToggleAutoReg args \
{
    global auto_reg
    if {$auto_reg} {
        cpAutoRegister autoregButton dummy 0
        set auto_reg 0
        send tbAutoReg set state 0
    } else {
        cpAutoRegister autoregButton dummy 1
        set auto_reg 1
        send tbAutoReg set state 1
    }
}


# Frame Tiles.
#------------------------------------------------------
proc tbSetTileFrames args \
{
    global tileOpt

    # Send the option to the client.
    if {[send tbTile get state ]} {
	if {$tileOpt == 0} {
	    # If mode is disabled, turn on the tile selection.
            selectTileOrientation junk junk Best
	} else {
	    # Otherwise, turn on in current mode.
            selectTileOrientation junk junk [tileSelToLabel $tileOpt]
	}
    } else {
        selectTileOrientation junk junk Disabled
    }
}; send tbTile addCallback tbSetTileFrames

proc tbTrackTileFrames {param old new} \
{
    send tileFramesButton set on [true $new]
    send tbTile set state $new
}; send tileFrames addCallback tbTrackTileFrames

proc tbTileFramesToggle args \
{
    set value [send tileFramesButton get on]
    if {$value} { set not 0 } else { set not 1 }

    send tileFramesButton set on $not
    send tbTile set state $not
    cpSetTileFrames tbTile junk $not
}


# Compass Indicator.
#------------------------------------------------------
proc tbToggleCompass { widget type state args } \
{
    global frame

    if {$state} {
	send compass set on True
	send tbCompass set state 1
        drawCompass
    } else {
	send compass set on False
	send tbCompass set state 0
        eraseCompass
    }
} ; foreach w {compass tbCompass} { send $w addCallback tbToggleCompass }