1197 lines
39 KiB
Tcl
1197 lines
39 KiB
Tcl
|
#
|
||
|
|
# Copyright 2004-2013 University of Zagreb.
|
||
|
|
#
|
||
|
|
# Redistribution and use in source and binary forms, with or without
|
||
|
|
# modification, are permitted provided that the following conditions
|
||
|
|
# are met:
|
||
|
|
# 1. Redistributions of source code must retain the above copyright
|
||
|
|
# notice, this list of conditions and the following disclaimer.
|
||
|
|
# 2. Redistributions in binary form must reproduce the above copyright
|
||
|
|
# notice, this list of conditions and the following disclaimer in the
|
||
|
|
# documentation and/or other materials provided with the distribution.
|
||
|
|
#
|
||
|
|
# THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
||
|
|
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||
|
|
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||
|
|
# ARE DISCLAIMED. IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE
|
||
|
|
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||
|
|
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||
|
|
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||
|
|
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||
|
|
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||
|
|
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||
|
|
# SUCH DAMAGE.
|
||
|
|
#
|
||
|
|
# This work was supported in part by Croatian Ministry of Science
|
||
|
|
# and Technology through the research contract #IP-2003-143.
|
||
|
|
#
|
||
|
|
|
||
|
|
# $Id: initgui.tcl 151 2015-03-27 17:14:57Z valter $
|
||
|
|
|
||
|
|
|
||
|
|
#****h* imunes/initgui.tcl
|
||
|
|
# NAME
|
||
|
|
# initgui.tcl
|
||
|
|
# FUNCTION
|
||
|
|
# Initialize GUI. Not included when operating in batch mode.
|
||
|
|
#****
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# GUI-related global variables
|
||
|
|
#
|
||
|
|
|
||
|
|
#****v* initgui.tcl/global variables
|
||
|
|
# NAME
|
||
|
|
# global variables
|
||
|
|
# FUNCTION
|
||
|
|
# GUI-related global varibles
|
||
|
|
#
|
||
|
|
# * newlink -- helps when creating a new link. If there is no
|
||
|
|
# link currently created, this value is set to an empty string.
|
||
|
|
# * selectbox -- the value of the box representing all the selected items
|
||
|
|
# * selected -- containes the list of node_id's of all selected nodes.
|
||
|
|
# * newCanvas --
|
||
|
|
#
|
||
|
|
# * animatephase -- starting dashoffset. With this value the effect of
|
||
|
|
# rotating line around selected itme is achived.
|
||
|
|
# * undolevel -- control variable for undo.
|
||
|
|
# * redolevel -- control variable for redo.
|
||
|
|
# * undolog -- control variable for saving all the past configurations.
|
||
|
|
# * changed -- control variable for indicating that there something changed
|
||
|
|
# in active configuration.
|
||
|
|
# * badentry -- control variable indicating that there has been a bad entry
|
||
|
|
# in the text box.
|
||
|
|
# * cursorstate -- control variable for animating cursor.
|
||
|
|
# * clock_seconds -- control variable for animating cursor.
|
||
|
|
# * oper_mode -- control variable reresenting operating mode, possible
|
||
|
|
# values are edit and exec.
|
||
|
|
# * grid -- control variable representing grid distance. All new
|
||
|
|
# elements on the
|
||
|
|
# canvas are snaped to grid. Default value is 24.
|
||
|
|
# * sizex -- X size of the canvas.
|
||
|
|
# * sizey -- Y size of the canvas.
|
||
|
|
# * curcanvas -- the value of the current canvas.
|
||
|
|
# * autorearrange_enabled -- control variable indicating is
|
||
|
|
# autorearrange enabled.
|
||
|
|
#
|
||
|
|
# * defLinkColor -- defines the default link color
|
||
|
|
# * defLinkWidth -- defines the width of the link
|
||
|
|
# * defEthBandwidth -- defines the ethernet bandwidth
|
||
|
|
# * defSerBandwidth -- defines the serail link bandwidth
|
||
|
|
# * defSerDelay -- defines the serail link delay
|
||
|
|
# * showIfNames -- control variable for showing interface names
|
||
|
|
# * showIfIPaddrs -- control variable for showing interface IPv4 addresses
|
||
|
|
# * showIfIPv6addrs -- control variable for showing interface IPv6 addrs
|
||
|
|
# * showNodeLabels -- control variable for showing node labels
|
||
|
|
# * showLinkLabels -- control variable for showing link labels
|
||
|
|
#
|
||
|
|
# * supp_router_models -- supproted router models, currently xorp quagga
|
||
|
|
# and static.
|
||
|
|
# * def_router_model -- default router model
|
||
|
|
#****
|
||
|
|
|
||
|
|
|
||
|
|
set newlink ""
|
||
|
|
set selectbox ""
|
||
|
|
set selected ""
|
||
|
|
set ns2srcfile ""
|
||
|
|
set animatephase 0
|
||
|
|
set changed 0
|
||
|
|
set badentry 0
|
||
|
|
set cursorState 0
|
||
|
|
set clock_seconds 0
|
||
|
|
set grid 24
|
||
|
|
set showGrid 1
|
||
|
|
set autorearrange_enabled 0
|
||
|
|
set activetool select
|
||
|
|
|
||
|
|
# resize Oval/Rectangle, "false" or direction: north/west/east/...
|
||
|
|
set resizemode false
|
||
|
|
|
||
|
|
#
|
||
|
|
# Initialize a few variables to default values
|
||
|
|
#
|
||
|
|
set defLinkColor Red
|
||
|
|
set defFillColor Gray
|
||
|
|
set defLinkWidth 2
|
||
|
|
set defEthBandwidth 0
|
||
|
|
set defSerBandwidth 0
|
||
|
|
set defSerDelay 0
|
||
|
|
|
||
|
|
set newtext ""
|
||
|
|
set newoval ""
|
||
|
|
set defOvalColor #CFCFFF
|
||
|
|
set defOvalLabelFont "Arial 12"
|
||
|
|
set newrect ""
|
||
|
|
set newfree ""
|
||
|
|
set defRectColor #C0C0FF
|
||
|
|
set defRectLabelFont "Arial 12"
|
||
|
|
set defTextFont "Arial 12"
|
||
|
|
set defTextFontFamily "Arial"
|
||
|
|
set defTextFontSize 12
|
||
|
|
set defTextColor #000000
|
||
|
|
|
||
|
|
set showIfNames 1
|
||
|
|
set showIfIPaddrs 1
|
||
|
|
set showIfIPv6addrs 1
|
||
|
|
set showNodeLabels 1
|
||
|
|
set showLinkLabels 1
|
||
|
|
set showZFSsnapshots 0
|
||
|
|
|
||
|
|
set IPv4autoAssign 1
|
||
|
|
set IPv6autoAssign 1
|
||
|
|
set hostsAutoAssign 0
|
||
|
|
|
||
|
|
set showTree 0
|
||
|
|
|
||
|
|
set showBkgImage 0
|
||
|
|
set showAnnotations 1
|
||
|
|
set iconSize normal
|
||
|
|
set zoom_stops [list 0.2 0.4 0.5 0.6 0.8 1 \
|
||
|
|
1.25 1.5 1.75 2.0 3.0]
|
||
|
|
set canvasBkgMode "original"
|
||
|
|
set alignCanvasBkg "center"
|
||
|
|
set bgsrcfile ""
|
||
|
|
|
||
|
|
set def_router_model quagga
|
||
|
|
|
||
|
|
set model quagga
|
||
|
|
set router_model $model
|
||
|
|
set routerDefaultsModel $model
|
||
|
|
set ripEnable 1
|
||
|
|
set ripngEnable 1
|
||
|
|
set ospfEnable 0
|
||
|
|
set ospf6Enable 0
|
||
|
|
set routerRipEnable 1
|
||
|
|
set routerRipngEnable 1
|
||
|
|
set routerOspfEnable 0
|
||
|
|
set routerOspf6Enable 0
|
||
|
|
set rdconfig [list $routerRipEnable $routerRipngEnable $routerOspfEnable $routerOspf6Enable]
|
||
|
|
set brguielements {}
|
||
|
|
set selectedExperiment ""
|
||
|
|
set copypaste_nodes 0
|
||
|
|
set cutNodes 0
|
||
|
|
set iconsrcfile [lindex [glob -directory $ROOTDIR/$LIBDIR/icons/normal/ *.gif] 0]
|
||
|
|
#interface selected in the topology tree
|
||
|
|
set selectedIfc ""
|
||
|
|
|
||
|
|
# bases for naming new nodes
|
||
|
|
array set nodeNamingBase {
|
||
|
|
pc pc
|
||
|
|
click_l2 cswitch
|
||
|
|
click_l3 crouter
|
||
|
|
ext ext
|
||
|
|
filter filter
|
||
|
|
router router
|
||
|
|
host host
|
||
|
|
hub hub
|
||
|
|
lanswitch switch
|
||
|
|
nat64 nat64-
|
||
|
|
packgen packgen
|
||
|
|
stpswitch stpswitch
|
||
|
|
}
|
||
|
|
|
||
|
|
# Packets required for GUI
|
||
|
|
#package require Img
|
||
|
|
|
||
|
|
#
|
||
|
|
# Window / canvas setup section
|
||
|
|
#
|
||
|
|
|
||
|
|
wm minsize . 640 410
|
||
|
|
wm geometry . 1016x716-20+0
|
||
|
|
|
||
|
|
set iconlist ""
|
||
|
|
foreach size "256 128 64" {
|
||
|
|
set path "$ROOTDIR/$LIBDIR/icons/imunes_icon$size.png"
|
||
|
|
if {[file exists $path]} {
|
||
|
|
set icon$size [image create photo -file $path]
|
||
|
|
append iconlist "\$icon$size "
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if { $iconlist != "" } {
|
||
|
|
eval wm iconphoto . -default $iconlist
|
||
|
|
}
|
||
|
|
|
||
|
|
ttk::style theme use imunes
|
||
|
|
|
||
|
|
ttk::panedwindow .panwin -orient horizontal
|
||
|
|
ttk::frame .panwin.f1
|
||
|
|
ttk::frame .panwin.f2 -width 200
|
||
|
|
.panwin add .panwin.f1 -weight 5
|
||
|
|
.panwin add .panwin.f2 -weight 0
|
||
|
|
.panwin forget .panwin.f2
|
||
|
|
pack .panwin -fill both -expand 1
|
||
|
|
pack propagate .panwin.f2 0
|
||
|
|
|
||
|
|
set mf .panwin.f1
|
||
|
|
|
||
|
|
menu .menubar
|
||
|
|
. configure -menu .menubar
|
||
|
|
|
||
|
|
.menubar add cascade -label File -underline 0 -menu .menubar.file
|
||
|
|
.menubar add cascade -label Edit -underline 0 -menu .menubar.edit
|
||
|
|
.menubar add cascade -label Canvas -underline 0 -menu .menubar.canvas
|
||
|
|
.menubar add cascade -label View -underline 0 -menu .menubar.view
|
||
|
|
.menubar add cascade -label Tools -underline 0 -menu .menubar.tools
|
||
|
|
.menubar add cascade -label TopoGen -underline 4 -menu .menubar.t_g
|
||
|
|
.menubar add cascade -label Widgets -underline 0 -menu .menubar.widgets
|
||
|
|
.menubar add cascade -label Events -underline 1 -menu .menubar.events
|
||
|
|
.menubar add cascade -label Experiment -underline 1 -menu .menubar.experiment
|
||
|
|
.menubar add cascade -label Help -underline 0 -menu .menubar.help
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# File
|
||
|
|
#
|
||
|
|
menu .menubar.file -tearoff 0
|
||
|
|
|
||
|
|
.menubar.file add command -label New -underline 0 \
|
||
|
|
-accelerator "Ctrl+N" -command { newProject }
|
||
|
|
bind . <Control-n> "newProject"
|
||
|
|
|
||
|
|
.menubar.file add command -label Open -underline 0 \
|
||
|
|
-accelerator "Ctrl+O" -command { fileOpenDialogBox }
|
||
|
|
bind . <Control-o> "fileOpenDialogBox"
|
||
|
|
|
||
|
|
.menubar.file add command -label Save -underline 0 \
|
||
|
|
-accelerator "Ctrl+S" -command { fileSaveDialogBox }
|
||
|
|
bind . <Control-s> "fileSaveDialogBox"
|
||
|
|
|
||
|
|
.menubar.file add command -label "Save As" -underline 5 \
|
||
|
|
-command { fileSaveAsDialogBox }
|
||
|
|
|
||
|
|
.menubar.file add command -label "Close" -underline 0 -command { closeFile }
|
||
|
|
|
||
|
|
#.menubar.file add separator
|
||
|
|
#.menubar.file add command -label "Print" -underline 0 \
|
||
|
|
# -command {
|
||
|
|
# set w .entry1
|
||
|
|
# catch {destroy $w}
|
||
|
|
# toplevel $w
|
||
|
|
# wm transient $w .
|
||
|
|
# wm resizable $w 0 0
|
||
|
|
# wm title $w "Printing options"
|
||
|
|
# wm iconname $w "Printing options"
|
||
|
|
#
|
||
|
|
# #dodan glavni frame "printframe"
|
||
|
|
# ttk::frame $w.printframe
|
||
|
|
# pack $w.printframe -fill both -expand 1
|
||
|
|
#
|
||
|
|
# ttk::label $w.printframe.msg -wraplength 5i -justify left -text "Print command:"
|
||
|
|
# pack $w.printframe.msg -side top
|
||
|
|
#
|
||
|
|
# ttk::frame $w.printframe.buttons
|
||
|
|
# pack $w.printframe.buttons -side bottom -fill x -pady 2m
|
||
|
|
# ttk::button $w.printframe.buttons.print -text Print -command "printCanvas $w"
|
||
|
|
# ttk::button $w.printframe.buttons.cancel -text "Cancel" -command "destroy $w"
|
||
|
|
# pack $w.printframe.buttons.print $w.printframe.buttons.cancel -side left -expand 1
|
||
|
|
#
|
||
|
|
# ttk::entry $w.printframe.e1
|
||
|
|
# $w.printframe.e1 insert 0 "lpr"
|
||
|
|
# pack $w.printframe.e1 -side top -pady 5 -padx 10 -fill x
|
||
|
|
#}
|
||
|
|
|
||
|
|
set printFileType ps
|
||
|
|
|
||
|
|
#.menubar.file add command -label "Print To File" -underline 9 \
|
||
|
|
# -command {
|
||
|
|
# global winOS
|
||
|
|
# set w .entry1
|
||
|
|
# catch {destroy $w}
|
||
|
|
# toplevel $w
|
||
|
|
# wm transient $w .
|
||
|
|
# wm resizable $w 0 0
|
||
|
|
# wm title $w "Printing options"
|
||
|
|
# wm iconname $w "Printing options"
|
||
|
|
#
|
||
|
|
# #dodan glavni frame "printframe"
|
||
|
|
# ttk::frame $w.printframe
|
||
|
|
# pack $w.printframe -fill both -expand 1
|
||
|
|
#
|
||
|
|
# ttk::label $w.printframe.msg -wraplength 5i -justify left -text "File:"
|
||
|
|
#
|
||
|
|
# ttk::frame $w.printframe.ftype
|
||
|
|
# ttk::radiobutton $w.printframe.ftype.ps -text "PostScript" \
|
||
|
|
# -variable printFileType -value ps -state enabled
|
||
|
|
# ttk::radiobutton $w.printframe.ftype.pdf -text "PDF" \
|
||
|
|
# -variable printFileType -value pdf -state enabled
|
||
|
|
#
|
||
|
|
# ttk::frame $w.printframe.path
|
||
|
|
#
|
||
|
|
# if {$winOS} {
|
||
|
|
# $w.printframe.pdf configure -state disabled
|
||
|
|
# } else {
|
||
|
|
# catch {exec ps2pdf} msg
|
||
|
|
# if { [string match *ps2pdfwr* $msg] != 1 } {
|
||
|
|
# $w.printframe.pdf configure -state disabled
|
||
|
|
# }
|
||
|
|
# }
|
||
|
|
#
|
||
|
|
# pack $w.printframe.msg -side top -fill x -padx 5
|
||
|
|
#
|
||
|
|
# ttk::button $w.printframe.path.browse -text "Browse" -width 8 \
|
||
|
|
# -command {
|
||
|
|
# global printFileType
|
||
|
|
# set printdest [tk_getSaveFile -initialfile print \
|
||
|
|
# -defaultextension .$printFileType]
|
||
|
|
# $w.printframe.path.e1 insert 0 $printdest
|
||
|
|
# }
|
||
|
|
#
|
||
|
|
# ttk::frame $w.printframe.buttons
|
||
|
|
# pack $w.printframe.buttons -side bottom -fill x -pady 2m
|
||
|
|
# ttk::button $w.printframe.buttons.print -text Print -command "printCanvasToFile $w $w.printframe.path.e1"
|
||
|
|
# ttk::button $w.printframe.buttons.cancel -text "Cancel" -command "destroy $w"
|
||
|
|
# pack $w.printframe.buttons.print $w.printframe.buttons.cancel -side left -expand 1
|
||
|
|
#
|
||
|
|
# ttk::entry $w.printframe.path.e1
|
||
|
|
# pack $w.printframe.path -fill both
|
||
|
|
# pack $w.printframe.path.e1 -side left -pady 2 -padx 5
|
||
|
|
# pack $w.printframe.path.browse -side left -pady 2 -padx 5
|
||
|
|
# pack $w.printframe.ftype -anchor w
|
||
|
|
# pack $w.printframe.ftype.ps $w.printframe.ftype.pdf -side left -fill x -padx 10
|
||
|
|
#}
|
||
|
|
|
||
|
|
.menubar.file add separator
|
||
|
|
.menubar.file add command -label Quit -underline 0 -command { exit }
|
||
|
|
.menubar.file add separator
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# Edit
|
||
|
|
#
|
||
|
|
menu .menubar.edit -tearoff 0
|
||
|
|
.menubar.edit add command -label "Undo" -underline 0 \
|
||
|
|
-accelerator "Ctrl+Z" -command undo -state disabled
|
||
|
|
bind . <Control-z> undo
|
||
|
|
.menubar.edit add command -label "Redo" -underline 0 \
|
||
|
|
-accelerator "Ctrl+Y" -command redo -state disabled
|
||
|
|
bind . <Control-y> redo
|
||
|
|
.menubar.edit add separator
|
||
|
|
.menubar.edit add command -label "Cut" -underline 0 \
|
||
|
|
-accelerator "Ctrl+X" -command cutSelection -state normal
|
||
|
|
bind . <Control-x> cutSelection
|
||
|
|
.menubar.edit add command -label "Copy" -underline 1 \
|
||
|
|
-accelerator "Ctrl+C" -command copySelection -state normal
|
||
|
|
bind . <Control-c> copySelection
|
||
|
|
.menubar.edit add command -label "Paste" -underline 0 \
|
||
|
|
-accelerator "Ctrl+V" -command paste -state normal
|
||
|
|
bind . <Control-v> paste
|
||
|
|
.menubar.edit add separator
|
||
|
|
.menubar.edit add command -label "Select all" \
|
||
|
|
-accelerator "Ctrl+A" -underline 0 -command "selectAllObjects"
|
||
|
|
bind . <Control-a> selectAllObjects
|
||
|
|
.menubar.edit add command -label "Select adjacent" \
|
||
|
|
-accelerator "Ctrl+D" -underline 7 -command selectAdjacent
|
||
|
|
bind . <Control-d> selectAdjacent
|
||
|
|
|
||
|
|
#
|
||
|
|
# Canvas
|
||
|
|
#
|
||
|
|
menu .menubar.canvas -tearoff 0
|
||
|
|
.menubar.canvas add command -label "New" -underline 0 -command {
|
||
|
|
newCanvas ""
|
||
|
|
switchCanvas last
|
||
|
|
set changed 1
|
||
|
|
updateUndoLog
|
||
|
|
}
|
||
|
|
.menubar.canvas add command -label "Rename" -underline 0 \
|
||
|
|
-command { renameCanvasPopup }
|
||
|
|
.menubar.canvas add command -label "Delete" -underline 0 -command {
|
||
|
|
upvar 0 ::cf::[set ::curcfg]::canvas_list canvas_list
|
||
|
|
upvar 0 ::cf::[set ::curcfg]::curcanvas curcanvas
|
||
|
|
|
||
|
|
if { [llength $canvas_list] == 1 } {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
foreach obj [.panwin.f1.c find withtag node] {
|
||
|
|
selectNode .panwin.f1.c $obj
|
||
|
|
}
|
||
|
|
deleteSelection
|
||
|
|
set i [lsearch $canvas_list $curcanvas]
|
||
|
|
set canvas_list [lreplace $canvas_list $i $i]
|
||
|
|
set curcanvas [lindex $canvas_list $i]
|
||
|
|
if { $curcanvas == "" } {
|
||
|
|
set curcanvas [lindex $canvas_list end]
|
||
|
|
}
|
||
|
|
switchCanvas none
|
||
|
|
set changed 1
|
||
|
|
updateUndoLog
|
||
|
|
}
|
||
|
|
.menubar.canvas add separator
|
||
|
|
.menubar.canvas add command -label "Resize" -underline 2 -command resizeCanvasPopup
|
||
|
|
.menubar.canvas add command -label "Background image" -underline 0 \
|
||
|
|
-command changeBkgPopup
|
||
|
|
|
||
|
|
.menubar.canvas add separator
|
||
|
|
.menubar.canvas add command -label "Previous" -accelerator "PgUp" \
|
||
|
|
-command { switchCanvas prev }
|
||
|
|
bind . <Prior> { switchCanvas prev }
|
||
|
|
.menubar.canvas add command -label "Next" -accelerator "PgDown" \
|
||
|
|
-command { switchCanvas next }
|
||
|
|
bind . <Next> { switchCanvas next }
|
||
|
|
.menubar.canvas add command -label "First" -accelerator "Home" \
|
||
|
|
-command { switchCanvas first }
|
||
|
|
bind . <Home> { switchCanvas first }
|
||
|
|
.menubar.canvas add command -label "Last" -accelerator "End" \
|
||
|
|
-command { switchCanvas last }
|
||
|
|
bind . <End> { switchCanvas last }
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# Tools
|
||
|
|
#
|
||
|
|
menu .menubar.tools -tearoff 0
|
||
|
|
.menubar.tools add command -label "Auto rearrange all" -underline 0 \
|
||
|
|
-command { rearrange all }
|
||
|
|
.menubar.tools add command -label "Auto rearrange selected" -underline 15 \
|
||
|
|
-command { rearrange selected }
|
||
|
|
.menubar.tools add separator
|
||
|
|
.menubar.tools add command -label "Align to grid" -underline 9 \
|
||
|
|
-command { align2grid }
|
||
|
|
.menubar.tools add separator
|
||
|
|
.menubar.tools add checkbutton -label "IPv4 auto-assign addresses/routes" \
|
||
|
|
-variable IPv4autoAssign
|
||
|
|
.menubar.tools add checkbutton -label "IPv6 auto-assign addresses/routes" \
|
||
|
|
-variable IPv6autoAssign
|
||
|
|
.menubar.tools add checkbutton -label "Auto-generate /etc/hosts file" \
|
||
|
|
-variable hostsAutoAssign
|
||
|
|
.menubar.tools add separator
|
||
|
|
.menubar.tools add command -label "Randomize MAC bytes" -underline 10 \
|
||
|
|
-command randomizeMACbytes
|
||
|
|
.menubar.tools add command -label "IPv4 address pool" -underline 3 \
|
||
|
|
-command {
|
||
|
|
set w .entry1
|
||
|
|
catch {destroy $w}
|
||
|
|
toplevel $w
|
||
|
|
wm transient $w .
|
||
|
|
#wm resizable $w 0 0
|
||
|
|
wm title $w "IPv4 autonumbering address pool"
|
||
|
|
wm iconname $w "IPv4 address pool"
|
||
|
|
grab $w
|
||
|
|
|
||
|
|
#dodan glavni frame "ipv4frame"
|
||
|
|
ttk::frame $w.ipv4frame
|
||
|
|
pack $w.ipv4frame -fill both -expand 1
|
||
|
|
|
||
|
|
ttk::label $w.ipv4frame.msg -text "IPv4 address range:"
|
||
|
|
pack $w.ipv4frame.msg -side top
|
||
|
|
|
||
|
|
ttk::entry $w.ipv4frame.e1 -width 27 -validate focus -invalidcommand "focusAndFlash %W"
|
||
|
|
$w.ipv4frame.e1 insert 0 $ipv4
|
||
|
|
pack $w.ipv4frame.e1 -side top -pady 5 -padx 10 -fill x
|
||
|
|
|
||
|
|
$w.ipv4frame.e1 configure -invalidcommand {checkIPv4Net %P}
|
||
|
|
|
||
|
|
ttk::frame $w.ipv4frame.buttons
|
||
|
|
pack $w.ipv4frame.buttons -side bottom -fill x -pady 2m
|
||
|
|
ttk::button $w.ipv4frame.buttons.apply -text "Apply" -command "IPv4AddrApply $w"
|
||
|
|
ttk::button $w.ipv4frame.buttons.cancel -text "Cancel" -command "destroy $w"
|
||
|
|
|
||
|
|
bind $w <Key-Return> "IPv4AddrApply $w"
|
||
|
|
bind $w <Key-Escape> "destroy $w"
|
||
|
|
|
||
|
|
pack $w.ipv4frame.buttons.apply -side left -expand 1 -anchor e -padx 2
|
||
|
|
pack $w.ipv4frame.buttons.cancel -side right -expand 1 -anchor w -padx 2
|
||
|
|
}
|
||
|
|
.menubar.tools add command -label "IPv6 address pool" -underline 3 \
|
||
|
|
-command {
|
||
|
|
set w .entry1
|
||
|
|
catch {destroy $w}
|
||
|
|
toplevel $w
|
||
|
|
wm transient $w .
|
||
|
|
#wm resizable $w 0 0
|
||
|
|
wm title $w "IPv6 autonumbering address pool"
|
||
|
|
wm iconname $w "IPv6 address pool"
|
||
|
|
grab $w
|
||
|
|
|
||
|
|
ttk::frame $w.ipv6frame
|
||
|
|
pack $w.ipv6frame -fill both -expand 1
|
||
|
|
|
||
|
|
ttk::label $w.ipv6frame.msg -text "IPv6 address range:"
|
||
|
|
pack $w.ipv6frame.msg -side top
|
||
|
|
|
||
|
|
ttk::entry $w.ipv6frame.e1 -width 27 -validate focus -invalidcommand "focusAndFlash %W"
|
||
|
|
$w.ipv6frame.e1 insert 0 $ipv6
|
||
|
|
pack $w.ipv6frame.e1 -side top -pady 5 -padx 10 -fill x
|
||
|
|
|
||
|
|
$w.ipv6frame.e1 configure -invalidcommand {checkIPv6Net %P}
|
||
|
|
|
||
|
|
ttk::frame $w.ipv6frame.buttons
|
||
|
|
pack $w.ipv6frame.buttons -side bottom -fill x -pady 2m
|
||
|
|
ttk::button $w.ipv6frame.buttons.apply -text "Apply" -command "IPv6AddrApply $w"
|
||
|
|
ttk::button $w.ipv6frame.buttons.cancel -text "Cancel" -command "destroy $w"
|
||
|
|
|
||
|
|
bind $w <Key-Return> "IPv6AddrApply $w"
|
||
|
|
bind $w <Key-Escape> "destroy $w"
|
||
|
|
|
||
|
|
pack $w.ipv6frame.buttons.apply -side left -expand 1 -anchor e -padx 2
|
||
|
|
pack $w.ipv6frame.buttons.cancel -side right -expand 1 -anchor w -padx 2
|
||
|
|
}
|
||
|
|
.menubar.tools add command -label "Routing protocol defaults" -underline 0 -command {
|
||
|
|
upvar 0 ::cf::[set ::curcfg]::curcanvas curcanvas
|
||
|
|
upvar 0 ::cf::[set ::curcfg]::oper_mode oper_mode
|
||
|
|
global router_model supp_router_models routerDefaultsModel
|
||
|
|
global routerRipEnable routerRipngEnable routerOspfEnable routerOspf6Enable
|
||
|
|
|
||
|
|
set wi .popup
|
||
|
|
catch {destroy $wi}
|
||
|
|
toplevel $wi
|
||
|
|
wm transient $wi .
|
||
|
|
wm resizable $wi 0 0
|
||
|
|
wm title $wi "Router Defaults"
|
||
|
|
grab $wi
|
||
|
|
|
||
|
|
#dodan glavni frame "routerframe"
|
||
|
|
ttk::frame $wi.routerframe
|
||
|
|
pack $wi.routerframe -fill both -expand 1
|
||
|
|
|
||
|
|
set w $wi.routerframe
|
||
|
|
|
||
|
|
ttk::labelframe $w.model -text "Model:"
|
||
|
|
ttk::labelframe $w.protocols -text "Protocols:"
|
||
|
|
|
||
|
|
ttk::checkbutton $w.protocols.rip -text "rip" -variable routerRipEnable
|
||
|
|
ttk::checkbutton $w.protocols.ripng -text "ripng" -variable routerRipngEnable
|
||
|
|
ttk::checkbutton $w.protocols.ospf -text "ospfv2" -variable routerOspfEnable
|
||
|
|
ttk::checkbutton $w.protocols.ospf6 -text "ospfv3" -variable routerOspf6Enable
|
||
|
|
|
||
|
|
ttk::radiobutton $w.model.quagga -text quagga -variable router_model \
|
||
|
|
-value quagga -command {
|
||
|
|
$w.protocols.rip configure -state normal
|
||
|
|
$w.protocols.ripng configure -state normal
|
||
|
|
$w.protocols.ospf configure -state normal
|
||
|
|
$w.protocols.ospf6 configure -state normal
|
||
|
|
}
|
||
|
|
ttk::radiobutton $w.model.xorp -text xorp -variable router_model \
|
||
|
|
-value xorp -command {
|
||
|
|
$w.protocols.rip configure -state normal
|
||
|
|
$w.protocols.ripng configure -state normal
|
||
|
|
$w.protocols.ospf configure -state normal
|
||
|
|
$w.protocols.ospf6 configure -state normal
|
||
|
|
}
|
||
|
|
ttk::radiobutton $w.model.static -text static -variable router_model \
|
||
|
|
-value static -command {
|
||
|
|
$w.protocols.rip configure -state disabled
|
||
|
|
$w.protocols.ripng configure -state disabled
|
||
|
|
$w.protocols.ospf configure -state disabled
|
||
|
|
$w.protocols.ospf6 configure -state disabled
|
||
|
|
}
|
||
|
|
|
||
|
|
if { $router_model == "static" || $oper_mode != "edit" } {
|
||
|
|
$w.protocols.rip configure -state disabled
|
||
|
|
$w.protocols.ripng configure -state disabled
|
||
|
|
$w.protocols.ospf configure -state disabled
|
||
|
|
$w.protocols.ospf6 configure -state disabled
|
||
|
|
}
|
||
|
|
|
||
|
|
if { $oper_mode != "edit" } {
|
||
|
|
$w.model.quagga configure -state disabled
|
||
|
|
$w.model.xorp configure -state disabled
|
||
|
|
$w.model.static configure -state disabled
|
||
|
|
}
|
||
|
|
if {"xorp" ni $supp_router_models} {
|
||
|
|
$w.model.xorp configure -state disabled
|
||
|
|
}
|
||
|
|
|
||
|
|
ttk::frame $w.buttons
|
||
|
|
ttk::button $w.buttons.b1 -text "Apply" -command { routerDefaultsApply $wi }
|
||
|
|
ttk::button $w.buttons.b2 -text "Cancel" -command {
|
||
|
|
set router_model $routerDefaultsModel
|
||
|
|
set routerRipEnable [lindex $rdconfig 0]
|
||
|
|
set routerRipngEnable [lindex $rdconfig 1]
|
||
|
|
set routerOspfEnable [lindex $rdconfig 2]
|
||
|
|
set routerOspf6Enable [lindex $rdconfig 3]
|
||
|
|
destroy $wi
|
||
|
|
}
|
||
|
|
|
||
|
|
pack $w.model -side top -fill x -pady 5
|
||
|
|
pack $w.model.quagga $w.model.xorp $w.model.static \
|
||
|
|
-side left -expand 1
|
||
|
|
pack $w.protocols -side top -pady 5
|
||
|
|
pack $w.protocols.rip $w.protocols.ripng \
|
||
|
|
$w.protocols.ospf $w.protocols.ospf6 -side left
|
||
|
|
pack $w.buttons -side bottom -fill x -pady 2
|
||
|
|
pack $w.buttons.b1 -side left -expand 1 -anchor e -padx 2
|
||
|
|
pack $w.buttons.b2 -side right -expand 1 -anchor w -padx 2
|
||
|
|
}
|
||
|
|
#.menubar.tools add separator
|
||
|
|
#.menubar.tools add command -label "ns2imunes converter" \
|
||
|
|
# -underline 0 -command {
|
||
|
|
#
|
||
|
|
# #dodana varijabla ns2imdialog, dodan glavni frame "ns2convframe"
|
||
|
|
# set ns2imdialog .ns2im-dialog
|
||
|
|
# catch {destroy $ns2imdialog}
|
||
|
|
# toplevel $ns2imdialog
|
||
|
|
# wm transient $ns2imdialog .
|
||
|
|
# wm resizable $ns2imdialog 0 0
|
||
|
|
# wm title $ns2imdialog "ns2imunes converter"
|
||
|
|
#
|
||
|
|
# ttk::frame $ns2imdialog.ns2convframe
|
||
|
|
# pack $ns2imdialog.ns2convframe -fill both -expand 1
|
||
|
|
#
|
||
|
|
# set f1 [ttk::frame $ns2imdialog.ns2convframe.entry1]
|
||
|
|
# set f2 [ttk::frame $ns2imdialog.ns2convframe.buttons]
|
||
|
|
#
|
||
|
|
# ttk::label $f1.l -text "ns2 file:"
|
||
|
|
#
|
||
|
|
# #entry $f1.e -width 25 -textvariable ns2srcfile
|
||
|
|
# ttk::entry $f1.e -width 25 -textvariable ns2srcfile
|
||
|
|
# ttk::button $f1.b -text "Browse" -width 8 \
|
||
|
|
# -command {
|
||
|
|
# set srcfile [tk_getOpenFile -parent $ns2imdialog \
|
||
|
|
# -initialfile $ns2srcfile]
|
||
|
|
# $f1.e delete 0 end
|
||
|
|
# $f1.e insert 0 "$srcfile"
|
||
|
|
# }
|
||
|
|
# ttk::button $f2.b1 -text "OK" -command {
|
||
|
|
# ns2im $srcfile
|
||
|
|
# destroy $ns2imdialog
|
||
|
|
# }
|
||
|
|
# ttk::button $f2.b2 -text "Cancel" -command { destroy $ns2imdialog}
|
||
|
|
#
|
||
|
|
# pack $f1.b $f1.e -side right
|
||
|
|
# pack $f1.l -side right -fill x -expand 1
|
||
|
|
# pack $f2.b1 -side left -expand 1 -anchor e
|
||
|
|
# pack $f2.b2 -side right -expand 1 -anchor w
|
||
|
|
# pack $f1 $f2 -fill x
|
||
|
|
#}
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# View
|
||
|
|
#
|
||
|
|
menu .menubar.view -tearoff 0
|
||
|
|
|
||
|
|
set m .menubar.view.iconsize
|
||
|
|
menu $m -tearoff 0
|
||
|
|
.menubar.view add cascade -label "Icon size" -menu $m -underline 5
|
||
|
|
$m add radiobutton -label "Small" -variable iconSize \
|
||
|
|
-value small -command { updateIconSize; redrawAll }
|
||
|
|
$m add radiobutton -label "Normal" -variable iconSize \
|
||
|
|
-value normal -command { updateIconSize; redrawAll }
|
||
|
|
|
||
|
|
.menubar.view add separator
|
||
|
|
|
||
|
|
.menubar.view add checkbutton -label "Show Interface Names" \
|
||
|
|
-underline 5 -variable showIfNames \
|
||
|
|
-command { redrawAllLinks }
|
||
|
|
.menubar.view add checkbutton -label "Show IPv4 Addresses " \
|
||
|
|
-underline 8 -variable showIfIPaddrs \
|
||
|
|
-command { redrawAllLinks }
|
||
|
|
.menubar.view add checkbutton -label "Show IPv6 Addresses " \
|
||
|
|
-underline 8 -variable showIfIPv6addrs \
|
||
|
|
-command { redrawAllLinks }
|
||
|
|
.menubar.view add checkbutton -label "Show Node Labels" \
|
||
|
|
-underline 5 -variable showNodeLabels -command {
|
||
|
|
foreach object [.panwin.f1.c find withtag nodelabel] {
|
||
|
|
if { $showNodeLabels } {
|
||
|
|
.panwin.f1.c itemconfigure $object -state normal
|
||
|
|
} else {
|
||
|
|
.panwin.f1.c itemconfigure $object -state hidden
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
.menubar.view add checkbutton -label "Show Link Labels" \
|
||
|
|
-underline 5 -variable showLinkLabels -command {
|
||
|
|
foreach object [.panwin.f1.c find withtag linklabel] {
|
||
|
|
if { $showLinkLabels } {
|
||
|
|
.panwin.f1.c itemconfigure $object -state normal
|
||
|
|
} else {
|
||
|
|
.panwin.f1.c itemconfigure $object -state hidden
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
.menubar.view add command -label "Show All" \
|
||
|
|
-underline 5 -command {
|
||
|
|
set showIfNames 1
|
||
|
|
set showIfIPaddrs 1
|
||
|
|
set showIfIPv6addrs 1
|
||
|
|
set showNodeLabels 1
|
||
|
|
set showLinkLabels 1
|
||
|
|
redrawAllLinks
|
||
|
|
foreach object [.panwin.f1.c find withtag linklabel] {
|
||
|
|
.panwin.f1.c itemconfigure $object -state normal
|
||
|
|
}
|
||
|
|
}
|
||
|
|
.menubar.view add command -label "Show None" \
|
||
|
|
-underline 6 -command {
|
||
|
|
set showIfNames 0
|
||
|
|
set showIfIPaddrs 0
|
||
|
|
set showIfIPv6addrs 0
|
||
|
|
set showNodeLabels 0
|
||
|
|
set showLinkLabels 0
|
||
|
|
redrawAllLinks
|
||
|
|
foreach object [.panwin.f1.c find withtag linklabel] {
|
||
|
|
.panwin.f1.c itemconfigure $object -state hidden
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
.menubar.view add separator
|
||
|
|
|
||
|
|
#.menubar.view add checkbutton -label "Show ZFS snaphots" \
|
||
|
|
# -variable showZFSsnapshots
|
||
|
|
|
||
|
|
#.menubar.view add separator
|
||
|
|
.menubar.view add checkbutton -label "Show Topology Tree" \
|
||
|
|
-variable showTree -underline 5 \
|
||
|
|
-command { topologyElementsTree }
|
||
|
|
|
||
|
|
.menubar.view add separator
|
||
|
|
|
||
|
|
.menubar.view add checkbutton -label "Show Background Image" \
|
||
|
|
-underline 5 -variable showBkgImage \
|
||
|
|
-command { redrawAll }
|
||
|
|
.menubar.view add checkbutton -label "Show Annotations" \
|
||
|
|
-underline 8 -variable showAnnotations \
|
||
|
|
-command { redrawAll }
|
||
|
|
.menubar.view add checkbutton -label "Show Grid" \
|
||
|
|
-underline 5 -variable showGrid \
|
||
|
|
-command { redrawAll }
|
||
|
|
|
||
|
|
|
||
|
|
.menubar.view add separator
|
||
|
|
.menubar.view add command -label "Zoom In" -accelerator "+" \
|
||
|
|
-command "zoom up"
|
||
|
|
bind . "+" "zoom up"
|
||
|
|
.menubar.view add command -label "Zoom Out" -accelerator "-" \
|
||
|
|
-command "zoom down"
|
||
|
|
bind . "-" "zoom down"
|
||
|
|
|
||
|
|
|
||
|
|
#dodan element "Themes"
|
||
|
|
.menubar.view add separator
|
||
|
|
set m .menubar.view.themes
|
||
|
|
menu $m -tearoff 0
|
||
|
|
set currentTheme imunes
|
||
|
|
.menubar.view add cascade -label "Themes" -menu $m
|
||
|
|
$m add radiobutton -label "alt" -variable currentTheme \
|
||
|
|
-value alt -command "ttk::style theme use alt"
|
||
|
|
$m add radiobutton -label "classic" -variable currentTheme\
|
||
|
|
-value classic -command "ttk::style theme use classic"
|
||
|
|
$m add radiobutton -label "default" -variable currentTheme\
|
||
|
|
-value default -command "ttk::style theme use default"
|
||
|
|
$m add radiobutton -label "clam" -variable currentTheme\
|
||
|
|
-value clam -command "ttk::style theme use clam"
|
||
|
|
$m add radiobutton -label "imunes" -variable currentTheme\
|
||
|
|
-value imunes -command "ttk::style theme use imunes"
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# Show
|
||
|
|
#
|
||
|
|
menu .menubar.widgets
|
||
|
|
global showConfig
|
||
|
|
set showConfig "None"
|
||
|
|
global lastObservedNode
|
||
|
|
set lastObservedNode ""
|
||
|
|
.menubar.widgets add radiobutton -label "None" \
|
||
|
|
-variable showConfig -underline 0 -value "None"
|
||
|
|
.menubar.widgets add separator
|
||
|
|
|
||
|
|
set widgetlist { \
|
||
|
|
{ "ifconfig" "ifconfig" } \
|
||
|
|
{ "IPv4 Routing table" "netstat -4 -rn" } \
|
||
|
|
{ "IPv6 Routing table" "netstat -6 -rn" } \
|
||
|
|
{ "RIP routes info" "vtysh -c \"show ip rip\"" } \
|
||
|
|
{ "RIPng routes info" "vtysh -c \"show ipv6 ripng\"" } \
|
||
|
|
{ "Process list" "ps ax" } \
|
||
|
|
{ "IPv4 sockets" "netstat -4 -an" } \
|
||
|
|
{ "IPv6 sockets" "netstat -6 -an" } \
|
||
|
|
{ "View startup script" "cat boot.conf" } \
|
||
|
|
{ "View startup log" "cat out.log" } \
|
||
|
|
{ "List files" "ls" } \
|
||
|
|
}
|
||
|
|
|
||
|
|
foreach widget $widgetlist {
|
||
|
|
.menubar.widgets add radiobutton -label [lindex $widget 0] \
|
||
|
|
-variable showConfig -underline 0 -value [lindex $widget 1]
|
||
|
|
}
|
||
|
|
|
||
|
|
.menubar.widgets add command -label "Custom..." \
|
||
|
|
-underline 0 -command {
|
||
|
|
global showConfig
|
||
|
|
set w .entry1
|
||
|
|
catch {destroy $w}
|
||
|
|
toplevel $w
|
||
|
|
wm transient $w .
|
||
|
|
wm resizable $w 0 0
|
||
|
|
wm title $w "Custom widget"
|
||
|
|
wm iconname $w "Custom widget"
|
||
|
|
|
||
|
|
ttk::frame $w.custom
|
||
|
|
pack $w.custom -fill both -expand 1
|
||
|
|
|
||
|
|
ttk::label $w.custom.label -wraplength 5i -justify left -text "Custom command:"
|
||
|
|
pack $w.custom.label -side top
|
||
|
|
|
||
|
|
ttk::frame $w.custom.buttons
|
||
|
|
pack $w.custom.buttons -side bottom -fill x -pady 2m
|
||
|
|
ttk::button $w.custom.buttons.ok -text OK -command {
|
||
|
|
set w .entry1
|
||
|
|
global showConfig
|
||
|
|
set showConfig [$w.custom.e1 get]
|
||
|
|
destroy $w
|
||
|
|
}
|
||
|
|
ttk::button $w.custom.buttons.cancel -text "Cancel" -command "destroy $w"
|
||
|
|
pack $w.custom.buttons.ok $w.custom.buttons.cancel -side left -expand 1
|
||
|
|
|
||
|
|
set commands {"ifconfig" "ps ax" "netstat -rnf inet" "netstat -rn" "ls" \
|
||
|
|
"cat boot.conf"}
|
||
|
|
ttk::combobox $w.custom.e1 -width 30 -values $commands
|
||
|
|
if {$showConfig != "None"} {
|
||
|
|
$w.custom.e1 insert 0 $showConfig
|
||
|
|
} else {
|
||
|
|
$w.custom.e1 insert 0 [lindex $commands 0]
|
||
|
|
}
|
||
|
|
|
||
|
|
pack $w.custom.e1 -side top -pady 5 -padx 10 -fill x
|
||
|
|
}
|
||
|
|
|
||
|
|
if {0} {
|
||
|
|
.menubar.widgets add separator
|
||
|
|
.menubar.widgets add radiobutton -label "Route" \
|
||
|
|
-variable showConfig -underline 0 -value "route"
|
||
|
|
}
|
||
|
|
|
||
|
|
#
|
||
|
|
# Events
|
||
|
|
#
|
||
|
|
menu .menubar.events -tearoff 0
|
||
|
|
.menubar.events add command -label "Start scheduling" -underline 0 \
|
||
|
|
-state normal -command "startEventScheduling"
|
||
|
|
.menubar.events add command -label "Stop scheduling" -underline 1 \
|
||
|
|
-state disabled -command "stopEventScheduling"
|
||
|
|
.menubar.events add separator
|
||
|
|
.menubar.events add command -label "Event editor" -underline 0 \
|
||
|
|
-command "elementsEventsEditor"
|
||
|
|
#
|
||
|
|
# Experiment
|
||
|
|
#
|
||
|
|
menu .menubar.experiment -tearoff 0
|
||
|
|
.menubar.experiment add command -label "Execute" -underline 0 \
|
||
|
|
-command "setOperMode exec"
|
||
|
|
.menubar.experiment add command -label "Terminate" -underline 0 \
|
||
|
|
-command "setOperMode edit" -state disabled
|
||
|
|
.menubar.experiment add command -label "Restart" -underline 0 \
|
||
|
|
-command "setOperMode edit; setOperMode exec" -state disabled
|
||
|
|
.menubar.experiment add separator
|
||
|
|
.menubar.experiment add command -label "Attach to experiment" -underline 0 \
|
||
|
|
-command "attachToExperimentPopup"
|
||
|
|
|
||
|
|
#
|
||
|
|
# Help
|
||
|
|
#
|
||
|
|
menu .menubar.help -tearoff 0
|
||
|
|
.menubar.help add command -label "About" -command {
|
||
|
|
toplevel .about
|
||
|
|
wm title .about "About IMUNES"
|
||
|
|
wm minsize .about 454 255
|
||
|
|
|
||
|
|
set mainFrame .about.main
|
||
|
|
|
||
|
|
ttk::frame $mainFrame -padding 4
|
||
|
|
grid $mainFrame -column 0 -row 0 -sticky n
|
||
|
|
grid columnconfigure .about 0 -weight 1
|
||
|
|
grid rowconfigure .about 0 -weight 1
|
||
|
|
|
||
|
|
set image [image create photo -file $ROOTDIR/$LIBDIR/icons/imunes_logo128.png]
|
||
|
|
ttk::label $mainFrame.logoLabel
|
||
|
|
$mainFrame.logoLabel configure -image $image
|
||
|
|
|
||
|
|
ttk::label $mainFrame.imunesLabel -text "IMUNES" -font "-size 12 -weight bold"
|
||
|
|
ttk::label $mainFrame.imunesVersion -text $imunesVersion -font "-size 10 -weight bold"
|
||
|
|
ttk::label $mainFrame.lastChanged -text $imunesChangedDate
|
||
|
|
ttk::label $mainFrame.imunesAdditions -text "$imunesAdditions" -font "-size 10 -weight bold"
|
||
|
|
ttk::label $mainFrame.imunesDesc -text "Integrated Multiprotocol Network Emulator/Simulator."
|
||
|
|
ttk::label $mainFrame.homepage -text "http://imunes.net/" -font "-underline 1 -size 10"
|
||
|
|
ttk::label $mainFrame.github -text "http://github.com/imunes/imunes" -font "-underline 1 -size 10"
|
||
|
|
ttk::label $mainFrame.copyright -text "Copyright (c) University of Zagreb 2004 - $imunesLastYear" -font "-size 8"
|
||
|
|
|
||
|
|
grid $mainFrame.logoLabel -column 0 -row 0 -pady {10 5} -padx 5
|
||
|
|
grid $mainFrame.imunesLabel -column 0 -row 1 -pady 5 -padx 5
|
||
|
|
grid $mainFrame.imunesVersion -column 0 -row 2 -pady {5 1} -padx 5
|
||
|
|
grid $mainFrame.lastChanged -column 0 -row 3 -pady {1 5} -padx 5
|
||
|
|
if { $imunesAdditions != ""} {
|
||
|
|
grid $mainFrame.imunesAdditions -column 0 -row 4 -pady {0 1} -padx 5
|
||
|
|
}
|
||
|
|
grid $mainFrame.imunesDesc -column 0 -row 5 -pady {5 10} -padx 5
|
||
|
|
grid $mainFrame.homepage -column 0 -row 6 -pady 1 -padx 5
|
||
|
|
grid $mainFrame.github -column 0 -row 7 -pady 1 -padx 5
|
||
|
|
grid $mainFrame.copyright -column 0 -row 8 -pady {20 10} -padx 5
|
||
|
|
|
||
|
|
bind $mainFrame.homepage <1> { launchBrowser [%W cget -text] }
|
||
|
|
bind $mainFrame.homepage <Enter> "%W configure -foreground blue; \
|
||
|
|
$mainFrame config -cursor hand1"
|
||
|
|
bind $mainFrame.homepage <Leave> "%W configure -foreground black; \
|
||
|
|
$mainFrame config -cursor arrow"
|
||
|
|
|
||
|
|
bind $mainFrame.github <1> { launchBrowser [%W cget -text] }
|
||
|
|
bind $mainFrame.github <Enter> "%W configure -foreground blue; \
|
||
|
|
$mainFrame config -cursor hand1"
|
||
|
|
bind $mainFrame.github <Leave> "%W configure -foreground black; \
|
||
|
|
$mainFrame config -cursor arrow"
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#
|
||
|
|
# Left-side toolbar
|
||
|
|
#
|
||
|
|
ttk::frame $mf.left
|
||
|
|
pack $mf.left -side left -fill y
|
||
|
|
|
||
|
|
foreach b {select link} {
|
||
|
|
|
||
|
|
set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/$b.gif]
|
||
|
|
|
||
|
|
ttk::button $mf.left.$b \
|
||
|
|
-image $image -style Toolbutton \
|
||
|
|
-command "setActiveTool $b"
|
||
|
|
pack $mf.left.$b -side top
|
||
|
|
|
||
|
|
# hover status line
|
||
|
|
set msg ""
|
||
|
|
if { $b == "select" } {
|
||
|
|
set msg "Select tool"
|
||
|
|
} elseif { $b == "link" } {
|
||
|
|
set msg "Create link"
|
||
|
|
}
|
||
|
|
|
||
|
|
bind $mf.left.$b <Any-Enter> ".bottom.textbox config -text {$msg}"
|
||
|
|
bind $mf.left.$b <Any-Leave> ".bottom.textbox config -text {}"
|
||
|
|
}
|
||
|
|
|
||
|
|
menu $mf.left.link_nodes -title "Link layer nodes"
|
||
|
|
menu $mf.left.net_nodes -title "Network layer nodes"
|
||
|
|
foreach b $all_modules_list {
|
||
|
|
set image [image create photo -file [$b.icon toolbar]]
|
||
|
|
|
||
|
|
if { [$b.layer] == "LINK" } {
|
||
|
|
$mf.left.link_nodes add command -image $image -hidemargin 1 \
|
||
|
|
-compound left -label [string range [$b.toolbarIconDescr] 8 end] \
|
||
|
|
-command "setActiveTool $b"
|
||
|
|
} elseif { [$b.layer] == "NETWORK" } {
|
||
|
|
$mf.left.net_nodes add command -image $image -hidemargin 1 \
|
||
|
|
-compound left -label [string range [$b.toolbarIconDescr] 8 end] \
|
||
|
|
-command "setActiveTool $b"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/l2.gif]
|
||
|
|
ttk::menubutton $mf.left.link_layer -image $image -style Toolbutton \
|
||
|
|
-menu $mf.left.link_nodes -direction right
|
||
|
|
bind $mf.left.link_layer <Any-Enter> ".bottom.textbox config -text {Add new link layer node}"
|
||
|
|
bind $mf.left.link_layer <Any-Leave> ".bottom.textbox config -text {}"
|
||
|
|
pack $mf.left.link_layer
|
||
|
|
|
||
|
|
set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/l3.gif]
|
||
|
|
ttk::menubutton $mf.left.net_layer -image $image -style Toolbutton \
|
||
|
|
-menu $mf.left.net_nodes -direction right
|
||
|
|
bind $mf.left.net_layer <Any-Enter> ".bottom.textbox config -text {Add new network layer node}"
|
||
|
|
bind $mf.left.net_layer <Any-Leave> ".bottom.textbox config -text {}"
|
||
|
|
pack $mf.left.net_layer
|
||
|
|
|
||
|
|
foreach b {rectangle oval freeform text} {
|
||
|
|
set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/$b.gif]
|
||
|
|
|
||
|
|
ttk::button $mf.left.$b \
|
||
|
|
-image $image -style Toolbutton \
|
||
|
|
-command "setActiveTool $b"
|
||
|
|
|
||
|
|
pack $mf.left.$b -side bottom
|
||
|
|
# hover status line
|
||
|
|
switch -exact -- $b {
|
||
|
|
rectangle { set msg "Add a Rectangle" }
|
||
|
|
oval { set msg "Add an Oval" }
|
||
|
|
freeform { set msg "Add a Freeform" }
|
||
|
|
text { set msg "Add a Textbox" }
|
||
|
|
default { set msg "" }
|
||
|
|
}
|
||
|
|
bind $mf.left.$b <Any-Enter> ".bottom.textbox config -text {$msg}"
|
||
|
|
bind $mf.left.$b <Any-Leave> ".bottom.textbox config -text {}"
|
||
|
|
}
|
||
|
|
|
||
|
|
foreach b $all_modules_list {
|
||
|
|
set $b [image create photo -file [$b.icon normal]]
|
||
|
|
set $b\_iconwidth [image width [set $b]]
|
||
|
|
set $b\_iconheight [image height [set $b]]
|
||
|
|
}
|
||
|
|
set pseudo [image create photo]
|
||
|
|
set pseudo_iconwidth 0
|
||
|
|
set pseudo_iconheight 0
|
||
|
|
|
||
|
|
. configure -background #808080
|
||
|
|
ttk::frame $mf.grid
|
||
|
|
ttk::frame $mf.hframe
|
||
|
|
ttk::frame $mf.vframe
|
||
|
|
set c [canvas $mf.c -bd 0 -relief sunken -highlightthickness 0\
|
||
|
|
-background gray \
|
||
|
|
-xscrollcommand "$mf.hframe.scroll set" \
|
||
|
|
-yscrollcommand "$mf.vframe.scroll set"]
|
||
|
|
|
||
|
|
canvas $mf.hframe.t -width 160 -height 18 -bd 0 -highlightthickness 0 \
|
||
|
|
-background #d9d9d9 \
|
||
|
|
-xscrollcommand "$mf.hframe.ts set"
|
||
|
|
bind $mf.hframe.t <1> {
|
||
|
|
upvar 0 ::cf::[set ::curcfg]::curcanvas curcanvas
|
||
|
|
|
||
|
|
set canvas [lindex [$mf.hframe.t gettags current] 1]
|
||
|
|
if { $canvas != "" && $canvas != $curcanvas } {
|
||
|
|
set curcanvas $canvas
|
||
|
|
switchCanvas none
|
||
|
|
}
|
||
|
|
}
|
||
|
|
bind $mf.hframe.t <Double-1> {
|
||
|
|
upvar 0 ::cf::[set ::curcfg]::curcanvas curcanvas
|
||
|
|
|
||
|
|
set canvas [lindex [$mf.hframe.t gettags current] 1]
|
||
|
|
if { $canvas != "" } {
|
||
|
|
if { $canvas != $curcanvas } {
|
||
|
|
set curcanvas $canvas
|
||
|
|
switchCanvas none
|
||
|
|
} else {
|
||
|
|
renameCanvasPopup
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
newCanvas ""
|
||
|
|
switchCanvas last
|
||
|
|
set changed 1
|
||
|
|
updateUndoLog
|
||
|
|
}
|
||
|
|
}
|
||
|
|
#scrollbar $mf.hframe.scroll -orient horiz -command "$c xview" \
|
||
|
|
# -bd 1 -width 14
|
||
|
|
#scrollbar $mf.vframe.scroll -command "$c yview" \
|
||
|
|
# -bd 1 -width 14
|
||
|
|
#scrollbar $mf.hframe.ts -orient horiz -command "$mf.hframe.t xview" \
|
||
|
|
# -bd 1 -width 14
|
||
|
|
|
||
|
|
ttk::scrollbar $mf.hframe.scroll -orient horiz -command "$c xview"
|
||
|
|
ttk::scrollbar $mf.vframe.scroll -command "$c yview"
|
||
|
|
ttk::scrollbar $mf.hframe.ts -orient horiz -command ".panwin.f1.hframe.t xview"
|
||
|
|
pack $mf.hframe.ts -side left -padx 0 -pady 0
|
||
|
|
pack $mf.hframe.t -side left -padx 0 -pady 0 -fill both -expand true
|
||
|
|
pack $mf.hframe.scroll -side left -padx 0 -pady 0 -fill both -expand true
|
||
|
|
pack $mf.vframe.scroll -side top -padx 0 -pady 0 -fill both -expand true
|
||
|
|
pack $mf.grid -expand yes -fill both -padx 1 -pady 1
|
||
|
|
grid rowconfig $mf.grid 0 -weight 1 -minsize 0
|
||
|
|
grid columnconfig $mf.grid 0 -weight 1 -minsize 0
|
||
|
|
grid $mf.c -in $mf.grid -row 0 -column 0 \
|
||
|
|
-rowspan 1 -columnspan 1 -sticky news
|
||
|
|
grid $mf.vframe -in $mf.grid -row 0 -column 1 \
|
||
|
|
-rowspan 1 -columnspan 1 -sticky news
|
||
|
|
grid $mf.hframe -in $mf.grid -row 1 -column 0 \
|
||
|
|
-rowspan 1 -columnspan 1 -sticky news
|
||
|
|
|
||
|
|
ttk::frame .bottom
|
||
|
|
pack .bottom -side bottom -fill x
|
||
|
|
pack propagate $mf 0
|
||
|
|
ttk::label .bottom.textbox -relief sunken -anchor w -width 999
|
||
|
|
ttk::label .bottom.zoom -relief sunken -anchor w -width 10
|
||
|
|
bind .bottom.zoom <Double-1> "selectZoom %X %Y"
|
||
|
|
bind .bottom.zoom <3> "selectZoomPopupMenu %X %Y"
|
||
|
|
ttk::label .bottom.cpu_load -relief sunken -anchor e -width 9
|
||
|
|
ttk::label .bottom.mbuf -relief sunken -anchor w -width 15
|
||
|
|
ttk::label .bottom.oper_mode -relief sunken -anchor w -width 9
|
||
|
|
ttk::label .bottom.experiment_id -relief sunken -anchor w -width 20
|
||
|
|
pack .bottom.experiment_id .bottom.oper_mode .bottom.mbuf .bottom.cpu_load \
|
||
|
|
.bottom.zoom .bottom.textbox -side right -padx 0 -fill both
|
||
|
|
|
||
|
|
#
|
||
|
|
# Event bindings and procedures for main canvas:
|
||
|
|
#
|
||
|
|
$c bind node <Any-Enter> "nodeEnter $c"
|
||
|
|
$c bind nodelabel <Any-Enter> "nodeEnter $c"
|
||
|
|
$c bind link <Any-Enter> "linkEnter $c"
|
||
|
|
$c bind linklabel <Any-Enter> "linkEnter $c"
|
||
|
|
$c bind node <Any-Leave> "anyLeave $c"
|
||
|
|
$c bind nodelabel <Any-Leave> "anyLeave $c"
|
||
|
|
$c bind link <Any-Leave> "anyLeave $c"
|
||
|
|
$c bind linklabel <Any-Leave> "anyLeave $c"
|
||
|
|
|
||
|
|
$c bind node <Double-1> "nodeConfigGUI $c {}"
|
||
|
|
$c bind nodelabel <Double-1> "nodeConfigGUI $c {}"
|
||
|
|
|
||
|
|
$c bind grid <Double-1> "double1onGrid $c %x %y"
|
||
|
|
|
||
|
|
$c bind link <Double-1> "linkConfigGUI $c {}"
|
||
|
|
$c bind linklabel <Double-1> "linkConfigGUI $c {}"
|
||
|
|
|
||
|
|
$c bind oval <Double-1> "annotationConfigGUI $c"
|
||
|
|
$c bind rectangle <Double-1> "annotationConfigGUI $c"
|
||
|
|
$c bind text <Double-1> "annotationConfigGUI $c"
|
||
|
|
$c bind freeform <Double-1> "annotationConfigGUI $c"
|
||
|
|
|
||
|
|
$c bind text <KeyPress> "textInsert $c %A"
|
||
|
|
$c bind text <Return> "textInsert $c \\n"
|
||
|
|
$c bind node <3> "button3node $c %x %y"
|
||
|
|
$c bind nodelabel <3> "button3node $c %x %y"
|
||
|
|
$c bind link <3> "button3link $c %x %y"
|
||
|
|
$c bind linklabel <3> "button3link $c %x %y"
|
||
|
|
|
||
|
|
$c bind route <Any-Enter> "anyLeave $c"
|
||
|
|
$c bind route <Any-Leave> "anyLeave $c"
|
||
|
|
$c bind showCfgPopup <Any-Leave> "anyLeave $c"
|
||
|
|
$c bind text <Any-Leave> "anyLeave $c"
|
||
|
|
|
||
|
|
$c bind oval <3> "button3annotation oval $c %x %y"
|
||
|
|
$c bind rectangle <3> "button3annotation rectangle $c %x %y"
|
||
|
|
$c bind text <3> "button3annotation text $c %x %y"
|
||
|
|
$c bind freeform <3> "button3annotation freeform $c %x %y"
|
||
|
|
|
||
|
|
$c bind selectmark <Any-Enter> "selectmarkEnter $c %x %y"
|
||
|
|
$c bind selectmark <Any-Leave> "selectmarkLeave $c %x %y"
|
||
|
|
|
||
|
|
$c bind background <3> "button3background $c %x %y"
|
||
|
|
#$c bind grid <3> "button3background $c %x %y"
|
||
|
|
|
||
|
|
bind $c <1> "button1 $c %x %y none"
|
||
|
|
bind $c <Control-Button-1> "button1 $c %x %y ctrl"
|
||
|
|
bind $c <B1-Motion> "button1-motion $c %x %y"
|
||
|
|
bind $c <B1-ButtonRelease> "button1-release $c %x %y"
|
||
|
|
bind . <Delete> deleteSelection
|
||
|
|
|
||
|
|
# Scrolling and panning support
|
||
|
|
bind $c <2> "$c scan mark %x %y"
|
||
|
|
bind $c <B2-Motion> "$c scan dragto %x %y 1"
|
||
|
|
bind $c <4> "$c yview scroll 1 units"
|
||
|
|
bind $c <5> "$c yview scroll -1 units"
|
||
|
|
bind . <Right> "$mf.c xview scroll 1 units"
|
||
|
|
bind . <Left> "$mf.c xview scroll -1 units"
|
||
|
|
bind . <Down> "$mf.c yview scroll 1 units"
|
||
|
|
bind . <Up> "$mf.c yview scroll -1 units"
|
||
|
|
|
||
|
|
# Escape to Select mode
|
||
|
|
bind . <Key-Escape> "setActiveTool select; selectNode $c none"
|
||
|
|
bind . <F5> "redrawAll"
|
||
|
|
|
||
|
|
#
|
||
|
|
# Popup-menu hierarchy
|
||
|
|
#
|
||
|
|
menu .button3menu -tearoff 0
|
||
|
|
menu .button3menu.connect -tearoff 0
|
||
|
|
menu .button3menu.moveto -tearoff 0
|
||
|
|
menu .button3menu.shell -tearoff 0
|
||
|
|
menu .button3menu.wireshark -tearoff 0
|
||
|
|
menu .button3menu.tcpdump -tearoff 0
|
||
|
|
menu .button3menu.canvases -tearoff 0
|
||
|
|
menu .button3menu.icon -tearoff 0
|
||
|
|
menu .button3menu.transform -tearoff 0
|
||
|
|
menu .button3menu.sett -tearoff 0
|
||
|
|
menu .button3menu.services -tearoff 0
|
||
|
|
|
||
|
|
menu .button3logifc -tearoff 0
|
||
|
|
#
|
||
|
|
# Invisible pseudo links
|
||
|
|
#
|
||
|
|
set invisible -1
|
||
|
|
bind . <Control-i> {
|
||
|
|
global invisible
|
||
|
|
set invisible [expr $invisible * -1]
|
||
|
|
redrawAll
|
||
|
|
}
|
||
|
|
|
||
|
|
focus -force .
|