#!/usr/bin/wish

# intercom.tcl
#
# Copyright (C) DFS Deutsche Flugsicherung (2004, 2005). 
# All Rights Reserved.
# Author: Andre Adrian
#
# Voice-over-IP Intercom Graphical User Interface
#
# Version 0.3.7
# open all UDP sockets before use to fix problem with slow CPUs


# UDP "connection" extension for Tcl/Tk
load /usr/local/lib/libudp1.0.6.so

# ##############################################################
# Begin Belegt [IS_30] und Umleitung [IS_41] Remote Signallisierung

# intercom.tcl to other intercom.tcl Signalling Receive init
proc rsig_recv_init {port} {
  set srv [udp_open $port]
  fconfigure $srv -buffering none -translation binary
  fileevent $srv readable [list ::rsig_recv $srv]
  # puts "Listening on udp port: [fconfigure $srv -myport]"
  return $srv
}

# intercom.tcl to other intercom.tcl Signalling Send init
proc rsig_send_init {host} {
  global rsig_send_sock
  
  set s [udp_open]
  fconfigure $s -remote [list $host 55004]
  set rsig_send_sock($host) $s
}

# intercom.tcl to other intercom.tcl Signalling Send
proc rsig_puts {host str} {
  global rsig_send_sock
  
  puts $rsig_send_sock($host) $str
  flush $rsig_send_sock($host)
}

# intercom.tcl from other intercom.tcl Signalling Receive
proc rsig_recv {sock} {
  global ip2tmap tping
  global t_updown umltgmap myipaddr

  set msg_body [read $sock]
  set msg_header [fconfigure $sock -peer]
  # puts "udp_server: $msg_header: [string length $msg_body] {$msg_body}"
  
  # to partner is first argument in msg_body
  set argv [split $msg_body]
  set ip_to [lindex $argv 1]
  set t_to $ip2tmap($ip_to)
  
  # from partner is taken from msg_header
  set conn [lindex $msg_header 0]
  set ip_from [lindex $conn 0]
  set t_from $ip2tmap($ip_from)
  
  switch [lindex $argv 0] {
    p {rsig_puts $ip_from "q $ip_to"   ;# got application ping
    }
    q {set tping ""   ;# got application ping response (pong)
    }
    c {.$t_from configure -highlightbackground cyan   ;# got call setup
       incr t_updown($t_from)
       .$t_to configure -highlightbackground cyan
       incr t_updown($t_to)
    }
    h {incr t_updown($t_from) -1    ;# got hangup
      if {$t_updown($t_from) <= 0} {
        set t_updown($t_from) 0
        .$t_from configure -highlightbackground "#d9d9d9"
      }
      incr t_updown($t_to) -1
      if {$t_updown($t_to) <= 0} {
        set t_updown($t_to) 0
        .$t_to configure -highlightbackground "#d9d9d9"
      }
    }
    d { # puts "rsig_recv ip_from=$ip_from ip_to=$ip_to"
      set umltgmap($ip_from) $ip_to   ;# got diversion
      # foreach i {1 2 3 4 5 6 7 8} {
      #   puts "umltgmap(10.232.35.$i) = $umltgmap(10.232.35.$i)"
      # }
    }
    default {puts "rsig_recv unknown msg=$msg_body"}
  }
  return
}

# End Belegt [IS_30] und Umleitung [IS_41] Remote Signallisierung

# ##############################################################
# Begin Stoerung Signalisierung [IS_31]

proc checkping {} {
  global tping
  
  #puts "checkping $tping"
  if {$tping != ""} {
    .$tping configure -background red
    .$tping configure -activebackground red
    .$tping configure -highlightbackground red
  }
}
# End Stoerung Signalisierung [IS_31]

# ##############################################################
# Direct Access Button

# View relevant function Arbeiter
proc da_update {t state} {
  switch $state {
  0 { .$t configure -foreground black         ;# nothing
      .$t configure -activeforeground black
      .$t configure -background "#d9d9d9"     ;# button is grey
      .$t configure -activebackground "#d9d9d9"}
  1 { .$t configure -foreground black         ;# transmit
      .$t configure -activeforeground black
      .$t configure -background yellow     
      .$t configure -activebackground yellow}
  2 { .$t configure -foreground black         ;# receive
      .$t configure -activeforeground black
      .$t configure -background magenta      
      .$t configure -activebackground magenta}
  3 { .$t configure -foreground black         ;# full duplex
      .$t configure -activeforeground black
      .$t configure -background green
      .$t configure -activebackground green}
  }
}

# View relevant function Vorarbeiter
proc da_ca_update {t state} {
  global ta_ip ip2tmap
  
  # update DA button
  da_update $t $state
  
  if {[info exists ip2tmap($ta_ip)]} {
    set t_alias $ip2tmap($ta_ip)
  } else {
    set t_alias ""
  }
  
  # Update Common Answer Button
  if { $t_alias == $t } {
    da_update ta $state
  }
}

# DA/CA button press callback
proc da_keyPress {t} {
  global t2ipmap state lsig_sock longKey tping umltgmap ip2tmap
  
  set longKey($t) 0   ;# 1 wenn Taste lange gedrückt, sonst 0  
  set ip $t2ipmap($t) ;# ip des remote intercom.tcl 
  set uip $umltgmap($ip) ;# Umleitung auf gleiche IP oder andere IP

  # avoid two connections to one partner in case of diversion
  if {$ip != $uip} {
    if {$state($t) == 0 || $state($t) == 2} {
      set tumltg $ip2tmap($uip)
      if {$state($tumltg) == 1 || $state($tumltg) == 3} {
        puts "da_keyPress: error: already connection to this partner"
        return
      }
    }
  }

  # remote signalling
  switch $state($t) {
  0 {set cmd c
    after 300 [list set longKey($t) 1]
    rsig_puts $uip "p $uip"  ;# send application ping
    set tping $t
    after 200 [list checkping]}
  1 {set cmd h}
  2 {set cmd c
    after 300 [list set longKey($t) 1]
    rsig_puts $uip "p $uip"  ;# send application ping
    set tping $t
    after 200 [list checkping]}
  3 {set cmd h}
  }

  # local signalling to intercomd - maybe with diversion
  puts $lsig_sock "$cmd $uip"
  flush $lsig_sock
  
  # local signalling intercom.tcl - with no diversion
  switch $cmd {
  c {tx_begin $ip}
  r {rx_begin $ip}
  h {tx_end $ip}
  d {rx_end $ip}
  }
  
# Begin Belegt Signalisierung [IS_30]
  foreach i {t1 t2 t3 t4 t5 t6 t7 t8} {
    set da_ip $t2ipmap($i)
    rsig_puts $da_ip "$cmd $uip"
  }
# End Belegt Signalisierung [IS_30]
}

# DA/CA button release callback
proc da_keyRelease {t} {
  global longKey
  
  if {$longKey($t)} {
    keyPress $t
  }
}

# ##############################################################
# Common Answer Button Req IS_14

proc ca_update {} {
  global ta_ip textmap
  
  # puts "ca_update $ta_ip"

  if {[info exists textmap($ta_ip)]} {
    set ta_text $textmap($ta_ip)
  } else {
    set ta_text $ta_ip
  }
  .ta configure -text $ta_text 
}
  
# ##############################################################
# Diversion (Umleitung) Req. IS_41

# Update Umleitungstaste Req. IS_41
proc umltg_update {} {
  global umltg_state tu_ip ip2tmap
  
  if {[info exists tu_ip]} {
    set told $ip2tmap($tu_ip)
    .$told configure -background "#d9d9d9"
    .$told configure -activebackground "#d9d9d9"
  }
  switch $umltg_state {
    0 { .tu configure -background "#d9d9d9"
        .tu configure -activebackground "#d9d9d9"
        .tu configure -text ""
    }
    1 { .tu configure -background orange
        .tu configure -activebackground orange
    }
  }
}

# Diversion Button callback
proc umltg_keyRelease {} {
  global umltg_state myipaddr t2ipmap

  switch $umltg_state {
    0 {set umltg_state 1}
    1 {set umltg_state 0
      # Diversion release == Diversion to myipaddr
      foreach i {t1 t2 t3 t4 t5 t6 t7 t8} {
        set da_ip $t2ipmap($i)
        rsig_puts $da_ip "d $myipaddr"
      }
    }
  }
  umltg_update
}

# Direct Access Buttons callback
proc umltg_da_keyRelease {t} {
  global t2ipmap textmap tu_ip ip2tmap myipaddr umltg_state
  
  # alten Zustand deaktivieren und updaten
  umltg_update
 
  # Model variable ändern
  set tu_ip $t2ipmap($t)
 
  # neuen Zustand updaten
  .$t configure -background orange
  .$t configure -activebackground orange
  set tu_text $textmap($tu_ip)
  .tu configure -text $tu_text
  
  # Begin Umleitung Signalisierung [IS_41]
  foreach i {t1 t2 t3 t4 t5 t6 t7 t8} {
    set da_ip $t2ipmap($i)
    rsig_puts $da_ip "d $tu_ip"
  }
  # End Umleitung Signalisierung [IS_41]
}

# ##############################################################
# Direct Access / Diversion Buttons Callbacks

proc keyPress {t} {
  global umltg_state
  
  switch $umltg_state {
    0 {da_keyPress $t}
    1 {}
  }
}

proc keyRelease {t} {
  global umltg_state told
  
  switch $umltg_state {
    0 {da_keyRelease $t}
    1 {umltg_da_keyRelease $t}
  }
}

# ##############################################################
# Direct Access model relevant function

proc tx_begin {ip} {
  global ip2tmap state

  set t $ip2tmap($ip)
  #puts "tx_begin $ip $t"
  switch $state($t) {
  0 {set state($t) 1}
  1 { }
  2 {set state($t) 3}
  3 { }
  }
  da_ca_update $t $state($t)
}

proc rx_begin {ip} {
  global ip2tmap state

  set t $ip2tmap($ip)
  #puts "rx_begin $ip $t"
  switch $state($t) {
  0 {set state($t) 2}
  1 {set state($t) 3}
  2 { }
  3 { }
  }
  
  # Answer Button Req IS_14
  global ta_ip
  
  set ta_ip $ip
  ca_update
  
  .ta configure -command [list keyRelease $t]
  bind .ta <ButtonPress-1> [list keyPress $t]
  # End Answer Button Req IS_14
  
  da_ca_update $t $state($t) 
}

proc tx_end {ip} {
  global ip2tmap state

  set t $ip2tmap($ip)
  #puts "tx_end $ip $t"
  switch $state($t) {
  0 {}
  1 {set state($t) 0}
  2 { }
  3 {set state($t) 2}
  }
  da_ca_update $t $state($t)
}

proc rx_end {ip} {
  global ip2tmap state

  set t $ip2tmap($ip)
  #puts "rx_end $ip $t"
  switch $state($t) {
  0 { }
  1 { }
  2 {set state($t) 0}
  3 {set state($t) 1}
  }
  da_ca_update $t $state($t)
}

# ##############################################################
# Local Signalling

# intercom.tcl from own intercomd Signalling Receive
proc lsig_recv {} {
  global lsig_sock
  
  gets $lsig_sock cmd
  # puts "lsig_recv $cmd"
  set argv [split $cmd]
  # puts $argv
  set ip [lindex $argv 1]
  switch [lindex $argv 0] {
    c {tx_begin $ip}
    r {rx_begin $ip}
    h {tx_end $ip}
    d {rx_end $ip}
  }
}

# ##############################################################
# Program exit (abort, close) Handler

proc onDestroy {} {
  global destroyflag lsig_sock rsig_recv_sock
  
  if {$destroyflag == 0} {
    set destroyflag 1
    puts "Terminate intercomd and intercom"
    close $lsig_sock
    close $rsig_recv_sock
    exec /usr/bin/killall -9 /usr/local/bin/intercomd \
      /usr/local/bin/intercomd1
  }
}

# ##############################################################
# Read configuration file - hack just use Tcl/Tk parser

proc guiconfig {t text ip} {
  global state longKey ip2tmap t2ipmap umltgmap
  
  set state($t) 0
  set longKey($t) 0
  
  rsig_send_init $ip
  
  set ip2tmap($ip) $t
  set t2ipmap($t) $ip
  
  set umltgmap($ip) $ip   ;# keine Umleitung
  
  .$t configure -text $text
  .$t configure -command [list keyRelease $t]
  bind .$t <ButtonPress-1> [list keyPress $t]
  
  # Answer Button Req IS_14
  global textmap
  
  set textmap($ip) $text
  
  da_ca_update $t $state($t)
}

# ##############################################################
# Begin main

# init and register programm termination handler
set destroyflag 0
bind . <Destroy> [list onDestroy]

# include GUI
source /usr/local/bin/intercom.ui.tcl
intercom_ui .

# init model
foreach {i} {t1 t2 t3 t4 t5 t6 t7 t8} {
  set t_updown($i) 0
}

# init view
foreach {i} {t1 t2 t3 t4 t5 t6 t7 t8 ta tu} {
  .$i configure -width 5 -height 2 -highlightthickness 12
}

# init Common Answer-Button Req. IS_14
set ta_ip ""

# init and register Diversion Req. IS_41
set umltg_state 0
.tu configure -command [list umltg_keyRelease]

# include configuration
if {[file exists ~/.intercom.conf]} {
  source ~/.intercom.conf
} else {
  file copy /usr/local/bin/intercom.conf ~/.intercom.conf
  puts ""
  puts "Please edit the file ~/.intercom.conf for your Labels and your"
  puts "IP-addresses. Then start intercom again."
  exit
}

# init local signalling to intercomd, a TCP connection
set lsig_sock [socket 127.0.0.1 4999]
fileevent $lsig_sock readable lsig_recv

# init remote signalling to intercom.tcl, an UDP "connection"
set rsig_recv_sock [rsig_recv_init 55004]

# set window title
set nodename [exec uname -n]
wm title . "intercom $nodename"

# hack: get my ip address
set hostsline [exec grep $nodename /etc/hosts]
set myipaddr [lindex [split $hostsline] 0]

# End main
# ##############################################################