开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
Editor.tcl
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：74k
源码类别：

通讯编程

开发平台：

Visual C++

Editor.tcl：源码内容
  1. #
  2. # Copyright (C) 2001 by USC/ISI
  3. # All rights reserved.                                            
  4. #                                                                
  5. # Redistribution and use in source and binary forms are permitted
  6. # provided that the above copyright notice and this paragraph are
  7. # duplicated in all such forms and that any documentation, advertising
  8. # materials, and other materials related to such distribution and use
  9. # acknowledge that the software was developed by the University of
  10. # Southern California, Information Sciences Institute.  The name of the
  11. # University may not be used to endorse or promote products derived from
  12. # this software without specific prior written permission.
  13. # 
  14. # THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  15. # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  16. # MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  17. # 
  18. # 
  20. # Editor.tcl
  21. #   - the nam editor
  23. # Must initialize C++/Tcl bound variables before use
  24. #   - Seems to be a bug in the design of tclcl
  25. NetworkModel/Editor set maximum_simulation_time_ 60.0
  27. Class Editor 
  29. Editor set uniqueID_ 0
  31. Editor proc getid {} {
  32.   set id [Editor set uniqueID_]
  33.   Editor set uniqueID_ [expr $id + 1]
  34.   return $id
  35. }
  37. #----------------------------------------------------------------------
  38. # Called when creating a new editor from nam console
  39. #   from anim-ctrl.tcl:on-new 
  40. #           set editor [new Editor ""]
  41. #----------------------------------------------------------------------
  42. Editor instproc init {tracefile} {
  43.   $self instvar menulist_ SharedEnv id_ editorwindow_ 
  44.                 editor_view_ balloon_ menubar_ save_filename_ 
  45.                 agent_types_ source_types_ lossmodel_types_ 
  46.                 toolbar_buttons_ current_tool_ netmodel_ mintime_ 
  47.                 now_ slider_model_ slider_view_ pipemode_ current_time_ 
  48.                 simulatior_property_window_
  50.   $self tkvar current_agent_ current_time_ current_source_ current_lossmodel_
  52.   set current_time_ 0.0
  54.   set id_ [Editor getid]
  55.   toplevel .nameditor-$id_
  56.   set editorwindow_ .nameditor-$id_
  57.   if {$tracefile == ""} {
  58.     wm title $editorwindow_ "NAM Editor - $id_"
  59.   } else {
  60.     wm title $editorwindow_ "NAM Editor - $tracefile"
  61.   }
  63.   #set agent_types_ {Null TCP TCP/FullTCP TCP/Reno TCP/NewReno 
  64.   #                 TCP/Vegas TCP/Sack1 TCP/Fack TCPSink 
  65.   #                 TCPSink/DelAck TCPSink/Sack1 UDP}
  66.   set agent_types_ {TCP TCP/Reno 
  67.                    TCP/Vegas TCP/Sack1 TCP/Fack UDP - Null TCPSink 
  68.                    TCPSink/DelAck TCPSink/Sack1}
  69.   set current_agent_ UDP
  70.   
  71.   # There is also a "Trace" traffic source which reads
  72.   # traffic information from a file
  73.   set source_types_ {CBR Exponential FTP Pareto Telnet} 
  74.   set current_source_ CBR
  76.   #set lossmodel_types_ {Periodic Uniform Expo SRM}
  77.   set lossmodel_types_ {Periodic Uniform}
  78.   set current_lossmodel_ Periodic
  79.   
  80.   set SharedEnv(CurrentPageId) 1
  81.   set SharedEnv(CurrentCanvas) "" 
  82.   set SharedEnv(PageWidth) 8.5i
  83.   set SharedEnv(PageHeight) 11i
  84.   set SharedEnv(PageVisX) 3i
  85.   set SharedEnv(PageVisY) 2i 
  86.   set SharedEnv(SlideBG) white
  87.   set SharedEnv(Landscape) 0 
  88.   set SharedEnv(ColorWidth) 400      
  89.   set SharedEnv(ColorHeight) 100
  90.   set SharedEnv(PrivateCmap) ""
  91.   set SharedEnv(ButtonOrient) left
  92.   set SharedEnv(ButtonCount)  10
  93.   set SharedEnv(ButtonSize) .35i
  94.   set SharedEnv(ButtonRelief) flat
  95.   set SharedEnv(ButtonStipple1) gray50
  96.   set SharedEnv(ButtonStipple2) {}
  97.   set SharedEnv(ButtonColor) cyan
  98.   set SharedEnv(Fill) "" 
  99.   set SharedEnv(MenuSelect) 0
  101.   button .b
  102.   set SharedEnv(Background) [.b cget -bg]
  103.   set SharedEnv(ActiveBackground) [.b cget -activebackground]
  104.   destroy .b
  106.   set SharedEnv(DefButtonColor) [. cget -bg]
  107.   set SharedEnv(Cut) ""
  108.   set SharedEnv(Copy) ""
  109.   set SharedEnv(Message) "Select"
  110.   set SharedEnv(Xpos) 0
  111.   set SharedEnv(Ypos) 0
  112.   set SharedEnv(Smooth) 0
  113.   set SharedEnv(Outline) black
  114.   set SharedEnv(Stipple) ""
  115.   set SharedEnv(Arrow) none
  116.   set SharedEnv(JoinStyle) miter 
  117.   set SharedEnv(Grid) 0
  118.   set SharedEnv(GridX) .25i
  119.   set SharedEnv(GridY) .25i
  120.   set SharedEnv(UnitX) i
  121.   set SharedEnv(UnitY) i
  122.   set SharedEnv(ScreenH) [winfo screenheight .]
  123.   set SharedEnv(ScreenW) [winfo screenwidth .]
  124.   set SharedEnv(Gravity) 1
  125.   set SharedEnv(GravityVal) 30
  126.   set SharedEnv(Sub-Cursor) ""
  127.   
  128.   set SharedEnv(Start) ""
  129.   set SharedEnv(top_left_corner) bottom_right_corner
  130.   set SharedEnv(top_side) bottom_side
  131.   set SharedEnv(top_right_corner) bottom_left_corner
  132.   set SharedEnv(right_side) left_side
  133.   set SharedEnv(bottom_right_corner) top_left_corner
  134.   set SharedEnv(bottom_side) top_side
  135.   
  136.   set SharedEnv(bottom_left_corner) top_right_corner
  137.   set SharedEnv(left_side) right_side
  138.   set SharedEnv(FixedAspect) True
  140.   # Intialize balloon help
  141.   set balloon_ [new BalloonHelp $editorwindow_]
  143.   if {$tracefile == ""} {
  144.     set save_filename_ ""
  145.   } else {
  146.     set save_filename_ $tracefile
  147.   }
  149.   # Create a new model to hold the editor's objects.
  150.   # Don't include a tracefile to signify this is 
  151.   # the creation of a nam editor window
  152.   set netmodel_ [new NetworkModel/Editor $self " "]
  153.   $netmodel_ set Wpxmin_ 500.0
  154.   $netmodel_ set Wpymin_ 500.0
  155.   $netmodel_ set Wpxmax_ 625.0
  156.   $netmodel_ set Wpymax_ 625.0
  160.   # Create menubar at the top of the window
  161.   frame $editorwindow_.menubar_ -relief raised -bd 2
  162.   $self buildMenubar $editorwindow_.menubar_
  163.   pack $editorwindow_.menubar_ -side top -fill x
  165.   # Creates Editor viewport with scrollbars and zoom controls
  166.   # Attaches that view to a network model
  167.   # -- This has to be created first because the toolbar needs the
  168.   #    editor_view to be setup in advance.
  169.   frame $editorwindow_.view
  170.   $self buildEditorView $editorwindow_.view
  172.   # TimeControls
  173.   frame $editorwindow_.timecontrols -borderwidth 2 -relief groove
  174.   $self buildTimeControls $editorwindow_.timecontrols
  176.   # Toolbar
  177.   frame $editorwindow_.tools -borderwidth 2 -relief groove
  178.   $self buildToolbar $editor_view_ $editorwindow_.tools
  180.   # TimeSlider
  181.   frame $editorwindow_.timeslider -relief flat -borderwidth 0
  182.   $self buildTimeSlider $editorwindow_.timeslider
  183.   
  185.   pack $editorwindow_.tools $editorwindow_.timecontrols -side top -fill x
  186.   pack $editorwindow_.timeslider -side bottom -fill x 
  187.   pack $editorwindow_.view -side left -fill both -expand true
  189.   # Object Properties Window
  190.   #frame $editorwindow_.properties
  191.   #pack $editorwindow_.properties -side left -fill y
  193.   bind $editorwindow_ <q> "destroy $editorwindow_"
  194.   bind $editorwindow_ <Q> "destroy $editorwindow_"
  195.   bind $editorwindow_ <Control-w> "destroy $editorwindow_"
  196.   bind $editorwindow_ <Control-W> "destroy $editorwindow_"
  197.   bind $editorwindow_ <Control-q> "[AnimControl instance] done"
  198.   bind $editorwindow_ <Control-Q> "[AnimControl instance] done"
  200.   $self setCursor Select
  202.   # Initial state: select
  203.   $self chooseAgent TCP 
  204.   $self chooseTrafficSource FTP
  205.   $self chooseTool select
  207. #  $editor_view_ zoom 1.6
  209.   # Load a nam editor ns script
  210.   if {$tracefile != ""} {
  211.     $self loadNsScript $tracefile
  212.   }
  213. }
  215. #----------------------------------------------------------------------
  216. # Cleanup variables that we have new-ed.
  217. #----------------------------------------------------------------------
  218. Editor instproc destroy {} {
  219.   $self instvar balloon_
  220.   delete $balloon_
  221.   delete $slider_model_
  222.   delete $slider_view_
  223. }
  225. #----------------------------------------------------------------------
  226. #
  227. #----------------------------------------------------------------------
  228. Editor instproc done {} {
  229.   $self instvar editorwindow_
  230.   destroy $editorwindow_
  231.   delete $self
  232. }
  234. #----------------------------------------------------------------------
  235. # Editor instproc buildEditorView {w}
  236. #  - Creates main canvas with scrollbars to which the user can add
  237. #    ns objects
  238. #----------------------------------------------------------------------
  239. Editor instproc buildEditorView {w} {
  240.   $self instvar id_ SharedEnv netmodel_ 
  241.         editor_view_ editorwindow_ balloon_ magnification viewOffset
  244.   # Create Window Layout
  245.   frame $w.view
  246.   #frame is just to sink the editor_view_
  247.   frame $w.view.sunk -borderwidth 2 -relief sunken
  249.   $netmodel_ view $w.view.sunk.net
  250.   set editor_view_ $w.view.sunk.net
  251. #    lappend netViews $editor_view_
  252.   set SharedEnv(CurrentCanvas) $editor_view_
  253.   pack $w.view.sunk.net -side top -expand true -fill both
  255.   # X scroll bar
  256.   $editor_view_ xscroll $w.view.hsb
  257.   scrollbar $w.view.hsb -orient horizontal -width 10 -borderwidth 1 
  258.                         -command "$editor_view_ xview"
  259.   $w.view.hsb set 0.0 1.0
  260.   pack $w.view.hsb -side bottom -fill x
  261.   pack $w.view.sunk -side top -fill both -expand true 
  263.   # Y scroll bar
  264.   frame $w.yscroll
  265.   $editor_view_ yscroll $w.yscroll.vsb
  266.   scrollbar $w.yscroll.vsb -orient vertical -width 10 -borderwidth 1 
  267.                            -command "$editor_view_ yview"
  268.   $w.yscroll.vsb set 0.0 1.0
  269.   pack $w.yscroll.vsb -side top -fill y -expand true
  271.   # Scrollbar spacer
  272.   frame $w.yscroll.l -width 12 -height -12
  273.   pack $w.yscroll.l -side top -ipady 6 
  275.   set view $editor_view_
  276.   
  277.   # Zoom bar
  278.   set magnification 1.0
  279.   set viewOffset(x) 0.0
  280.   set viewOffset(y) 0.0
  282.   frame $w.zoom -borderwidth 2 -relief groove
  283.   frame $w.zoom.bar 
  284.   pack $w.zoom.bar -side top
  286.   # Put the zoom bar on the left
  287.   button $w.zoom.bar.zoomin -bitmap "zoomin" 
  288.                                    -command "$view zoom 1.6" 
  289.                                    -highlightthickness 0 
  290.                                    -borderwidth 1
  292.   button $w.zoom.bar.zoomout -bitmap "zoomout" 
  293.                                     -command "$view zoom 0.625" 
  294.                                     -highlightthickness 0 
  295.                                     -borderwidth 1
  296.   pack $w.zoom.bar.zoomin 
  297.        $w.zoom.bar.zoomout 
  298.        -side top
  300.   $balloon_ balloon_for $w.zoom.bar.zoomin "Zoom In"
  301.   $balloon_ balloon_for $w.zoom.bar.zoomout "Zoom Out"
  303.   
  304.   pack $w.zoom -side left -fill y
  305.   pack $w.yscroll -side right -fill y
  306.   pack $w.view -side left -fill both -expand true
  308.   $self viewBind $editor_view_
  309. }
  311. #----------------------------------------------------------------------
  312. # Editor instproc viewBind {netView}
  313. #   - Setup mouse button bindings
  314. #----------------------------------------------------------------------
  315. Editor instproc viewBind {netView} {
  316.   $self instvar SharedEnv 
  318.   bind $netView <Button-1>        "$self handleLeftButtonClick %x %y"
  319.   bind $netView <Button-3>        "$self handleRightButtonClick %x %y"
  320.   bind $netView <Any-B1-Motion>   "$self handleLeftButtonDrag %x %y"
  321.   bind $netView <ButtonRelease-1> "$self handleLeftButtonRelease %x %y"
  322.   bind $netView <Motion>          "$self handleMouseMovement %x %y"
  323.   bind $netView <Double-Button-1> "$self handleLeftButtonDoubleClick %x %y"
  325. #       bind $netView <ButtonPress-3> "$self start_info $netView %x %y right"
  326. #       bind $netView <ButtonPress-2> "$self view_drag_start $netView %x %y"
  327. #       bind $netView <B2-Motion> "$self view_drag_motion $netView %x %y"
  328. #       bind $netView <ButtonRelease-3> "$self end_info $netView"
  329. }
  331. #----------------------------------------------------------------------
  332. # Editor instproc handleRightButtonClick {x y} 
  333. #  - Allows user to edit properties of an object by right clicking
  334. #    without having to switch to the select tool and double clicking
  335. #----------------------------------------------------------------------
  336. Editor instproc handleRightButtonClick {x y} {
  337.   $self instvar current_tool_
  339.   set old_tool $current_tool_
  340.   $self chooseTool select 
  341.   $self handleLeftButtonDoubleClick $x $y
  342.   $self chooseTool $old_tool
  343. }
  345. #----------------------------------------------------------------------
  346. #
  347. #----------------------------------------------------------------------
  348. Editor instproc handleLeftButtonDoubleClick {x y} {
  349.   $self instvar SharedEnv editor_view_ current_tool_ editorwindow_
  350.     
  351.   switch $current_tool_ {
  352.     select {
  353.       set objinfo [$editor_view_ getObjectProperty $x $y]
  354.       if {[string compare $objinfo "NONE"] == 0 } {
  355.         return 
  356.       }
  358.       set item [lindex $objinfo 0]
  359.       set item [lindex $item 0]
  360.       $self displayObjectProperties $editorwindow_.properties $item $x $y $objinfo
  361.       place_frame $editorwindow_ $editorwindow_.properties $x $y
  362.     }
  363.   }
  364. }
  366. #----------------------------------------------------------------------
  367. # Editor instproc handleMouseMovement {x y}
  368. #----------------------------------------------------------------------
  369. Editor instproc handleMouseMovement {x y} {
  370.   $self instvar SharedEnv editor_view_ current_tool_
  372.   set objinfo [$editor_view_ getObjectInformation $x $y]
  373.   if {[string compare $objinfo "NONE"] != 0} {
  374.      $editor_view_ showAgentLink $x $y
  375.   } else {
  376.      $editor_view_ hideAgentLinks
  377.   }
  379.   switch $current_tool_ {
  380.     deleteobject -
  381.     select {
  382.     #  set objinfo [$editor_view_ getObjectInformation $x $y]
  383.       if {[string compare $objinfo "NONE"] != 0} {
  384.         $self enterObject $editor_view_ $x $y $objinfo
  385.       } else {
  386.         catch {destroy $editor_view_.f}
  387.       }
  388.     }
  389.   }
  390. }
  392. #----------------------------------------------------------------------
  393. # Editor instproc handleLeftButtonClick {x y}
  394. #     - called when mouse button 1 is pressed
  395. #     - switches over to EditView::command(..) in editview.cc
  396. #----------------------------------------------------------------------
  397. Editor instproc handleLeftButtonClick {x y} {
  398.   $self instvar SharedEnv editor_view_ current_tool_
  399.   $self tkvar current_agent_ current_source_ current_lossmodel_
  400.                 
  401.   switch $current_tool_ {
  402.     # These functions are in editview.cc: command()
  403.     select      {$editor_view_ setPoint $x $y 0}
  404.     addnode     {$editor_view_ addNode $x $y}
  405.     addlink     {$editor_view_ addLink $x $y}
  406.     addagent    {$editor_view_ addAgent $x $y $current_agent_}
  407.     addtrafficsource {$editor_view_ addTrafficSource $x $y $current_source_}
  408.     addlossmodel {$editor_view_ addLossModel $x $y $current_lossmodel_}
  409.     deleteobject {
  410.       $editor_view_ deleteObject $x $y 
  411.     }
  412.   }
  413.   $self renderFrame
  414. }
  416. #----------------------------------------------------------------------
  417. #
  418. #----------------------------------------------------------------------
  419. Editor instproc handleLeftButtonRelease {x y} {
  420.   $self instvar SharedEnv editor_view_ current_tool_ slider_view_
  422. #  switch $SharedEnv(Cursor) {
  423.   switch $current_tool_ {
  424. #    Select {
  425.     select {
  426.       set marker_list [$editor_view_ releasePoint $x $y]
  427.       $slider_view_ clearMarkers
  428.       if {$marker_list != "NONE"} {
  429.         $self addTimeSliderNodeMarkers $marker_list
  430.       }
  432.     }
  433. #    Link   {
  434.     addlink   {
  435.       $editor_view_ releasePoint $x $y
  436.     }
  437.   }
  438. }
  440. #----------------------------------------------------------------------
  441. #
  442. #----------------------------------------------------------------------
  443. Editor instproc handleLeftButtonDrag {x y} {
  444.   $self instvar SharedEnv editor_view_ current_tool_
  446.   switch $current_tool_ {
  447.     select {
  448.       $editor_view_ moveTo $x $y
  449.     }
  450.     addlink   {
  451.       $editor_view_ moveTo $x $y 
  452.     }
  453.   }
  454. }
  457. #----------------------------------------------------------------------
  458. #
  459. #----------------------------------------------------------------------
  460. Editor instproc showPalette {property_variable} {
  461. #    $self createColorPalette .colorpalette 
  462. #        {0000 3300 6600 9900 CC00 FF00} 
  463. #        {0000 3300 6600 9900 CC00 FF00} 
  464. #        {0000 3300 6600 9900 CC00 FF00} 
  465. #        .colorsp
  466.     $self createColorPalette .colorpalette 
  467.         {00 33 66 99 CC FF} 
  468.         {00 33 66 99 CC FF} 
  469.         {00 33 66 99 CC FF} 
  470.         .colorsp
  471. }
  473. #----------------------------------------------------------------------
  474. #----------------------------------------------------------------------
  475. Editor instproc addTimeListItem {time_menu textbox} {
  476.   $self instvar start_stop_time_list_
  477.   $self tkvar start_stop_time_ 
  478.  
  479.   # Grab the time value from the grab textbox
  480.   set value [$textbox get 0.0 1.end]
  483.   set duplicate "no"
  484.   foreach time $start_stop_time_list_ {
  485.     if {$value == $time} {
  486.       set duplicate "yes"
  487.     }
  488.   }
  490.   if {$duplicate != "yes"} {
  491.     # Create a new sorted list with the new time value added
  492.     set add_list [lsort -real [linsert $start_stop_time_list_ 0 $value]]
  494.     # generate updated menu and update start_stop_time_list_
  495.     $self generateTimeListMenu $time_menu $add_list
  497.     # Set shown menu value to be the newly added value
  498.     set start_stop "start"
  499.     foreach time $start_stop_time_list_ {
  500.       if {$value == $time} {
  501.         set start_stop_time_ "$start_stop $time"
  502.       }
  504.       if {$start_stop == "start"} {
  505.         set start_stop "stop"
  506.       } else {
  507.         set start_stop "start"
  508.       }
  509.     }
  510.   }
  511. }
  512. #----------------------------------------------------------------------
  513. #----------------------------------------------------------------------
  514. Editor instproc deleteTimeListItem {time_menu} {
  515.   $self instvar start_stop_time_list_
  516.   $self tkvar start_stop_time_ 
  518.   # Grab only the time value from the menu which is after the
  519.   # start/stop label
  520.   set time [lindex $start_stop_time_ 1]
  521.   # Find the index in the time list of this time value
  522.   # so that it can be removed using lreplace
  523.   set index [lsearch $start_stop_time_list_ $time]
  525.   # Remove time value and generate new menu
  526.   $self generateTimeListMenu $time_menu 
  527.                          [lreplace $start_stop_time_list_ $index $index]
  529.   # Update the menu to show the first time item which 
  530.   # will always be a start value
  531.   set start_stop_time_ "start [lindex $start_stop_time_list_ 0]"
  532. }
  533.   
  535. #----------------------------------------------------------------------
  536. #----------------------------------------------------------------------
  537. Editor instproc generateTimeListMenu {list_menu list_values} {
  538.  $self instvar start_stop_time_list_
  539.   
  540.  # Remove old menu
  541.  $list_menu delete 0 end
  542.  
  543.  # Create list menu
  544.  set start_stop "start"
  545.  foreach time_value $list_values {
  546.    $list_menu add radiobutton -label "$start_stop $time_value" 
  547.                  -variable start_stop_time_ 
  548.                  -command "set [$self tkvarname start_stop_time_] 
  549.                            "$start_stop $time_value""
  550.    if {$start_stop == "start"} {
  551.      set start_stop "stop"
  552.    } else {
  553.      set start_stop "start"
  554.    }
  555.  }
  557.  set start_stop_time_list_ $list_values
  558. }
  559.   
  560. #----------------------------------------------------------------------
  561. #----------------------------------------------------------------------
  562. Editor instproc displaySimulatorProperties {window_name} {
  563. $self instvar SharedEnv netmodel_
  564. $netmodel_ instvar maximum_simulation_time_
  566.         # Setup
  567. set window $window_name
  568. if {[winfo exists $window]} {
  569. wm deiconify $window
  570. raise $window
  571. return
  572. }
  574. eval toplevel $window $SharedEnv(PrivateCmap)
  576. wm protocol $window WM_DELETE_WINDOW "wm withdraw $window"
  578. frame $window.properties
  580. label $window.properties.title 
  581.       -wraplength 200 
  582.       -text "Simulator Properties"
  583. pack $window.properties.title -side top
  585. frame $window.properties.simulation_time
  586. label $window.properties.simulation_time.label 
  587.       -wraplength 300 -text "Maximum Simulation Time (seconds)"
  588. text $window.properties.simulation_time.value 
  589.      -width 10 -height 1
  590. $window.properties.simulation_time.value insert 
  591.      0.0 $maximum_simulation_time_
  592. pack $window.properties.simulation_time.label -side left
  593. pack $window.properties.simulation_time.value -side right
  595. pack $window.properties.simulation_time -side top
  597. # Apply and Cancel Buttons
  598. frame $window.buttons
  600. button $window.buttons.apply -text "Apply"
  601.        -command "$self setSimulatorProperties $window; 
  602.                  destroy $window"
  603. button $window.buttons.cancel -text "Cancel" 
  604.        -command "destroy $window"
  606. pack $window.buttons.apply $window.buttons.cancel 
  607.      -side left -padx 1m -pady 1m
  609. pack $window.buttons -side bottom -padx 1m -pady 1m
  610. pack $window.properties -side top
  611. }
  613. #----------------------------------------------------------------------
  614. Editor instproc setSimulatorProperties {window} {
  615. $self instvar netmodel_ editorwindow_ slider_model_ slider_view_
  616. $netmodel_ instvar maximum_simulation_time_
  618. # EditorNetModel maximum simulation time
  619. set maximum_simulation_time_ 
  620.     [$window.properties.simulation_time.value get 0.0 1.end]
  621. $slider_model_ destroy
  622. $slider_view_ destroy
  624. $self buildTimeSlider $editorwindow_.timeslider
  625. }
  627. #----------------------------------------------------------------------
  628. #----------------------------------------------------------------------
  629. Editor instproc setDropDownValue {value} {
  630.   $self tkvar drop_down_value_
  632.   set drop_down_value_ $value
  633. }
  636. #----------------------------------------------------------------------
  637. #----------------------------------------------------------------------
  638. Editor instproc reloadObjectProperties {display_frame x y} {
  639.   $self instvar editor_view_ editorwindow_
  640.   $self tkvar drop_down_value_
  642.   $self undisplayObjectProperties $display_frame
  644.   set objinfo [$editor_view_ getObjectProperty $x $y $drop_down_value_]
  645.   if {[string compare $objinfo "NONE"] == 0 } {
  646.     return 
  647.   }
  649.   set item [lindex $objinfo 0]
  650.   set item [lindex $item 0]
  651.   $self displayObjectProperties $editorwindow_.properties $item $x $y $objinfo
  652.   place_frame $editorwindow_ $editorwindow_.properties $x $y
  653. }
  655. #----------------------------------------------------------------------
  656. # Editor instproc
  657. # displayObjectProperties {display_frame item x y properties}
  658. #  - A draws the list of properties for an editor object.
  659. #  - The format of the "properties" list is
  660. #    {label modified_variable property_type}
  661. #  - update_object contains a list of each property and it's stored
  662. #    value
  663. #----------------------------------------------------------------------
  664. Editor instproc displayObjectProperties {display_frame item x y properties} {
  665.   $self instvar SharedEnv colorarea property_values textwidgets drop_down_list_
  666.   $self tkvar current_time_ start_stop_time_ drop_down_value_
  668.   set SharedEnv($item) $properties
  670.   $self undisplayObjectProperties $display_frame
  671.   frame $display_frame -relief raised -borderwidth 1 
  673.   set number 0
  674.   
  675.   foreach property $properties {
  676.     set property_label [lindex $property 0]
  677.     set property_variable [lindex $property 1]
  678.     set property_type [lindex $property 2]
  679.     set property_value [lindex $property 3]
  680.     
  681.     set property_values($property_variable) $property_value 
  683.     # Create frame to hold each property line
  684.     frame $display_frame.line_$number
  686.     if {$property_type == "title"} {
  687.       # Displays the title in the property window frame
  688.       label $display_frame.line_$number.title -wraplength 200 
  689.                                               -text $property_label
  690.       pack $display_frame.line_$number.title -side top
  693.     } elseif {$property_type == "text"} { 
  694.       # Otherwise just put a label
  695.       label $display_frame.line_$number.label_${property_variable} 
  696.            -wraplength 300 -text "$property_label"
  697.       text $display_frame.line_$number.input_${property_variable} 
  698.            -width 10 -height 1
  699.       set textwidgets($property_variable) 
  700.           $display_frame.line_$number.input_${property_variable}
  702.       # Set text box to current variable value
  703.       $display_frame.line_$number.input_${property_variable} insert 
  704.             0.0 $property_value
  706.       pack $display_frame.line_$number.label_${property_variable} -side left
  707.       pack $display_frame.line_$number.input_${property_variable} -side right
  710.     } elseif {$property_type == "color"} {
  711.       # We have a color property
  712.       button $display_frame.line_$number.label_${property_variable} 
  713.              -text "$property_label" 
  714.              -command "$self showPalette $display_frame.line_$number.input_${property_variable}"
  715.       text $display_frame.line_$number.input_${property_variable} 
  716.            -width 10 -height 1
  717.       set textwidgets($property_variable) 
  718.           $display_frame.line_$number.input_${property_variable}
  720.       $display_frame.line_$number.input_${property_variable} insert 
  721.             0.0 $property_value
  723.       pack $display_frame.line_$number.label_${property_variable} -side left
  724.       pack $display_frame.line_$number.input_${property_variable} -side right
  726.       #set colorarea $display_frame.line_$number.eCOLOR
  727.       set colorarea $textwidgets($property_variable)
  728.       pack $display_frame.line_$number.input_${property_variable} -side right
  731.     } elseif {$property_type == "label"} {
  732.       label $display_frame.line_$number.label_${property_variable} 
  733.            -wraplength 200 -text "$property_label"
  734.       pack $display_frame.line_$number.label_${property_variable} -side left
  737.     } elseif {$property_type == "timelist"} {
  738.       # Displays a complex time list object with
  739.       # Buttons for grabbing the current time, add the time to the 
  740.       # start/stop time list and removing time from the list.
  741.       # It should look like this.
  742.       # [Grab]  ___________  [Add] [Remove] [- time list menu]
  743.       label $display_frame.line_$number.label_${property_variable} 
  744.            -wraplength 100 -text "$property_label"
  746.       button $display_frame.line_$number.set_${property_variable} 
  747.              -text "Grab" 
  748.              -command "$self insertTimeInto 
  749.               $display_frame.line_$number.input_${property_variable}"
  751.       text $display_frame.line_$number.input_${property_variable} 
  752.            -width 10 -height 1
  753.       $display_frame.line_$number.input_${property_variable} insert 
  754.             0.0 [lindex $property_value 0]
  756.       set time_menu $display_frame.line_$number.timelist_${property_variable}.menu
  758.       # Add Remove list widgets
  759.       button $display_frame.line_$number.add_${property_variable} 
  760.              -text "Add" -command "$self addTimeListItem $time_menu 
  761.               $display_frame.line_$number.input_${property_variable}"
  763.       # Add a drop down list of start and stop times that are passed in
  764.       # from the object in the property_value as a list
  765.       set start_stop_time_ " "
  766.       menubutton $display_frame.line_$number.timelist_${property_variable} 
  767.                  -textvariable [$self tkvarname start_stop_time_] 
  768.                  -text $start_stop_time_ 
  769.                  -indicatoron 1 -menu $time_menu 
  770.                  -relief raised -bd 2 -highlightthickness 2 -anchor c 
  771.                  -direction flush -width 15
  772.       
  773.       menu $time_menu -tearoff 0
  774.       $self generateTimeListMenu $time_menu $property_value
  775.       set start_stop_time_ "start [lindex $property_value 0]"
  776.       
  777. #      label $display_frame.line_$number.label_${property_variable} 
  778. #           -text "$property_label"
  780.       button $display_frame.line_$number.remove_${property_variable} 
  781.         -text "Remove" -command "$self deleteTimeListItem $time_menu"
  783.       pack $display_frame.line_$number.label_${property_variable} -side left
  784.       pack $display_frame.line_$number.set_${property_variable} 
  785.            $display_frame.line_$number.input_${property_variable} -side left
  786.       pack $display_frame.line_$number.remove_${property_variable} 
  787.            $display_frame.line_$number.timelist_${property_variable} 
  788.            $display_frame.line_$number.add_${property_variable} -side right
  790.     } elseif {$property_type == "time"} {
  791.       # Display a button and text box
  792.       #  - the button grabs the time from current_time_
  793.       #  - the text box allows the time to be set expicitly
  794.       text $display_frame.line_$number.input_${property_variable} 
  795.            -width 10 -height 1
  796.       set textwidgets($property_variable) 
  797.           $display_frame.line_$number.input_${property_variable}
  799.       button $display_frame.line_$number.label_${property_variable} 
  800.         -text "$property_label" 
  801.         -command "$self insertTimeInto 
  802.                         $display_frame.line_$number.input_${property_variable}"
  804.       #label $display_frame.line_$number.label_${property_variable} 
  805.       #     -text "$property_label"
  807.       # Set text box to current variable value
  808.       $display_frame.line_$number.input_${property_variable} insert 
  809.             0.0 $property_value
  811.       pack $display_frame.line_$number.label_${property_variable} -side left
  812.       pack $display_frame.line_$number.input_${property_variable} -side right
  815.     #-------------- drop down list -------------------------------------
  816.     } elseif {$property_type == "drop_down_list"} {
  817.       set drop_down_value_ [lindex $property_value 0]
  818.       set drop_down_list_ [lindex $property_value 1]
  820.       # used to save typing and make this more readable
  821.       set line_frame $display_frame.line_$number
  823.       label $line_frame.label_${property_variable} 
  824.            -wraplength 100 -text "$property_label"
  826.       # Create a button from which to hang menu 
  827.       menubutton $line_frame.list_${property_variable} 
  828.              -textvariable [$self tkvarname drop_down_value_] 
  829.              -text $drop_down_value_ 
  830.              -indicatoron 1 -menu $line_frame.list_${property_variable}.menu 
  831.              -relief raised -bd 2 -highlightthickness 2 -anchor c 
  832.              -direction flush -width 17
  834.       # Create menu object and the menu selections
  835.       menu $line_frame.list_${property_variable}.menu -tearoff 0
  836.       foreach i $drop_down_list_ {
  837.         if {$i == "-"} {
  838.           $line_frame.list_${property_variable}.menu add separator
  839.         } else {
  840.           $line_frame.list_${property_variable}.menu add radiobutton -label $i 
  841.                 -variable drop_down_value_ 
  842.                 -command "$self setDropDownValue $i; $self reloadObjectProperties $display_frame $x $y" 
  843.         }
  844.       }
  845.       $self setDropDownValue [lindex $property_value 0]
  846. #      $line_frame.list_${property_variable} configure -width 16
  848.       pack $line_frame.label_${property_variable} -side left
  849.       pack $line_frame.list_${property_variable} -side right
  851.     #-------------- Boolean Check Box--------------------------------
  852.     } elseif {$property_type == "checkbox"} {
  853.       # Otherwise just put a label
  854.       checkbutton $display_frame.line_$number.checkbox_${property_variable} 
  855.             -text "$property_label" -variable $property_variable
  857.       #set textwidgets($property_variable) 
  858.       #    $display_frame.line_$number.input_${property_variable}
  860.       pack $display_frame.line_$number.checkbox_${property_variable} -side left
  861.     }
  864.     pack $display_frame.line_$number -side top -fill x 
  865.     incr number
  866.   } ;# End foreach
  868.   
  869.   # Apply and Cancel Buttons
  870.   frame $display_frame.buttons
  871.   button $display_frame.buttons.apply -text "Apply"
  872.          -command "$self setObjectProperties {$properties}; 
  873.           $self undisplayObjectProperties $display_frame"
  874.   button $display_frame.buttons.cancel -text "Cancel" 
  875.          -command "$self undisplayObjectProperties $display_frame"
  877.   pack $display_frame.buttons.apply $display_frame.buttons.cancel -side left 
  878.        -padx 1m -pady 1m
  879.   pack $display_frame.buttons -side bottom -padx 1m -pady 1m
  880. }
  883. #----------------------------------------------------------------------
  884. #
  885. #----------------------------------------------------------------------
  886. Editor instproc insertTimeInto {textbox} {
  887.   $self tkvar current_time_    
  888.   $textbox delete 0.0 end
  889.   $textbox insert 0.0 $current_time_
  890. }
  892. #----------------------------------------------------------------------
  893. #
  894. #----------------------------------------------------------------------
  895. Editor instproc undisplayObjectProperties {display_frame} {
  896.   if {[winfo exists $display_frame]} {
  897.     # Need to delete old properties widgets
  898.     foreach widget [pack slaves $display_frame] {
  899.       # Each property has a frame for it's line(ie. label textbox)
  900.       set subwidgets [pack slaves $widget]
  901.       if {[llength $subwidgets] > 0} {
  902.         pack forget $subwidgets
  903.         destroy $subwidgets
  904.       }
  905.       pack forget $widget
  906.       destroy $widget
  907.     }
  908.   }
  909.   catch {destroy $display_frame}
  910. }
  912. #-----------------------------------------------------------------------
  913. # Editor instproc setObjectProperties {properties}
  914. #  - takes property list and sets each property in the list to it's
  915. #    value
  916. #  - properties format is:
  917. #    {{label variable type value} {label variable type value}}
  918. #-----------------------------------------------------------------------
  919. Editor instproc setObjectProperties {properties} {
  920.   $self instvar editor_view_ property_values textwidgets 
  921.                 start_stop_time_list_
  922.   $self tkvar drop_down_value_
  924.   foreach property $properties {
  925.   #  puts $property
  926.     
  927.     set property_label [lindex $property 0]
  928.     set property_variable [lindex $property 1]
  929.     set property_type [lindex $property 2]
  931.     if {$property_type == "title"} {
  932.       # This should be the first property and property_value should
  933.       # include the object type and id
  934.       set property_value [lindex $property 3]
  935.       set type [lindex $property_value 0]
  936.       set typeid [lindex $property_value 1] 
  938.     } elseif {$property_type == "label"} {
  939.       # Do nothing for a label
  941.     } elseif {$property_type == "timelist"} {
  942.       set property_value $start_stop_time_list_
  944.     } elseif {$property_type == "drop_down_list"} {
  945.       set property_value $drop_down_value_
  947.     } elseif {$property_type == "checkbox"} {
  949.     } else {
  950.       # Get the value from the text box
  951.       set property_value [$textwidgets($property_variable) get 0.0 1.end]
  952.       #puts [$textwidgets($property_variable) get 0.0 1.end]
  953.     }
  955.     switch "$type" {
  956.       Node {
  957.         $editor_view_ setNodeProperty $typeid 
  958.                                       $property_value 
  959.                                       $property_variable
  960.       }
  962.       Agent {
  963.         $editor_view_ setAgentProperty $typeid 
  964.                                        $property_value 
  965.                                        $property_variable
  966.       }
  968.       Link {
  969.         set src_dst [split $typeid "-"]
  970.         set src [lindex $src_dst 0]
  971.         set dst [lindex $src_dst 1]
  972.         $editor_view_ setLinkProperty $src $dst 
  973.                                       $property_value 
  974.                                       $property_variable
  975.       }
  977.       QueueHandle {
  978.         set src_dst [split $typeid "-"]
  979.         set source [lindex $src_dst 0]
  980.         set destination [lindex $src_dst 1]
  981.         $editor_view_ setQueueHandleProperty $source $destination 
  982.                                              $property_value 
  983.                                              $property_variable
  984.       }
  986.       TrafficSource {
  987.         $editor_view_ setTrafficSourceProperty $typeid 
  988.                                                $property_value 
  989.                                                $property_variable
  990.       }
  991.  
  993.       LossModel {
  994.         $editor_view_ setLossModelProperty $typeid 
  995.                                            $property_value 
  996.                                            $property_variable
  997.       }
  999.     }
  1000.   }
  1001. }
  1003. #----------------------------------------------------------------------
  1004. # Editor instproc buildToolbar {view toolbar} {
  1005. #   - Toolbar along the top side of the nam editor window
  1006. #   - Tools are:
  1007. #        select
  1008. #        addnode
  1009. #        addlink
  1010. #        addagent
  1011. #        addtrafficsource
  1012. #        deleteobject
  1013. #----------------------------------------------------------------------
  1014. Editor instproc buildToolbar {view toolbar} {
  1015.   $self instvar magnification viewOffset SharedEnv balloon_ 
  1016.         state_buttons_ edit_state_ editorwindow_ agent_types_ 
  1017.         source_types_ toolbar_buttons_ current_tool_ 
  1018.         lossmodel_types_
  1019.   $self tkvar current_agent_ current_source_ current_lossmodel_
  1021.   # Build toolbar
  1022.   frame $toolbar.leftside
  1024.   button $toolbar.leftside.select -bitmap "select" 
  1025.                                   -command "$self chooseTool select" 
  1026.                                   -highlightthickness 0 -borderwidth 1
  1027.   set toolbar_buttons_(select) $toolbar.leftside.select
  1029.   button $toolbar.leftside.addnode -bitmap "addnode" 
  1030.                               -command " $self chooseTool addnode" 
  1031.                               -highlightthickness 0 -borderwidth 1
  1032.   set toolbar_buttons_(addnode) $toolbar.leftside.addnode
  1034.   button $toolbar.leftside.addlink -bitmap "addlink" 
  1035.                               -command "$self chooseTool addlink" 
  1036.                               -highlightthickness 0 -borderwidth 1
  1037.   set toolbar_buttons_(addlink) $toolbar.leftside.addlink
  1039.   button $toolbar.leftside.addagent -text "Agent" 
  1040.                         -command "$self chooseTool addagent" 
  1041.                         -highlightthickness 0 -borderwidth 1
  1042.   set toolbar_buttons_(addagent) $toolbar.leftside.addagent
  1044.   #---------------------------------------------------------------------
  1045.   # Create drop down list of agents
  1046.   #   - current_agent_ needs to be initialized to first element in
  1047.   #     $agent_types_
  1048.   menubutton $toolbar.leftside.agent_list -textvariable [$self tkvarname current_agent_] 
  1049.              -text $current_agent_ 
  1050.              -indicatoron 1 -menu $toolbar.leftside.agent_list.menu 
  1051.              -relief raised -bd 2 -highlightthickness 2 -anchor c 
  1052.              -direction flush
  1053.   menu $toolbar.leftside.agent_list.menu -tearoff 0
  1054.   foreach i $agent_types_ {
  1055.     if {$i == "-"} {
  1056.       $toolbar.leftside.agent_list.menu add separator
  1057.     } else {
  1058.       $toolbar.leftside.agent_list.menu add radiobutton -label $i 
  1059.                                       -variable current_agent_ 
  1060.                                       -command "$self chooseAgent $i" 
  1061.     }
  1062.   }
  1064.   $toolbar.leftside.agent_list configure -width 16
  1066.   # Traffic source button and drop down list
  1067.   button $toolbar.leftside.add_traffic_source -text "Traffic Source" 
  1068.                         -command "$self chooseTool addtrafficsource" 
  1069.                         -highlightthickness 0 -borderwidth 1
  1070.   set toolbar_buttons_(addtrafficsource) $toolbar.leftside.add_traffic_source
  1072.   #---------------------------------------------------------------------
  1073.   # Drop down list of Traffic Sources
  1074.   #   - $current_source_ needs to be initialized to first element in
  1075.   #     $source_types_
  1076.   menubutton $toolbar.leftside.source_list -textvariable [$self tkvarname current_source_] 
  1077.              -indicatoron 1 -menu $toolbar.leftside.source_list.menu 
  1078.              -relief raised -bd 2 -highlightthickness 2 -anchor c 
  1079.              -direction flush
  1080.   menu $toolbar.leftside.source_list.menu -tearoff 0
  1081.   foreach i $source_types_ {
  1082.     $toolbar.leftside.source_list.menu add radiobutton -label $i 
  1083.                                       -variable current_source_ 
  1084.                                       -command "$self chooseTrafficSource $i" 
  1085.   }
  1086.   $toolbar.leftside.source_list configure -width 16
  1087.   
  1088.   #---------------------------------------------------------------------
  1089.   # Loss Model button and drop down list
  1090.   #
  1091.   button $toolbar.leftside.add_lossmodel -text "Loss Model" 
  1092.                         -command "$self chooseTool addlossmodel" 
  1093.                         -highlightthickness 0 -borderwidth 1
  1094.   set toolbar_buttons_(addlossmodel) $toolbar.leftside.add_lossmodel
  1096.   # Drop down list of Loss Models
  1097.   #   - $current_lossmodel_ needs to be initialized to first element in
  1098.   #     $lossmodel_types_
  1099.   menubutton $toolbar.leftside.lossmodel_list 
  1100.              -textvariable [$self tkvarname current_lossmodel_] 
  1101.              -indicatoron 1 -menu $toolbar.leftside.lossmodel_list.menu 
  1102.              -relief raised -bd 2 -highlightthickness 2 -anchor c 
  1103.              -direction flush
  1104.   menu $toolbar.leftside.lossmodel_list.menu -tearoff 0
  1105.   foreach i $lossmodel_types_ {
  1106.     $toolbar.leftside.lossmodel_list.menu add radiobutton -label $i 
  1107.                                       -variable current_lossmodel_ 
  1108.                                       -command "$self chooseLossModel $i" 
  1109.   }
  1110.   $toolbar.leftside.lossmodel_list configure -width 16
  1111.   
  1112.   #---------------------------------------------------------------------
  1113.   # Delete Object Button
  1114.   button $toolbar.leftside.deleteobject -bitmap "delete" 
  1115.                         -command "$self chooseTool deleteobject" 
  1116.                         -highlightthickness 0 -borderwidth 1
  1117.   set toolbar_buttons_(deleteobject) $toolbar.leftside.deleteobject
  1119.   pack $toolbar.leftside.select 
  1120.        $toolbar.leftside.addnode 
  1121.        $toolbar.leftside.addlink 
  1122.        $toolbar.leftside.addagent 
  1123.        $toolbar.leftside.agent_list 
  1124.        $toolbar.leftside.add_traffic_source 
  1125.        $toolbar.leftside.source_list 
  1126.        $toolbar.leftside.add_lossmodel 
  1127.        $toolbar.leftside.lossmodel_list 
  1128.        $toolbar.leftside.deleteobject 
  1129.        -side left
  1131.   pack $toolbar.leftside -side left 
  1132. #  pack $toolbar.zoombar -side left -fill x
  1134.   $balloon_ balloon_for $toolbar.leftside.select "Select Object, Move Object or Get Object Properties"
  1135.   $balloon_ balloon_for $toolbar.leftside.addnode "Add Node"
  1136.   $balloon_ balloon_for $toolbar.leftside.addlink "Add Link or Connect Agents"
  1137.   $balloon_ balloon_for $toolbar.leftside.addagent "Add Agent to a Node"
  1138.   $balloon_ balloon_for $toolbar.leftside.agent_list "Choose Which Agent to Add"
  1139.   $balloon_ balloon_for $toolbar.leftside.add_traffic_source "Add Traffic Source"
  1140.   $balloon_ balloon_for $toolbar.leftside.source_list "Choose Which Traffic Source to Add"
  1141.   $balloon_ balloon_for $toolbar.leftside.add_lossmodel "Add Link Loss Model"
  1142.   $balloon_ balloon_for $toolbar.leftside.lossmodel_list "Choose Which Loss Model to Add"
  1143.   $balloon_ balloon_for $toolbar.leftside.deleteobject "Delete Object"
  1144. }
  1147. #-----------------------------------------------------------------------
  1148. # Editor instproc buildTimeControls {w}
  1149. #  - builds the set of time controls into the frame w
  1150. #  - This code was originally copied from build-ui.tcl so it is not
  1151. #    very pretty looking 
  1152. #-----------------------------------------------------------------------
  1153. Editor instproc buildTimeControls {w} {
  1154.   $self instvar rateSlider granularity time_step_ stepDisp running 
  1155.         direction balloon_ current_time_step_ previous_time_step_
  1156.   $self tkvar current_time_
  1158.   set current_time_step_ 0.0001
  1160.   set f [smallfont]
  1161.   frame $w.bar -relief groove -borderwidth 2
  1163. #  frame $w.bar.rate -borderwidth 1 -relief sunken
  1165. #  scale $w.bar.rate.slider -orient horizontal -width 7p 
  1166. #                           -label "Step:" -font [smallfont] 
  1167. #                           -from -60 -to -1 -showvalue false 
  1168. #                           -relief flat 
  1169. #                           -borderwidth 1 -highlightthickness 0 
  1170. #                      -troughcolor [option get . background Nam]
  1172. #  pack $w.bar.rate.slider -side top -fill both -expand true
  1173. #  set rateSlider $w.bar.rate.slider
  1175.   #puts [time2real [option get . rate Nam]]
  1176. #  set granularity [option get . granularity Nam]
  1177.   #set time_step_ [time2real [option get . rate Nam]]
  1178. #  set time_step_ 10.0
  1179.   
  1180. #  set stepDisp [step_format $time_step_]
  1181. #  set current_time_step_ [expr 10*log10($time_step_)]
  1182. #  set previous_time_step_ $current_time_step_
  1183. #  $rateSlider set $current_time_step_
  1185. #  bind $rateSlider <ButtonRelease-1> "$self set_rate [%W get] 1"
  1186. #  bind $rateSlider <ButtonPress-1> "$self on-rateslider-press"
  1187. #  bind $rateSlider <B1-Motion> "$self on-rateslider-motion [%W get]"
  1189. #  trace variable stepDisp w "$self displayStep"
  1191.   # Shows the current time in the time control bar
  1192.   label $w.bar.timer_label -text "Time :" 
  1193.                         -anchor w -font $f -borderwidth 1 
  1194.                         -relief sunken -anchor e
  1195.   label $w.bar.timer_value -textvariable [$self tkvarname current_time_] 
  1196.                         -width 14 -anchor w -font $f -borderwidth 1 
  1197.                         -relief sunken -anchor e
  1199. #  frame $w.bar.run
  1200. #  button $w.bar.run.b -bitmap play -borderwidth 1 -relief raised 
  1201. #                      -highlightthickness 0 -font $f  
  1202. #                      -command "puts "$self set_run $w""
  1203. #  frame $w.bar.run.f -height 5 -relief sunken 
  1204. #                     -borderwidth 1
  1205. #  pack $w.bar.run.b -side top -fill both -expand true
  1206. #  pack $w.bar.run.f -side top -fill x
  1207. #  $balloon_ balloon_for $w.bar.run.b "play forward" 1000
  1209. #  frame $w.bar.back
  1210. #  button $w.bar.back.b -bitmap back -borderwidth 1 -relief raised 
  1211. #                       -highlightthickness 0 -font $f 
  1212. #                       -command "puts "$self set_back $w""
  1213. #  $balloon_ balloon_for $w.bar.back.b "play backward" 1000
  1215.   # hilight running labels as $running changes
  1216. #  trace variable running w "$self trace_running_handler $w"
  1217.   
  1218. #  frame $w.bar.back.f -height 5 -relief sunken 
  1219. #                      -borderwidth 1
  1220. #  pack $w.bar.back.b -side top -fill both -expand true
  1221. #  pack $w.bar.back.f -side top -fill x
  1222.         
  1223. #  frame $w.bar.stop
  1224. #  button $w.bar.stop.b -bitmap stop -borderwidth 1 -relief raised 
  1225. #                       -highlightthickness 0 -font $f 
  1226. #                       -command "puts "$self stop 1;
  1227. #                                 $self renderFrame;
  1228. #                                 $self highlight $w.bar.stop 1""
  1230. #  $balloon_ balloon_for $w.bar.stop.b "stop" 1000
  1231. #  frame $w.bar.stop.f -height 5 -relief sunken 
  1232. #                      -borderwidth 1
  1234. #  pack $w.bar.stop.b -side top -fill both -expand true
  1235. #  pack $w.bar.stop.f -side top -fill x
  1237. #  frame $w.bar.rew
  1238. #  button $w.bar.rew.b -bitmap rew -borderwidth 1 -relief raised 
  1239. #                      -highlightthickness 0 -font $f 
  1240. #                      -command "$self rewind"
  1242. #  $balloon_ balloon_for $w.bar.rew.b "rewind" 1000
  1243. #  frame $w.bar.rew.f -height 5 -relief sunken 
  1244. #                     -borderwidth 1
  1245. #  pack $w.bar.rew.b -side top -fill both -expand true
  1246. #  pack $w.bar.rew.f -side top -fill x
  1248. #  frame $w.bar.ff
  1249. #  button $w.bar.ff.b -bitmap ff -borderwidth 1 -relief raised 
  1250. #                     -highlightthickness 0 -font $f 
  1251. #                     -command "$self fast_fwd"
  1252. #  $balloon_ balloon_for $w.bar.ff.b "fast forward" 1000
  1254. #  frame $w.bar.ff.f -height 5 -relief sunken 
  1255. #                    -borderwidth 1
  1256. #  pack $w.bar.ff.b -side top -fill both -expand true
  1257. #  pack $w.bar.ff.f -side top -fill x
  1259. #  pack $w.bar.rate -side right -fill y
  1260.   pack $w.bar.timer_value $w.bar.timer_label -side right -pady 0 
  1261.                        -ipady 1 -padx 1 -fill y
  1262. #  pack $w.bar.ff -side right -padx 1 -pady 1 -fill both -expand true
  1263. #  pack $w.bar.run -side right -padx 1 -pady 1 -fill both -expand true
  1264. #  pack $w.bar.stop -side right -padx 1 -pady 1 -fill both -expand true
  1265. #  pack $w.bar.back -side right -padx 1 -pady 1 -fill both -expand true
  1266. #  pack $w.bar.rew -side right -padx 1 -pady 1 -fill both -expand true
  1268.   pack $w.bar -fill x -expand 1 -side right
  1270. #  $self instvar prevbutton
  1271. #  set prevbutton $w.bar.stop
  1273. #  start out stopped
  1274. #  $self highlight $w.bar.stop 1
  1275. }
  1277. #-----------------------------------------------------------------------
  1278. # Editor instproc buildTimeSlider {view w}
  1279. #  - creates a time slider to be used in setting time events
  1280. #  - w is the slider frame
  1281. #-----------------------------------------------------------------------
  1282. Editor instproc buildTimeSlider {w} {
  1283.   $self tkvar showpanel
  1284.   $self instvar mintime_ now_ slider_model_ pipemode_ slider_view_ netmodel_
  1285.   $netmodel_ instvar maximum_simulation_time_ ;# This is set by editornetmodel.cc
  1287.   # Initialize Time Slider Values
  1288.   set mintime_ 0.0
  1289.   set now_ 0.0
  1291.   set slider_model_ [new TimesliderModel $mintime_ $maximum_simulation_time_ $now_ $self]
  1292.   set slider_view_ [new TimesliderView $w $slider_model_]
  1294.   $slider_model_ addObserver $slider_view_
  1295.   $slider_model_ setpipemode 0
  1297.   $self setCurrentTime 0.0
  1298. }
  1300. #------------- Functions needed for TimeSlider -------------
  1301. Editor instproc setsliderPressed {v} {
  1302. #  puts "setsliderPressed $v"
  1303. }
  1305. #-----------------------------------------------------------------------
  1306. #-----------------------------------------------------------------------
  1307. Editor instproc setCurrentTime {time} {
  1308.   $self tkvar current_time_
  1310.   set current_time_ $time
  1311.   $self renderFrame
  1312. }
  1314. #-----------------------------------------------------------------------
  1315. #-----------------------------------------------------------------------
  1316. Editor instproc slidetime {a b} {
  1317. #  puts "slidetime $a $b"
  1318. }
  1320. #-----------------------------------------------------------------------
  1321. #-----------------------------------------------------------------------
  1322. Editor instproc fast_fwd {} {
  1323. #  $self instvar current_time_step_ slider_model_
  1324. #  $self tkvar current_time_
  1325. #  puts "fast_fwd -> $current_time_step_"
  1326. #  set current_time_ [expr $current_time_ + $current_time_step_]
  1327. #  $slider_model_ setcurrenttime $current_time_step_
  1328.   
  1329. }
  1331. #-----------------------------------------------------------------------
  1332. #-----------------------------------------------------------------------
  1333. Editor instproc rewind {} {
  1334. #  $self instvar current_time_step_ slider_model_
  1335. #  $self tkvar current_time_
  1336. #  puts "rewind -> $current_time_step_"
  1337. #  set current_time_ [expr $current_time_ - $current_time_step_]
  1338. #  $slider_model_ setcurrenttime $current_time_step_
  1339. }
  1341. #-----------------------------------------------------------------------
  1342. #-----------------------------------------------------------------------
  1343. Editor instproc setsliderPressed {b} {
  1344. #  puts "setsliderPressed $b"
  1345. }
  1347. #-----------------------------------------------------------------------
  1348. #-----------------------------------------------------------------------
  1349. Editor instproc getrunning {} {
  1350. #  puts getrunning
  1351.   return 1
  1352. }
  1355. #-----------------------------------------------------------------------
  1356. # Editor instproc renderFrame {} 
  1357. #  -- called by the TimeSlider after the slider is released
  1358. #-----------------------------------------------------------------------
  1359. Editor instproc renderFrame {} {
  1360.   $self instvar editor_view_ netmodel_ slider_view_
  1361.   $self tkvar current_time_
  1363.   $netmodel_ updateNodePositions $current_time_
  1364.   $editor_view_ draw $current_time_
  1365. }
  1366. #------------- End Functions needed for TimeSlider -------------
  1369. #-----------------------------------------------------------------------
  1370. # Editor instproc addTimeSliderNodeMarkers{} 
  1371. #-----------------------------------------------------------------------
  1372. Editor instproc addTimeSliderNodeMarkers {marker_list} {
  1373. $self instvar slider_view_
  1374. foreach line $marker_list {
  1375. set node_id [lindex $line 0]
  1376. foreach time [lrange $line 1 end] {
  1377. $slider_view_ addMarker $time $node_id seagreen
  1378. }
  1379. }
  1380. }
  1384. #-----------------------------------------------------------------------
  1385. # Editor instproc buildMenubar {w}
  1386. #  - w is the parent window frame
  1387. #-----------------------------------------------------------------------
  1388. Editor instproc buildMenubar {w} {
  1389.   $self instvar editorwindow_ menubar_ agent_types_ 
  1390.         source_types_ lossmodel_types_
  1392.   $self tkvar current_agent_ current_source_ current_lossmodel_
  1393.   # File Menu
  1394.   menubutton $w.file -text File -underline 0 
  1395.              -menu $w.file.menu
  1396.   menu $w.file.menu
  1397.   $w.file.menu add command -label New 
  1398.                      -underline 0 -command "$self newFile"
  1399.   $w.file.menu add command -label Open 
  1400.                      -underline 0 -command "$self openFile"
  1401.   $w.file.menu add command -label Save 
  1402.                      -underline 0 -command "$self doSave"
  1403.   $w.file.menu add command -label "Save As..." 
  1404.                      -underline 4 -command "$self doSaveAs"
  1405.   $w.file.menu add separator
  1406.   $w.file.menu add command -label "Run Ns" 
  1407.                      -underline 1 -command "$self doSave; $self runNs"
  1408.   $w.file.menu add command -label "Close" 
  1409.                      -underline 0 -command "destroy $editorwindow_"
  1411.   # Edit Menu
  1412.   menubutton $w.edit -text Edit -underline 0 
  1413.              -menu $w.edit.menu
  1414.   menu $w.edit.menu
  1415.   $w.edit.menu add command -label "Undo" 
  1416.                      -underline 0 -command "puts Undo" -state disabled
  1417.   $w.edit.menu add command -label "Redo" 
  1418.                      -underline 0 -command "puts Redo" -state disabled
  1419.   $w.edit.menu add separator
  1420.   $w.edit.menu add command -label "Cut" 
  1421.                      -underline 0 -command "puts Cut" -state disabled
  1422.   $w.edit.menu add command -label "Copy" 
  1423.                      -underline 0 -command "puts Copy" -state disabled
  1424.   $w.edit.menu add command -label "Paste" 
  1425.                      -underline 0 -command "puts Paste" -state disabled
  1426.   $w.edit.menu add separator
  1427.   $w.edit.menu add command -label "Simulator Properties" 
  1428.                      -underline 0 -command "$self displaySimulatorProperties .properties"
  1430.   # Tools Menu
  1431.   menubutton $w.tools -text Tools -underline 0 
  1432.              -menu $w.tools.menu
  1433.   menu $w.tools.menu
  1434.   $w.tools.menu add command -label "Select" 
  1435.                      -underline 0 -command "$self chooseTool select"
  1436.   $w.tools.menu add command -label "Add Node" 
  1437.       -underline 0  
  1438.       -command "$self chooseTool addnode"
  1439.   $w.tools.menu add command -label "Add Link" 
  1440.       -underline 0  
  1441.       -command "$self chooseTool addlink"
  1443.   # Cascading Agents menu
  1444.   $w.tools.menu add cascade -label "Agents" 
  1445.       -underline 0 -menu $w.tools.menu.agents
  1446.   menu $w.tools.menu.agents
  1447.   foreach i $agent_types_ {
  1448.     if {$i == "-"} {
  1449.       $w.tools.menu.agents add separator
  1450.     } else {
  1451.       $w.tools.menu.agents add radiobutton 
  1452.            -label $i -variable current_agent_ -value $i 
  1453.            -command "$self chooseAgent $i"
  1454.     }
  1455.   }
  1457.   # Cascading Sources menu
  1458.   $w.tools.menu add cascade -label "Traffic Sources" 
  1459.       -underline 0 -menu $w.tools.menu.sources
  1460.   menu $w.tools.menu.sources
  1461.   foreach i $source_types_ {
  1462.     $w.tools.menu.sources add radiobutton 
  1463.            -label $i -variable current_source_ -value $i 
  1464.            -command "$self chooseTrafficSource $i"
  1465.   }
  1467.   # Cascading Loss Models menu
  1468.   $w.tools.menu add cascade -label "Link Loss Models" 
  1469.       -underline 0 -menu $w.tools.menu.lossmodels
  1470.   menu $w.tools.menu.lossmodels
  1471.   foreach i $lossmodel_types_ {
  1472.     $w.tools.menu.lossmodels add radiobutton 
  1473.            -label $i -variable current_lossmodel_ -value $i 
  1474.            -command "$self chooseLossModel $i"
  1475.   }
  1477.   $w.tools.menu add command -label "Delete Object" 
  1478.                      -underline 0 -command "$self chooseTool deleteobject"
  1481.   # Attach Menus to Parent Window
  1482.   pack $w.file $w.edit 
  1483.        $w.tools -side left   
  1485.   # Add Help menu to the Right
  1486.   menubutton $w.help -text "Help" -underline 0 
  1487.              -menu $w.help.menu
  1488.   menu $w.help.menu
  1489.   $w.help.menu add command -label "Help" 
  1490.              -underline 0 -command "$self showHelp"
  1491.   pack $w.help -side right
  1493.   # Enable Keyboard Focus
  1494. #  tk_menuBar $editorwindow_.menubar_  
  1495. #             $editorwindow_.menubar_.file 
  1496. #             $editorwindow_.menubar_.edit
  1498. }
  1500. #----------------------------------------------------------------------
  1501. #
  1502. #----------------------------------------------------------------------
  1503. Editor instproc setMessage {} {
  1504.   $self instvar SharedEnv
  1505.   return $SharedEnv(Cursor)
  1506. }
  1508. #----------------------------------------------------------------------
  1509. #
  1510. #----------------------------------------------------------------------
  1511. Editor instproc originObject { name } {
  1512.         $self instvar SharedEnv
  1513.                 
  1514.         set bb [$SharedEnv(CurrentCanvas) bbox $name]
  1515.         set x [lindex $bb 0]
  1516.         set y [lindex $bb 1]
  1517.         if {$x > 0} {
  1518.                 set nx -$x
  1519.         } else {
  1520.                 set nx [expr abs($x)]
  1521.         }
  1522.         if {$y > 0} {
  1523.                 set ny -$y              
  1524.         } else {         
  1525.                 set ny [expr abs($y)]
  1526.         }       
  1527.         $SharedEnv(CurrentCanvas) move $name $nx $ny
  1528. }    
  1530. #----------------------------------------------------------------------
  1531. #
  1532. #----------------------------------------------------------------------
  1533. Editor instproc scaleObject {name ratio width height} {
  1534.   $self instvar SharedEnv
  1536.   set bb [eval $SharedEnv(CurrentCanvas) bbox $name]
  1537.   if {"$bb" != ""} {
  1538.     set x [lindex $bb 2]
  1539.     set y [lindex $bb 3]
  1540.     if {$ratio == "variable"} {
  1541.       set scalex [expr ($width + 0.0) / $x]
  1542.       set scaley [expr ($height + 0.0) / $y]
  1543.       if {$scalex > $scaley} {
  1544.         set scale $scaley
  1545.       } else {
  1546.         set scale $scalex
  1547.       }
  1548.     } elseif {$ratio != ""} {
  1549.       set scalex $ratio
  1550.       set scaley $ratio
  1551.       set scale $ratio
  1552.     } else {
  1553.       set scalex [expr ($width + 0.0) / $x]
  1554.       set scaley [expr ($height + 0.0) / $y]
  1555.       if {$scalex > $scaley} {
  1556.         set scalex $scaley
  1557.         set scale $scaley
  1558.       } else {
  1559.         set scaley $scalex
  1560.         set scale $scalex
  1561.       }
  1562.     }
  1563.     $SharedEnv(CurrentCanvas) scale $name 0 0 $scalex $scaley
  1564.     foreach i [$SharedEnv(CurrentCanvas) find withtag all] {
  1565.       set type [$SharedEnv(CurrentCanvas) type $i]
  1566.       if {"$type" != "text"} {
  1567.         continue
  1568.       }
  1569.       if {$SharedEnv(FontScale)} {
  1570.         set fn [$SharedEnv(CurrentCanvas) itemcget $i -font]
  1571.         regexp 
  1572.         {([-][^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-)([^-]*)(-.*)}
  1573.           $fn dummy d1 size d2;
  1574.         if {"$dummy" != ""} {
  1575.           set nsize [expr round($size * $scale)]
  1576.           if {$nsize < 20} {
  1577.             set nsize 20
  1578.           }
  1579.           $SharedEnv(CurrentCanvas) itemconfigure $i 
  1580.             -font ${d1}${nsize}${d2}
  1581.           set fnn [$SharedEnv(CurrentCanvas) itemcget $i -font]
  1582.           regexp 
  1583.             {([-][^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-[^-]*-)([^-]*)(-.*)}
  1584.             $fnn dummy d1 nsize d2;
  1585.           if { ($scale < 1 && $nsize < $size ) || 
  1586.              ($scale > 1 && $nsize > $size) } {
  1587.             $SharedEnv(CurrentCanvas) itemconfigure $i 
  1588.               -width [expr [$SharedEnv(CurrentCanvas) itemcget $i 
  1589.               -width] * $scale]
  1590.           } else {
  1591.             $SharedEnv(CurrentCanvas) itemconfigure $i 
  1592.               -font $fn
  1593.           }
  1594.         }
  1595.       } else {
  1596.         $SharedEnv(CurrentCanvas) itemconfigure $i 
  1597.           -width [expr [$SharedEnv(CurrentCanvas) itemcget $i -width] 
  1598.             * $scale]
  1599.       }
  1600.     }
  1601.   }
  1602. }
  1606. #----------------------------------------------------------------------
  1607. #
  1608. #----------------------------------------------------------------------
  1609. Editor instproc setCursor { value } {                              
  1610.         $self instvar SharedEnv                                   
  1611.                                                         
  1612.         set SharedEnv(Cursor) $value                       
  1613.         $self setRadioButton SharedEnv(Cursor) $value    
  1614. }
  1616. #----------------------------------------------------------------------
  1617. #
  1618. #----------------------------------------------------------------------
  1619. Editor instproc setRadioButton { var value } {
  1620.         $self instvar SharedEnv
  1622.         if {[info exists SharedEnv(W_${value})]} {
  1623.                 set bd [$SharedEnv(W_${value}) cget -bd]
  1624.                 $self clearRadioVariable $var
  1625.                 $SharedEnv(W_${value}) configure -relief sunken
  1626.                 $SharedEnv(W_${value}) move all $bd $bd
  1627.                 set SharedEnv($var) $SharedEnv(W_${value})
  1628.         }        
  1629.         set $var "$value"       
  1630. }
  1632. #----------------------------------------------------------------------
  1633. #
  1634. #----------------------------------------------------------------------
  1635. Editor instproc clearRadioVariable {var} { 
  1636.         $self instvar SharedEnv           
  1637.         if {[info exists SharedEnv($var)] && [winfo exists $SharedEnv($var)]} {
  1638.                 set bd [$SharedEnv($var) cget -bd]
  1639.                 $SharedEnv($var) configure -relief $SharedEnv(ButtonRelief)
  1640.                 eval $SharedEnv($var) move all -$bd -$bd
  1641.         }       
  1642.         set $var ""  
  1643. }
  1645. #----------------------------------------------------------------------
  1646. #  Editor instproc enterObject { w x y value }
  1647. #     - Shows an objects popup info window
  1648. #----------------------------------------------------------------------
  1649. Editor instproc enterObject { w x y value } {
  1650. catch {destroy $w.f}
  1651. frame $w.f -relief groove -borderwidth 2
  1652. message $w.f.msg -width 8c -text $value
  1653. pack $w.f.msg
  1654. pack $w.f
  1655. catch {place_frame $w $w.f [expr $x+10] [expr $y+10]}
  1656. }
  1659. #----------------------------------------------------------------------
  1660. #
  1661. #----------------------------------------------------------------------
  1662. Editor instproc enterToolButtons { w x y value } {
  1663.   $self instvar SharedEnv
  1664.     set geo [winfo geometry $w]
  1665.     set px [lindex [split $geo "+"] 1]
  1666.     set py [lindex [split $geo "+"] 2]
  1667.     set psize [lindex [split $geo "+"] 0]
  1668.     set pxsize [lindex [split $psize "x"] 0]
  1669.     set pysize [lindex [split $psize "x"] 1]
  1670.                         
  1671.     set w [winfo parent $w]
  1673.     catch {destroy $w.fm}
  1675.     frame $w.fm -relief groove -borderwidth 2
  1676.     message $w.fm.msg -width 10c -text $value -background yellow
  1677.     pack $w.fm.msg
  1678.     pack $w.fm 
  1680.     catch {place_frame $w $w.fm [expr $pxsize+$px] [expr $pysize+$py]}
  1681. }
  1683. #----------------------------------------------------------------------
  1684. #
  1685. #----------------------------------------------------------------------
  1686. Editor instproc leaveToolButtons { w } {
  1687.     set w [winfo parent $w]
  1688.     catch {destroy $w.fm} 
  1689. }
  1692. #----------------------------------------------------------------------
  1693. # Editor instproc createColorPalette {name redlist greenlist bluelist replace}
  1694. #  - This procedure is pretty messy but it seems to work in creating
  1695. #    a color selection box and putting the result into the variable
  1696. #    colorarea via the getcolornam procedure.
  1697. #  - I don't feel like renaming the variables to make to more readable
  1698. #    and straightforward like I have done on other parts of 
  1699. #    poorly written code similar to this.
  1700. #----------------------------------------------------------------------
  1701. Editor instproc createColorPalette {name redlist greenlist bluelist replace} {
  1702. $self instvar SharedEnv netmodel_
  1704. # Setup
  1705. set w ${name}
  1706. if {[winfo exists $w]} {
  1707. wm deiconify $w
  1708. raise $w
  1709. return
  1710. }
  1712. set SharedEnv($name) $replace
  1713. eval toplevel $w $SharedEnv(PrivateCmap)
  1715. wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
  1717. frame $w.f
  1719. foreach red $redlist {
  1720. frame $w.f.rcol_${red}
  1721. foreach green $greenlist {
  1722. frame $w.f.grow_${red}${green}
  1723. foreach blue $bluelist {
  1724. if { [info exists SharedEnv($w.f.c${red}${green}${blue})] } {
  1725. frame $w.f.c${red}${green}${blue} 
  1726. -relief raised -height 2m -width 2m 
  1727. -highlightthickness 0 
  1728. -bd 1 -bg $SharedEnv($w.f.c${red}${green}${blue})
  1729. } else {
  1730. frame $w.f.c${red}${green}${blue} 
  1731. -relief raised -height 2m -width 2m 
  1732. -highlightthickness 0 
  1733. -bd 1 -bg "#${red}${green}${blue}"
  1734. }
  1735. pack $w.f.c${red}${green}${blue} -side left 
  1736. -in $w.f.grow_${red}${green} -fill both -expand true
  1738. bind $w.f.c${red}${green}${blue} <1> {
  1739. %W configure -relief sunken
  1740. }
  1742. # This grabs the color and puts it into the color text box 
  1743. bind $w.f.c${red}${green}${blue} <Double-Button-1> "$self getcolorname %W; destroy $w"
  1745. bind $w.f.c${red}${green}${blue} <ButtonRelease-1> "$self getcolorname %W; destroy $w"
  1746.           
  1747. }
  1748. pack $w.f.grow_${red}${green} -side top -in $w.f.rcol_${red} -fill both -expand true
  1749. }
  1750. pack $w.f.rcol_${red} -side left -in $w.f -fill both -expand true
  1751. }
  1753. frame $w.f.c_none -width 4m -relief raised -bd 1 
  1754. -highlightthickness 0
  1755. pack $w.f.c_none -in $w.f -side left -fill y 
  1757. pack $w.f -in $w -expand true -fill both
  1759. # Return
  1760. wm geometry $w $SharedEnv(ColorWidth)x$SharedEnv(ColorHeight)
  1761. }
  1763. #----------------------------------------------------------------------
  1764. # Editor instproc getcolorname {w} 
  1765. #  - gets the clicked on color value from the color palette window
  1766. #    and puts the result into the textbox pointed at by colorarea
  1767. #  - colorarea is set in the displayObjectProperties procedure.
  1768. #----------------------------------------------------------------------
  1769. Editor instproc getcolorname {w} {
  1770.   $self instvar netmodel_ colorarea
  1772.   $w configure -relief raised
  1773.   set colorv [$w cget -bg] 
  1774.   set rgb [winfo rgb $w $colorv]
  1776.   set colorn "[$netmodel_ lookupColorName [lindex $rgb 0] 
  1777.                [lindex $rgb 1] [lindex $rgb 2]]"
  1779.   if {[info exists colorarea] && [winfo exists $colorarea]} {
  1781.       $colorarea delete 0.0 end
  1782.       $colorarea insert 0.0 $colorn 
  1783.       catch { $colorarea tag add bgcolor 0.0 end }
  1784.       $colorarea tag configure bgcolor -background $colorn
  1785.   
  1786.   }
  1787.   
  1788. }
  1790. #----------------------------------------------------------------------
  1791. #
  1792. #----------------------------------------------------------------------
  1793. Editor instproc showHelp {} {
  1794.   $self instvar editorwindow_
  1795.   set w $editorwindow_.1
  1796.   if {[winfo exists $w]} {
  1797.     wm deiconify $w
  1798.     raise $w
  1799.     return
  1800.   }
  1801.   toplevel $w
  1802.   wm title $w "Quick Tips on using the Nam Editor"
  1803.   listbox $w.lbox -width 48 -height 11
  1804.   pack $w.lbox -side left -expand yes -fill both
  1805.   $w.lbox insert 0 
  1806.           "Nam Editor Help"
  1807.           "-----------------------------------------------" 
  1808.           "1) Create nodes using the add node tool " 
  1809.           "2) Connect them using the add link tool." 
  1810.           "3) Attach an agent to a node"
  1811.           "4) Connect agents by using the link tool."
  1812.           "5) Set options by double clicking or right clicking on each object."
  1813.           "6) Run the scenario using the File Menu command, Run Ns."
  1814.           "-----------------------------------------------" 
  1815.           "Please report all bugs to ns-users@isi.edu"
  1816.   $w.lbox selection set 0
  1817. }
  1819. #----------------------------------------------------------------------
  1820. # Editor instproc chooseTool {tool}
  1821. #  - tools are created in the buildToolbar procedure
  1822. #----------------------------------------------------------------------
  1823. Editor instproc chooseTool {tool} {
  1824.   $self instvar SharedEnv state_buttons_ toolbar_buttons_ 
  1825.                 current_tool_ slider_view_
  1826.   $self tkvar current_agent_ current_source_
  1827.   $slider_view_ instvar delete_marker_
  1829.   # Release last tool button
  1830.   if [info exists current_tool_] {
  1831.     $toolbar_buttons_($current_tool_) configure -relief raised
  1832.   }
  1834.   # Depress current tool button
  1835.   set current_tool_ $tool
  1836.   if [info exists toolbar_buttons_($tool)] {
  1837.     $toolbar_buttons_($tool) configure -relief sunken
  1838.   }
  1840.   if {$tool == "deleteobject"} {
  1841.     # Set the slider view to delete it's markers if they are clicked upon
  1842.     set delete_marker_ 1
  1843.   } else {
  1844.     set delete_marker_ 0
  1845.   }
  1846. }
  1848. #----------------------------------------------------------------------
  1849. # Editor instproc chooseAgent {agent}
  1850. #  -- This function is used to set the current_agent_ variable.
  1851. #     I believe there is a bug in otcl and creating menubuttons.
  1852. #     The scope of a instvar varible doesn't seem to be passed in
  1853. #     properly to the menubutton function.
  1854. #----------------------------------------------------------------------
  1855. Editor instproc chooseAgent {agent} {
  1856.   $self tkvar current_agent_
  1858.   set current_agent_ $agent
  1859.   $self chooseTool addagent
  1861. }
  1863. #----------------------------------------------------------------------
  1864. # Editor instproc chooseTrafficSource {source} 
  1865. #  -- This function is used to set the current_source_ variable.
  1866. #     I believe there is a bug in otcl and creating menubuttons.
  1867. #     The scope of a instvar varible doesn't seem to be passed in
  1868. #     properly to the menubutton function.
  1869. #
  1870. #----------------------------------------------------------------------
  1871. Editor instproc chooseTrafficSource {source} {
  1872.  $self tkvar current_source_
  1874.  set current_source_ $source
  1875.  $self chooseTool addtrafficsource
  1877. }
  1879. #----------------------------------------------------------------------
  1880. # Editor instproc chooseLossModel {lossmodel} 
  1881. #----------------------------------------------------------------------
  1882. Editor instproc chooseLossModel {lossmodel} {
  1883.  $self tkvar current_lossmodel_
  1885.  set current_lossmodel_ $lossmodel
  1886.  $self chooseTool addlossmodel
  1888. }
  1890. #----------------------------------------------------------------------
  1891. #
  1892. #----------------------------------------------------------------------
  1893. Editor instproc popupCanvasSet { type } {
  1894.   $self instvar SharedEnv edit_state_ state_buttons_
  1896.   # Release last state button, press down new one
  1897.   if [info exists edit_state_] {
  1898.     $state_buttons_($edit_state_) configure -relief raised
  1899.   }
  1900.   set edit_state_ $type
  1901.   if [info exists state_buttons_($type)] {
  1902.     $state_buttons_($type) configure -relief sunken
  1903.   }
  1905.   $self setCursor "$type"
  1906.   switch "$SharedEnv(Cursor)" {
  1907.     Cut {
  1908.       set SharedEnv(Message) Cut
  1909.       $self setCursor "Cut"
  1910.       #cutCopySelected Cut Imp_Selected 1
  1911.       #set SharedEnv(Message) Select
  1912.       #enableSelectionButtons
  1913.     }
  1914.     Paste {
  1915.       if {$SharedEnv(Cut) == ""} {
  1916.         setCursor "Select"
  1917.         set SharedEnv(Message) Select
  1918.         enableSelectionButtons
  1919.       }
  1920.     }
  1921.     Link -
  1922.     Node -
  1923.     Queue -
  1924.     Agent -
  1925.     Text {
  1926.       set SharedEnv(Sub-Cursor) ""
  1927.       #$SharedEnv(CurrentCanvas) delete SharedEnv(curline)
  1928.       #$SharedEnv(CurrentCanvas) delete selector
  1929.       $SharedEnv(CurrentCanvas) dctag
  1930.       set SharedEnv(Message) $SharedEnv(Cursor)
  1931.       #deselectAll
  1932.       #disableSelectionButtons
  1933.     }
  1934.     Select {
  1935.       set SharedEnv(Message) $SharedEnv(Cursor)
  1936.       #deselectAll
  1937.       #enableSelectionButtons
  1938.     }
  1939.   
  1940.     Print {
  1941.       #printRaise .print
  1942.       
  1943.       return
  1944.     }
  1945.   }
  1946.   focus $SharedEnv(CurrentCanvas)
  1947. }
  1949. #----------------------------------------------------------------------
  1950. #
  1951. #----------------------------------------------------------------------
  1952. Editor instproc newFile {} {
  1953.         set editor [new Editor ""]
  1954. }
  1956. #----------------------------------------------------------------------
  1957. #
  1958. #----------------------------------------------------------------------
  1959. Editor instproc openFile {} {
  1960.   $self instvar editorwindow_
  1961. #  $self tkvar openFile_
  1963.   set openFile_ [tk_getOpenFile 
  1964.                 -filetypes {{{Nam Editor} {.ns .enam}} 
  1965.                             {{All Files} {*}}} 
  1966.                 -parent $editorwindow_]
  1968.   if {$openFile_ == ""} {
  1969.     return 
  1970.   }
  1972.   set editor [new Editor $openFile_]
  1973.   return
  1974. }
  1976. #----------------------------------------------------------------------
  1977. # Editor instproc doSave {}
  1978. #  - Saves the file if save_filename_ is defined otherwise it
  1979. #    calls doSaveAs
  1980. #----------------------------------------------------------------------
  1981. Editor instproc doSave {} {
  1982.   $self instvar save_filename_
  1983.   
  1984.   if {"$save_filename_" != ""} {
  1985.     $self writeFile $save_filename_
  1986.   } else {
  1987.     $self doSaveAs
  1988.   }
  1989. }
  1991. #----------------------------------------------------------------------
  1992. # Editor instproc doSaveAs {}
  1993. #  - brings up a saveas dialog box and if the filename exists it calls
  1994. #    writeFile to write out the nam editor ns script
  1995. #----------------------------------------------------------------------
  1996. Editor instproc doSaveAs {} {
  1997.   $self instvar save_filename_ editorwindow_
  1999.   set filename [tk_getSaveFile -defaultextension ".ns" 
  2000.                                -filetypes {{{Nam Editor} {.ns .enam}}} 
  2001.                                -parent $editorwindow_]
  2002.   if {"$filename" != ""} {
  2003.     $self writeFile $filename
  2004.   }
  2005. }
  2007. #----------------------------------------------------------------------
  2008. # Editor instproc writeFile {filename}
  2009. #  - calls saveasns to write out the nam generate ns script to a file
  2010. #    and raises a message if a problem occurred.
  2011. #  - "saveasns" is part of enetmodel.cc:command
  2012. #----------------------------------------------------------------------
  2013. Editor instproc writeFile {filename} {
  2014.   $self instvar netmodel_ save_filename_ editorwindow_
  2016.   if {"$filename" != ""} {
  2017.     regexp {(.*)[.]ns} $filename matched filename_root
  2018.     catch {$netmodel_ saveasns $filename $filename_root} error
  2020.     if {![info exists error]} {
  2021.       $self msgRaise .alert "Nam File Error" "ERROR: Unable to save file: $filename."
  2022.     } else {
  2023.       set save_filename_ $filename
  2024.       wm title $editorwindow_ "Nam Editor - $save_filename_"
  2025.       update
  2026.     }
  2027.   }
  2028. }
  2030. #----------------------------------------------------------------------
  2031. #
  2032. #----------------------------------------------------------------------
  2033. Editor instproc runNs {} {
  2034.   $self instvar save_filename_
  2035.   if {$save_filename_ != ""} {
  2036.     set filename $save_filename_
  2037.     catch {exec ns $filename &} error
  2038.     if {[info exists error]} {
  2039.       if {[regexp {([0-9]+)} $error matched process_id]} {
  2040.         $self msgRaise .alert "Nam - Ns id $process_id" "Ns should be running as process id $process_id.n
  2041.                                  The result will be shown when it finishes."
  2042.       } else {
  2043.         $self msgRaise .alert "Nam - Ns Error" "Ns was unable to run.          n
  2044.                                  The error message reported was:n
  2045.                                  [ $error ]"
  2046.       }
  2047.     }
  2048.   }
  2049. }
  2051. #----------------------------------------------------------------------
  2052. #
  2053. #----------------------------------------------------------------------
  2054. Editor instproc msgRaise {name title message} {  
  2055.         $self instvar SharedEnv   
  2057.         set w ${name}   
  2058.         set SharedEnv(MsgReplace) $SharedEnv(CurrentCanvas)
  2060.         if {![winfo exists $name]} {
  2061.                $self  msgRequestor $name
  2062.         }
  2063.         $w.message configure -text "$message"
  2064.         wm title $w $title
  2065.         wm deiconify $w
  2066.         focus $w
  2067. }
  2069. #----------------------------------------------------------------------
  2070. #
  2071. #----------------------------------------------------------------------
  2072. Editor instproc msgRequestor {name} {
  2073.         $self instvar SharedEnv
  2075.         set w ${name}   
  2076.         toplevel $w
  2077. #               wm transient $w .
  2078.         wm protocol $w WM_DELETE_WINDOW {set dummy 1}
  2079.         frame $w.f -borderwidth 0 -highlightthickness 0
  2080.         frame $w.texttop -borderwidth 0 -highlightthickness 0
  2081.         frame $w.textbottom -relief raised -bd 1
  2082.         label $w.message
  2083.         button $w.ok -text "Ok" -command "$self msgLower $w"
  2084.         pack $w.message -in $w.texttop -fill both -expand true
  2085.         pack $w.ok -in $w.textbottom -side bottom -padx 2m -pady 2m
  2086.         pack $w.texttop $w.textbottom -anchor sw -in $w -fill x -expand true
  2087.         pack $w.f -in $w
  2088.         wm withdraw $w
  2089. }
  2091. #----------------------------------------------------------------------
  2092. #
  2093. #----------------------------------------------------------------------
  2094. Editor instproc msgLower {name} {
  2095.         $self instvar SharedEnv
  2097.         set w ${name}
  2098.         wm withdraw $w
  2099. }
  2102. #-----------------------------------------------------------------------
  2103. # Editor instproc moveToMarkerTime {time} {
  2104. #   - adjusts the current time to the one held by the clicked on 
  2105. #     timeslider marker
  2106. #-----------------------------------------------------------------------
  2107. Editor instproc moveToMarkerTime {time} {
  2108. $self instvar slider_model_
  2111. $slider_model_ setcurrenttime $time
  2112. $self setCurrentTime $time
  2113. }
  2115. #-----------------------------------------------------------------------
  2116. # Editor instproc removeMarker {time node_id}
  2117. #   - deletes the node movement value that is associated with
  2118. #     a timeslider marker
  2119. #-----------------------------------------------------------------------
  2120. Editor instproc removeMarker {time node_id} {
  2121. $self instvar netmodel_
  2123. $netmodel_ removeNodeMovement $node_id $time
  2124. $self renderFrame
  2125. }