#!/bin/sh
# the next line restarts using wish \
exec wish "$0" ${1+"$@"}

# ----------------------------------------------------------------------------
#
# Tkexchg - A currency converter / calculator
#
# Author:       Prabhanjan M.
# Date:         08 Jan, 2000 
# Last change:  06 Jun, 2003
# Version:      1.0
#
# Uses the PACIFIC exchange rate service at
# <http://pacific.commerce.ubc.ca/xr/rates.html>
#
# I am indebted to the "Freeware Currency converter"
# <http://www.belgraver.demon.nl/currconv/index.html>
# for the idea of a currency converter.
#
# ----------------------------------------------------------------------------
#
#   Copyright (C) 2003  Prabhanjan M.
#   Copyright is only on the code in this file.
#   No claim is made to the bitmaps.
#
#   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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# ----------------------------------------------------------------------------

package require http

proc SetMessage {message} {
    global XChg

    set XChg(Message) $message
}

proc RatesAvailable {{op {}}} {
    global XChg

    if {$op == "?"} {
        return $XChg(InitDone)
    } else {
        set XChg(InitDone) $op
    }
}

proc LastUpdate {op {value {}}} {
    global XChg

    switch $op {
        set { set XChg(UpdatedOn) $value }
        get { return $XChg(UpdatedOn)    }
    }
}

proc Settings {} {
    global XChg _ok _proxyhost _proxyport

    if {[winfo exists .s]} return

    set _proxyhost $XChg(ProxyHost)
    set _proxyport $XChg(ProxyPort)
    set ok 0

    toplevel .s
    wm title .s "Settings"
    frame .s.f1
    frame .s.f2
    frame .s.f3

    label .s.f1.l -text "Proxy host:"
    entry .s.f1.e -textvar _proxyhost
    pack .s.f1.l .s.f1.e -side left
    
    label .s.f2.l -text "Proxy port:"
    entry .s.f2.e -textvar _proxyport
    pack .s.f2.l .s.f2.e -side left

    button .s.f3.b1 -text Ok     -command { set _ok 1; destroy .s }
    button .s.f3.b2 -text Cancel -command { set _ok 0; destroy .s }
    pack .s.f3.b1 .s.f3.b2 -side left -padx 5

    pack .s.f1 .s.f2 .s.f3 -side top -pady 5

    tkwait window .s
    if {$_ok} {
        set XChg(ProxyHost) $_proxyhost
        set XChg(ProxyPort) $_proxyport
        SetMessage "Configured proxy http://$XChg(ProxyHost):$XChg(ProxyPort)"
    }
}

proc GetPage {url} {
   global env XChg

   if {$XChg(ProxyHost) != ""} {
      regexp {(http://)?([^:]*)(:([0-9]*))?/?} $XChg(ProxyHost) -> .. proxyhost .. ..
      set proxyport $XChg(ProxyPort)
      ::http::config -proxyhost $proxyhost -proxyport $proxyport
   }

   if {[llength [array names env http_proxy]] != 0} {
      set proxyport 80
      regexp {(http://)?([^:]*)(:([0-9]*))?/?} $env(http_proxy) -> .. proxyhost .. proxyport
      ::http::config -proxyhost $proxyhost -proxyport $proxyport
   }
   set token [::http::geturl $url]
   return [::http::data $token]
}

proc ReadRates {} {
   global XChg

   .menubar.file entryconfigure 0 -state disabled
   SetMessage {Updating exchange rates}
   . config -cursor watch

   set page [GetPage http://pacific.commerce.ubc.ca/xr/rates.html]
   set page [split $page \n]

   # Initialize currency list to null
   for {set a 65} {$a < 91} {incr a} {
      set letter [format %c $a]
      set XChg(CURRLIST,$letter) ""
   }

   set ccount 0
   foreach line $page { 
      if {[regexp {^\s*<tr.*>\s*$} $line d] } {
         incr ccount
         set fcount 0
         continue
      }

      if {[regexp {^\s*<td.*><tt>(.*)</tt><.*td>\s*$} $line d f]} {
         set XChg(ISO,$ccount) $f
         continue
      }

      if {[regexp {^\s*<td.*>(.*)<.*td>\s*$} $line d f]} {
         if {$fcount == 3} {
            set XChg(USDU,$ccount) $f
         }
         if {$fcount == 0} {
            regsub {\*\* (.*)} $f {\1} f 
            set XChg(CURR,$ccount) $f
            set letter [string index $f 0]
            lappend XChg(CURRLIST,$letter) [list $ccount $f]
         }
         incr fcount
         continue
      }
   }

   SaveVars

   # Clear existing stuff because their meanings would have changed
   ClearGUI

   ShowCurrencyNames
   .menubar.file entryconfigure 0 -state normal
   LastUpdate set [clock format [clock seconds] -format {%d %b, %Y}]
   . config -cursor left_ptr
   RatesAvailable 1
}

proc ShowCurrencyNames {} {
   global XChg

   # Destroy pre-existing menus
   foreach i {left right} {
      set mm $XChg(Menu$i)
      $mm delete 0 end
      foreach let_menu [winfo children $mm] {
         destroy $let_menu
      }
   }

   set letters_present ""
   set letters_strength ""

   for {set a 65} {$a < 91} {incr a} {
      set letter [format %c $a]
      if {$XChg(CURRLIST,$letter) == ""} continue

      lappend letters_present $letter
      lappend letters_strength [llength $XChg(CURRLIST,$letter)]
   }

   set prev_menu ""
   set prev_menu_strength 0
   set menu_count 0

   foreach j {left right} {
      menu $XChg(Menu$j).m0 -tearoff 0
      $XChg(Menu$j) add cascade -label a \
         -menu .top.${j}.frame0.mb.curr.m0
   }

   for {set i 0} {$i < [llength $letters_present]} {incr i} {
      set letter [lindex $letters_present $i]
      set curr_menu $letter
      set curr_menu_strength [lindex $letters_strength $i]
      set can_merge [expr {$prev_menu_strength + $curr_menu_strength < 16}]
      if {$can_merge} {
         set curr_menu_strength [expr $prev_menu_strength + $curr_menu_strength]
         set curr_menu "${prev_menu}${curr_menu}"
      } else {
         lappend menu_list $prev_menu

         foreach j {left right} {
            .top.${j}.frame0.mb.curr entryconfig $menu_count \
               -label $prev_menu
         }
         incr menu_count
         foreach j {left right} {
            menu $XChg(Menu$j).m$menu_count -tearoff 0
            $XChg(Menu$j) add cascade -label $letter \
               -menu .top.${j}.frame0.mb.curr.m$menu_count
         }
      }
      set prev_menu_strength $curr_menu_strength
      set prev_menu $curr_menu


      # Create the menus
      set XChg(CURRLIST,$letter) [lsort -index 1 $XChg(CURRLIST,$letter)]

      foreach element $XChg(CURRLIST,$letter) {
         set index [lindex $element 0]
         set currency [lindex $element 1]
         foreach j {left right} {
            $XChg(Menu$j).m$menu_count add command -label $currency \
               -command [list SelectCurrency $j $index]
         }
      }
   }

   if {$can_merge} {
      foreach j {left right} {
         $XChg(Menu$j) entryconfig $menu_count \
            -label $prev_menu
      }
   }

}

proc SelectCurrency {i index} {
   global XChg

   set XChg(Curr$i) $XChg(CURR,$index)
   set XChg(ISO$i) $XChg(ISO,$index)
   set XChg(USDU$i) $XChg(USDU,$index)
   ComputeExchange [opposite_dir $i]
}

proc opposite_dir {dir} {
    switch $dir {
    left { return right }
    right { return left }
    }
}

proc ComputeExchange {i} {         
   global XChg

   set j [opposite_dir $i]

   if { $XChg(ISOleft) == "..." || $XChg(ISOright) == "..."} {
      SetMessage {Please choose the currencies to convert between}
      set XChg(Value$j) ""
      return
   }
   if { $XChg(Value$i) == ""} {
      SetMessage {Please enter the amount to convert}
      set XChg(Value$j) ""
      return
   }
   if {! [RatesAvailable ?] } ReadRates
   set XChg(Value$j) [expr ($XChg(Value$i))*($XChg(USDU$j))/($XChg(USDU$i))]
   set XChg(Value$j) [expr {round($XChg(Value$j)*100)/100.0}]

   SetMessage {Tkexchg v1.0}
}

proc ExitCommand {} {
   SaveVars
   exit
}

proc SaveVars {} {
   global XChg

   if {[catch {
      set chan [open $XChg(RCFILE) w]
      puts $chan "LastUpdate set \"[LastUpdate get]\""
      puts $chan "array set XChg \[list [array get XChg] \]"
      puts $chan "RatesAvailable [RatesAvailable ?]"
      puts $chan "SetMessage {}"
      close $chan
   }]} {
      SetMessage \
         "Updated exchange rates but couldn't save them in $XChg(RCFILE)"
   } else {
      SetMessage {Updated exchange rates}
   }
}

proc ClearGUI {} {
   global XChg

   set XChg(Currleft) {Select currency 1}
   set XChg(Currright) {Select currency 2}
   set XChg(ISOleft) {...}
   set XChg(ISOright) {...}
   set XChg(Valueleft) {}
   set XChg(Valueright) {}
}

proc InitVars {} {
   global XChg env tcl_platform

   if {$tcl_platform(platform) == "windows"} {
      set XChg(RCFILE) .tkexchg
   } else {
      set XChg(RCFILE) [file join $env(HOME) .tkexchg]
   }

   set XChg(ProxyHost) ""
   set XChg(ProxyPort) ""

   SetMessage {TkExchg v1.0}
   ClearGUI
   RatesAvailable 0

   if {[catch {source $XChg(RCFILE)} msg]} {
      puts $msg
   }

   if {! [RatesAvailable ?]} {
      SetMessage {No saved info found. Please update exchange rates.}
   } else {
      ShowCurrencyNames
      SetMessage "Rates last updated on: [LastUpdate get]"
   }

}

proc InitWindow {} {
   global XChg

   . configure -menu .menubar
   wm protocol . WM_DELETE_WINDOW ExitCommand

   menu .menubar -tearoff 0
   .menubar add cascade -label File -underline 0 -menu .menubar.file
   .menubar add cascade -label Help -underline 0 -menu .menubar.help

   menu .menubar.file -tearoff 0
   menu .menubar.help -tearoff 0

   .menubar.file add command -label {Update Rates} \
      -underline 0 -command ReadRates
   .menubar.file add command -label Settings... \
      -underline 0 -command Settings
   .menubar.file add separator
   .menubar.file add command -label Exit -underline 1 -command ExitCommand

   .menubar.help add command -label {Update Time} -underline 0 \
      -command {
         if {! [RatesAvailable ?]} {
            SetMessage {Rates not available. Please update rates.}
         } else {
            SetMessage "Rates last updated on: [LastUpdate get]"
         }
      } 
   .menubar.help add separator
   .menubar.help add command -label About -underline 0 \
      -command { SetMessage {Tkexchg v1.0 by Prabhanjan M. (Jan 2000)} }


   frame .top
   frame .bottom -bd 2 -relief sunken

   frame .top.left
   frame .top.right

   foreach i {left right} {
      set fr0 [frame .top.$i.frame0]
      set fr1 [frame .top.$i.frame1]
      menubutton ${fr0}.mb -direction right \
         -menu ${fr0}.mb.curr -textvar XChg(Curr${i}) \
         -fg blue -activeforeground blue
      menu ${fr0}.mb.curr -tearoff 0
      set XChg(Menu$i) ${fr0}.mb.curr

      label ${fr1}.iso -width 3 -textvar XChg(ISO$i)
      entry ${fr1}.value -textvar XChg(Value${i}) -fg red -width 10

      pack ${fr0}.mb -side left
      pack .top.$i.frame0 -side top
      pack ${fr1}.iso -side left
      pack ${fr1}.value -padx 5 -side top
      pack $fr0
      pack $fr1
   }
   
   label .bottom.lbl -textvar XChg(Message) -anchor w

   pack .top.left .top.right -side left
   pack .top -side top

   pack .bottom.lbl -padx 5 -fill x
   pack .bottom -fill x -side bottom

   foreach k {left right} {
      bind .top.${k}.frame1.value <Key-Return> {
         regsub {\.top\.(.*).frame1.value} %W {\1} i
         ComputeExchange $i
      }
   }

   update
}

proc main {argc argv} {
   InitWindow
   InitVars
}

main $argc $argv

# vim:syn=tcl:
