#!/usr/bin/wish8.0
#############################################################################
# Visual Tcl v1.20 Project
#

#################################
# GLOBAL VARIABLES
#
global Bulle; 
global DialupRetrieval; 
global FaxReception; 
global Standalone; 
global VoiceReception; 
global device; 
global gui; 
global stat; 
global widget; 
    set widget(ModemMenu) {.top17.cpd21.03.04}
    set widget(faxnumlabel) {.top17.fra29.lab35}
    set widget(memcanvas) {.top17.fra29.can18}
    set widget(radio4rings) {.top17.cpd21.03.04.men36}
    set widget(rev,.top17.cpd21.03.04) {ModemMenu}
    set widget(rev,.top17.cpd21.03.04.men36) {radio4rings}
    set widget(rev,.top17.fra22.but23) {stopbutton}
    set widget(rev,.top17.fra22.but28) {playbutton}
    set widget(rev,.top17.fra24.tex25) {text}
    set widget(rev,.top17.fra29.can18) {memcanvas}
    set widget(rev,.top17.fra29.lab33) {voicenumlabel}
    set widget(rev,.top17.fra29.lab35) {faxnumlabel}
    set widget(stopbutton) {.top17.fra22.but23}
    set widget(text) {.top17.fra24.tex25}
    set widget(voicenumlabel) {.top17.fra29.lab33}

#################################
# USER DEFINED PROCEDURES
#
proc init {argc argv} {
#
# TkUsr v0.50
#
# Copyright (C) 1998-2000 Ludovic Drolez (ldrolez@usa.net)
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.       
#
# todo: 
# button to update the list
# stop the building of stats with one click (for the impatient)
# speed up the start-up
# full support of all features: ...
# upload of messages
# support for a few more options
# Built-in G3 decoding in Tcl ? (Fast enough ?)
# Built-in GSM decoding in Tcl ? (maybe on a K9 16GHz ?)
#
    global device stat gui

    set device(device) /dev/modem
    set device(buffer) {}
    set device(data) 0
    set device(dev) ""
    set device(lastreset) 0
    set device(auto) 0
    set device(binary) 0
    set device(test) 0
    set device(lastvaliddate) [clock seconds]
    # AT command to go to Self Mode
    set device(MCS) "+MCS"
    
    set stat(0) ""

    set gui(version) 0.50
    set gui(textback) lightgrey
    set gui(textfore) #A2FFAC

    # variables which contain balloon help
    set gui(mem.balloon) ""
    set gui(voice.balloon) ""
    set gui(fax.balloon) ""
     
    set gui(play.img) {
	R0lGODlhDQAPAMIAAJSVlAAAAAD/Ff///////////////////yH+Dk1hZGUg
	d2l0aCBHSU1QACH5BAEKAAQALAAAAAANAA8AAAMuCLrUTiBICV6LIuf6sN5d
	8GkcJI6giZLqmg3eOrToTH/2/YZjfp07C2BAJFoaCQA7
    }
    set gui(stop.img) {
	R0lGODlhDQAPAMIAAJSVlAAAAI6Ojv////8AAP///////////yH+Dk1hZGUg
	d2l0aCBHSU1QACH5BAEKAAcALAAAAAANAA8AAAMoCLrM8TCKAQK5GM+a+7ad
	RoEh8ZXXiaolG7reiJryOgp4rlND7/+9BAA7
    }  
    set gui(newmess.img) {
	R0lGODlhCQAHAMIAAMXCxQCCAIOBgwD/AAA0Of///////////yH+Dk1hZGUg
	d2l0aCBHSU1QACH5BAEKAAcALAAAAAAJAAcAAAMWeBon+mGQBssI08VxMY2B
	5yzio2RPAgA7
    }
    set gui(oldmess.img) {
	R0lGODlhCQAHAMIAAMXCxQCCAIOBgwD/AAA0Of///////////yH5BAEKAAcA                    
	LAAAAAAJAAcAAAMWeCrHuoC0JwoQkgnABZ6bl1Gf84xKAgA7
    }
    image create photo play -data $gui(play.img)
    image create photo stop -data $gui(stop.img)
    image create photo newmess -data $gui(newmess.img)
    image create photo oldmess -data $gui(oldmess.img)

    # balloon bindings
    bind Bulle <Enter> {
	set mess $Bulle(%W)
	if {[string index $mess 0] == "&"} {
	    upvar #0 [string range $mess 1 end] var
	    set mess $var
	}
    
        set Bulle(set) 0
	set Bulle(first) 1
	set Bulle(id) [after 200 {balloon %W $mess %X %Y}]
    }

    bind Bulle <Button> {
	set Bulle(first) 0
	kill_balloon
    }

    bind Bulle <Leave> {
	set Bulle(first) 0
	kill_balloon
    }

    bind Bulle <Motion> {
	if {$Bulle(set) == 0} {
	    set mess $Bulle(%W)
	    if {[string index $mess 0] == "&"} {
		upvar #0 [string range $mess 1 end] var
		set mess $var
	    }
    	    after cancel $Bulle(id)
    	    set Bulle(id) [after 200 {balloon %W $mess %X %Y}]
	}
    }
}

init $argc $argv

proc {ByteUnstuff} {data array} {
#
# Unescape DLE (0x10) codes from data:
#   DLE DLE => DLE
#   DLE SUB(0x1A) => DLE DLE
#   DLE ETX(0x03) = end of page, the data is put in another hash
# 
# I: data: data to decode
# O: array: contains one or more pages of data (array(1), array(2)...)
# R: number of pages 
#
    upvar $array adata

    set numpage 1
    set out ""
    while 1 {
	set id [string first "\x10" $data]
	if {$id == -1} break
	append out [string range $data 0 [expr $id - 1]]
	set nextchar [string index $data [expr $id+1]]
	set data [string range $data [expr $id+2] end]
	switch $nextchar {
	    "\x10" { append out \x10 }
	    "\x1A" { append out \x10\x10 }
	    "\x03" { set adata($numpage) $out
		    set out ""
		    incr numpage
	    ;# end of page }	    
	    default { append out \x10$nextchar }
	}
    }
	# no eop found
	#if {$numpage == "1"} {
	#	set adata(1) $out$data
	#    }

	set adata($numpage) $out$data
	return $numpage
}

proc {ClearModem} {} {
#
# clear modem's memory
#
    global env widget
    
    # clear messages
    SendGetOK "AT+MEM\r"
    # reset the modem clock
    ModemClockReset
    # clear the text widget
    $widget(text) delete 0.0 end
}

proc {CloseModem} {} {
#
# save modem settings
#
    global device
    # save setings
    if {$device(faxreception.changed)} {
	SendGetOK "AT+MCF=$device(faxreception)\r"	    
    }
    if {$device(voicereception.changed)} {
	SendGetOK "AT+MCV=$device(voicereception)\r"	    
    }
    if {$device(dialupretrieval.changed)} {
	SendGetOK "AT+MCD=$device(dialupretrieval)\r"	    
    }
    if {$device(retrievalpassword.changed)} {
	SendGetOK "AT+MCP=$device(retrievalpassword)\r"	    
    }
    SendGetOK "AT+MCR=$device(rings)\r"	    
    SendGetOK "AT$device(MCS)=$device(auto)\r"
    # 
    if {$device(clockwasreset)} {
	ModemClockReset
    }
}

proc {DateFormat} {d h m} {
#
# 
#    
    global device
    
    if {($d != 255) && ($device(lastreset) != 0)} {
	set cl [clock scan "$d day $h hour $m minute" -base $device(lastreset)]
	# try to detect if the modem has been reset
	if {$cl > $device(lastvaliddate)} {
	    set device(lastvaliddate) 0
	    return "(invalid date)"
	}
	if {$cl <= [clock seconds]} {
	    set device(lastvaliddate) $cl
	    return [clock format $cl -format "%a %b %d %H:%M"]
	}
    } else {
	return "(unknown date)"
    }
}

proc {Debug} {debuglevel string} {
global gui
    
    if {$gui(debug) >= $debuglevel} {
	puts $string
    }
}

proc {DebugSetLevel} {level} {
global gui

    set gui(debug) $level
}

proc {GetFax} {number} {
#
# retreive a fax in g3 format
#
    global device stat

    # is it really a fax ?
    if {![info exists stat($number.type)]} {
	return
    }
    if {$stat($number.type) != 1} {
	return
    }
   
    
    set startpage $stat($number.page) 
    # download the 1st page
    set d [GetMemPage $startpage]
    set addr [expr $stat($number.hi)*256 + $stat($number.lo) + 2]

    set header [string range $d $addr [expr $addr+34]]
    set data [string range $d [expr $addr+34] end]
    # extract the data from the header
    binary scan $header cccccccca20cScS h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr
    set h_naddr [expr ($h_naddr + 0x10000) % 0x10000]
    set h_paddr [expr ($h_paddr + 0x10000) % 0x10000]
    foreach v {h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr} {
	Debug 2 "header $v: [set $v]"
    }

    # one or more pages ?
    if {$startpage == $h_npage} {
	# only one page
	set data [string range $data 0 [expr $h_naddr - 1]]
    } else {
	# get the following pages
	incr startpage
	while {$startpage <= $h_npage} {
	    set d [GetMemPage $startpage]
	    # remove the checksum
	    if {$h_npage == $startpage} {
		set end [expr $h_naddr - 1]
	    } else {
		set end end
	    }
	    append data [string range $d 2 $end]
	    incr startpage
	}
    }

    set pages(0) ""
    # decode the data and split into pages
    set num [ByteUnstuff $data pages]
    # do we have 1 page or more ?
    if {$stat($number.length) > 1} {
	set ext .1.g3
    } else {
	set ext .g3
    }
    # get the file name
    set name [tk_getSaveFile -defaultextension g3 -initialfile "fax$number$ext"]
    if {$name != ""} {
	# save one or more pages
	for {set i 1} {$i <= $stat($number.length)} {incr i} {
	    regsub "\.1\.g3" $name ".$i.g3" name
	    if {[catch {open $name w} f]} {
		Debug 0 $f
	    } else {
		catch { puts -nonewline $f $pages($i) }
		close $f  
	    }
	}
    }
}

proc {GetLineOK} {} {
#
# get data until the next 'OK' or 'ERROR'
#
    global device
    
    set result {}
    set last ""
    set dlast $device(data)
    while {[string first "OK" $last] && [string first "ERROR" $last]== -1} {
	if {[llength $device(buffer)] == 0} {
	    tkwait variable device(data)
	    set device(data) 0
	}
	set last [lindex $device(buffer) 0]
	set device(buffer) [lrange $device(buffer) 1 1000]
	if {$last != ""} {
	    lappend result $last
	}
	if {$last != ""} {
	    Debug 2 "$dlast>$last"
	}
    }
    return $result
}

proc {GetMemPage} {page} {
#
# get a memory page and cache it for fast retrieving
#
    global device

    set device(d) ""
    if {[info exists device(cache.$page)]} {
	return $device(cache.$page)
    }
    # download a page
    set device(binary) 1
    fconfigure $device(dev) -translation binary
    # get the page
    set device(data) 0
    Send "AT+MTP=$page\r"
    # wait for data 
    tkwait variable device(data)
    set device(buffer) ""
    # cache the page
    set device(cache.$page) $device(d)
    # cancel binary mode
    fconfigure $device(dev) -translation auto
    set device(binary) 0
    
    return $device(d)
}

proc {GetMess} {number} {
#
# retreive and save a message in GSM format
#
    global device stat

    # is it really a message ?
    if {![info exists stat($number.type)]} {
	return
    }
    if {$stat($number.type) != 2} {
	return
    }
    
    set startpage $stat($number.page) 
    # download the 1st page
    set d [GetMemPage $startpage]
    set addr [expr $stat($number.hi)*256 + $stat($number.lo) + 2]

    set header [string range $d $addr [expr $addr+34]]
    set data [string range $d [expr $addr+34] end]
    # extract the data from the header
    binary scan $header cccccccca20cScS h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr

    set h_naddr [expr ($h_naddr + 0x10000) % 0x10000]
    set h_paddr [expr ($h_paddr + 0x10000) % 0x10000]
    foreach v {h_idx h_type h_info h_attr h_stat h_day h_hour h_min h_faxid h_ppage h_paddr h_npage h_naddr} {
	Debug 2 "header $v: [set $v]"
    }
    # one or more pages ?
    if {$startpage == $h_npage} {
	# only one page
	set data [string range $data 0 [expr $h_naddr - 1]]
    } else {
	# get the following pages
	incr startpage
	while {$startpage <= $h_npage} {
	    set d [GetMemPage $startpage]
	    # remove the checksum
	    if {$h_npage == $startpage} {
		set end [expr $h_naddr - 1]
	    } else {
		set end end
	    }
	    append data [string range $d 2 $end]
	    Debug 2 "datalen:[string length $data]" 
	    incr startpage
	}
    }

    # unstuff data, $num should always be 1
    set pages(0) ""
    set num [ByteUnstuff $data pages]
    # write the file
    set name [tk_getSaveFile -defaultextension .gsm -initialfile "message$number.gsm"]
    if {$name != ""} {
	set f [open $name w]
	puts -nonewline $f $pages(1)
	close $f  
    }
}

proc {GetModemStats} {num} {
#
#
#
    return [split [lindex [SendGetOK "AT+MSR=$num\r"] 0] , ]
}

proc {InitDevice} {dev} {
#
# open the device file and set callbacks
#
    global device
    
    set device(dev) [open $dev {RDWR}]
    fconfigure $device(dev) -mode 38400,n,8,1 -buffering none -translation auto
    fileevent $device(dev) readable {Reader}
    set device(data) 0
}

proc {ModemClockReset} {} {
#
# Reset the modem's clock and save the current time to ~/.tkusrrc
#
    global env

    SendGetOK "AT+MCC\r"
    set sec [clock seconds]
    exec echo $sec > $env(HOME)/.tkusrrc
}

proc {ModemGetClock} {} {
#
# get the value of the modem's internal clock
#
    global device

    set clk [split [lindex [SendGetOK "AT+MCC?\r"] 0] ,]
    set d [ToDec [lindex $clk 0]]
    set h [ToDec [lindex $clk 1]]
    set m [ToDec [lindex $clk 2]]
    set s [ToDec [lindex $clk 3]]
    if {$d == 255} {
	set device(clockwasreset) 1 
	set device(clock) 0 
    } else {
	set device(clockwasreset) 0
	set device(clock) [expr $d*3600*24 + $h*3600 + $m*60 + $s]      
    }
}

proc {OpenModem} {} {
#
# initialise the modem and get settings 
#
    global device Standalone FaxReception VoiceReception DialupRetrieval
    
    SendGetOK "ATE0\r"
    # query the modem type
    set type [lindex [SendGetOK "ATI3\r"] 0]
    if {[regexp -nocase pro $type]} {
	# professional message modem
	set device(MCS) "+MCA"
    }
    # check if the modem is in SM
    set device(auto) [lindex [SendGetOK "AT$device(MCS)?\r"] 0]
    set Standalone $device(auto) 
    # Go to SM
    SendGetOK "AT$device(MCS)=1\r"
    # show global stats
    UIUpdateGlobalStat
    # number of rings before reply
    set device(rings) [lindex [SendGetOK "AT+MCR?\r"] 0]
    # 
    set device(dialupretrieval) [lindex [SendGetOK "AT+MCD?\r"] 0]
    set device(dialupretrieval.changed) 0
    set DialupRetrieval $device(dialupretrieval) 
    set device(faxreception) [lindex [SendGetOK "AT+MCF?\r"] 0]
    set device(faxreception.changed) 0
    set FaxReception $device(faxreception) 
    set device(voicereception) [lindex [SendGetOK "AT+MCV?\r"] 0]
    set device(voicereception.changed) 0
    set VoiceReception $device(voicereception)
    set device(retrievalpassword) [lindex [SendGetOK "AT+MCP?\r"] 0]
    set device(retrievalpassword.changed) 0

    #SendGetOK "AT+MCL?\r"
    #SendGetOK "AT+MCM?\r"
    #SendGetOK "AT+MCP?\r"
    #SendGetOK "AT+MFI?\r"
   
    # clock query
    ModemGetClock
}

proc {PlayMess} {num} {
#
# play a voice message
#
    global widget gui stat

    # is it really a message ?
    if {![info exists stat($num.type)] && ($num != 0) && ($num != 255)} {
	return
    }
    if {$stat($num.type) != 2} {
	return
    }
    Send "AT+MVP=$num\r"
    set gui(status) Playing
    $widget(stopbutton) configure -state normal
    GetLineOK
    $widget(stopbutton) configure -state disabled
    set gui(status) ""
}

proc {Popup} {num x y} {
#
# contextual popup menu (on right click)
#
    global stat

    if {![info exists stat($num.type)]} {
	return
    } 

    catch { destroy .popup }
    menu .popup -tearoff 0

    
    switch $stat($num.type) {
	1 {
	    .popup add command -label "Save Fax" -command "GetFax $num"
	    .popup add command -label "Info (not yet)" -command {}
	}
	2 {
	    .popup add command -label "Play Message" -command "PlayMess $num"  
	    .popup add command -label "Save Message" -command "GetMess $num"
	    .popup add command -label "Info (not yet)" -command {}
	}
    }
    # build the menu
    tk_popup .popup $x $y
}

proc {ProgressBind} {canvas variable} {
#
#
#
    global gui
    trace variable $variable w "ProgressUpdate"
    set gui($variable.canvas) $canvas
    $canvas create rect 0 0 0 0 -fill #80FF80 -outline #80FF80 -width 0 -tags bar
    set h [$canvas cget -height] 
    set w [$canvas cget -width] 
    $canvas create text [expr $w/2+2] [expr $h/2+2] -text "" -fill black -tags text
}

proc {ProgressUpdate} {var index op} {
#
#
#
    global gui

    # 
    set el "${var}($index).canvas"
    set canvas $gui($el)
    set h [$canvas cget -height] 
    set w [$canvas cget -width] 
    set value $gui($index)
    $canvas coords bar 2 2 [expr (($value*($w))/100)+2] [expr $h+2]
    $canvas itemconfigure text -text "$value %"
}

proc {Quit} {} {
# Quit the app 
    CloseModem
    exit 0
}

proc {Reader} {} {
#
# the device's file event
#
    global device
    
    # are we in binary mode ?
    if {$device(binary)} {
	set ch [read $device(dev) 2]
	append device(d) $ch
	set l [string length $device(d)]
	if {[string range $device(d) [expr $l-6] end] == "\x0d\x0aOK\x0d\x0a"} {
	    set device(d) [string range $device(d) 0 [expr $l-7]]
	    incr device(data)
	}
    } else {
	gets $device(dev) line
	lappend device(buffer) $line
	incr device(data)
    }
}

proc {Send} {str} {
#
# send a simple string to the modem
#
    global device
    
    Debug 2 "<$str"
    puts $device(dev) $str
}

proc {SendGetOK} {str} {
#
# send a simple string to the modem and wait for a response
#
    global device
    
    Debug 2 "<$str"
    puts $device(dev) $str
    return [ GetLineOK ]
}

proc {ToDec} {str} {
#
# remove the heading '0' 
# to avoid the automatic octal to decimal conversion by Tcl
#
    set result ""
    if {[string index $str 0] == " "} {
	set result [string trim $str]
    } else {
	scan $str %d result
    }
    return $result
}

proc {UISetPassword} {} {
#
# show the UI to set modem's retrieval password
#
    Window show .top18
}

proc {UIUpdateGlobalStat} {} {
global device gui

    if $device(test) return
    
    set stat0 [GetModemStats 0]

    set device(mem) [ToDec [lindex $stat0 1]]
    set device(numvoice) [ToDec [lindex $stat0 2]]
    set device(numvoiceu) [ToDec [lindex $stat0 3]]
    set device(numfax) [ToDec [lindex $stat0 4]]
    set device(numfaxu) [ToDec [lindex $stat0 5]]
    # update global stats
    set gui(mem) [expr 100-$device(mem)]
    set gui(mem.balloon) "Free memory: $gui(mem) %"
    set gui(voice) "$device(numvoice)"
    set gui(voice.balloon) "Stored voice messages: $gui(voice)
Unreleased voice messages $device(numvoiceu)"
    set gui(fax) "$device(numfax)"
    set gui(fax.balloon) "Stored fax messages: $gui(fax)
Unreleased fax messages $device(numfaxu)"
}

proc {UIUpdateStat} {} {
#
# update the text widget
#
    global device stat gui widget

    $widget(text) tag configure back0 -background $gui(textback)
    $widget(text) tag configure back1 -background $gui(textfore)
    $widget(text) tag configure foo -tabs "1.2c center 2.7c numeric 5c left 11.5c left 12.5c left"

    for {set i [expr $device(numvoice) + $device(numfax)]} {$i >= 1} {incr i -1} {
	set line ""

	set st [GetModemStats $i]
	set mess [ToDec [lindex $st 0]]
	set type [ToDec [lindex $st 1]]
	if {$mess == ""} {
	    # problem => let's skip
	    continue
	}
	switch $type {
	    1	{set type fax}
	    2	{set type voice}
	    3	{set type data}
	    default	{set type unkown}
	}
	set sec  [ToDec [lindex $st 2]]
	set attr [ToDec [lindex $st 3]]
	set stats [ToDec [lindex $st 4]]
	if {$stats == 98} {
	    set stats OK
	}
	set days  [ToDec [lindex $st 5]]		
	set hour [ToDec [lindex $st 6]]
	set min  [ToDec [lindex $st 7]]
	set callid  [string trim [lindex $st 8]]
	
	# save all these stats in an array
	set t [list num type sec attr status day hour min callid page hi lo checksum]
	set j 0
	foreach s $st {
	    set stat($i.[lindex $t $j]) [ToDec $s]  
	    incr j
	}

	append line "$mess\t$type"
	if {$type == "voice"} {
	    append line "\t$sec sec "
	} else {
	    append line "\t$sec pages from '$callid'"
	}
        append line "\tat [DateFormat $days $hour $min]"
	switch -- $attr {
	    255 {
		set img newmess
	    }
	    252 -
	    253 {
		set img oldmess 
	    }
	}
	append line "\t \n"
	$widget(text) insert 1.0 $line  [list back[expr $mess%2] foo]
	$widget(text) image create 1.[expr [string length $line]-1] -image $img
	$widget(text) insert 1.[string length $line] "\tstat:$stats"  [list back[expr $mess%2] foo]
	 
	#if {$i == 2} break
    }
    # add mouse bindings to the text widget
    bind $widget(text) <Button-1> { PlayMess [expr int([lindex [$widget(text) dump -mark current] 2])] } 
    bind $widget(text) <Button-3> { Popup [expr int([lindex [$widget(text) dump -mark current] 2])] %X %Y }
}

proc {balloon} {target message {cx 0} {cy 0}} {
##############################################################################
# balloon.tcl - procedures used by balloon help
#
# Copyright (C) 1996-1997 Stewart Allen
# 
# This is part of vtcl source code
# Adapted for general purpose by 
# Daniel Roche <dan@lectra.com>
# version 1.1 ( Dec 02 1998 ) 
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

##############################################################################
#
global Bulle
    
    if {$Bulle(first) == 1 } {
        set Bulle(first) 2
	if { $cx == 0 && $cy == 0 } {
	    set x [expr [winfo rootx $target] + ([winfo width $target]/2)]
	    set y [expr [winfo rooty $target] + [winfo height $target] + 4]
	} else {
	    set x [expr $cx + 4]
	    set y [expr $cy + 4]
	}
        toplevel .balloon -bg black
        wm overrideredirect .balloon 1
        label .balloon.l  -text $message -relief flat  -bg #ffffaa -fg black -padx 2 -pady 0 -anchor w
        pack .balloon.l -side left -padx 1 -pady 1
        wm geometry .balloon +${x}+${y}
        set Bulle(set) 1
    }
}

proc {kill_balloon} {} {
global Bulle
    after cancel $Bulle(id)
    if {[winfo exists .balloon] == 1} {
        destroy .balloon
    }
    set Bulle(set) 0
}

proc {set_balloon} {target message} {
global Bulle
    set Bulle($target) $message
    bindtags $target "[bindtags $target] Bulle"
}

proc {main} {argc argv} {
#
# main proc
#
    global device gui widget env uimem

    # set the debug level (0-2)
    DebugSetLevel 2
    # other lines to overcome VTcl's limitations
    $widget(ModemMenu) entryconfigure 1 -label "Standalone mode"
    $widget(ModemMenu) entryconfigure 2 -label "Fax reception"
    $widget(ModemMenu) entryconfigure 3 -label "Voice reception"
    $widget(ModemMenu) entryconfigure 5 -label "Dialup retrieval"
    # modify default values set by VTcl
    wm geometry .top17 ""
    wm title .top17 "TkUsr $gui(version)"
    # handle WM close event
    wm protocol .top17 WM_DELETE_WINDOW Quit

    # progress indicator
    ProgressBind $widget(memcanvas) gui(mem)
    # balloon help
    set_balloon $widget(memcanvas) &gui(mem.balloon)
    set_balloon $widget(voicenumlabel) &gui(voice.balloon)
    set_balloon $widget(faxnumlabel) &gui(fax.balloon)

    InitDevice $device(device)
    catch { set device(lastreset) [exec cat $env(HOME)/.tkusrrc] }
    OpenModem

    # update the stats area
    if {$device(test) == 0} {
	UIUpdateStat
    }
}

proc {Window} {args} {
global vTcl
    set cmd [lindex $args 0]
    set name [lindex $args 1]
    set newname [lindex $args 2]
    set rest [lrange $args 3 end]
    if {$name == "" || $cmd == ""} {return}
    if {$newname == ""} {
        set newname $name
    }
    set exists [winfo exists $newname]
    switch $cmd {
        show {
            if {$exists == "1" && $name != "."} {wm deiconify $name; return}
            if {[info procs vTclWindow(pre)$name] != ""} {
                eval "vTclWindow(pre)$name $newname $rest"
            }
            if {[info procs vTclWindow$name] != ""} {
                eval "vTclWindow$name $newname $rest"
            }
            if {[info procs vTclWindow(post)$name] != ""} {
                eval "vTclWindow(post)$name $newname $rest"
            }
        }
        hide    { if $exists {wm withdraw $newname; return} }
        iconify { if $exists {wm iconify $newname; return} }
        destroy { if $exists {destroy $newname; return} }
    }
}

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
    if {$base == ""} {
        set base .
    }
    ###################
    # CREATING WIDGETS
    ###################
    wm focusmodel $base passive
    wm geometry $base 200x200+0+0
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm withdraw $base
    wm title $base "vt.tcl"
    ###################
    # SETTING GEOMETRY
    ###################
}

proc vTclWindow.top17 {base} {
    if {$base == ""} {
        set base .top17
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 446x227+168+230
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm deiconify $base
    wm title $base "TkUsr 0.50"
    frame $base.cpd21 \
        -borderwidth 2 -height 30 -relief raised -width 30 
    menubutton $base.cpd21.01 \
        -anchor w -menu .top17.cpd21.01.02 -padx 4 -pady 3 -text File \
        -width 4 
    menu $base.cpd21.01.02 \
        -cursor {} -tearoff 0 
    $base.cpd21.01.02 add command \
        -command Quit -label Quit -state active 
    menubutton $base.cpd21.03 \
        -anchor w -menu .top17.cpd21.03.04 -padx 4 -pady 3 -text Modem \
        -width 6 
    menu $base.cpd21.03.04 \
        -cursor {} -tearoff 0 
    $base.cpd21.03.04 add cascade \
        -label {Answer After} -menu .top17.cpd21.03.04.men36 -state active 
    $base.cpd21.03.04 add checkbutton \
        -command {set device(auto) $Standalone} -label {Standalone mode} \
        -variable Standalone 
    $base.cpd21.03.04 add checkbutton \
        \
        -command {set device(faxreception) $FaxReception;set device(faxreception.changed) 1} \
        -label {Fax reception} -variable FaxReception 
    $base.cpd21.03.04 add checkbutton \
        \
        -command {set device(voicereception) $VoiceReception;set device(voicereception.changed) 1} \
        -label {Voice reception} -variable VoiceReception 
    $base.cpd21.03.04 add separator
    $base.cpd21.03.04 add checkbutton \
        \
        -command {set device(dialupretrieval) $DialupRetrieval;set device(dialupretrieval.changed) 1} \
        -label {Dialup retrieval} -variable DialupRetrieval 
    $base.cpd21.03.04 add command \
        -command UISetPassword -label {Set Password} 
    $base.cpd21.03.04 add separator
    $base.cpd21.03.04 add command \
        -command {PlayMess 0} -label {Play Outgoing Message} 
    $base.cpd21.03.04 add command \
        -command {PlayMess 255} -label {Play Mem Full Message} 
    $base.cpd21.03.04 add separator
    $base.cpd21.03.04 add command \
        -command ClearModem -label {Clear memory} 
    menu $base.cpd21.03.04.men36 \
        -tearoff 0 
    $base.cpd21.03.04.men36 add radiobutton \
        -command {set device(rings) 3} -label {3 rings} -state active \
        -value 3 -variable device(rings) 
    $base.cpd21.03.04.men36 add radiobutton \
        -command {set device(rings) 4} -label {4 rings} -value 4 \
        -variable device(rings) 
    $base.cpd21.03.04.men36 add radiobutton \
        -command {set device(rings) 5} -label {5 rings} -value 5 \
        -variable device(rings) 
    $base.cpd21.03.04.men36 add radiobutton \
        -command {set device(rings) 6} -label {6 rings} -value 6 \
        -variable device(rings) 
    menubutton $base.cpd21.05 \
        -anchor w -menu .top17.cpd21.05.06 -padx 4 -pady 3 -text Help \
        -width 4 
    menu $base.cpd21.05.06 \
        -tearoff 0 
    $base.cpd21.05.06 add command \
        \
        -command {tk_messageBox -type ok -message "TkUsr $gui(version)\n\n Copyright (C) 1998-2000 Ludovic Drolez <ldrolez@usa.net>"} \
        -label About 
    frame $base.fra22 \
        -borderwidth 2 -height 75 -width 125 
    button $base.fra22.but23 \
        -borderwidth 1 \
        -command {Send " ";$widget(stopbutton) configure -state disabled} \
        -image stop -padx 9 -pady 3 -state disabled 
    button $base.fra22.but28 \
        -borderwidth 1 -image play -padx 9 -pady 3 -state disabled 
    frame $base.fra24 \
        -borderwidth 2 -height 75 -relief groove -width 125 
    text $base.fra24.tex25 \
        -background lightgrey -cursor hand2 -font { helvetica 12 } -height 10 \
        -width 60 -wrap none -yscrollcommand {.top17.fra24.scr26 set} 
    bind $base.fra24.tex25 <Button-1> {
        PlayMess [expr int([lindex [$widget(text) dump -mark current] 2])]
    }
    bind $base.fra24.tex25 <Button-3> {
        Popup [expr int([lindex [$widget(text) dump -mark current] 2])] %X %Y
    }
    scrollbar $base.fra24.scr26 \
        -borderwidth 1 -command {.top17.fra24.tex25 yview} -orient vert \
        -width 10 
    frame $base.fra29 \
        -borderwidth 1 -height 75 -relief sunken -width 125 
    label $base.fra29.lab30 \
        -borderwidth 1 -text Mem: 
    label $base.fra29.lab32 \
        -borderwidth 1 -text {   Voice:} 
    label $base.fra29.lab33 \
        -borderwidth 1 -relief sunken -text {0} \
        -textvariable gui(voice) 
    label $base.fra29.lab34 \
        -borderwidth 1 -text {   Fax:} 
    label $base.fra29.lab35 \
        -borderwidth 1 -relief sunken -text {0} \
        -textvariable gui(fax) 
    label $base.fra29.lab18 \
        -borderwidth 1 -textvariable gui(status) 
    canvas $base.fra29.can18 \
        -borderwidth 1 -height 14 -relief sunken -width 48 
    ###################
    # SETTING GEOMETRY
    ###################
    grid $base.cpd21 \
        -in .top17 -column 0 -row 1 -columnspan 1 -rowspan 1 -sticky ew 
    pack $base.cpd21.01 \
        -in .top17.cpd21 -anchor center -expand 0 -fill none -side left 
    pack $base.cpd21.03 \
        -in .top17.cpd21 -anchor center -expand 0 -fill none -side left 
    pack $base.cpd21.05 \
        -in .top17.cpd21 -anchor center -expand 0 -fill none -side right 
    grid $base.fra22 \
        -in .top17 -column 0 -row 2 -columnspan 1 -rowspan 1 -sticky w 
    grid $base.fra22.but23 \
        -in .top17.fra22 -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 8 \
        -ipady 2 
    grid $base.fra22.but28 \
        -in .top17.fra22 -column 1 -row 0 -columnspan 1 -rowspan 1 -ipadx 8 \
        -ipady 2 
    grid $base.fra24 \
        -in .top17 -column 0 -row 3 -columnspan 1 -rowspan 1 
    grid $base.fra24.tex25 \
        -in .top17.fra24 -column 0 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra24.scr26 \
        -in .top17.fra24 -column 1 -row 0 -columnspan 1 -rowspan 1 \
        -sticky nesw 
    grid $base.fra29 \
        -in .top17 -column 0 -row 4 -columnspan 1 -rowspan 1 -sticky ew 
    grid $base.fra29.lab30 \
        -in .top17.fra29 -column 0 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra29.lab32 \
        -in .top17.fra29 -column 2 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra29.lab33 \
        -in .top17.fra29 -column 3 -row 0 -columnspan 1 -rowspan 1 -ipadx 4 
    grid $base.fra29.lab34 \
        -in .top17.fra29 -column 4 -row 0 -columnspan 1 -rowspan 1 
    grid $base.fra29.lab35 \
        -in .top17.fra29 -column 5 -row 0 -columnspan 1 -rowspan 1 -ipadx 4 
    grid $base.fra29.lab18 \
        -in .top17.fra29 -column 6 -row 0 -columnspan 1 -rowspan 1 -ipadx 4 
    grid $base.fra29.can18 \
        -in .top17.fra29 -column 1 -row 0 -columnspan 1 -rowspan 1 
}

proc vTclWindow.top18 {base} {
    if {$base == ""} {
        set base .top18
    }
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    ###################
    # CREATING WIDGETS
    ###################
    toplevel $base -class Toplevel
    wm focusmodel $base passive
    wm geometry $base 160x48+304+179
    wm maxsize $base 1009 870
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm title $base "Set Retrieve Password"
    label $base.lab19  -borderwidth 1 -text Password: 
    entry $base.ent20  -width 4 -textvariable device(retrievalpassword)
    button $base.but21  -padx 9 -pady 3 -text Set -width 8 -command {set device(retrievalpassword.changed) 1;destroy .top18} 
    button $base.but22  -padx 9 -pady 3 -text Cancel -width 8 -command {set device(retrievalpassword.changed) 0;destroy .top18} 
    ###################
    # SETTING GEOMETRY
    ###################
    grid $base.lab19  -in .top18 -column 0 -row 0 -columnspan 1 -rowspan 1 -sticky e 
    grid $base.ent20  -in .top18 -column 1 -row 0 -columnspan 1 -rowspan 1 -sticky w 
    grid $base.but21  -in .top18 -column 0 -row 2 -columnspan 1 -rowspan 1 
    grid $base.but22  -in .top18 -column 1 -row 2 -columnspan 1 -rowspan 1
}

Window show .
Window show .top17

main $argc $argv
