#!/bin/sh # the next line restarts using wish\ exec wish "$0" "$@" if {![info exists vTcl(sourcing)]} { package require Tk switch $tcl_platform(platform) { windows { option add *Button.padY 0 } default { option add *Scrollbar.width 10 option add *Scrollbar.highlightThickness 0 option add *Scrollbar.elementBorderWidth 2 option add *Scrollbar.borderWidth 2 } } } ############################################################################# # Visual Tcl v1.60 Project # ############################################################################# ## vTcl Code to Load Stock Images if {![info exist vTcl(sourcing)]} { ############################################################################# ## Procedure: vTcl:rename proc ::vTcl:rename {name} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. regsub -all "\\." $name "_" ret regsub -all "\\-" $ret "_" ret regsub -all " " $ret "_" ret regsub -all "/" $ret "__" ret regsub -all "::" $ret "__" ret return [string tolower $ret] } ############################################################################# ## Procedure: vTcl:image:create_new_image proc ::vTcl:image:create_new_image {filename {description {no description}} {type {}} {data {}}} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. # Does the image already exist? if {[info exists ::vTcl(images,files)]} { if {[lsearch -exact $::vTcl(images,files) $filename] > -1} { return } } if {![info exists ::vTcl(sourcing)] && [string length $data] > 0} { set object [image create [vTcl:image:get_creation_type $filename] -data $data] } else { # Wait a minute... Does the file actually exist? if {! [file exists $filename] } { # Try current directory set script [file dirname [info script]] set filename [file join $script [file tail $filename] ] } if {![file exists $filename]} { set description "file not found!" ## will add 'broken image' again when img is fixed, for now create empty set object [image create photo -width 1 -height 1] } else { set object [image create [vTcl:image:get_creation_type $filename] -file $filename] } } set reference [vTcl:rename $filename] set ::vTcl(images,$reference,image) $object set ::vTcl(images,$reference,description) $description set ::vTcl(images,$reference,type) $type set ::vTcl(images,filename,$object) $filename lappend ::vTcl(images,files) $filename lappend ::vTcl(images,$type) $object # return image name in case caller might want it return $object } ############################################################################# ## Procedure: vTcl:image:get_image proc ::vTcl:image:get_image {filename} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. set reference [vTcl:rename $filename] # Let's do some checking first if {![info exists ::vTcl(images,$reference,image)]} { # Well, the path may be wrong; in that case check # only the filename instead, without the path. set imageTail [file tail $filename] foreach oneFile $::vTcl(images,files) { if {[file tail $oneFile] == $imageTail} { set reference [vTcl:rename $oneFile] break } } } return $::vTcl(images,$reference,image) } ############################################################################# ## Procedure: vTcl:image:get_creation_type proc ::vTcl:image:get_creation_type {filename} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. switch [string tolower [file extension $filename]] { .ppm - .jpg - .bmp - .gif {return photo} .xbm {return bitmap} default {return photo} } } foreach img { } { eval set _file [lindex $img 0] vTcl:image:create_new_image\ $_file [lindex $img 1] [lindex $img 2] [lindex $img 3] } } ############################################################################# ## vTcl Code to Load User Images catch {package require Img} foreach img { {{[file join / export-4 ncosrvnfs-cp hpcops grids cliqr_new noaasealandgull_small.gif]} {user image} user {}} } { eval set _file [lindex $img 0] vTcl:image:create_new_image\ $_file [lindex $img 1] [lindex $img 2] [lindex $img 3] } ############################################################################# # vTcl Code to Load Stock Fonts if {![info exist vTcl(sourcing)]} { set vTcl(fonts,counter) 0 ############################################################################# ## Procedure: vTcl:font:add_font proc ::vTcl:font:add_font {font_descr font_type {newkey {}}} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. if {[info exists ::vTcl(fonts,$font_descr,object)]} { ## cool, it already exists return $::vTcl(fonts,$font_descr,object) } incr ::vTcl(fonts,counter) set newfont [eval font create $font_descr] lappend ::vTcl(fonts,objects) $newfont ## each font has its unique key so that when a project is ## reloaded, the key is used to find the font description if {$newkey == ""} { set newkey vTcl:font$::vTcl(fonts,counter) ## let's find an unused font key while {[vTcl:font:get_font $newkey] != ""} { incr ::vTcl(fonts,counter) set newkey vTcl:font$::vTcl(fonts,counter) } } set ::vTcl(fonts,$newfont,type) $font_type set ::vTcl(fonts,$newfont,key) $newkey set ::vTcl(fonts,$newfont,font_descr) $font_descr set ::vTcl(fonts,$font_descr,object) $newfont set ::vTcl(fonts,$newkey,object) $newfont lappend ::vTcl(fonts,$font_type) $newfont ## in case caller needs it return $newfont } ############################################################################# ## Procedure: vTcl:font:getFontFromDescr proc ::vTcl:font:getFontFromDescr {font_descr} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. if {[info exists ::vTcl(fonts,$font_descr,object)]} { return $::vTcl(fonts,$font_descr,object) } else { return "" } } vTcl:font:add_font \ "-family lucida -size 18" \ stock \ vTcl:font8 } ############################################################################# # vTcl Code to Load User Fonts vTcl:font:add_font \ "-family helvetica -size 16 -weight bold -slant roman -underline 0 -overstrike 0" \ user \ vTcl:font10 vTcl:font:add_font \ "-family {urw gothic l} -size 48 -weight normal -slant italic -underline 0 -overstrike 0" \ user \ vTcl:font12 ################################# # VTCL LIBRARY PROCEDURES # if {![info exists vTcl(sourcing)]} { ############################################################################# ## Library Procedure: Window proc ::Window {args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. global vTcl foreach {cmd name newname} [lrange $args 0 2] {} set rest [lrange $args 3 end] if {$name == "" || $cmd == ""} { return } if {$newname == ""} { set newname $name } if {$name == "."} { wm withdraw $name; return } set exists [winfo exists $newname] switch $cmd { show { if {$exists} { wm deiconify $newname } elseif {[info procs vTclWindow$name] != ""} { eval "vTclWindow$name $newname $rest" } if {[winfo exists $newname] && [wm state $newname] == "normal"} { vTcl:FireEvent $newname <> } } hide { if {$exists} { wm withdraw $newname vTcl:FireEvent $newname <> return} } iconify { if $exists {wm iconify $newname; return} } destroy { if $exists {destroy $newname; return} } } } ############################################################################# ## Library Procedure: vTcl:DefineAlias proc ::vTcl:DefineAlias {target alias widgetProc top_or_alias cmdalias} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. global widget set widget($alias) $target set widget(rev,$target) $alias if {$cmdalias} { interp alias {} $alias {} $widgetProc $target } if {$top_or_alias != ""} { set widget($top_or_alias,$alias) $target if {$cmdalias} { interp alias {} $top_or_alias.$alias {} $widgetProc $target } } } ############################################################################# ## Library Procedure: vTcl:DoCmdOption proc ::vTcl:DoCmdOption {target cmd} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. ## menus are considered toplevel windows set parent $target while {[winfo class $parent] == "Menu"} { set parent [winfo parent $parent] } regsub -all {\%widget} $cmd $target cmd regsub -all {\%top} $cmd [winfo toplevel $parent] cmd uplevel #0 [list eval $cmd] } ############################################################################# ## Library Procedure: vTcl:FireEvent proc ::vTcl:FireEvent {target event {params {}}} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. ## The window may have disappeared if {![winfo exists $target]} return ## Process each binding tag, looking for the event foreach bindtag [bindtags $target] { set tag_events [bind $bindtag] set stop_processing 0 foreach tag_event $tag_events { if {$tag_event == $event} { set bind_code [bind $bindtag $tag_event] foreach rep "\{%W $target\} $params" { regsub -all [lindex $rep 0] $bind_code [lindex $rep 1] bind_code } set result [catch {uplevel #0 $bind_code} errortext] if {$result == 3} { ## break exception, stop processing set stop_processing 1 } elseif {$result != 0} { bgerror $errortext } break } } if {$stop_processing} {break} } } ############################################################################# ## Library Procedure: vTcl:Toplevel:WidgetProc proc ::vTcl:Toplevel:WidgetProc {w args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. if {[llength $args] == 0} { ## If no arguments, returns the path the alias points to return $w } set command [lindex $args 0] set args [lrange $args 1 end] switch -- [string tolower $command] { "setvar" { foreach {varname value} $args {} if {$value == ""} { return [set ::${w}::${varname}] } else { return [set ::${w}::${varname} $value] } } "hide" - "show" { Window [string tolower $command] $w } "showmodal" { ## modal dialog ends when window is destroyed Window show $w; raise $w grab $w; tkwait window $w; grab release $w } "startmodal" { ## ends when endmodal called Window show $w; raise $w set ::${w}::_modal 1 grab $w; tkwait variable ::${w}::_modal; grab release $w } "endmodal" { ## ends modal dialog started with startmodal, argument is var name set ::${w}::_modal 0 Window hide $w } default { uplevel $w $command $args } } } ############################################################################# ## Library Procedure: vTcl:WidgetProc proc ::vTcl:WidgetProc {w args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. if {[llength $args] == 0} { ## If no arguments, returns the path the alias points to return $w } set command [lindex $args 0] set args [lrange $args 1 end] uplevel $w $command $args } ############################################################################# ## Library Procedure: vTcl:toplevel proc ::vTcl:toplevel {args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. uplevel #0 eval toplevel $args set target [lindex $args 0] namespace eval ::$target {set _modal 0} } } if {[info exists vTcl(sourcing)]} { proc vTcl:project:info {} { set base .top17 namespace eval ::widgets::$base { } namespace eval ::widgets::$base.lab18 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab20 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.ent21 { array set save {-disabledforeground 1 -foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.ent22 { array set save {-disabledforeground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.ent23 { array set save {-disabledforeground 1 -foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.lab24 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab25 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab26 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab27 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab28 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.ent29 { array set save {-disabledforeground 1 -foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.lab30 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab31 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.ent33 { array set save {-disabledforeground 1 -foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.lab35 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab36 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.ent37 { array set save {-disabledforeground 1 -foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.lab38 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.ent39 { array set save {-disabledforeground 1 -foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.lab40 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab41 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but42 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but43 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab45 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -font 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but46 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab49 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but18 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -state 1 -text 1} } namespace eval ::widgets::$base.lis17 { array set save {-background 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -selectbackground 1 -yscrollcommand 1} } namespace eval ::widgets::$base.scr18 { array set save {-activebackground 1 -background 1 -command 1 -highlightcolor 1 -troughcolor 1 -width 1} } namespace eval ::widgets::$base.tex22 { array set save {-foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -wrap 1 -yscrollcommand 1} } namespace eval ::widgets::$base.scr17 { array set save {-activebackground 1 -command 1 -highlightcolor 1 -troughcolor 1 -width 1} } namespace eval ::widgets::$base.lab17 { array set save {-activebackground 1 -activeforeground 1 -anchor 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but19 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -state 1 -text 1} } namespace eval ::widgets::$base.but21 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -state 1 -text 1} } namespace eval ::widgets::$base.but26 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.m29 { array set save {-activebackground 1 -activeforeground 1 -cursor 1 -disabledforeground 1 -foreground 1} } namespace eval ::widgets::$base.ent20 { array set save {-disabledforeground 1 -foreground 1 -highlightcolor 1 -insertbackground 1 -selectbackground 1 -selectforeground 1 -textvariable 1} } namespace eval ::widgets::$base.lab21 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab22 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but22 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab23 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -relief 1 -text 1} } namespace eval ::widgets::$base.lab32 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -image 1 -text 1} } namespace eval ::widgets::$base.lab33 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -font 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but20 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -relief 1 -text 1} } namespace eval ::widgets::$base.but17 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } set base .top22 namespace eval ::widgets::$base { set set,origin 1 set set,size 1 set runvisible 1 } namespace eval ::widgets::$base.but28 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -font 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.m17 { array set save {-activebackground 1 -activeforeground 1 -cursor 1 -disabledforeground 1 -foreground 1} } namespace eval ::widgets::$base.but18 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -state 1 -text 1} } namespace eval ::widgets::$base.but23 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.can19 { array set save {-background 1 -closeenough 1 -height 1 -highlightcolor 1 -highlightthickness 1 -insertbackground 1 -selectbackground 1 -selectborderwidth 1 -selectforeground 1 -width 1} } namespace eval ::widgets::$base.lab17 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab19 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightcolor 1 -justify 1 -text 1} } namespace eval ::widgets::$base.lab18 { array set save {-activebackground 1 -activeforeground 1 -anchor 1 -background 1 -borderwidth 1 -disabledforeground 1 -font 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab21 { array set save {-activebackground 1 -activeforeground 1 -anchor 1 -background 1 -borderwidth 1 -disabledforeground 1 -font 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab22 { array set save {-activebackground 1 -activeforeground 1 -anchor 1 -background 1 -borderwidth 1 -disabledforeground 1 -font 1 -foreground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.but24 { array set save {-activebackground 1 -activeforeground 1 -background 1 -command 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets::$base.lab25 { array set save {-activebackground 1 -activeforeground 1 -background 1 -borderwidth 1 -disabledforeground 1 -foreground 1 -highlightbackground 1 -highlightcolor 1 -text 1} } namespace eval ::widgets_bindings { set tagslist _TopLevel } namespace eval ::vTcl::modules::main { set procs { init main includes sleep vTclWindow. vTclWindow.top17 vTclWindow.top22 } set compounds { } set projectType single } } } ################################# # USER DEFINED PROCEDURES # ############################################################################# ## Procedure: main proc ::main {argc argv} { global widget env GRPHGD global work includes ## Creation of the working directory and clearing of any possible remaining working directory ## possibly left behind from an inappropriate exit. set pwd [pwd] set work "$pwd/cliqrwork" set GRPHGD $env(GRPHGD) set HPCCF $env(HPCCF) catch {eval exec "cp $GRPHGD/cliqr_new/noaasealandgull_small.gif ."} puts "Cleaning up..." eval exec "rm -Rf $work" puts "Creating working directory..." eval exec "mkdir $work" puts "Copying scripts..." eval exec "cp -R $GRPHGD/cliqr_new/ $work/cliqr" eval exec "mv $work/cliqr/cliqrclean.csh $pwd/cliqrclean.csh" puts "Copying model data...This may take a while..." eval exec "cp -R $GRPHGD/cliqr_new/CHGHUR $work/CHGHUR" eval exec "cp $GRPHGD/cliqr_new/filelist.txt $work" puts "Initializing..." ## Clear text in storm listbox, load in new storms from filelist.txt .top17.lis17 delete 0 end set flist [open "$work/filelist.txt" r] while {[eof $flist] == "0"} { gets $flist line .top17.lis17 insert end [string range $line 0 end] } close $flist .top17.lab17 configure -text "CLIQR initialized." } ############################################################################# ## Procedure: includes proc ::includes {} { global widget ## To get around the vtcl erasing garbage package require http } ############################################################################# ## Procedure: sleep proc ::sleep {time} { ## A function that will sleep for $time seconds and still process other events while waiting global widget global end after $time set end 1 vwait end } ############################################################################# ## Initialization Procedure: init proc ::init {argc argv} { } init $argc $argv ################################# # VTCL GENERATED GUI PROCEDURES # proc vTclWindow. {base} { if {$base == ""} { set base . } ################### # CREATING WIDGETS ################### wm focusmodel $top passive wm geometry $top 1x1+0+0; update wm maxsize $top 1585 1170 wm minsize $top 1 1 wm overrideredirect $top 0 wm resizable $top 1 1 wm withdraw $top wm title $top "vtcl.tcl" bindtags $top "$top Vtcl.tcl all" vTcl:FireEvent $top <> wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <>" ################### # SETTING GEOMETRY ################### vTcl:FireEvent $base <> } proc vTclWindow.top17 {base} { if {$base == ""} { set base .top17 } if {[winfo exists $base]} { wm deiconify $base; return } set top $base ################### # CREATING WIDGETS ################### vTcl:toplevel $top -class Toplevel \ -menu "$top.m29" -background #000080 -highlightcolor black wm focusmodel $top passive wm geometry $top 898x817+666+195; update wm maxsize $top 1585 1170 wm minsize $top 1 1 wm overrideredirect $top 0 wm resizable $top 1 1 wm deiconify $top wm title $top "CLIQR" bindtags $top "$top Toplevel all _TopLevel" vTcl:FireEvent $top <> wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <>" label $top.lab18 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text Lat: label $top.lab20 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text Lon: entry $top.ent21 \ -disabledforeground #a1a1a1 -foreground black -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable lon entry $top.ent22 \ -disabledforeground #a1a1a1 -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable cenpres entry $top.ent23 \ -disabledforeground #a1a1a1 -foreground black -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable outpres label $top.lab24 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text {Central Pressure:} label $top.lab25 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text N label $top.lab26 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text W label $top.lab27 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text mb label $top.lab28 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text {Outer Pressure:} entry $top.ent29 \ -disabledforeground #a1a1a1 -foreground black -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable outrad label $top.lab30 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text mb label $top.lab31 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text {Outer Radius:} entry $top.ent33 \ -disabledforeground #a1a1a1 -foreground black -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable dir label $top.lab35 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text nm label $top.lab36 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text Speed: entry $top.ent37 \ -disabledforeground #a1a1a1 -foreground black -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable spd label $top.lab38 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text kts entry $top.ent39 \ -disabledforeground #a1a1a1 -foreground black -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable mxwnd label $top.lab40 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text Dir: label $top.lab41 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text deg button $top.but42 \ -activebackground #ff0000 -activeforeground black -background #8e0000 \ -command { ##eval exec "rm -f $work/cliqr/.nfs*" eval exec "rm -Rf $work/cliqr/*" eval exec "rm -Rf $work/CHGHUR" eval exec "rm -Rf $work/cliqr" eval exec "rm -Rf $work" eval exec "rm -f cliqrclean.csh" exit} \ -disabledforeground #a1a1a1 -foreground black \ -highlightbackground #8e0000 -highlightcolor black -text EXIT button $top.but43 \ -activebackground #00ff00 -activeforeground black -background #008e00 \ -command {global lat global lon global cenpres global outpres global outrad global mxwnd global dir global spd global work ## Using manually input data, run search, display results .top17.tex22 delete 1.0 end .top17.lab17 configure -text "Running CLIQR search..." update idletasks set cmd "perl $work/cliqr/cliqr2.pl $lat $lon $cenpres $outpres $outrad $mxwnd $dir $spd" eval exec xterm -e $cmd set matches [open "$work/cliqr/cliqrout.txt" r] set matchdata [read $matches] .top17.tex22 insert end $matchdata .top17.but18 configure -state normal .top17.but19 configure -state normal .top17.but21 configure -state disabled .top17.but26 configure -state normal .top17.lab17 configure -text "Search complete." ## Remove duplicates from results file, do nothing with these results yet set cmd "perl $work/cliqr/rmdupstrm.pl" eval exec $cmd} \ -disabledforeground #7a6628 -foreground black \ -highlightbackground #008e00 -highlightcolor black \ -text {USE MANUAL INPUT} label $top.lab45 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 \ -font [vTcl:font:getFontFromDescr "-family lucida -size 18"] \ -foreground #ffffff -highlightcolor black -text OR button $top.but46 \ -activebackground #00ff00 -activeforeground black -background #008e00 \ -command {global lat global lon global cenpres global outpres global outrad global mxwnd global dir global spd global work ## If no selection made in listbox, default to first storm in list if {[.top17.lis17 curselection] == ""} { set strmfile [.top17.lis17 get 0] } else { set strmfile [.top17.lis17 get [.top17.lis17 curselection]] } ## clear text, run initial data script and display in text boxes .top17.tex22 delete 1.0 end .top17.lab17 configure -text "Setting initial data..." update idletasks puts $strmfile set cmd "perl $work/cliqr/getinitialdata.pl $strmfile" eval exec $cmd set idata [open "$work/CHGHUR/storm/initdata.txt" r] set name [gets $idata] set lat [gets $idata] set lon [gets $idata] set cenpres [gets $idata] set outpres [gets $idata] set outrad [gets $idata] set mxwnd [gets $idata] set dir [gets $idata] set spd [gets $idata] close $idata ## Run the actual search, pass initial data to the search script .top17.lab17 configure -text "Running CLIQR search..." update idletasks set cmd "perl $work/cliqr/cliqr2.pl $lat $lon $cenpres $outpres $outrad $mxwnd $dir $spd" eval exec xterm -e $cmd ## Open and display output from search results file set matches [open "$work/cliqr/cliqrout.txt" r] set matchdata [read $matches] .top17.tex22 insert end $matchdata .top17.but18 configure -state normal .top17.but19 configure -state normal .top17.but21 configure -state disabled .top17.but26 configure -state normal .top17.lab17 configure -text "Search complete." ## Run script to remove duplicate storms from the result file, do nothing with these results yet set cmd "perl $work/cliqr/rmdupstrm.pl" eval exec $cmd} \ -disabledforeground #7a6628 -foreground black \ -highlightbackground #008e00 -highlightcolor black -text {GET DATA} label $top.lab49 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text {Select Storm:} button $top.but18 \ -activebackground #ffffff -activeforeground black -background #808080 \ -command {.top17.tex22 delete 1.0 end .top17.lab17 configure -text "Text output cleared." .top17.but21 configure -state disabled .top17.but19 configure -state disabled .top17.but18 configure -state disabled} \ -disabledforeground #a1a1a1 -foreground black \ -highlightbackground #808080 -highlightcolor black -state disabled \ -text Clear listbox $top.lis17 \ -background #005efe -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -selectbackground #00fefe \ -yscrollcommand "$top.scr18 set" scrollbar $top.scr18 \ -activebackground #f6f7f6 -background #d7d7d7 \ -command "$top.lis17 yview" -highlightcolor black \ -troughcolor #c1c2c1 -width 10 text $top.tex22 \ -foreground black -highlightcolor black -insertbackground black \ -selectbackground #c1c2c1 -selectforeground black -wrap word \ -yscrollcommand "$top.scr17 set" vTcl:DefineAlias "$top.tex22" "textOut" vTcl:WidgetProc "$top" 1 scrollbar $top.scr17 \ -activebackground #f6f7f6 -command "$top.tex22 yview" \ -highlightcolor black -troughcolor #c1c2c1 -width 10 label $top.lab17 \ -activebackground #f6f7f6 -activeforeground black -anchor w \ -background #000080 -borderwidth 1 -disabledforeground #a1a1a1 \ -foreground #ffffff -highlightcolor black -text {CLIQR initialized.} button $top.but19 \ -activebackground #00ff00 -activeforeground black -background #008e00 \ -command {.top17.tex22 delete 1.0 end set matches [open "$work/cliqr/cliqroutuniq.txt" r] set matchdata [read $matches] .top17.tex22 insert end $matchdata .top17.but19 configure -state disabled .top17.but21 configure -state normal} \ -disabledforeground #004800 -foreground black \ -highlightbackground #008e00 -highlightcolor black -state disabled \ -text {Remove duplicates} button $top.but21 \ -activebackground #00ff00 -activeforeground black -background #008000 \ -command {.top17.tex22 delete 1.0 end set matches [open "$work/cliqr/cliqrout.txt" r] set matchdata [read $matches] .top17.tex22 insert end $matchdata .top17.but21 configure -state disabled .top17.but19 configure -state normal} \ -disabledforeground #004800 -foreground black \ -highlightbackground #008e00 -highlightcolor black -state disabled \ -text {Restore duplicates} button $top.but26 \ -activebackground #ff00ff -activeforeground black -background #aa00aa \ -command {global ridx global rainimage global matchyr global matchname global best global work global bname global byear ## New window open, clear out related index-based variables set ridx 0 set nameyr "" ## Create the list of images and their file locations, read into array imgarr set cmd "perl $work/cliqr/imagelist.pl" eval exec $cmd set imgs [open "$work/cliqr/cliqrrainimgs.txt" r] for {set i 0} {[eof $imgs] == "0"} {incr i 1} { set imgarr($i) [gets $imgs] set maxidx [expr $i-1] } set bestmatch [open "$work/cliqr/cliqroutuniq.txt" r] ## Reading in individual lines of the results, duplicates removed, for displaying ## the info in the lower left corner. These lines are the full database lines. for {set i 0} {[eof $bestmatch] == "0"} {incr i 1} { set best($i) [gets $bestmatch] while {[string range $best($i) 24 27] < 1950 && [eof $bestmatch] == "0"} { set best($i) [gets $bestmatch] } } ## ## Code identical to the next/prev buttons from here on down. ## NOTE: those buttons have a couple extra lines at the end that this does not have ## set bname [string range $best($ridx) 7 15] set btime [string range $best($ridx) 17 22] set byear [string range $best($ridx) 24 27] set blat [string range $best($ridx) 29 32] set blon [string range $best($ridx) 34 38] set bwnd [string range $best($ridx) 40 42] set bcenpres [string range $best($ridx) 44 47] set broci [string range $best($ridx) 62 64] set bspd [expr [string range $best($ridx) 107 109] / 6] set bdir [string range $best($ridx) 111 113] Window show .top22 ## Display the data for the current index (that would be ridx) .top22.lab18 configure -text "Best Matching point for $bname $byear:" .top22.lab21 configure -text "Lat: $blat Lon: $blon Winds: $bwnd kts Pressure: $bcenpres mb" .top22.lab22 configure -text "Speed: $bspd kts Dir: $bdir Radius: $broci nm" ## If the image exists, display it, else display the "no graphic available" image if {[string equal [string range $imgarr($ridx) 1 6] "export"]} { set rainimage [image create photo -file $imgarr($ridx) -height 1200 -width 1200] } else { set rainimage [image create photo -file "$work/cliqr/nographic.gif" -height 1200 -width 1200] } .top22.can19 create image 0 0 -image $rainimage -anchor nw ## To process the name and year out of the file names in the image list ## NOTE: not really necessary now with the advent of the info being read from the results file if {[string length $imgarr($ridx)]>40} { if {[string equal [string range $imgarr($ridx) 21 2] "td"]} { set matchname [concat [string toupper [string range $imgarr($ridx) 21 2]] [string range $imgarr($ridx) 23 2]] set matchyr [string range $imgarr($ridx) end-20 end-17] append nameyr $matchname " of " $matchyr } else { set matchname [string toupper [string range $imgarr($ridx) 21 end-21]] set matchyr [string range $imgarr($ridx) end-20 end-17] append nameyr $matchname " " $matchyr } } else { set matchname [string range $imgarr($ridx) 25 end-5] set matchyr [string range $imgarr($ridx) end-4 end] append nameyr $matchname " " $matchyr } .top22.lab19 configure -text $nameyr .top22.lab19 configure -text $nameyr .top22.but18 configure -state disabled .top22.but23 configure -state normal } \ -disabledforeground #550055 -foreground black \ -highlightbackground #aa00aa -highlightcolor black \ -text {View Rainfall Graphics} menu $top.m29 \ -activebackground #f6f7f6 -activeforeground black -cursor {} \ -disabledforeground #a1a1a1 -foreground black entry $top.ent20 \ -disabledforeground #a1a1a1 -foreground black -highlightcolor black \ -insertbackground black -selectbackground #c1c2c1 \ -selectforeground black -textvariable lat label $top.lab21 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text {Max Winds:} label $top.lab22 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text kts button $top.but22 \ -activebackground #ffff00 -activeforeground black -background #c8c800 \ -command {## Run the script that is called by the cron, also warning users that it may not function as hoped. #set updatecmd "csh /export/lnx159/eff3/fliqr/copyinit.csh" set HPCCF $env(HPCCF) set updatecmd "ssh hpcops@${HPCCF} \"cd klein/cliqr/fliqr ; copyinit.csh\" " set answer [tk_messageBox -message "This is a possibly detrimental function at the current\ntime, do you wish to continue?" -type okcancel -icon warning] if {[string equal $answer "ok"]} { eval exec xterm -e $updatecmd main $argv $argc }} \ -disabledforeground #a3d4a3 -foreground black \ -highlightbackground #c8c800 -highlightcolor black \ -text {Force File Update} label $top.lab23 \ -activebackground #f6f7f6 -activeforeground black -background #ff0000 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -relief raised \ -text {If you don't know a value, enter a '0'} label $top.lab32 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground black \ -highlightcolor black \ -image [vTcl:image:get_image [file join / export-4 ncosrvnfs-cp hpcops grids cliqr_new noaasealandgull_small.gif]] \ -text label label $top.lab33 \ -activebackground #f6f7f6 -activeforeground black -background #ffffff \ -borderwidth 1 -disabledforeground #a1a1a1 \ -font [vTcl:font:getFontFromDescr "-family {urw gothic l} -size 48 -weight normal -slant italic -underline 0 -overstrike 0"] \ -highlightcolor black -text CLIQR button $top.but20 \ -activebackground #000080 -activeforeground black -background #000080 \ -command {Window show .top22} -disabledforeground #a1a1a1 \ -foreground black -highlightbackground #000080 -highlightcolor black \ -relief flat -text . button $top.but17 \ -activebackground #ff0000 -activeforeground black -background #00ffff \ -command {.top17.tex22 delete 1.0 end set help [open "$GRPHGD/cliqr_new/cliqr.help" r] set helptxt [read $help] .top17.tex22 insert end $helptxt} \ -disabledforeground #a1a1a1 -foreground black \ -highlightbackground #00ffff -highlightcolor black -text HELP! ################### # SETTING GEOMETRY ################### place $top.lab18 \ -in $top -x 5 -y 20 -width 36 -height 23 -anchor nw \ -bordermode ignore place $top.lab20 \ -in $top -x 115 -y 20 -width 36 -height 23 -anchor nw \ -bordermode ignore place $top.ent21 \ -in $top -x 150 -y 20 -width 53 -height 22 -anchor nw \ -bordermode ignore place $top.ent22 \ -in $top -x 115 -y 47 -width 78 -height 22 -anchor nw \ -bordermode ignore place $top.ent23 \ -in $top -x 115 -y 73 -width 78 -height 22 -anchor nw \ -bordermode ignore place $top.lab24 \ -in $top -x 5 -y 48 -width 106 -height 23 -anchor nw \ -bordermode ignore place $top.lab25 \ -in $top -x 95 -y 20 -width 16 -height 23 -anchor nw \ -bordermode ignore place $top.lab26 \ -in $top -x 205 -y 20 -width 16 -height 23 -anchor nw \ -bordermode ignore place $top.lab27 \ -in $top -x 195 -y 50 -width 31 -height 23 -anchor nw \ -bordermode ignore place $top.lab28 \ -in $top -x 5 -y 73 -width 106 -height 23 -anchor nw \ -bordermode ignore place $top.ent29 \ -in $top -x 100 -y 99 -width 73 -height 22 -anchor nw \ -bordermode ignore place $top.lab30 \ -in $top -x 195 -y 75 -width 31 -height 23 -anchor nw \ -bordermode ignore place $top.lab31 \ -in $top -x 7 -y 100 -width 91 -height 23 -anchor nw \ -bordermode ignore place $top.ent33 \ -in $top -x 40 -y 125 -width 38 -height 22 -anchor nw \ -bordermode ignore place $top.lab35 \ -in $top -x 175 -y 100 -width 26 -height 23 -anchor nw \ -bordermode ignore place $top.lab36 \ -in $top -x 110 -y 127 -width 46 -height 23 -anchor nw \ -bordermode ignore place $top.ent37 \ -in $top -x 155 -y 125 -width 38 -height 22 -anchor nw \ -bordermode ignore place $top.lab38 \ -in $top -x 200 -y 127 -width 26 -height 23 -anchor nw \ -bordermode ignore place $top.ent39 \ -in $top -x 80 -y 155 -width 38 -height 22 -anchor nw \ -bordermode ignore place $top.lab40 \ -in $top -x 5 -y 127 -width 31 -height 23 -anchor nw \ -bordermode ignore place $top.lab41 \ -in $top -x 79 -y 127 -width 31 -height 23 -anchor nw \ -bordermode ignore place $top.but42 \ -in $top -x 790 -y 135 -width 93 -height 48 -anchor nw \ -bordermode ignore place $top.but43 \ -in $top -x 150 -y 155 -width 138 -height 28 -anchor nw \ -bordermode ignore place $top.lab45 \ -in $top -x 245 -y 55 -width 61 -height 38 -anchor nw \ -bordermode ignore place $top.but46 \ -in $top -x 430 -y 155 -width 83 -height 28 -anchor nw \ -bordermode ignore place $top.lab49 \ -in $top -x 315 -y 0 -width 96 -height 28 -anchor nw \ -bordermode ignore place $top.but18 \ -in $top -x 815 -y 785 -width 68 -height 23 -anchor nw \ -bordermode ignore place $top.lis17 \ -in $top -x 325 -y 30 -width 168 -height 111 -anchor nw \ -bordermode ignore place $top.scr18 \ -in $top -x 490 -y 30 -width 16 -height 111 -anchor nw \ -bordermode ignore place $top.tex22 \ -in $top -x 20 -y 195 -width 868 -height 580 -anchor nw \ -bordermode ignore place $top.scr17 \ -in $top -x 880 -y 195 -width 16 -height 580 -anchor nw \ -bordermode ignore place $top.lab17 \ -in $top -x 15 -y 790 -width 521 -height 23 -anchor nw \ -bordermode ignore place $top.but19 \ -in $top -x 685 -y 785 -width 123 -height 23 -anchor nw \ -bordermode ignore place $top.but21 \ -in $top -x 555 -y 785 -width 123 -height 23 -anchor nw \ -bordermode ignore place $top.but26 \ -in $top -x 625 -y 135 -width 148 -height 48 -anchor nw \ -bordermode ignore place $top.ent20 \ -in $top -x 40 -y 20 -width 53 -height 22 -anchor nw \ -bordermode ignore place $top.lab21 \ -in $top -x 5 -y 155 -width 71 -height 23 -anchor nw \ -bordermode ignore place $top.lab22 \ -in $top -x 120 -y 155 -width 26 -height 23 -anchor nw \ -bordermode ignore place $top.but22 \ -in $top -x 310 -y 155 -width 113 -height 28 -anchor nw \ -bordermode ignore place $top.lab23 \ -in $top -x 0 -y 0 -width 236 -height 18 -anchor nw \ -bordermode ignore place $top.lab32 \ -in $top -x 740 -y 10 -width 151 -height 118 -anchor nw \ -bordermode ignore place $top.lab33 \ -in $top -x 565 -y 17 -width 201 -height 103 -anchor nw \ -bordermode ignore place $top.but20 \ -in $top -x 0 -y 440 -width 13 -height 13 -anchor nw \ -bordermode ignore place $top.but17 \ -in $top -x 525 -y 135 -width 83 -height 48 -anchor nw \ -bordermode ignore vTcl:FireEvent $base <> } proc vTclWindow.top22 {base} { if {$base == ""} { set base .top22 } if {[winfo exists $base]} { wm deiconify $base; return } set top $base ################### # CREATING WIDGETS ################### vTcl:toplevel $top -class Toplevel \ -menu "$top.m17" -background #000080 -highlightcolor black wm withdraw $top wm focusmodel $top passive wm geometry $top 1220x1037+110+63; update wm maxsize $top 1585 1170 wm minsize $top 1 1 wm overrideredirect $top 0 wm resizable $top 1 1 wm title $top "CLIQR Graphics" bindtags $top "$top Toplevel all _TopLevel" vTcl:FireEvent $top <> wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <>" button $top.but28 \ -activebackground #ff0000 -activeforeground black -background #8e0000 \ -command {## Closes rainfall graphic window and clears image for next use Window hide .top22 $rainimage blank} \ -disabledforeground #a1a1a1 \ -font [vTcl:font:getFontFromDescr "-family helvetica -size 16 -weight bold -slant roman -underline 0 -overstrike 0"] \ -foreground black -highlightbackground #8e0000 -highlightcolor black \ -text Return menu $top.m17 \ -activebackground #f6f7f6 -activeforeground black -cursor {} \ -disabledforeground #a1a1a1 -foreground black button $top.but18 \ -activebackground #00ff00 -activeforeground black -background #008e00 \ -command global\ ridx\nglobal\ rainimage\nglobal\ matchname\nglobal\ matchyr\nglobal\ best\nglobal\ bname\nglobal\ byear\n\n##\ Previous\ buttons\ should\ decrement\ the\ index?\ Yep.\nset\ ridx\ \[expr\ \$ridx-1\]\nset\ nameyr\ \"\"\nset\ bname\ \[string\ range\ \$best(\$ridx)\ 7\ 15\]\nset\ btime\ \[string\ range\ \$best(\$ridx)\ 17\ 22\]\nset\ byear\ \[string\ range\ \$best(\$ridx)\ 24\ 27\]\nset\ blat\ \[string\ range\ \$best(\$ridx)\ 29\ 32\]\nset\ blon\ \[string\ range\ \$best(\$ridx)\ 34\ 38\]\nset\ bwnd\ \[string\ range\ \$best(\$ridx)\ 40\ 42\]\nset\ bcenpres\ \[string\ range\ \$best(\$ridx)\ 44\ 47\]\nset\ broci\ \[string\ range\ \$best(\$ridx)\ 62\ 64\]\nset\ bspd\ \[expr\ \[string\ range\ \$best(\$ridx)\ 107\ 109\]\ /\ 6\]\nset\ bdir\ \[string\ range\ \$best(\$ridx)\ 111\ 113\]\n.top22.lab18\ configure\ -text\ \"Best\ Matching\ point\ for\ \$bname\ \$byear:\"\n.top22.lab21\ configure\ -text\ \"Lat:\ \$blat\ \ Lon:\ \$blon\ \ Winds:\ \$bwnd\ kts\ \ Pressure:\ \$bcenpres\ mb\"\n.top22.lab22\ configure\ -text\ \"Speed:\ \$bspd\ kts\ \ Dir:\ \$bdir\ \ Radius:\ \$broci\ nm\"\n##\ Parses\ name\ from\ image\ list,\ not\ entirely\ necessary\ as\ the\ name/year\ is\ read\ from\ the\n##\ unique\ results\ file,\ and\ in\ a\ better\ format\ as\ well.\nif\ \{\[string\ length\ \$imgarr(\$ridx)\]>40\}\ \{\n\ \ \ \ if\ \{\[string\ equal\ \[string\ range\ \$imgarr(\$ridx)\ 21\ 2\]\ \"td\"\]\}\ \{\n\ \ \ \ \ \ \ \ set\ matchname\ \[concat\ \[string\ toupper\ \[string\ range\ \$imgarr(\$ridx)\ 21\ 2\]\]\ \[string\ range\ \$imgarr(\$ridx)\ 23\ 2\]\]\n\ \ \ \ \ \ \ \ set\ matchyr\ \[string\ range\ \$imgarr(\$ridx)\ end-20\ end-17\]\n\ \ \ \ \ \ \ \ append\ nameyr\ \$matchname\ \"\ of\ \"\ \$matchyr\n\ \ \ \ \}\ else\ \{\ \ \ \ \n\ \ \ \ \ \ \ \ set\ matchname\ \[string\ toupper\ \[string\ range\ \$imgarr(\$ridx)\ 21\ end-21\]\]\n\ \ \ \ \ \ \ \ set\ matchyr\ \[string\ range\ \$imgarr(\$ridx)\ end-20\ end-17\]\n\ \ \ \ \ \ \ \ append\ nameyr\ \$matchname\ \"\ \"\ \$matchyr\n\ \ \ \ \}\n\}\ else\ \{\n\ \ \ \ set\ matchname\ \[string\ range\ \$imgarr(\$ridx)\ 25\ end-5\]\n\ \ \ \ set\ matchyr\ \[string\ range\ \$imgarr(\$ridx)\ end-4\ end\]\n\ \ \ \ append\ nameyr\ \$matchname\ \"\ \"\ \$matchyr\n\}\n##\ Display\ image\ graphic,\ if\ exists,\ else\ display\ \"no\ image\ avail\"\ graphic\nif\ \{\[string\ equal\ \[string\ range\ \$imgarr(\$ridx)\ 1\ 6\]\ \"export\"\]\}\ \{\n\ \ \ \ \$rainimage\ blank\n\ \ \ \ set\ rainimage\ \[image\ create\ photo\ -file\ \$imgarr(\$ridx)\ \\\n\ \ \ \ \ \ \ \ -height\ 1200\ -width\ 1200\]\n\}\ else\ \{\n\ \ \ \ \$rainimage\ blank\n\ \ \ \ set\ rainimage\ \[image\ create\ photo\ -file\ \"\$work/cliqr/nographic.gif\"\ \\\n\ \ \ \ \ \ \ \ -height\ 1200\ -width\ 1200\]\n\}\n.top22.can19\ create\ image\ 0\ 0\ -image\ \$rainimage\ -anchor\ nw\n##\ If\ we're\ at\ the\ beginning\ of\ the\ list,\ disable\ button\ to\ stop\ any\ runaways.\nif\ \{\$ridx==0\}\ \{\n\ \ \ \ .top22.but18\ configure\ -state\ disabled\n\}\n.top22.lab19\ configure\ -text\ \$nameyr\n.top22.but23\ configure\ -state\ normal \ -disabledforeground #004800 -foreground black \ -highlightbackground #008e00 -highlightcolor black -state disabled \ -text {Prev Img} button $top.but23 \ -activebackground #00ff00 -activeforeground black -background #008e00 \ -command global\ ridx\nglobal\ rainimage\nglobal\ matchyr\nglobal\ matchname\nglobal\ best\nglobal\ maxidx\nglobal\ bname\nglobal\ byear\n\n\n##\ Next\ button,\ so\ increment\ index\ and\ get\ info\ all\ over\ again!\nset\ ridx\ \[expr\ \$ridx+1\]\nset\ nameyr\ \"\"\nset\ bname\ \[string\ range\ \$best(\$ridx)\ 7\ 15\]\nset\ btime\ \[string\ range\ \$best(\$ridx)\ 17\ 22\]\nset\ byear\ \[string\ range\ \$best(\$ridx)\ 24\ 27\]\nset\ blat\ \[string\ range\ \$best(\$ridx)\ 29\ 32\]\nset\ blon\ \[string\ range\ \$best(\$ridx)\ 34\ 38\]\nset\ bwnd\ \[string\ range\ \$best(\$ridx)\ 40\ 42\]\nset\ bcenpres\ \[string\ range\ \$best(\$ridx)\ 44\ 47\]\nset\ broci\ \[string\ range\ \$best(\$ridx)\ 62\ 64\]\n##\ Division\ is\ a\ tricksy\ little\ thing\ in\ tcl,\ so\ to\ make\ sure\ that\ it\ doesn't\ divide\ a\ NaN...\nif\ \{!\[string\ equal\ \[string\ range\ \$best(\$ridx)\ 107\ 109\]\ \"\"\]\}\ \{\n\ \ \ \ set\ bspd\ \[expr\ \[string\ range\ \$best(\$ridx)\ 107\ 109\]\ /\ 6\]\n\}\nset\ bdir\ \[string\ range\ \$best(\$ridx)\ 111\ 113\]\n.top22.lab18\ configure\ -text\ \"Best\ Matching\ point\ for\ \$bname\ \$byear:\"\n.top22.lab21\ configure\ -text\ \"Lat:\ \$blat\ \ Lon:\ \$blon\ \ Winds:\ \$bwnd\ kts\ \ Pressure:\ \$bcenpres\ mb\"\n.top22.lab22\ configure\ -text\ \"Speed:\ \$bspd\ kts\ \ Dir:\ \$bdir\ \ Radius:\ \$broci\ nm\"\n##\ Parsing\ the\ name\ out\ of\ the\ image\ list,\ not\ entirely\ necessary\ since\ the\ name\ and\ year\n##\ are\ read\ in\ from\ the\ unique\ results\ file\nif\ \{\[string\ length\ \$imgarr(\$ridx)\]>40\}\ \{\n\ \ \ \ if\ \{\[string\ equal\ \[string\ range\ \$imgarr(\$ridx)\ 21\ 2\]\ \"td\"\]\}\ \{\n\ \ \ \ \ \ \ \ set\ matchname\ \[concat\ \[string\ toupper\ \[string\ range\ \$imgarr(\$ridx)\ 21\ 2\]\]\ \[string\ range\ \$imgarr(\$ridx)\ 23\ 2\]\]\n\ \ \ \ \ \ \ \ set\ matchyr\ \[string\ range\ \$imgarr(\$ridx)\ end-20\ end-17\]\n\ \ \ \ \ \ \ \ append\ nameyr\ \$matchname\ \"\ of\ \"\ \$matchyr\n\ \ \ \ \}\ else\ \{\ \ \ \ \n\ \ \ \ \ \ \ \ set\ matchname\ \[string\ toupper\ \[string\ range\ \$imgarr(\$ridx)\ 21\ end-21\]\]\n\ \ \ \ \ \ \ \ set\ matchyr\ \[string\ range\ \$imgarr(\$ridx)\ end-20\ end-17\]\n\ \ \ \ \ \ \ \ append\ nameyr\ \$matchname\ \"\ \"\ \$matchyr\n\ \ \ \ \}\n\}\ else\ \{\n\ \ \ \ set\ matchname\ \[string\ range\ \$imgarr(\$ridx)\ 25\ end-5\]\n\ \ \ \ set\ matchyr\ \[string\ range\ \$imgarr(\$ridx)\ end-4\ end\]\n\ \ \ \ append\ nameyr\ \$matchname\ \"\ \"\ \$matchyr\n\}\n##\ If\ the\ image\ exists,\ display\ it,\ else\ just\ display\ the\ no\ graphic\ image\nif\ \{\[string\ equal\ \[string\ range\ \$imgarr(\$ridx)\ 1\ 6\]\ \"export\"\]\}\ \{\n\ \ \ \ \$rainimage\ blank\n\ \ \ \ set\ rainimage\ \[image\ create\ photo\ -file\ \$imgarr(\$ridx)\ \\\n\ \ \ \ \ \ \ \ -height\ 1200\ -width\ 1200\]\n\}\ else\ \{\n\ \ \ \ \$rainimage\ blank\n\ \ \ \ set\ rainimage\ \[image\ create\ photo\ -file\ \"\$work/cliqr/nographic.gif\"\ \\\n\ \ \ \ \ \ \ \ -height\ 1200\ -width\ 1200\]\n\}\n.top22.can19\ create\ image\ 0\ 0\ -image\ \$rainimage\ -anchor\ nw\n##\ If\ we're\ at\ the\ maximum\ index,\ then\ don't\ disable\ this\ button\ so\ it\ can't\ run\ away.\nif\ \{\$ridx==\$maxidx\}\ \{\n\ \ \ \ .top22.but23\ configure\ -state\ disabled\n\}\n.top22.lab19\ configure\ -text\ \$nameyr\n.top22.but18\ configure\ -state\ normal \ -disabledforeground #004800 -foreground black \ -highlightbackground #008e00 -highlightcolor black -text {Next Img} canvas $top.can19 \ -background #000080 -closeenough 1.0 -height 273 \ -highlightcolor black -highlightthickness 0 -insertbackground black \ -selectbackground #c1c2c1 -selectborderwidth 0 \ -selectforeground black -width 389 label $top.lab17 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -text Storm: label $top.lab19 \ -activebackground #f6f7f6 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground #ffffff \ -highlightcolor black -justify left -text {DENNIS 1993} label $top.lab18 \ -activebackground #f6f7f6 -activeforeground black -anchor w \ -background #000080 -borderwidth 1 -disabledforeground #a1a1a1 \ -font {Helvetica 16 bold} -foreground #fefefe -highlightcolor black \ -text {Best Matching point for DENNIS :} label $top.lab21 \ -activebackground #f6f7f6 -activeforeground black -anchor w \ -background #000080 -borderwidth 1 -disabledforeground #a1a1a1 \ -font {Helvetica 10 bold} -foreground #fefefe -highlightcolor black \ -text {Lat: 18.7 Lon: 39.7 Winds: 45 kts Pressure: 1000 mb} label $top.lab22 \ -activebackground #f6f7f6 -activeforeground black -anchor w \ -background #000080 -borderwidth 1 -disabledforeground #a1a1a1 \ -font {Helvetica 10 bold} -foreground #fefefe -highlightcolor black \ -text {Speed: 11 kts Dir: 307 Radius: 120 nm} button $top.but24 \ -activebackground #ffff00 -activeforeground black -background #c8c800 \ -command {global matchname global matchyr set tcWeb "http://www.hpc.ncep.noaa.gov/tropical/rain/" append tcWeb [string tolower [string trim $matchname]] $matchyr append tcWeb ".html" eval exec "mozilla $tcWeb"} \ -disabledforeground #a1a1a1 -foreground black \ -highlightbackground #c8c800 -highlightcolor black -text {More Info} label $top.lab25 \ -activebackground #000080 -activeforeground black -background #000080 \ -borderwidth 1 -disabledforeground #a1a1a1 -foreground White \ -highlightbackground #000080 -highlightcolor black \ -text {(launches Mozilla)} ################### # SETTING GEOMETRY ################### place $top.but28 \ -in $top -x 730 -y 930 -width 133 -height 63 -anchor nw \ -bordermode ignore place $top.but18 \ -in $top -x 610 -y 945 -width 88 -height 58 -anchor nw \ -bordermode ignore place $top.but23 \ -in $top -x 895 -y 945 -width 93 -height 58 -anchor nw \ -bordermode ignore place $top.can19 \ -in $top -x 5 -y 5 -width 1210 -height 914 -anchor nw \ -bordermode ignore place $top.lab17 \ -in $top -x 715 -y 1000 -width 56 -height 33 -anchor nw \ -bordermode ignore place $top.lab19 \ -in $top -x 765 -y 1000 -width 126 -height 33 -anchor nw \ -bordermode ignore place $top.lab18 \ -in $top -x 15 -y 920 -width 461 -height 28 -anchor nw \ -bordermode ignore place $top.lab21 \ -in $top -x 15 -y 945 -width 461 -height 28 -anchor nw \ -bordermode ignore place $top.lab22 \ -in $top -x 15 -y 975 -width 461 -height 28 -anchor nw \ -bordermode ignore place $top.but24 \ -in $top -x 1035 -y 945 -width 113 -height 43 -anchor nw \ -bordermode ignore place $top.lab25 \ -in $top -x 1035 -y 995 -width 111 -height 18 -anchor nw \ -bordermode ignore vTcl:FireEvent $base <> } ############################################################################# ## Binding tag: _TopLevel bind "_TopLevel" <> { if {![info exists _topcount]} {set _topcount 0}; incr _topcount } bind "_TopLevel" <> { if {[set ::%W::_modal]} { vTcl:Toplevel:WidgetProc %W endmodal } else { destroy %W; if {$_topcount == 0} {exit} } } bind "_TopLevel" { if {[winfo toplevel %W] == "%W"} {incr _topcount -1} } Window show . Window show .top17 Window show .top22 main $argc $argv