QUIC/inet/examples/rundemo

#!/bin/sh
# the next line restarts using wish (on cygwin, use wish84 or the like) \
exec wish "$0" "$@"

#==========================================================================
#  DEMO
#  part of OMNeT++
#==========================================================================

#--------------------------------------------------------------
#  Copyright (C) 1992-2003 Andras Varga
#
#  This file is distributed WITHOUT ANY WARRANTY. See the file
#  `license' for details on this and other legal matters.
#--------------------------------------------------------------


#
# Configuration
#
set wantScrollbar 1
set unixbrowser "firefox"
#set unixbrowser "mozilla"
#set unixbrowser "konqueror"
#set unixbrowser "netscape"

#
# title line:   {"title"}
# program line: {"name" "directory" "unix-command" "windows-command"}
# readme line:  {"name" "readme-file"}
# docu line:    {"name" "readme-file"  "html-file"}
# separator:    {}
#
set i 0
set first ""
foreach line {
   {"INET Framework"}
   {"About..."               "README"               "../doc/index.html"}

   {"Ethernet"}
   {"ARP Test"               "ethernet/arptest"     "./run"               "run"}
   {"ARP Test 2"             "ethernet/arptest2"    "./run"               "run"}
   {"LANs: mixed Ethernet"   "ethernet/lans"        "./run mixed.ini"     "run mixed.ini"}
   {"LANs: Ethernet bus"     "ethernet/lans"        "./run bus.ini"       "run bus.ini"}
   {"LANs: hub"              "ethernet/lans"        "./run hub.ini"       "run hub.ini"}
   {"LANs: switch"           "ethernet/lans"        "./run switch.ini"    "run switch.ini"}
   {"LANs: duplexswitch"     "ethernet/lans"        "./run duplexswitch.ini" "run duplexswitch.ini"}
   {"LANs: two hosts"        "ethernet/lans"        "./run twoHosts.ini"  "run twoHosts.ini"}
   {"LANs: very large LAN"   "ethernet/lans"        "./run largeNet.ini"  "run largeNet.ini"}

   {"INET"}
   {"NClients/Telnet"        "inet/nclients"        "./run"               "run"}
   {"NClients/HTTP"          "inet/nclients" "./run basicHTTP.ini"        "run basicHTTP.ini"}
   {"NClients/file transfer" "inet/nclients" "./run filetransfer.ini"     "run filetransfer.ini"}
   {"FlatNet"                "inet/flatnet"         "./run"               "run"}
   {"KIDSNw1"                "inet/kidsnw1"         "./run"               "run"}
   {"Multicast"              "inet/multicast"       "./run"               "run"}
   {"RouterPerf"             "inet/routerperf"      "./run"               "run"}
   {"BulkTransfer"           "inet/bulktransfer"    "./run"               "run"}
   {"RedTest"                "inet/redtest"         "./run"               "run"}
   {"TcpSack"                "inet/tcpsack"         "./run"               "run"}
   {"TcpTimestamps"          "inet/tcptimestamps"   "./run"               "run"}
   {"TcpWindowScale"         "inet/tcpwindowscale"  "./run"               "run"}
   {"TcpClientServer"        "inet/tcpclientserver" "./run"               "run"}
   {"BER"                    "inet/ber"             "./run"               "run"}

   {"IPv6 (work in progress)"}
   {"NClients"               "ipv6/nclients"        "./run"               "run"}
   {"DemoNetworkEth"         "ipv6/demonetworketh"  "./run"               "run"}
   {"Mobile IPv6"            "ipv6/mobileipv6"      "./run"               "run"}

   {"SCTP"}
   {"NClients"               "sctp/nclients"        "./run"               "run"}
   {"Multi-homing"           "sctp/multihomed"      "./run"               "run"}

   {"Emulation"}
   {"Traceroute"             "emulation/traceroute" "./run"               "run"}
   {"ExtClient"              "emulation/extclient"  "./run"               "run"}
   {"ExtServer"              "emulation/extserver"  "./run"               "run"}

   {"Ad-hoc"}
   {"Mobility models"        "adhoc/mobility"       "./run"               "run"}
   {"802.11b ad-hoc"         "adhoc/ieee80211"      "./run"               "run"}
   {"802.11b ad-hoc (MF impl.)" "adhoc/mf80211"     "./run"               "run"}

   {"Wireless"}
   {"802.11 AP and hosts"   "wireless/lan80211"     "./run"               "run"}
   {"802.11 handover"       "wireless/handover"     "./run"               "run"}
   {"802.11 thruput test"   "wireless/throughput"   "./run"               "run"}
   {"802.11 thruput test 2" "wireless/hosttohost"   "./run"               "run"}

   {"MPLS/RSVP-TE"}
   {"TestTE/failure"         "mpls/testte_failure"  "./run"               "run"}
   {"TestTE/reroute"         "mpls/testte_reroute"  "./run"               "run"}
   {"TestTE/routing"         "mpls/testte_routing"  "./run"               "run"}
   {"TestTE/tunnel "         "mpls/testte_tunnel"   "./run"               "run"}
   {"LDP/test"               "mpls/ldp"             "./run"               "run"}
   {"Net37"                  "mpls/net37"           "./run"               "run"}

   {"OSPFv2"}
   {"SimpleTest"             "ospfv2/simpletest"    "./run"               "run"}
   {"Areas"                  "ospfv2/areas"         "./run"               "run"}
   {"Backbone"               "ospfv2/backbone"      "./run"               "run"}
   {"FullTest"               "ospfv2/fulltest"      "./run"               "run"}
} {
   lappend samples $i
   if {[llength $line]==0} {
       set db($i,type) "spacer"
   } elseif {[llength $line]==1} {
       set db($i,type) "heading"
       set db($i,title) [lindex $line 0]
   } elseif {[llength $line]==2} {
       set db($i,type) "readme"
       set db($i,title) [lindex $line 0]
       set db($i,readme) [lindex $line 1]
       if {$first==""} {set first $i}
   } elseif {[llength $line]==3} {
       set db($i,type) "docu"
       set db($i,title) [lindex $line 0]
       set db($i,readme) [lindex $line 1]
       set db($i,docu) [lindex $line 2]
       if {$first==""} {set first $i}
   } elseif {[llength $line]==4} {
       set db($i,type) "program"
       set db($i,title) [lindex $line 0]
       set db($i,dir)   [lindex $line 1]
       set db($i,uprog) [lindex $line 2]
       set db($i,wprog) [lindex $line 3]
       if {$first==""} {set first $i}
   } else {
       tk_messageBox -title {Error} -type ok -icon error -message "Error in table: wrong #items in {$line}"
       exit
   }
   incr i
}


proc createWindow {} {
    global wantScrollbar samples first db fonts colors

    wm focusmodel . passive
    wm minsize . 1 1
    wm overrideredirect . 0
    wm resizable . 1 1
    wm deiconify .
    wm title . "OMNeT++ Demo Simulations"
    wm protocol . WM_DELETE_WINDOW {exit}
    wm geometry . "650x400"

    #################################
    # Menu bar
    #################################

    menu .menubar
    . config -menu .menubar

    # Create menus
    foreach i {
       {filemenu     -label File -underline 0}
       {helpmenu     -label Help -underline 0}
    } {
       eval .menubar add cascade -menu .menubar.$i
       menu ".menubar.[lindex $i 0]" -tearoff 0
    }

    # File menu
    foreach i {
      {command -command exit -label Exit -underline 1}
    } {
      eval .menubar.filemenu add $i
    }

    # Help menu
    foreach i {
      {command -command helpAbout -label {About OMNeT++} -underline 0}
    } {
      eval .menubar.helpmenu add $i
    }

    #################################
    # Create main display area
    #################################

    frame .sel -bd 2 -relief groove
    frame .main -bd 2 -relief groove
    pack .sel -expand 0 -fill y  -side left -padx 2
    pack .main -expand 1 -fill both  -side right  -padx 2

    frame .main.up
    frame .main.lo
    frame .main.mid
    pack .main.up -expand 0 -fill x  -side top
    pack .main.lo -expand 0 -fill x  -side bottom
    pack .main.mid -expand 1 -fill both -side top

    label .main.up.banner -bg $colors(banner) -relief groove  -font $fonts(bold)
    pack .main.up.banner -fill x -side top

    text .main.mid.text -yscrollcommand ".main.mid.sb set" -width 80 -height 20  -wrap none
    scrollbar .main.mid.sb -command ".main.mid.text yview"
    pack .main.mid.sb -anchor center -expand 0 -fill y  -side right
    pack .main.mid.text -anchor center -expand 1 -fill both -side left

    button .main.lo.start -font $fonts(bold) -bg $colors(startbutton)
    pack .main.lo.start -expand 1 -fill x  -padx 10 -pady 6

    canvas .sel.c -width 200
    pack .sel.c -side left -expand yes -fill both
    if {$wantScrollbar} {
        .sel.c config -yscrollcommand ".sel.s set"
        scrollbar .sel.s -command ".sel.c yview"
        pack .sel.s -side right -fill y
    }
    frame .sel.c.f
    .sel.c create window 0 0 -anchor nw -window .sel.c.f
    set f .sel.c.f

    #label $f.banner -text "Sample simulations:" -bg $colors(banner) -relief groove -font $fonts(bold)
    #pack $f.banner -fill x -side top
    foreach i $samples {
        if {$db($i,type)=="spacer"} {
            frame $f.$i -relief flat
            pack $f.$i -fill x -side top -pady 5
        } elseif {$db($i,type)=="heading"} {
            label $f.$i -text $db($i,title) -bg $colors(banner) -relief groove  -font $fonts(bold)
            pack $f.$i -fill x -side top -padx 5 -pady 5
        } elseif {$db($i,type)=="readme" || $db($i,type)=="docu" || $db($i,type)=="program"} {
            button $f.$i -text $db($i,title) -bd 1 -command "showDemo $i"
            pack $f.$i -fill x -side top -padx 5 -pady 2
        } else {
            tk_messageBox -title {Error} -type ok -icon error -message "internal error: wrong type '$db($i,type)'"
            exit
        }
    }

    update
    .sel.c config -width [winfo width .sel.c.f]
    .sel.c config -scrollregion "0 0 0 [winfo height .sel.c.f]"
    showDemo $first
}

proc helpAbout {} {
    tk_messageBox -title {About} -type ok -icon info -message {Demo simulations for OMNEST/OMNeT++.}
}

proc showDemo {sample} {
   global samples db colors tcl_platform

   set f .sel.c.f
   foreach i $samples {
        if {$db($i,type)=="readme" || $db($i,type)=="docu" || $db($i,type)=="program"} {
            $f.$i config -relief raised -bg $colors(unselbutton)
        }
   }

   $f.$sample config -relief sunken -bg $colors(selbutton)

   if {$db($sample,type)=="readme"} {

       .main.up.banner config -text "$db($sample,title)"
       pack forget .main.lo
       loadFile .main.mid.text $db($sample,readme)

   } elseif {$db($sample,type)=="docu"} {
       .main.up.banner config -text "$db($sample,title)"
       .main.lo.start config -text "Open documentation\n($db($sample,docu))"
       .main.lo.start config -command "openDocu $sample"
       pack forget .main.lo
       pack .main.lo -expand 0 -fill x -side bottom -before .main.mid
       loadFile .main.mid.text $db($sample,readme)

   } elseif {$db($sample,type)=="program"} {

       if {$tcl_platform(platform)=="unix"} {
         set cmd "cd $db($sample,dir); $db($sample,uprog)"
       } else {
         set cmd "cd $db($sample,dir); $db($sample,wprog)"
       }
       .main.up.banner config -text "$db($sample,title) README"
       .main.lo.start config -text "Launch $db($sample,title)\n($cmd)"
       .main.lo.start config -command "runSample $sample"
       pack forget .main.lo
       pack .main.lo -expand 0 -fill x -side bottom -before .main.mid
       loadFile .main.mid.text "$db($sample,dir)/README"

   } else {
       tk_messageBox -title {Error} -type ok -icon error -message "internal error: wrong type '$db($sample,type)'"
       exit
   }
}

proc loadFile {t filename} {
    $t delete 1.0 end

    if [catch {
       # try with ".txt" suffix as well
       if [catch {set f [open $filename r]}] {set f [open "$filename.txt" r]}
       set contents [read $f]
       close $f
    } err] {
       #tk_messageBox -title {OMNeT++ Demo} -type ok -icon error -message "Cannot display README: $err"
       return
    }

    $t insert end $contents
    $t mark set insert 1.0
}

proc runSample {sample} {
    global samples db tcl_platform

    if {$tcl_platform(platform) == "unix"} {
      set prog $db($sample,uprog)
    } else {
      set prog "cmd /c $db($sample,wprog)"
    }

    set pwd [pwd]
    if [catch {
       cd $db($sample,dir)
       #exec $prog &
       #exec [lindex $prog 0] [lindex $prog 1] [lrange $prog 2 end] &
       eval exec $prog &
     } err] {
       tk_messageBox -title {OMNeT++ Demo} -type ok -icon error -message "Error running the simulation program: $err"
    }
    cd $pwd
}

proc openDocu {sample} {
    global samples db tcl_platform unixbrowser

    if [catch {
       if {$tcl_platform(platform) == "windows"} {
           exec cmd.exe /c start $db($sample,docu)
       } else {
           exec $unixbrowser $db($sample,docu) &
       }
     } err] {
       tk_messageBox -title {OMNeT++ Demo} -type ok -icon error -message "Error running the simulation program: $err"
    }
}

#===================================================================
#    GENERIC BINDINGS
#===================================================================

proc generic_bindings {} {
   bind Button <Return> {tkButtonInvoke %W}
}

#===================================================================
#    FONT BINDINGS
#===================================================================

proc font_bindings {} {
   global fonts tcl_platform colors

   set colors(banner)      #e0e0a0
   set colors(unselbutton) #c0c0c0
   set colors(selbutton)   #ffffff
   set colors(startbutton) #e0e0a0

   #
   # fonts() array elements:
   #  normal:  menus, labels etc
   #  bold:    buttons
   #  icon:    toolbar 'icons'
   #  big:     STOP button
   #  msgname: message name during animation
   #  fixed:   text windows and listboxes
   #

   if {$tcl_platform(platform) == "unix"} {
      set fonts(normal) -Adobe-Helvetica-Medium-R-Normal-*-12-*-*-*-*-*-*-*
      set fonts(bold)   -Adobe-Helvetica-Bold-R-Normal-*-12-*-*-*-*-*-*-*
      set fonts(icon)   -Adobe-Times-Bold-I-Normal-*-12-*-*-*-*-*-*-*
      set fonts(big)    -Adobe-Helvetica-Medium-R-Normal-*-18-*-*-*-*-*-*-*
      set fonts(msgname) -Adobe-Helvetica-Medium-R-Normal-*-12-*-*-*-*-*-*-*
      set fonts(fixed)  fixed
      set fonts(balloon) -Adobe-Helvetica-Medium-R-Normal-*-12-*-*-*-*-*-*-*
   } else {
      # Windows, Mac
      set fonts(normal) -Adobe-Helvetica-Medium-R-Normal-*-*-140-*-*-*-*-*-*
      set fonts(bold)   -Adobe-Helvetica-Bold-R-Normal-*-*-140-*-*-*-*-*-*
      set fonts(icon)   -Adobe-Helvetica-Bold-R-Normal-*-*-140-*-*-*-*-*-*
      set fonts(big)    -Adobe-Helvetica-Medium-R-Normal-*-*-180-*-*-*-*-*-*
      set fonts(msgname) -Adobe-Helvetica-Medium-R-Normal-*-*-140-*-*-*-*-*-*
      set fonts(fixed)  FixedSys
      set fonts(balloon) -Adobe-Helvetica-Medium-R-Normal-*-*-140-*-*-*-*-*-*
   }

   if {$tcl_platform(platform) == "unix"} {
       option add *Scrollbar.width  12
       option add *Menubutton.font  $fonts(normal)
       option add *Menu.font        $fonts(normal)
       option add *Label.font       $fonts(normal)
       option add *Entry.font       $fonts(normal)
       option add *Listbox.font     $fonts(fixed)
       option add *Text.font        $fonts(fixed)
       option add *Button.font      $fonts(bold)
   }
}

proc checkVersion {} {

   global tk_version tk_patchLevel

   catch {package require Tk}
   if {$tk_version<8.0} {
      wm deiconify .
      wm title . "Bad news..."
      frame .f
      pack .f -expand 1 -fill both -padx 2 -pady 2
      label .f.l1 -text "Your version of Tcl/Tk is too old!"
      label .f.l2 -text "Tcl/Tk 8.0 or later required."
      button .f.b -text "OK" -command {exit}
      pack .f.l1 .f.l2 -side top -padx 5
      pack .f.b -side top -pady 5
      focus .f.b
      wm protocol . WM_DELETE_WINDOW {exit}
      tkwait variable ok
   }
   if {[string compare $tk_patchLevel "8.0p1"]<0} {
      tk_messageBox -title {Warning} -type ok -icon warning \
        -message {Old Tcl/Tk version. At least 8.0p1 is strongly recommended!}
   }
}

set tk_strictMotif 1
cd [file dirname [info script]]
checkVersion
generic_bindings
font_bindings
createWindow