#!/bin/sh
# restart using wish \
  exec wish8.0 "$0" ${1+"$@"}

# tclticker, a stock ticker 
# copyright 1999,2000 tom poindexter <tpoindex@nyx.net>

# This software is copyrighted by Tom Poindexter,
# 1999.  The following terms apply to all files associated with the software 
# unless explicitly disclaimed in individual files.
# 
# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software and its documentation for any purpose, provided
# that existing copyright notices are retained in all copies and that this
# notice is included verbatim in any distributions. No written agreement,
# license, or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors
# and need not follow the licensing terms described here, provided that
# the new terms are clearly indicated on the first page of each file where
# they apply.
# 
# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# 
# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
# 
# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal 
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
# are acquiring the software on behalf of the Department of Defense, the
# software shall be classified as "Commercial Computer Software" and the
# Government shall have only "Restricted Rights" as defined in Clause
# 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
# authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license. 
 

if {! [info exists env(TCLTICKER_LIB)]} {
    lappend auto_path [file join [file dirname $argv0] lib]
} else {
    lappend auto_path $env(TCLTICKER_LIB)
}   

package require http 2.0

wm title . TclTicker

# global variables used
global refresh tick_speed tick_font tick_size tick_ontop tick_round
global ticker_symbols data 
global service_list service
global proxy_host proxy_port
global mail_host  mail_port

global index last_time_stamp

# 'index' is used to cycle through ticker symbols in ticker_symbols array
set index 0

# last_time_stamp is timestamp of last data refresh
set last_time_stamp ""

# 'next_refresh' - after id of next refresh request
global next_refresh
set next_refresh ""


proc doticker {t} {
    global tick_speed tick_ontop ticker_symbols data tcl_platform
    global index last_time_stamp
    if {! [info exists ticker_symbols(1)] } {
	$t configure -state normal
	$t delete 1.0 end
	$t configure -state disabled
	update idletasks
	get_parms "No ticker symbols have been entered,\n\
		   please enter symbols to display."
        after 100 [list doticker $t]
	return
    }
    # find out how much text on the line, change laurent's code to use pixels
    set wid [winfo width $t]
    incr wid 20 	;# make sure new messages get appended before needed
    set len [font measure [$t cget -font] [$t get 1.0 1.end]]
    if {[expr {$len < $wid}]} {
	set msg "  . . .  "
        if {![info exists ticker_symbols($index)]} {
            set index 1
	    set msg "  (click here!)  $last_time_stamp  . . .  "
        } else {
	    set msg "  . . .  "
        }
        set symbol $ticker_symbols($index)
	set sign $data($symbol,sign)
	set message "$symbol $data($symbol,last) $data($symbol,delta)"
        $t configure -state normal
        $t insert end $msg fill
        $t insert end $message tag$sign
        $t configure -state disabled
        incr index
	# windows doesn't support visibility events, so try to force it up if 
	# tick_ontop is wanted, may cause some flicker, or work poorly :-(
	if {$tick_ontop && "$tcl_platform(platform)" == "windows"} {
	    wm withdraw .  ; update
	    raise .        ; update
	    wm deiconify . ; update
	    raise .        ; update
	}
    }
    $t configure -state normal
    $t delete 1.0
    $t configure -state disabled
    after $tick_speed [list doticker $t]
}

proc font_trace {args} {
    global tick_font tick_size
    .t configure -font "$tick_font $tick_size"
}

proc start_ticker {} {
    global tick_speed tick_font tick_size tick_ontop
    text .t  -relief sunken -bd 0 -wrap none -bg black -state disabled  \
	-exportselection 0 -height 1 -width 60 \
	-font "$tick_font $tick_size" -highlightthickness 0
    bind .t <Button-1> get_parms
    bind .t <Button-2> get_parms
    bind .t <Button-3> get_parms
    .t tag configure fill -foreground white
    .t tag configure tag  -foreground white
    .t tag configure tag= -foreground yellow
    .t tag configure tag- -foreground red
    .t tag configure tag+ -foreground green
    pack .t  -expand 1 -fill x -pady 6 -padx 4
    . configure -bg black

    trace variable tick_font w font_trace
    trace variable tick_size w font_trace
    # allow window to be resized in width, but not in height
    wm resizable . 1 0
    # for unix, make window always on top if desired
    bind . <Visibility> {
	if {$tick_ontop && \
	    ( "%s" == "VisibilityPartiallyObscured" || \
	      "%s" == "VisibilityFullyObscured") } {
	    raise .
	}
    }

    doticker .t
}

proc do_refresh {} {
    global service
    if {[catch {$service} svc_rc]} {
        set_last_time " quote_retrieval_error "
    } elseif {$svc_rc} {
        set_last_time
    } else {
        # service module ran, but didn't complete, don't do anyting
    }
}

proc refresh_data {args} {
    global refresh service next_refresh index
    if {"[lindex $args 0]" == "restart"} {
	catch {after cancel $next_refresh}
    }

    after 0 do_refresh

    set next_refresh [after [expr {$refresh * 60000}] "refresh_data" ]
}


proc get_parms {{msg {}}} {
    global refresh tick_speed tick_font tick_size tick_ontop tick_round
    global index ticker_symbols data 
    global service_list service
    global proxy_host proxy_port
    global mail_host  mail_port
    global temp_refresh temp_tick_speed 
    global temp_tick_ontop temp_tick_round doParms
    global temp_proxy_host temp_proxy_port
    global temp_mail_host  temp_mail_port

    catch {
      bind .t <Button-1> {}
      bind .t <Button-2> {}
      bind .t <Button-3> {}
    }
    set temp_refresh $refresh
    set temp_tick_speed $tick_speed
    set temp_tick_ontop $tick_ontop
    set temp_tick_round $tick_round
    set temp_proxy_host $proxy_host
    set temp_proxy_port $proxy_port
    set temp_mail_host  $mail_host
    set temp_mail_port  $mail_port

    # turn off ticker on top during dialog
    set save_tick_ontop $tick_ontop
    set tick_ontop 0

    catch {destroy .p}
    toplevel .p -class Dialog
    wm title .p "TclTicker: Set Parameters"
    wm withdraw .p
    update

    if {[string length $msg]} {
	label .p.msg -text $msg -relief raised
	pack .p.msg -side top -fill x
    }

    label .p.l0 -text "version 1.2 - Copyright 1999 Tom Poindexter"
    pack .p.l0 -side top

    frame .p.q
    label .p.q.l1 -text "quote service:"
    pack .p.q.l1 -side left
    scrollbar .p.q.scr -orient vertical -command ".p.q.service yview"
    listbox .p.q.service -width 30 -height 3 \
		-exportselection 0 \
		-selectmode single -yscrollcommand ".p.q.scr set"
    pack .p.q.service -side left -fill y
    if {[llength $service_list] > 3} {
	pack .p.q.scr -side left -fill y
    }
    pack .p.q -side top -pady 4

    frame .p.p
    label .p.p.l1 -text "http proxy host:"
    entry .p.p.ph -width 20 -textvariable temp_proxy_host
    label .p.p.l2 -text " port:"
    entry .p.p.pp -width 4 -textvariable temp_proxy_port
    pack .p.p.pp .p.p.l2 .p.p.ph .p.p.l1 -side right -padx 3 
    pack .p.p -side top -padx 4

    frame .p.m
    label .p.m.l1 -text "smtp relay host:"
    entry .p.m.mh -width 20 -textvariable temp_mail_host
    label .p.m.l2 -text " port:"
    entry .p.m.mp -width 4 -textvariable temp_mail_port
    pack .p.m.mp .p.m.l2 .p.m.mh .p.m.l1 -side right -padx 3 
    pack .p.m -side top -pady 4 -padx 4

    frame .p.s
    scale .p.s.tick -label "ticker delay (milliseconds)" -from 100 -to 500 \
		-orient horizontal -resolution 50 \
		-length 160 -variable temp_tick_speed 
    pack .p.s.tick -side  left
    scale .p.s.refresh -label "data refresh (minutes)"   -from 1 -to 15 \
		-orient horizontal -length 160 -variable temp_refresh 
    pack .p.s.refresh -side right
    pack .p.s -side top

    frame .p.t
    label .p.t.l1 -text "ticker font:"
    scrollbar .p.t.fscr -orient horizontal -command ".p.t.fon yview" 
    listbox .p.t.fon -height 1 -width 10 -highlightthickness 0 \
		-selectborderwidth 0 \
		-exportselection 0 -selectmode single \
		-yscrollcommand ".p.t.fscr set" 
    .p.t.fon configure -selectbackground [.p.t.fon cget -background]
    .p.t.fon configure -selectforeground [.p.t.fon cget -foreground]
    label .p.t.l2 -text "    size:"
    scrollbar .p.t.sscr -orient horizontal -command ".p.t.siz yview"
    listbox .p.t.siz -height 1 -width 3 -highlightthickness 0 \
		-selectborderwidth 0 \
		-exportselection 0 -selectmode single \
		-yscrollcommand ".p.t.sscr set"
    .p.t.siz configure -selectbackground [.p.t.siz cget -background]
    .p.t.siz configure -selectforeground [.p.t.siz cget -foreground]
    pack .p.t.l1 .p.t.fon  .p.t.fscr .p.t.l2 .p.t.siz .p.t.sscr -side left \
		-padx 2
    pack .p.t -side top -pady 4 -padx 4

    frame .p.c
    checkbutton .p.c.on -text "always on top"     -variable temp_tick_ontop
    checkbutton .p.c.rd -text "round to hundreds" -variable temp_tick_round
    pack .p.c.on .p.c.rd -side left -padx 10
    pack .p.c -side top

    frame .p.f 
    frame .p.f.f
    label .p.f.f.l2 -text "security symbols:" 
    button .p.f.f.look -text "symbol lookup..." -command symbol_lookup
    pack .p.f.f.l2 .p.f.f.look -side left -padx 20 -fill x
    pack .p.f.f -side top
    scrollbar .p.f.scr -command ".p.f.symbols yview" -orient vertical
    text .p.f.symbols -width 40 -height 4  -wrap word \
		-yscrollcommand ".p.f.scr set"
    pack .p.f.scr -side right -fill y
    pack .p.f.symbols -side left -fill both -expand 1
    pack .p.f -side top -pady 4

    frame .p.b
    button .p.b.ok  -text " Ok "     -command {set doParms 1}
    button .p.b.can -text " Cancel " -command {set doParms 0}
    button .p.b.ex  -text " Exit TclTicker "   -command {exit}
    pack .p.b.ok .p.b.can .p.b.ex -side left -padx 10 -pady 5
    pack .p.b -side top

    # fill inital services
    eval .p.q.service insert end $service_list
    .p.q.service selection set [lsearch -exact $service_list $service]

    # fill font choices
    .p.t.fon insert end Courier Helvetica Times
    if {[set idx [lsearch -exact "Courier Helvetica Times" $tick_font]] < 0} {
	set idx 1
    }
    .p.t.fon selection set $idx
    .p.t.fon see $idx

    # fill size choices
    .p.t.siz insert end 8 10 12 14 16 18
    if {[set idx [lsearch -exact "8 10 12 14 16 18" $tick_size]] < 0} {
	set idx 2
    }
    .p.t.siz selection set $idx
    .p.t.siz see $idx

    # fill initial symbols
    set i 0
    while {[info exists ticker_symbols([incr i])]} {
	.p.f.symbols insert end "$ticker_symbols($i)   "
    }

    set doParms 0
    wm deiconify .p
    focus .p
    raise .p
    update
    grab .p
    wm protocol .p WM_DELETE_WINDOW {set doParms 0}
    vwait doParms

    if {$doParms == 1} {
	set service [.p.q.service get [.p.q.service curselection]]
	set symbol_list [.p.f.symbols get 1.0 end]
	regsub -all "\[ \n\t\]\[ \n\t\]?" $symbol_list { } symbol_list
	set i 0
	unset ticker_symbols
	array set ticker_symbols {}
	foreach sym [split $symbol_list] {
	    if {[string length $sym] == 0} continue
	    set ticker_symbols([incr i]) $sym
	}
	set tick_speed $temp_tick_speed
	set tick_font  [.p.t.fon get \
	    [expr int(round([lindex [.p.t.fon yview] 0]*[.p.t.fon size]))]]
	set tick_size  [.p.t.siz get \
	    [expr int(round([lindex [.p.t.siz yview] 0]*[.p.t.siz size]))]]
	set tick_ontop $temp_tick_ontop
	set tick_round $temp_tick_round
	if {$tick_ontop} {
	    raise .
	}
	set refresh    $temp_refresh
	set_last_time

	if {[string length [string trim $temp_proxy_host]]} { 
	    set proxy_host [string trim $temp_proxy_host]
	    if {[string length [string trim $temp_proxy_port]] && \
		[scan $temp_proxy_port %d j] == 1} {
	        set proxy_port $j
	    } else {
	        set proxy_port ""
	    }
	} else {
	    set proxy_host ""
	    set proxy_port ""
	}
        http::config -proxyhost "$proxy_host" -proxyport "$proxy_port"

	if {[string length [string trim $temp_mail_host]]} { 
	    set mail_host [string trim $temp_mail_host]
	    if {[string length [string trim $temp_mail_port]] && \
		[scan $temp_mail_port %d j] == 1} {
	        set mail_port $j
	    } else {
	        set mail_port ""
	    }
	} else {
	    set mail_host ""
	    set mail_port ""
	}

	write_defaults
	refresh_data restart
	set index 0

    }  else {
       # restore tick_ontop
       set tick_ontop $save_tick_ontop
    }

    catch {
      bind .t <Button-1> get_parms
      bind .t <Button-2> get_parms
      bind .t <Button-3> get_parms
    }

    destroy .p
    catch {destroy .l}
}


proc symbol_lookup {} {
    global service proxy_host proxy_port
    catch {destroy .l}
    toplevel .l -class Dialog
    wm title .l "TclTicker: Symbol Lookup"

    if {[string length $proxy_host]} {
	set proxy $proxy_host
	if {[string length $proxy_port]} {
	    append proxy : $proxy_port
	}
    } else {
	set proxy (none)
    }

    label .l.l1 -text "lookup service: $service\n\
		using http proxy: $proxy"
    pack .l.l1  -side top -fill y
    label .l.msg -text ""
    pack .l.msg -side top -fill y

    frame .l.s
    label .l.s.l1 -text "search:"
    entry .l.s.sym -width 20
    button .l.s.go -text search -command do_lookup
    bind .l.s.sym <Key-Return> do_lookup
    pack .l.s.l1 .l.s.sym .l.s.go -side left -padx 4
    pack .l.s -side top -pady 4
    
    label .l.l2 -text "results"
    pack .l.l2 -side top

    frame .l.r
    scrollbar .l.r.v -orient vertical   -command ".l.r.res yview"
    scrollbar .l.r.h -orient horizontal -command ".l.r.res xview"
    listbox .l.r.res -width 35 -height 10 \
		    -exportselection 0 -selectmode multiple \
		    -yscrollcommand ".l.r.v set" \
		    -xscrollcommand ".l.r.h set" 
    pack .l.r.h -side bottom -fill x
    pack .l.r.v -side right -fill y
    pack .l.r.res -side left -expand 1 
    pack .l.r -side top 

    frame .l.b
    button .l.b.ok -text "Add selections" -command add_symbols
    button .l.b.can -text Cancel -command {destroy .l}
    pack .l.b.ok .l.b.can -side left -padx 10
    pack .l.b -side top -pady 4 
    grab .l
    focus .l.s.sym
    update
    tkwait window .l
}


proc do_lookup {} {
    global service
    catch {
      .l.msg configure -text "searching..."
      update idletasks
      set str [string trim [.l.s.sym get]]
      set symco_list ""
      set count 0
      if {! [catch {set symco_list [${service}_lookup $str]} res] } {
	  foreach {sym co} $symco_list {
	      .l.r.res insert end "$sym   $co"
	      incr count
	  }
      }
      if {$count} {
          .l.msg configure -text "search complete"
      } else {
          .l.msg configure -text "nothing found"
      }
    }
}

proc add_symbols {} {
    catch {
      set sel_list [.l.r.res curselection]
      set count 0
      foreach idx $sel_list {
	  incr count
	  set sym [lindex [split [.l.r.res get $idx]] 0]
	  .p.f.symbols insert end "  $sym "
      }
      .l.r.res selection clear 0 end
      if {$count} {
	  .l.msg configure -text "selections added"
      }
    }
}




# start it up!

set_defaults

if {[string match *setup* [string tolower [lindex $argv 0]]]} {
    set setup 1
} else {
    set setup 0
}

if {! [read_defaults] || $setup} {
    # first time, or no .tclticker file, get parms, or want 'setup'
    wm withdraw .

    if {! $setup} {
        set msg "Welcome to TclTicker!  This appears to be the first time\n\
        you have started TclTicker.  Please review these settings, and click\n\
        \"Ok\" to save your settings."
    } else {
        set msg ""
    }

    get_parms $msg
}

start_ticker
wm deiconify .
raise .
update		;# get ticker going while waiting on inital data
refresh_data

