#!/bin/sh
# the next line restarts using wish (on cygwin, use wish84 or the like) \
WISH="wish"; if [ -f ~/.wishname ]; then WISH=`cat ~/.wishname`; fi; exec $WISH "$0" "$@"

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

#--------------------------------------------------------------
#  Copyright (C) 1992-2015 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 "netscape"
#set unixbrowser "mozilla"
#set unixbrowser "konqueror"

array set colors {
   color1 #c1b59d
   color2 #e85b13
   color3 #c4c4cc
   color4 #4cb28a
   color5 #d0b48f
   color6 #80a3a7
   color7 #ABC4D8
   color8 #948ca6
   color9 #e99b04
   colorA #e1e0d8
   colorB #748e16
}

#
# title line:   {"color" "title"}
# program line: {"color" "name" "directory" "unix-command" "windows-command"}
# readme line:  {"color" "name" "readme-file"}
# docu line:    {"color" "name" "readme-file"  "html-file"}
# separator:    {}
#
set i 0
set first ""
foreach line {
   {color1  "About..."         "README"}
   {color2  "Tictoc"           "tictoc"           "./tictoc"        "tictoc"}
   {color3  "NedDemo"          "neddemo"          "./neddemo"       "neddemo"}
   {color3  "Histograms"       "histograms"       "./histograms"    "histograms"}
   {color4  "Fifo"             "fifo"             "./fifo"          "fifo"}
   {color4  "CQN"              "cqn"              "./cqn"           "cqn"}
   {color4  "QueueNet"         "queuenet"         "./queuenet"      "queuenet"}
   {color4  "QueueingLibExt"   "queueinglibext"   "./queueing"      "queueing"}
   {color5  "Aloha"            "aloha"            "./aloha"         "aloha"}
   {color5  "Dyna"             "dyna"             "./dyna"          "dyna"}
   {color5  "Hypercube"        "hypercube"        "./hypercube"     "hypercube"}
   {color5  "Routing"          "routing"          "./routing"       "routing"}
   {color6  "Canvas"           "canvas"           "./canvas"        "canvas"}
   {color6  "OpenSceneGraph Intro"       "osg-intro"      "./osg-intro"       "osg-intro"}
   {color6  "OpenSceneGraph Earth"       "osg-earth"      "./osg-earth"       "osg-earth"}
   {color6  "OpenSceneGraph Indoor"      "osg-indoor"     "./osg-indoor"      "osg-indoor"}
   {color6  "OpenSceneGraph Satellites"  "osg-satellites" "./osg-satellites"  "osg-satellites"}
   {color7  "CQN/ParSim"       "cqn/parsim"       "./runparsim"     "runparsim"}
   {color7  "Routing/Parsim"   "routing/parsim"   "./runparsim -c Net60-parsim" "runparsim -c Net60-parsim"}
   {color7  "Dyna/RealTime"    "dyna/realtime"    "./run"           "run"}
   {color7  "Sockets/HTTP"     "sockets"          "./sockets -c HTTPExample"    "sockets -c HTTPExample"}
   {color7  "Sockets/Telnet"   "sockets"          "./sockets -c TelnetExample"  "sockets -c TelnetExample"}
   {color8  "Embedding"        "embedding"        "./embedding"     "embedding"}
   {color8  "Embedding2"       "embedding2"       "./embedding2"    "embedding2"}
} {
   lappend samples $i
   if {[llength $line]==0} {
       set db($i,type) "spacer"
   } elseif {[llength $line]==2} {
       set db($i,type) "heading"
       set db($i,color) $colors([lindex $line 0])
       set db($i,title) [lindex $line 1]
   } elseif {[llength $line]==3} {
       set db($i,type) "readme"
       set db($i,color) $colors([lindex $line 0])
       set db($i,title) [lindex $line 1]
       set db($i,readme) [lindex $line 2]
       if {$first==""} {set first $i}
   } elseif {[llength $line]==4} {
       set db($i,type) "docu"
       set db($i,color) $colors([lindex $line 0])
       set db($i,title) [lindex $line 1]
       set db($i,readme) [lindex $line 2]
       set db($i,docu) [lindex $line 3]
       if {$first==""} {set first $i}
   } elseif {[llength $line]==5} {
       set db($i,type) "program"
       set db($i,color) $colors([lindex $line 0])
       set db($i,title) [lindex $line 1]
       set db($i,dir)   [lindex $line 2]
       set db($i,uprog) [lindex $line 3]
       set db($i,wprog) [lindex $line 4]
       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 colors tcl_platform

    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}

    #################################
    # 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 BoldFont
    pack .main.up.banner -fill x -side top

    text .main.mid.text -yscrollcommand ".main.mid.sb set" -width 82 -height 25 -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 BoldFont -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

    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 BoldFont
            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"
            if {$db($i,color)!=""} {$f.$i config -bg $db($i,color)}
            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

    # prevent window from changing size when a demo is selected
    wm geometry . "[winfo width .]x[winfo height .]"
}

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.$i config -relief raised
        }
   }

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

   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) == "windows"} {
      set prog $db($sample,wprog)
      regsub -- {\\} $prog {\\\\} prog
      # run the program, possibly without getting a console window pop up
      # with the funky line below, we only get a minimized one while the program runs...
      set prog "cmd.exe /c start /min cmd.exe /c $prog"
   } else {
      set prog $db($sample,uprog)
   }

   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 tcl_platform colors

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

   # set up fonts
   if {[string equal [tk windowingsystem] win32]} {
      # Windows
      set normalfamily [getFirstAvailableFontFamily {"Segoe UI" "MS Sans Serif" "Arial"} unknown]
      set monofamily [getFirstAvailableFontFamily {"DejaVu Sans Mono" "Courier New" "Consolas" "Terminal"} unknown]
      set size 9
      if {$normalfamily == "Segoe UI"} {set size 9}  ;# text in this font appears to be smaller than in MS Sans Serif or Arial
   } elseif {[string equal [tk windowingsystem] aqua]} {
      # Mac
      set normalfamily [getFirstAvailableFontFamily {"Lucida Grande" Helvetica} unknown]
      set monofamily [getFirstAvailableFontFamily {"Monaco" "Courier"} unknown]
      set size 13
   } else {
      # Linux and other systems
      set normalfamily [getFirstAvailableFontFamily {Ubuntu Arial Verdana Helvetica Tahoma "DejaVu Sans" "Nimbus Sans L" FreeSans Sans} unknown]
      set monofamily [getFirstAvailableFontFamily {"Ubuntu Mono" "DejaVu Sans Mono" "Courier New" "FreeMono" "Courier"} unknown]
      if {[tk scaling] > 1.5} {set size 11} else {set size 9}
   }

   font configure TkDefaultFont -family $normalfamily -size $size
   font configure TkFixedFont -family $monofamily -size $size
   font create BoldFont -family $normalfamily -size $size -weight 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!}
   }
}

proc getFirstAvailableFontFamily {preferencelist defaultvalue} {
    set families [font families]
    foreach family $preferencelist {
        set index [lsearch $families $family]
        if {$index != -1} {
            return [lindex $families $index]
        }
    }
    return $defaultvalue
}

cd [file dirname [info script]]
checkVersion
generic_bindings
font_bindings
createWindow