#!nviz -f # Please log changes in the ChangeLog file in this directory # (Use "C-x 4 a" from emacs to add an entry) global src_boot catch {destroy .wait_ok} source $src_boot/etc/nviz2.2/scripts/config.tcl # Create a simple list of script tools which are invoked by pressing # the specified buttons # Globals global ScriptState FieldsChanged global source_files source_index global state_file Nv_ # Source_files is a list of (map_name map_id) tuples # Source index represents the index of the source_file chosen # Field_Data is a list containing a tuple of the form # (window map_type map_att map_source) for each field set ScriptState 0 set FieldsChanged 0 set source_files [list] set source_index 0 set Field_Data [list] set state_file "" set Nv_(APP) "." # Make the top-level window "width" resizable only wm resizable . true false # Titlebar label .title -text [G_msg "Map Object File Sequencing"] -relief raised pack .title -side top -fill x -expand yes frame .controls # Create buttons for adding fields frame .controls.fields -relief groove -bd 2 set rname .controls.fields label $rname.title -text [G_msg "Fields:"] button $rname.add -text [G_msg "Add"] -command "add_field" button $rname.delete -text [G_msg "Delete"] -command "delete_field" button $rname.state -text [G_msg "State File: None"] -command "change_state_file" pack $rname.title $rname.add $rname.delete $rname.state \ -fill x -expand no -padx 2 -pady 2 # Create buttons for cancelling or accepting frame .controls.options -relief groove -bd 2 set rname .controls.options label $rname.title -text [G_msg "Options:"] button $rname.cancel -text [G_msg "Done"] -command "done_script" button $rname.accept -text [G_msg "Add To Script"] -command "build_script" button $rname.build -text [G_msg "Build Script..."] -command "build_standalone_script" button $rname.load -text [G_msg "Load Fields..."] -command "load_fields" button $rname.save -text [G_msg "Save Fields..."] -command "save_fields" pack $rname.title $rname.cancel $rname.accept \ $rname.build $rname.load $rname.save\ -fill x -expand no -padx 2 -pady 2 pack .controls.fields .controls.options -side left \ -fill x -expand yes -padx 1 -pady 1 -anchor n # Create area to display fields frame .fields -relief groove -bd 2 canvas .fields.display_area -width 10c -height 6c \ -xscrollcommand ".fields.scrollx set" -confine true \ -xscrollincrement 1 # This frame created to display frame numbers next to the list of # files in fields frame .fields.display_area.frames -relief groove -bd 2 -width 2c -height 6c label .fields.display_area.frames.l1 -text [G_msg "Frame"] label .fields.display_area.frames.l2 -text " " listbox .fields.display_area.frames.frame_list \ -yscrollcommand ".fields.scrolly set" -height 9 place .fields.display_area.frames.l1 -relx 0.5 -rely 0.0 -anchor n place .fields.display_area.frames.l2 \ -in .fields.display_area.frames.l1 -relx 0.5 -rely 1.0 -anchor n place .fields.display_area.frames.frame_list \ -in .fields.display_area.frames.l2 -relx 0.5 -rely 2.0 \ -relwidth 2.0 -anchor n frame .fields.display_area.hold .fields.display_area configure -scrollregion [list 0 0 28c 28c] .fields.display_area create window 0 0 -anchor nw \ -window .fields.display_area.frames -tags frames set bound [.fields.display_area bbox frames] .fields.display_area create window [lindex $bound 2] 0 -anchor nw \ -window .fields.display_area.hold scrollbar .fields.scrolly -orient vertical -command "canvas_scroll_height" scrollbar .fields.scrollx -orient horizontal -command ".fields.display_area xview" pack .fields.display_area -fill both pack .fields.scrolly -side left -fill y -padx 2 -pady 2 -before .fields.display_area pack .fields.scrollx -side bottom -fill x -padx 2 -pady 2 # pack everything pack .controls .fields -fill x -expand yes ################################################### # Load fields data from a file... ################################################### proc load_fields {} { global Field_Data FieldsChanged state_file # First make sure we're not overwriting something... if {$FieldsChanged} then { if {[tk_dialog .verify [G_msg "Verify"] [G_msg "Current fields have not been saved, really load new fields?"] \ @/usr/local/lib/tk/bitmaps/warning \ 1 [G_msg "Ok"] [G_msg "Cancel"]] == 1} then { # Cancel the exit return } } # Have user select a file set new_file [create_file_browser .fields_file 1 0] if {$new_file == -1} then return # Read in each of the file fields one at a time, and create # Field_Data as appropriate if {[catch {set file_hook [open $new_file r]} error_code] != 0} then { display_error [format [G_msg "Error while opening file: %s"] $error_code] return } # Delete the old set of fields set Field_Data [list] # Read in state file if {[catch {gets $file_hook state_file} error_code] != 0} then { display_error [format [G_msg "While reading state_file: %s"] $error_code] return } set_new_state_file $state_file # Get number of fields if {[catch {gets $file_hook num_fields} error_code] != 0} then { display_error [format [G_msg "While reading number of fields: %s"] $error_code] return } # For each field create a field segment which automatically # updates Field_Data for {set i 0} {$i < $num_fields} {incr i} { # Input field type if {[catch {gets $file_hook field_type} error_code] != 0} then { display_error [format [G_msg "While reading field type: %s"] $error_code] return } # Input field attribute if {[catch {gets $file_hook field_att} error_code] != 0} then { display_error [format [G_msg "While reading field attribute: %s"] $error_code] return } # Input field source if {[catch {gets $file_hook field_source} error_code] != 0} then { display_error "While reading field source: $error_code" return } # Input number of map files in file sequence if {[catch {gets $file_hook num_map_files} error_code] != 0} then { display_error "While reading map sequence: $error_code" return } # Output each of the map files in the sequence set map_files [list] for {set j 0} {$j < $num_map_files} {incr j} { if {[catch {gets $file_hook this_map} error_code] != 0} then { display_error "While reading map sequence: $error_code" return } lappend map_files $this_map } # Finally create the new segment add_field_segment $field_type $field_source "$map_files" $field_att } # If load successful then unset FieldsChanged and exit close $file_hook set FieldsChanged 0 } ################################################### # Save the fields data into a file... ################################################### proc save_fields {} { global FieldsChanged Field_Data state_file # Check to see if there are any fields to save if {[llength $Field_Data] == 0} then return # Have user select a file set new_file [create_file_browser .fields_file 1 0] if {$new_file == -1} then return # For each field, save the following info: # 1. Type: Surface, Vect or Site # 2. Attribute: Topography, Color, Mask, Transparency, Shininess, # Emission (only valid if type=surface) # 3. Source map: name of source file + logical name of map object # 4. Number of elements in map sequence # 4. List of map sequence if {[catch {set file_hook [open $new_file w+]} error_code] != 0} then { display_error "While opening file: $error_code" return } # Write out state file first if {[catch {puts $file_hook "$state_file"} error_code] != 0} then { display_error "While writing state_file: $error_code" return } # Output number of fields if {[catch {puts $file_hook "[llength $Field_Data]"} error_code] != 0} then { display_error "While writing number of fields: $error_code" return } foreach i $Field_Data { # Output field type if {[catch {puts $file_hook "[lindex $i 1]"} error_code] != 0} then { display_error "While writing field type: $error_code" return } # Output field attribute if {[catch {puts $file_hook "[lindex $i 2]"} error_code] != 0} then { display_error "While writing field attribute: $error_code" return } # Output field source if {[catch {puts $file_hook "[lindex $i 3]"} error_code] != 0} then { display_error "While writing field source: $error_code" return } # Output number of map files in file sequence if {[catch {puts $file_hook "[[lindex $i 0].files size]"} error_code] != 0} then { display_error "While writing map sequence: $error_code" return } # Output each of the map files in the sequence for {set j 0} {$j < [[lindex $i 0].files size]} {incr j} { if {[catch {puts $file_hook "[[lindex $i 0].files get $j]"} error_code] != 0} then { display_error "While writing map sequence: $error_code" return } } } # If save successful then unset FieldsChanged and exit close $file_hook set FieldsChanged 0 } ################################################### # Routine to display error ################################################### proc display_error { err_string } { tk_dialog .file_error "File Error" "$err_string" \ error 0 "Dismiss" } ################################################### # First checks that the fields have been saved, then exits ################################################### proc done_script {} { global FieldsChanged if {$FieldsChanged} then { if {[tk_dialog .verify "Verify" "Fields have not been saved, really exit?" \ @/usr/local/lib/tk/bitmaps/warning \ 1 "Ok" "Cancel"] == 1} then { # Cancel the exit return } } # Otherwise just exit exit } ################################################### # Given the current list of fields, build a script # for displaying all the given segments ################################################### proc build_script {} { global Field_Data state_file global ProcessName # Tasks # 1. Determine the number of frames we need. By definition, fields # which specify no entry for a frame (i.e. file list smaller than # total number of frames) are not changed for that frame. # 2. Output preliminary code for outer loop, generate uniques ids # for each file in the file list which will hold the map_id handle # 3. Loop over fields, for each field do the following: # a. Output code to find the map id for the source of # this field. # b. Based on the loop index, output code to set the appropriate # attribute for this map based on the list of fields. # 4. Output loop termination code and comments # 1. set num_frames [.fields.display_area.frames.frame_list size] send $ProcessName "Nv_script_add_string \"\\n\# Start of file sequence code\"" # Output command to load the state file if present if {"$state_file" != ""} then { send $ProcessName "Nv_script_add_string \"SendScriptLineWait \\\"load_state_aux $state_file\\\" script_play\"" } # 2. set loop_id [unique_id iloop] set field_list [list] foreach field $Field_Data { set new_id [unique_id mhandle] set temp $field lappend temp "$new_id" lappend field_list "$temp" set field_source [lindex $field 3] set field_type [lindex $field 1] send $ProcessName "Nv_script_add_string \"set $new_id \\\[ReturnMapHandle $field_source\\\]\"" } send $ProcessName "Nv_script_add_string \"for \{set $loop_id 0\} \{\\\$$loop_id < $num_frames\} \{incr $loop_id\} \{\"" send $ProcessName "Nv_script_add_string \" SendScriptLine \\\"global NVIZ_BLANK_MAPS\\\"\"" send $ProcessName "Nv_script_add_string \" SendScriptLine \\\"set NVIZ_BLANK_MAPS \{\}\\\"\"" # 3. foreach field $field_list { # Extract map handle for this field set map_handle [lindex $field [expr [llength $field] - 1]] # Get list of files set file_list [list] for {set i 0} {$i < [[lindex $field 0].files size]} {incr i} { lappend file_list "[[lindex $field 0].files get $i]" } # Create list of indices wich correspond to blank files set blanks [list] set j 0 foreach i $file_list { if [regexp -- "\-\- blank \-\-" "$i"] then { if {[regexp "\(NO CHANGE\)" "$i"] == 0} then { lappend blanks $j } } incr j } # Create list of indices which correspond to NO CHANGE set no_changes [list] set j 0 foreach i $file_list { if [regexp "\(NO CHANGE\)" "$i"] then { lappend no_changes $j } incr j } # Map attribute type to a value set att_type map switch [lindex $field 2] { Topography { set att_type topo } Color { set att_type color } Mask { set att_type mask } Transparency { set att_type transp } Shininess { set att_type shin } Emission { set att_type emi } } # Now output code to handle the current frame for this field send $ProcessName "Nv_script_add_string \" if \{\\\$$loop_id < [llength $file_list]\} then \{\"" send $ProcessName "Nv_script_add_string \" if \{\\\[lsearch \\\{$no_changes\\\} \\\$$loop_id\\\] == -1\} then \{\"" send $ProcessName "Nv_script_add_string \" if \{\\\[lsearch \\\{$blanks\\\} \\\$$loop_id\\\] > -1\} then \{\"" # Blanking a map object is a little tricky, heres the code to do it send $ProcessName "Nv_script_add_string \" SendScriptLine \\\"lappend NVIZ_BLANK_MAPS \\\[ExtractMapID \\\$$map_handle\\\]\\\"\"" # Finally close off with the rest of the code for this frame send $ProcessName "Nv_script_add_string \" \} else \{\"" send $ProcessName "Nv_script_add_string \" SendScriptLine \\\"\\\$$map_handle set_att $att_type \\\[lindex \\\{$file_list\\\} \\\$$loop_id\\\]\\\"\"" send $ProcessName "Nv_script_add_string \" \}\"" send $ProcessName "Nv_script_add_string \" \}\"" send $ProcessName "Nv_script_add_string \" \}\"" } # End foreach field ... # 4. send $ProcessName "Nv_script_add_string \" \# Put image saving code here\"" send $ProcessName "Nv_script_add_string \"\}\\n\"" } ################################################### # Routine to edit a field ################################################### proc edit_field { field_window field_type } { global FieldsChanged # Tasks # 1. Get the current list of entries # 2. Call the filemapBrowser with the old list of entries # 3. On return, if not cancel then use the returned # list of maps to reset the list for this field set old_list [list] for {set i 0} { $i < [$field_window.files size] } {incr i} { lappend old_list [$field_window.files get $i] } set map_sequence [create_filemap_browser .map_seq $field_type 1 "$old_list"] if {$map_sequence == -1} then { return } $field_window.files delete 0 end foreach i $map_sequence { $field_window.files insert end "$i" } fix_frame_numbers # Note that we have changed... set FieldsChanged 1 } ################################################### # Routine to delete a field ################################################### proc delete_field {} { global deleted_field Field_Data FieldsChanged # Tasks: # 1. Change button highlights to reflect delete mode # and change button bindings to cause a delete # 2. Popup dialog telling user to press the button of # the field they wish to delete. # 3. Ask if they really want to delete field such-and-such # 4. On affirmitive delete the given field # 5. Restore the button bindings # Save the old bindings and define new ones set old_bindings [list] foreach i [pack slaves .fields.display_area.hold] { lappend old_bindings \ [list $i "[lindex [$i.header configure -command] 4]" \ "[lindex [$i.header configure -bg] 4]"] $i.header configure -command "set deleted_field $i" $i.header configure -bg burlywood } # Popup information dialog if {[tk_dialog .delete_info \ "Info" "Press the button of the field you wish to delete" \ {} 0 "Ok" "Cancel"] == 1} then { # Cancel the delete cancel_delete "$old_bindings" return } set deleted_field -1 tkwait variable deleted_field # Verify delete # Extract source and attribute info set source_name [lindex [$deleted_field.header configure -text] 4] set att_name [lindex [$deleted_field.header2 configure -text] 4] if {[tk_dialog .delete_verify \ "Verify" "Really delete <$source_name $att_name> ?" \ @/usr/local/lib/tk/bitmaps/warning \ 1 "Ok" "Cancel"] == 1} then { # Cancel the delete cancel_delete "$old_bindings" return } # Restore bindings cancel_delete "$old_bindings" # and proceed with the delete (also remove from Field_Data list) destroy $deleted_field set index -1 set j 0 foreach i $Field_Data { if {$deleted_field == [lindex $i 0]} then { set index $j } incr j } set Field_Data [lreplace $Field_Data $index $index] # Note that we have changed... set FieldsChanged 1 } ################################################### # Routine to restore button bindings which were created # for a delete ################################################### proc cancel_delete { prev_bindings } { foreach i $prev_bindings { set field [lindex $i 0] set cmd [lindex $i 1] set bg [lindex $i 2] $field.header configure -command "$cmd" -bg "$bg" } } ################################################### # Routine to add a new field ################################################### proc add_field {} { global FieldsChanged # Two things are done here. First the user fills in field type, # attribute, and source fields, this builds the skeleton for the # field. Second, the user chooses a set of files in order to use # for this field. The user may edit this list later if necessary. # Create frame for adding a new field to the field list # This popup has three entries: field type, attribute and existing surface toplevel .add_field # Field type frame set rname .add_field.field_type frame $rname label $rname.lbl -text [G_msg "Field Type: "] menubutton $rname.mb -text [G_msg "Surface"] -menu $rname.mb.m -relief raised menu $rname.mb.m foreach i {Surface Vector Site} { $rname.mb.m add command -label "$i" -command "set_field_type $i" } pack $rname.lbl -side left -anchor w pack $rname.mb -side right -anchor e # Field attribute frame set rname .add_field.field_att frame $rname label $rname.lbl -text [G_msg "Field Attribute: "] menubutton $rname.mb -text [G_msg "Topography"] -menu $rname.mb.m -relief raised menu $rname.mb.m foreach i {Topography Color Mask Transparency Shininess Emission} { $rname.mb.m add command -label "$i" -command "set_field_att $i" } pack $rname.lbl -side left -anchor w pack $rname.mb -side right -anchor e # Field source frame set rname .add_field.source frame $rname label $rname.lbl -text [G_msg "Use Nviz Map: "] menubutton $rname.mb -text [G_msg "None"] -menu $rname.mb.m -relief raised menu $rname.mb.m set_sources Surface pack $rname.lbl -side left -anchor w pack $rname.mb -side right -anchor e # Accept and Cancel buttons button .add_field.accept -text [G_msg "Accept"] -command "create_new_field" button .add_field.cancel -text [G_msg "Cancel"] -command "destroy .add_field" # Pack everything in pack .add_field.field_type .add_field.field_att .add_field.source \ .add_field.accept .add_field.cancel -anchor w -expand yes -fill x # Grab focus to avoid user pressing other buttons grab .add_field tkwait window .add_field grab release .add_field } ################################################### # Routine to create a new field from the add_field option ################################################### proc create_new_field {} { global source_files source_index FieldsChanged global ProcessName # Extract field type, attribute and set from information. # If set-from is none then popup a warning and exit if {[llength $source_files] == 0 } then { # Error, need to set from existing source file tk_dialog .no_source "No Source" \ "Error - \"Use Nviz Map\" can not be \"None\"" {} 0 "Ok" return } set map_from [lindex $source_files $source_index] set map_type [lindex [.add_field.field_type.mb configure -text] 4] set map_att [lindex [.add_field.field_att.mb configure -text] 4] # Call the filemapBrowser to get a list of files # then create the new field entry switch $map_type { Surface { set filemap_type rast } Vector { set filemap_type vect } Site { set filemap_type site } } set map_sequence [create_filemap_browser .map_seq $filemap_type 1] # Check for cancel option from create_filemap_browser if {$map_sequence == -1} then { return } # Figure out logical name switch $map_type { Surface { set log_name [send $ProcessName "Nlogical_from_literal Nsurf[lindex $map_from 1]"] } Vector { set log_name [send $ProcessName "Nlogical_from_literal Nvect[lindex $map_from 1]"] } Site { set log_name [send $ProcessName "Nlogical_from_literal Nsite[lindex $map_from 1]"] } } # Create the new field entry with the given maps add_field_segment $map_type \ "$log_name" "$map_sequence" $map_att # Last thing, delete the add_field window destroy .add_field # Note that we have changed... set FieldsChanged 1 } ################################################### # Routine to get list of available entries for the set-from field ################################################### proc set_sources {type} { global source_files source_index ProcessName set source_list [list] set source_files [list] set source_index 0 set rname .add_field.source switch $type { Surface { foreach i [send $ProcessName "Nget_map_list surf" ] { set map_name [lindex [send $ProcessName "Nsurf$i get_att topo"] 1] lappend source_list "$map_name" lappend source_files [list "$map_name" $i] } } Vector { foreach i [send $ProcessName "Nget_map_list vect" ] { set map_name [send $ProcessName "Nvect$i get_att map" ] lappend source_list "$map_name" lappend source_files [list "$map_name" $i] } } Site { foreach i [send $ProcessName "Nget_map_list site" ] { set map_name [send $ProcessName "Nsite$i get_att map" ] lappend source_list "$map_name" lappend source_files [list "$map_name" $i] } } } $rname.mb.m delete 0 last if {[llength $source_list] == 0} then { $rname.mb.m add command -label [G_msg "None"] -command "set_source_file None 0" set_source_file "None" 0 } else { set j 0 foreach i $source_list { $rname.mb.m add command -label "$i" -command "set_source_file \"$i\" $j" incr j } set_source_file "[lindex $source_list 0]" 0 } } ################################################### # Routine to update source field on menu event ################################################### proc set_source_file {name index} { global source_index # Just set the menubutton to the appropriate field .add_field.source.mb configure -text "$name" set source_index $index } ################################################### # Routine to update appropriate fields in add_field display ################################################### proc set_field_type {name} { # Two things: change text on menubutton, and change field # attributes according to the type of field set .add_field.field_type.mb configure -text "$name" # Change attribute field based on type switch $name { Surface { set blist {Topography Color Mask Transparency Shininess Emission}} Vector { set blist {File}} Site { set blist {File}} } set_field_att [lindex $blist 0] .add_field.field_att.mb.m delete 0 last foreach i $blist { .add_field.field_att.mb.m add command -label "$i" -command "set_field_att $i" } # Reload new list of possible sources set_sources $name } ################################################### # Routine to update appropriate fields in add_field display ################################################### proc set_field_att {name} { # Change text on menubutton .add_field.field_att.mb configure -text "$name" } ################################################### # Routine to create field segment from a field description # Returns the window which holds this field ################################################### proc add_field_segment {type file file_list {att Topography}} { global Field_Data # Create a frame to hold a button and list for this field set slave [unique_id .fields.display_area.hold.field_] set fd_tuple [list] lappend fd_type $slave frame $slave -relief groove -bd 2 switch $type { Surface { set bname "Surface: $file" set lname "Attribute: $att" set map_type rast lappend fd_type Surface $att $file } Vector { set bname "Vector: $file" set lname "" set map_type vect lappend fd_type Vector file $file } Site { set bname "Site: $file" set lname "" set map_type site lappend fd_type Site file $file } } lappend Field_Data "$fd_type" button $slave.header -text "$bname" -command "edit_field $slave $map_type" label $slave.header2 -text "$lname" listbox $slave.files -yscrollcommand ".fields.scrolly set" -height 9 foreach i $file_list { $slave.files insert end $i } pack $slave.header $slave.header2 $slave.files -fill x -expand yes # Pack the new field and readjust the scroll region pack $slave -side left -anchor n set cur_width [lindex [lindex [.fields.display_area configure -scrollregion] 4] 2] set cur_height [lindex [lindex [.fields.display_area configure -scrollregion] 4] 3] set cur_width [expr int([string trimright $cur_width c])] set cur_height [expr int([string trimright $cur_height c])] set slave_width [expr [llength [pack slaves .fields.display_area.hold]] * 5] if {$cur_width < $slave_width} then { set cur_width [expr $slave_width + 1] } append cur_width "c" append cur_height "c" .fields.display_area configure -scrollregion [list 0 0 $cur_width $cur_height] fix_frame_numbers } ################################################### # Routine to determine if we have enough frame numbers # displayed for the current set of fields ################################################### proc fix_frame_numbers {} { # Fix the frames field if necessary set num_frames [.fields.display_area.frames.frame_list size] set max 0 foreach i [pack slaves .fields.display_area.hold] { if {[$i.files size] > $max} then { set max [$i.files size] } } if {$num_frames != $max} then { .fields.display_area.frames.frame_list delete 0 end for {set i 1} {$i <= $max} {incr i} { .fields.display_area.frames.frame_list insert end $i } } } ################################################### # Routine to handle canvas scrollbar. This is a sort of # odd scroll bar since it controls scrolling of internal listboxes ################################################### proc canvas_scroll_height {args} { # get the list of all current canvas slaves, this in turn gives # us the set of listboxes we need to scroll foreach i [pack slaves .fields.display_area.hold] { # For each slaved listbox, call the yview command eval "$i.files yview" "$args" } # Don't forget to set the frame number listbox as well eval ".fields.display_area.frames.frame_list yview" "$args" } ################################################### # Change the name of the state file to load before # generating the given sequence ################################################### proc change_state_file {} { set new_file [create_file_browser .state_file 1 0] if {$new_file == -1} then return set_new_state_file $new_file } proc set_new_state_file { name } { global state_file set state_file "$name" if {"$name" == ""} then { set name None } .controls.fields.state configure -text [format [G_msg "State File: %s"] $name] } ################################################### # Generate a unique id ################################################### proc unique_id { base } { global _unique_id_num if {[catch {puts "$_unique_id_num"}] != 0} then { set _unique_id_num 0 } incr _unique_id_num return $base$_unique_id_num } ################################################### # Given the current list of fields, build a script # for displaying all the given segments ################################################### proc build_standalone_script {} { global Field_Data state_file global Build_Image_Name # Get a file name for the new script set new_file [create_file_browser .script_file 1 0] if {$new_file == -1} then return # Get a name for frames set R .build_frame_name toplevel $R label $R.l -text [G_msg "Enter an image root name"] -relief raised entry $R.e -width 20 -relief sunken button $R.accept -text [G_msg "Accept"] -command "set Build_Image_Name \[$R.e get\] ; destroy $R" button $R.cancel -text [G_msg "Cancel"] -command "set Build_Image_Name -1 ; destroy $R" pack $R.l $R.e $R.accept $R.cancel -padx 1 -pady 1 -fill x -expand yes grab $R tkwait window $R grab release $R if {$Build_Image_Name == -1} then return # Open the file if {[catch {set file_hook [open $new_file w]} error_code] != 0} then { display_error "While opening script file: $error_code" return } # Output script file header puts $file_hook "\# This script created by the script_file_tools program" puts $file_hook "global Nv_mapLoopMode Nv_mapLoopFile" puts $file_hook "set Nv_mapLoopMode 0" puts $file_hook "set Nv_mapLoopFile \"\"" puts $file_hook "SendScriptLine \"Nunset_cancel_func\"\n" # Define a function useful for padding values puts $file_hook "proc pad { x } {" puts $file_hook " while {\[string length \"\$x\"\] < 5} {" puts $file_hook " set x \"0\$x\"" puts $file_hook " }" puts $file_hook " return \$x" puts $file_hook "}\n" # Tasks # 1. Determine the number of frames we need. By definition, fields # which specify no entry for a frame (i.e. file list smaller than # total number of frames) are not changed for that frame. # 2. Output preliminary code for outer loop, generate uniques ids # for each file in the file list which will hold the map_id handle # 3. Loop over fields, for each field do the following: # a. Output code to find the map id for the source of # this field. # b. Based on the loop index, output code to set the appropriate # attribute for this map based on the list of fields. # 4. Output loop termination code and comments # 1. set num_frames [.fields.display_area.frames.frame_list size] puts $file_hook "\n\# Start of file sequence code" # Output command to load the state file if present if {"$state_file" != ""} then { puts $file_hook "SendScriptLineWait \"load_state_aux $state_file\" script_play" } # 2. set loop_id [unique_id iloop] set field_list [list] foreach field $Field_Data { set new_id [unique_id mhandle] set temp $field lappend temp "$new_id" lappend field_list "$temp" set field_source [lindex $field 3] set field_type [lindex $field 1] puts $file_hook "set $new_id \[ReturnMapHandle $field_source\]" } puts $file_hook "for {set $loop_id 0} {\$$loop_id < $num_frames} {incr $loop_id} {" puts $file_hook " SendScriptLine \"global NVIZ_BLANK_MAPS\"" puts $file_hook " SendScriptLine \"set NVIZ_BLANK_MAPS {}\"" # 3. foreach field $field_list { # Extract map handle for this field set map_handle [lindex $field [expr [llength $field] - 1]] # Get list of files set file_list [list] for {set i 0} {$i < [[lindex $field 0].files size]} {incr i} { lappend file_list "[[lindex $field 0].files get $i]" } # Create list of indices wich correspond to blank files set blanks [list] set j 0 foreach i $file_list { if [regexp -- "\-\- blank \-\-" "$i"] then { if {[regexp "\(NO CHANGE\)" "$i"] == 0} then { lappend blanks $j } } incr j } # Create list of indices which correspond to NO CHANGE set no_changes [list] set j 0 foreach i $file_list { if [regexp "\(NO CHANGE\)" "$i"] then { lappend no_changes $j } incr j } # Map attribute type to a value set att_type map switch [lindex $field 2] { Topography { set att_type topo } Color { set att_type color } Mask { set att_type mask } Transparency { set att_type transp } Shininess { set att_type shin } Emission { set att_type emi } } # Now output code to handle the current frame for this field puts $file_hook " if {\$$loop_id < [llength $file_list]} then {" puts $file_hook " if {\[lsearch \{$no_changes\} \$$loop_id\] == -1} then {" puts $file_hook " if {\[lsearch \{$blanks\} \$$loop_id\] > -1} then {" # Blanking a map object is a little tricky, heres the code to do it puts $file_hook " SendScriptLine \"lappend NVIZ_BLANK_MAPS \[ExtractMapID \$$map_handle\]\"" # Finally close off with the rest of the code for this frame puts $file_hook " } else {" puts $file_hook " SendScriptLine \"\$$map_handle set_att $att_type \[lindex \{$file_list\} \$$loop_id\]\"" puts $file_hook " }" puts $file_hook " }" puts $file_hook " }" } # End foreach field ... # 4. puts $file_hook " \# Image saving code here" puts $file_hook " if {\[catch {set Frame_Num}\]} then { set Frame_Num 0 }" puts $file_hook " SendScriptLine \"Nsurf_draw_all\"" puts $file_hook " SendScriptLine \"Nvect_draw_all\"" puts $file_hook " SendScriptLine \"Nsite_draw_all\"" puts $file_hook " SendScriptLine \"Nwrite_ppm $Build_Image_Name\[pad \$Frame_Num\].ppm\"" puts $file_hook " incr Frame_Num" puts $file_hook " after 1000" puts $file_hook "}\n" # Close file and quit close $file_hook }