#!/bin/sh
# TK interface to iax client library command line interface.
# Copyright 2004 Sun Microsystems, by Stephen Uhler.
# see License for license terms
# This line is a tcl comment (but not a shell comment) \
/usr/bin/wish $0 -- $* & exit 0

# This is my name
set appname "tkiaxphone"
set version "0.2"

# items saved in preferences
set pref_vars "server user pass ext preferred_codec"

# debugging, enable with "debug" environment variable or "-d".

proc debug {{msg ""}} {
    global env
    if {[info exists env(DEBUG)]} {
	puts stderr "[lindex [info level -1] 0]:\t$msg"
    }
}

# Return the real path of a file, relative to us, so we can find our gui.
# This works when the GUI files are in the same directory as us.
# override with the environment variable IAXPHONEHOME

proc real_path {file} {
    global argv0 env
    if {[info exists env(IAXPHONEHOME)]} {
	set base $env(IAXPHONEHOME)
    } else {
	set base [file dirname [file join [pwd] $argv0]]
    }
    debug "$base / $file"
    file join $base $file
}

# find our rc file name for storing preferences.

proc getrcfile {{name ""}} {
    global env tcl_platform
    if {$name == ""} {
	global appname
	set name $appname
    }
    if {$tcl_platform(platform) == "unix"} {
	set fmt ".%src"
    } else {
	set fmt "%s.ini"
    }
    set result [file join $env(HOME) [format $fmt $name]]
    debug $result
    return $result
}

# Make the touch-pad buttons work.

proc do_button {win} {
  global state
  set digit [$win cget -text]
  if {$state == "free"} {
      global number
      append number $digit
  } elseif {[regexp complete $state]} {
      phone_command "t $digit"
      phone_command "p $digit"
      status "sending $digit"
  }
}

# accept a number remotely, and dial it
# use from send

proc make_call {num} {
    global number

    debug $num
    set number $num
    do_send
    wm deiconify .
    raise .
}

# dial the number

proc do_send {} {
    global state number phone prefs

    # no server to connect to, bring up settings panel

    if {$prefs(server) == ""} {
       do_prefs
       status "no server specified"
       return
    }
    if {$state == "free" && $number != ""} {
	if {$prefs(user) != ""} {
	    set prefix "$prefs(user):$prefs(pass)@"
	} else {
	    set prefix ""
	}
	phone_command "dial $prefix$prefs(server)/$number"
	status "dialing $number"
	.phone.hangup configure -text hangup -command "phone_command h"
    } else {
	status "no number to dial"
    }
}

# manage what the "hangup button" does

proc do_hangup {} {
    global number state
    switch -regexp $state {
        active {
	    phone_command "hangup"
	    status hangup
        }
        default {
	    set number ""
        }
    }
}

# set the status line text

proc status {text {max 20}} {
    global status
    set status  [wrap $text $max]
}

# wrap text, try to use word boundaries

proc wrap {text max} {
   set result ""
   set len [string length $text]
   while {$len > $max} {
       set index [string wordstart $text $max]
       if {$index == 0} {
           lappend result [string range $text 0 [expr {$max - 1}]]
           set text [string range $text $max end]
       } else {
           lappend result [string range $text 0 [expr {$index - 1}]]
           set text [string range $text $index end]
       }
       set len [string length $text]
   }
   if {$len > 0} {
       lappend result $text
   }
   return [join $result \n]
}

# initialize the phone interface

proc phone_setup {} {
    global phone env
    catch {close $phone}
    set env(PA_MIN_LATENCY_MSEC) 1	;# minimize audio latency
    set phone [open |[real_path iaxcli] w+]
    fconfigure $phone -buffering line
    fileevent $phone r phone_event
    phone_command "set delim !"
}

# register with the iax server

proc register {} {
    global prefs
    if {[info exists prefs(preferred_codec)]} {
         phone_command "set codec $prefs(preferred_codec)"
    }
    if {[info exists prefs(server)]} {
        phone_command "register $prefs(user) $prefs(pass) $prefs(server)"
	status "registering..."
	if {$prefs(ext) != ""} {
            phone_command "set name $prefs(ext)"
	}
    }
}

# issue a command to the phone interface

proc phone_command {cmd} {
    global phone
    debug $cmd
    puts $phone $cmd
}

# issue command to phone, get response.
# XXX there might be a race condition here as an "Event" could sneak in

proc phone_response {cmd} {
    global phone

    set save_event [fileevent $phone r]
    fileevent $phone r {}
    phone_command $cmd
    while {![regexp {^[?]!(.*)} [set line [gets $phone]] x result]} {
	puts stderr "AARG, lost: ($line)"
    }
    debug ($result)
    fileevent $phone r $save_event
    return $result
}

# handle events from the phone interface

proc phone_event {args} {
    global phone appname
    if {[eof $phone]} {
	fileevent $phone r {}
	wm withdraw .
	tk_dialog .error $appname "lost connection, terminating" error 0 OK
	exit 0
    }
    set line [split [gets $phone] !]
    debug $line
    set cmd [lindex $line 0] 
    switch $cmd {
       T {
           set msg [lindex $line 2]
	   # don't display un-interpreted messages, or "incoming call"s.
	   # The incoming calls are handled in state messages instead
	   if {![regexp {\(type|Incoming call} $msg]} {
	       status $msg
	   }
       }
       S { do_state [lindex $line 2] [lindex $line 3] [lindex $line 4]}
       L { do_level [lindex $line 1] [lindex $line 2] }
       default { debug "unprocessed: $cmd" }
    }
}

# start a visual ringing, then continue to "ring" for a while
# win: the widget to blink

proc start_ringing {win {continue start}} {
    if {$continue == "start"} {
       upvar #0 $win-bg bg $win-fg fg
       set fg [$win cget -fg]
       set bg [$win cget -bg]
       start_ringing $win on
    } elseif {$continue == "on"}  {
       $win configure -fg white -bg black
       after 150 [list start_ringing $win off]
    } elseif {$continue == "off"}  {
       $win configure -fg black -bg red
       after 150 [list start_ringing $win on]
    } elseif {$continue == "stop"} {
       after cancel [list start_ringing $win off]
       after cancel [list start_ringing $win on]
       upvar #0 $win-bg bg $win-fg fg
       catch {
           $win configure -bg $bg -fg $fg
           unset fg bg
       }
    }
}

# stop ringing a window

proc stop_ringing {win} {
    start_ringing $win stop
}

# handle an incoming call

proc ring_on {} {
    debug
    wm deiconify .
    raise .
    start_ringing .phone.status
    .phone.send configure -text answer -command call_answer -state normal
    .phone.hangup configure -text reject -command call_reject -state normal
}

# the user answered the call

proc call_answer {} {
    phone_command answer
    status answered
}

# the user rejected the call

proc call_reject {} {
    phone_command x
    status "Call rejected"
}

# The called party picked up the call

proc ring_answered {} {
    debug
    stop_ringing .phone.status
    .phone.send configure -text send -command "" -state disabled
    .phone.hangup configure -text hangup -command "phone_command h"
}

# The call was terminated

proc call_done {} {
    debug
    stop_ringing .phone.status
   .phone.send configure -text send -command do_send -state normal
   .phone.hangup configure -command do_clear -text clear
}

# the number-to-dial was cleared

proc do_clear {} {
   global number
   set number ""
   stop_ringing .phone.status
}

# process state transitions from the phone interface

proc do_state {new {num ""} {name ""}} {
    global state
    if {$state == $new} return
    set state $new
    debug $state
    switch -glob $state {
        active,ringing {
	    ring_on
	    if {$name != ""} {
	        status "call from $name"
	    } elseif {$num != ""} {
	        status "call from $num"
	    } else {
	        status "Incoming call"
	    }
        }
	active,outgoing,complete -
	active,complete {
	    ring_answered
	}
	*free* {
	    call_done
	}
	* {
	    debug "unimplemented"
	}
    }
}

# manage record/play levels

set last_play ""
set last_record ""
proc do_level {rec_db play_db} {
    global last_play last_record
    if {$last_play==$play_db && $last_record==$rec_db} return

    set last_play $play_db
    set last_record $rec_db

    set p [expr {($play_db + 99.0) / 99.0}]
    place .monitor.play_value -in .monitor.play \
	-anchor sw -bordermode outside -width 5 -relheight $p \
	-y [winfo height .monitor.play]

    set r [expr {($rec_db + 99.0) / 99.0}]
    place .monitor.record_value -in .monitor.record \
	-anchor sw -bordermode outside -width 5 -relheight $r \
	-y [winfo height .monitor.record]
}

proc show_about {} {
    global appname version
    status "$appname version $version"
}

# display the audio control panel, start monitoring

proc show_audio {how} {
    global show_audio	;# checkbutton state
    set show_audio $how
    if {$how} {
        global record play
        grid .monitor -row 0 -column 0
        set record [phone_response "get record"]
        set play [phone_response "get play"]
        phone_command "set monitor on"
	status "showing audio controls"
    } else {
	grid forget .monitor
	phone_command "set monitor off"
	status "audio controls removed"
    }
}

# set audio level

proc set_audio {what value} {
    phone_command "set $what $value"
}

# exit

proc do_quit {} {
    global prefs_saved appname
    if {!$prefs_saved} {
        switch [tk_dialog .warning $appname "Unsaved preferences" \
		question 0 "quit now" "save preferences and quit" "cancel"] {
	    1	{prefs_save}
	    2	{return}
	}
    }
    exit 0
}

# preferences management

# called from preferences menu

proc do_prefs {} {
    global appname
    catch {destroy .prefs}
    toplevel .prefs
    wm title .prefs "$appname settings"
    pref_ui .prefs
}

# reset preferences to previous values

proc pref_cancel {} {
   pref_setup
   status "settings cancelled"
   update idletasks
   after 100
   destroy .prefs
}

# initialize the settings form

proc pref_setup {} {
   global prefs pref_vars
   foreach i $pref_vars {
       upvar #0 input_$i value
       set value $prefs($i)
   }
}

# save settings settings into array

set prefs_saved 1
proc pref_ok {} {
   global prefs	;# preferences array
   global prefs_saved pref_vars
   foreach i $pref_vars {
       upvar #0 input_$i value
       set prefs($i) $value
   }
   if {$prefs(user) != ""} {
       register
   }
   set prefs_saved 0
   destroy .prefs
}

# save the current preferences

proc prefs_save {} {
    global prefs prefs_saved appname
    set name [getrcfile]
    if {[catch {
       set fd [open $name w]
       puts $fd [array get prefs]
       close $fd
       status "settings saved"
    }]} {
       status "ERROR saving settings"
       debug $::errorInfo
       tk_dialog .error $appname "Can't save preferences to $name" error 0 OK
    }
   set prefs_saved 1
}

# load the preferences

proc prefs_load {} {
    global prefs
    if {[catch {
       set fd [open [getrcfile] r]
       array set prefs [read $fd]
       status "settings initialized"
       debug "prefs: [array get prefs]"
       close $fd
    }]} {
       array set prefs { user "" pass "" server "" ext	   "" }
       status "ERROR reading settings"
       debug $::errorInfo
    }
    pref_setup
}

# accept keyboard dialing

array set alphamap {
                   a 2 b 2 c 2   d 3 e 3 f 3
 g 4 h 4 i 4       j 5 k 5 l 5   m 6 n 6 o 6
 p 7 q 7 r 7 s 7   t 8 u 8 v 8   w 9 x 9 y 9 z 9
}

proc map_key {code} {
    global alphamap number

    switch -regexp [string tolower $code] {
       {^[a-z]$}	{append number $alphamap($code)}
       {^[0-9]$}	{append number $code}
       {delete}	-
       {backspace}	{set number [string range $number 0 \
			   [expr { [string length $number] - 2} ]]}
       {return}		{do_send}
       default	{status "invalid key: $code"}
    }
}

# initialization

if {[lsearch -glob $argv -d*] >= 0} {
    set env(DEBUG) on
}

prefs_load
wm title . $appname
tk appname $appname
catch "destroy .phone .monitor .menubar"

menu .menubar
menu .menubar.file -tearoff 0
.menubar add cascade -label "File" -menu .menubar.file -underline 0
.menubar.file add command -label "Save prefs" -command prefs_save
.menubar.file add command -label Quit -command do_quit

menu .menubar.edit -tearoff 0
.menubar add cascade -label "Edit" -menu .menubar.edit -underline 0
.menubar.edit add command -label settings... -command do_prefs
.menubar.edit add checkbutton -label "show audio controls" \
	-command {show_audio $show_audio} -variable show_audio 

menu .menubar.help -tearoff 0
.menubar add cascade -label "Help" -menu .menubar.help -underline 0
.menubar.help add command -label About -command show_about

. configure -menu .menubar

frame .phone
grid .phone -column 1 -row 0
source [real_path phone.ui.tcl]
source [real_path pref.ui.tcl]
phone_ui .phone

# setup audio control

source [real_path monitor.ui.tcl]
frame .monitor -border 2 -relief groove
monitor_ui .monitor
frame .monitor.play_value -bg green
frame .monitor.record_value -bg red
.monitor.dismiss_audio configure -command "show_audio 0"
.monitor.record configure -command "set_audio record"
.monitor.play configure -command "set_audio play"

# allow kbd input anywhere on the main panel

bind . <Key> {map_key %K} ;# enable keyboard dialing
bindtags .phone.entry {all}
raise .

set number ""
set state free

# set keypad bindings

foreach i {0 1 2 3 4 5 6 7 8 9 0 sharp star} {
 .phone.b$i configure -bg white -fg black -command "do_button .phone.b$i"
}

call_done
phone_setup
register
