#!/bin/sh
# the next line restarts using wish \
exec wish $0 -- $@
# Time-stamp: <2007-12-08 16:08:14 poser>
#
# Copyright (C) 2005-2007 William J. Poser (billposer@alum.mit.edu)
# This program is free software; you can redistribute it and/or modify
# it under the terms of version 2 of the GNU General Public License
# as published by the Free Software Foundation.
#
# 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.#
# A copy of the GNU General Public License is contained in the
# procedure "License" in this file.
# If it is not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
# or go to the web page:  http://www.gnu.org/licenses/gpl.txt.

set Version "1.1"
package require msgcat
package require uninum

set DebugP 0
set InitFile     ".numberconverterrc";
set ReadInitFileP 1
set AutodetectNumberSystemP 1;
set KeepOnTopP 0

set InputBase 10
set OutputBase 10
set GeneralGroupSize 0
set FirstGroupSize   0
set SeparatorCharacter ","
set InputNumberSystem "Western"
set OutputNumberSystem "Western_Lower"
set MaximumValueRepresentable "unlimited"
set DefaultInputFont courier
set DefaultOutputFont code2000
set DefaultInputFontSize  12
set DefaultOutputFontSize 12

option add *Background \#FFB377
option add *Button.Background LightBlue
option add *Button.activeBackground LightGreen
option add *Button.activeForeground Black
option add *Checkbutton.Background LightBlue
option add *Checkbutton.activeBackground LightGreen
option add *Checkbutton.activeForeground Black
option add *Text.Background NavajoWhite
option add *Entry.Background NavajoWhite
option add *Spinbox.Background NavajoWhite
option add *Spinbox.readonlyBackground NavajoWhite


proc _ {s} {return [::msgcat::mc $s]};	# Define shorthand for gettext

proc dmsg {msg} {
    if {$::DebugP} {
	puts stderr $msg;
    }
}

proc ShowMessage {msg} {
    tk_messageBox -message $msg -type ok -title "Message" -icon info
}

#Portability
#Figure out what system we are running on
if {[string equal $tcl_platform(platform) windows]} {
    set System MSWindows;
    dmsg "Running under MS Windows";
} elseif {[string equal $tcl_platform(platform) unix]} {
    if {[string equal $tcl_platform(os) Darwin]} {
	set System MacOSX;
	dmsg "Running under Mac OS X";
    } else {
	set System Unix;
	dmsg "Running under Unix";
    }
}

if {[string match $System MSWindows]} {
    set NonBinPath [file dirname [info script]];
    set ::env(CYGWIN) "";
    set InitFile "NumberConverterInit";
}

proc SetupEvents {sys} {
    switch $sys {
	Unix {
	    event add <<B3>> <ButtonPress-3>
	    event add <<B3Release>> <ButtonRelease-3>
	}
	MacOSX {
	    event add <<B3>> <Control-ButtonPress-1>
	    event add <<B3Release>> <Control-ButtonRelease-1>
	}
	MSWindows {
	    event add <<B3>> <ButtonPress-3>
	    event add <<B3Release>> <ButtonRelease-3>
	}
    }
}

proc DetermineGraphicsSystem {} {
    global AquaP
    global System
    global WindowSystem

    if {[string match X11*  [winfo server .]]} {
	set AquaP 0
	set WindowSystem X11
    } else {
	if {[string match $System MSWindows]} {
	    set AquaP 0;
	    set WindowSystem MSWindows;
	}
	if {[string match $System MacOSX]} {
	    set AquaP 1
	    set WindowSystem Aqua
	}
    }
}


proc argshift {k} {
    set ::argv [lrange $::argv $k end];
}

proc Usage {} {
    puts {Usage: NumberConverter [options]};
    puts [_ "    -f <file>                read configuration from <file>"];
    puts [_ "    -h                       help"];
    puts [_ "    -i                       do not read initialization file"];
    puts [_ "    -v                       version"];
}


proc PrintCopyright {fh} {
    puts $fh "Copyright (C) 2007 William J. Poser.";
    puts $fh [_ "This program is free software; you can redistribute
it and/or modify it under the terms of version 2 of the
GNU General Public License as published by the Free
Software Foundation."];
}

proc PrintVersion {fh} {
    puts $fh "NumberConverter $::Version";
}

if {[string match $::System MSWindows]} {

    proc ToggleKeepOnTop {} {
	if {!$::KeepOnTopP} {
	    after cancel $::MainAfterID
	} else {
	    if {[winfo exists .]} {
		raise .
		set ::MainAfterID [after 1000 [info level 0]]
	    }
	}
    }
} else {
    proc ToggleKeepOnTop {} {
	if {[winfo exists .]} {
	    if {!$::KeepOnTopP} {
		bind . <Visibility> ""
	    } else {
		bind . <Visibility> {
		    if {[string match %W .] &&
			[string compare %s VisibilityUnobscured]} {
			raise %W
			update
		    }
		}
	    }
	}
    }
}

proc ShowHelp {} {
    ShowMessage "not yet implemented"
}

#Check whether the argument represents a Boolean value
#and interpret it if it is.
proc Boolean {s} {
     switch -regexp $s {
	 1	{return 1}
	 T.*	{return 1}
	 t.*	{return 1}
	 Y.*	{return 1}
	 y.*	{return 1}
	 ok	{return 1}
	 on	{return 1}
	 0 	{return 0}
	 F.*	{return 0}
	 f.*	{return 0}
	 N.*	{return 0}
	 n.*	{return 0}
	 off	{return 0}
	 default {error}
     }
}

proc LoadConfiguration {ConfigFile} {
    set CommentCharacter \#;
    if { [catch {open $ConfigFile "r"} ConfigHandle ] != 0} {
	ShowMessage [format [_ "Unable to open file %s."] $ConfigFile];
	return ;
    }

    while { [gets $ConfigHandle line] > 0} {
	if {[string index $line 0] == $CommentCharacter} {
	    continue
	}
	set lp [split $line];
	switch -regexp -- [lindex $lp 0] {
	    {(?i)Balloon[-_ ]?Help[-_ ]?P} {
		SetBalloonHelpShowP [lindex $lp 1]
	    }
	    {(?i)Input[-_ ]?Base} {
		set ::InputBase [lindex $lp 1];
	    }
	    {(?i)Output[-_ ]?Base} {
		set ::OutputBase [lindex $lp 1];
	    }
	    {(?i)General[-_ ]?Group[-_ ]?SSize} {
		set ::GeneralGroupSize [lindex $lp 1];
	    }
	    {(?i)First[-_ ]?Group[-_ ]?SSize} {
		set ::FirstGroupSize [lindex $lp 1];
	    }
	    {(?i)Separator[-_ ]?Character} {
		set ::SeparatorCharacter [lindex $lp 1];
	    }
	    {(?i)Generate[-_ ]?Roman[-_ ]?With[-_ ]?Bar[-_ ]?P} {
		set ::Uninum_Generate_Roman_With_Bar_P [Boolean [lindex $lp 1]]
	    }
	    default {
	    }
	}
    }
    close $ConfigHandle;
    ShowMessage [format [_ "Read configuration from %s."] $ConfigFile]
    return ;
}

#Get command line arguments
while {[string match -* [lindex $argv 0]]} {
    switch -glob -- [lindex $argv 0] {
	-f* {
	    set InitFile [lindex $argv 1];
	    argshift 2;
	} 
	-h* {
	    Usage;
	    exit 0;
	}
	-i* {
	    set ReadInitFileP 0;
	    argshift 1;
	}
	-v* {
	    PrintVersion stdout
	    PrintCopyright stdout
	    exit 0;
	}
	default {
	    puts [format [_ "Command line option %s not recognized."] [lindex $argv 0]];
	    PrintVersion stdout
	    Usage;
	    exit 0;
	}
    }
};					# End of while

#Look first in the current directory, then in the user's home directory.
if {$ReadInitFileP} { 
    if { [file exists $InitFile] } {
	LoadConfiguration $InitFile;
    } else {
	set cwd [pwd];
	cd;
	if {[file exists $InitFile] } {
	    LoadConfiguration $InitFile;
	}
	cd $cwd;
    }
}

array set ErrorNumberToString {
    128	"String contains illegal character"
    130	"Unknown number system"
    131 "The specified base is not acceptable"
    132	"The string contains a digit too large for the base"
    133	"Storage allocation error"
    134	"The input number is too large to represent in the output number system"
    135	"The output number contains a character outside the BMP "
    136	"The output number system cannot represent zero" 
    137	"The input string is not a well-formed number" 
}

proc HandleError {ErrorNumber} {
    ClearOutput
    ShowMessage $::ErrorNumberToString($ErrorNumber)
    if {$ErrorNumber == 134} {
	set max [UninumNumberSystemMaximumValue $::OutputNumberSystem]
	if {$::uninum_err == 0} {
	    ShowMessage [format "The maximum value representable in this number system is %s" $max]
	}
    }
}

proc Space2Underscore {s} {
    return [string map {" " "_"} $s]
}

proc Underscore2Space {s} {
    return [string map {"_" " "} $s]
}

proc ConvertAndDisplay {} {
    set Input [.f.io.input get]
    if {[string length $Input] < 1} {
	ClearOutput
	return
    }
    if {$::AutodetectNumberSystemP} {
	set tmp [StrGuessNumberSystem $Input]
	if {$::uninum_err == 0} {
	    .f.io.ins set [Underscore2Space $tmp]
	    set Value [UNStrToWNStr $Input $tmp]
	}
	set ::uninum_err 0
    }
    set Value [UNStrToWNStr $Input  [Space2Underscore [.f.io.ins get]]]
    if {$::uninum_err > 0} {HandleError $::uninum_err;return}
    set ::Uninum_Output_General_Group_Size [.f.par.del.ggrpsbx get]
    set ::Uninum_Output_First_Group_Size [.f.par.del.fgrpsbx get]
    scan  [lindex [split [.f.par.del.dchsbx get] ""] 0] %c c
    set ::Uninum_Output_Group_Separator $c
    set ::Uninum_Input_Base [.f.par.bas.ibasbx get]
    set ::Uninum_Output_Base [.f.par.bas.obasbx get]
    set ::OutputNumberSystem [Space2Underscore [.f.io.ons get]]
    set Result [WNStrToUNStr $Value [Space2Underscore $::OutputNumberSystem]]
    if {$::uninum_err > 0} {HandleError $::uninum_err;return}
    .f.io.output configure -state normal
    .f.io.output delete 1.0 end
    .f.io.output insert end $Result
    .f.io.output configure -state disabled
}

proc ClearInput {} {
    .f.io.input delete 0 end
}

proc ClearOutput {} {
    .f.io.output configure -state normal
    .f.io.output delete 1.0 end
    .f.io.output configure -state disabled
}

proc Save {} {
    set num [.f.io.output get 1.0 end]
    if {$num == ""} {
	ShowMessage [_ "There is no output to save."];
	return;
    }
    set SaveFile [tk_getSaveFile -initialfile "NumberConverterOutput"];
    if {$SaveFile != ""} {
	if {[catch {open $SaveFile "w"} SaveHandle ] != 0} {
	    ShowMessage [format [_ "Unable to open %s."] $SaveFile];
	    return;
	}
	puts $SaveHandle $num
	close $SaveHandle;
    }
}

font create InputFont  -family $DefaultInputFont -size $DefaultInputFontSize
font create OutputFont -family $DefaultInputFont -size $DefaultOutputFontSize

proc SetInputFont {} {
    font configure InputFont -family [.f.io.ift get] -size [.f.io.ifs get]
}

proc SetOutputFont {} {
    font configure OutputFont -family [.f.io.oft get] -size [.f.io.ofs get]
}

#Obtain lists of number systems
set NumToStringNSMaxLength 0
foreach x [lsort [split [Tcl_ListNumberSystems 0]]] {
    set cur [Underscore2Space $x]
    lappend NumToStringList $cur
    set curlen [string length $cur]
    if {$curlen > $NumToStringNSMaxLength} {set NumToStringNSMaxLength $curlen}
}
set StringToNumList $NumToStringList
set StringToNumNSMaxLength $NumToStringNSMaxLength 
foreach x [split [Tcl_ListNumberSystems 1]] {
    set cur [Underscore2Space $x]
    lappend StringToNumList $cur
    set curlen [string length $cur]
    if {$curlen > $StringToNumNSMaxLength} {set StringToNumNSMaxLength $curlen}
}
set StringToNumList [lsort $StringToNumList]

#Set up GUI
frame .f -border 2 -relief ridge

frame .f.io -relief flat -border 2
entry .f.io.input  -relief sunken  -width 40 -font InputFont
text  .f.io.output -width 40  -height 1 -font OutputFont \
    -relief sunken -exportselection 1

bind .f.io.input <Return> {ConvertAndDisplay}

spinbox .f.io.ins -width $StringToNumNSMaxLength -values $StringToNumList \
    -state readonly -wrap 1
spinbox .f.io.ons -width $NumToStringNSMaxLength -values $NumToStringList \
    -state readonly  -wrap 1
.f.io.ins set $InputNumberSystem
.f.io.ons set $OutputNumberSystem

set FontList [lsort [font families]]
spinbox .f.io.ift -values $FontList -state readonly -wrap 1 -command SetInputFont
spinbox .f.io.oft -values $FontList -state readonly -wrap 1 -command SetOutputFont
.f.io.ift set $DefaultInputFont
.f.io.oft set $DefaultOutputFont

spinbox .f.io.ifs -state readonly -wrap 1 -command SetInputFont  -from 4 -to 30 -width 2
spinbox .f.io.ofs -state readonly -wrap 1 -command SetOutputFont -from 4 -to 30 -width 2
.f.io.ifs set $DefaultInputFontSize
.f.io.ofs set $DefaultOutputFontSize

grid .f.io.input  -column 0 -row 0 -padx {5 5} -pady {5 5} -sticky w -columnspan 2
grid .f.io.output -column 2 -row 0 -padx {5 5} -pady {5 5} -sticky w -columnspan 2

grid .f.io.ift    -column 0 -row 1 -padx {5 5} -pady {5 5} -sticky w
grid .f.io.oft    -column 2 -row 1 -padx {5 5} -pady {5 5} -sticky w
grid .f.io.ifs    -column 1 -row 1 -padx {5 5} -pady {5 5} -sticky w
grid .f.io.ofs    -column 3 -row 1 -padx {5 5} -pady {5 5} -sticky w

grid .f.io.ins    -column 0 -row 2 -padx {5 5} -pady {5 5} -sticky w -columnspan 2
grid .f.io.ons    -column 2 -row 2 -padx {5 5} -pady {5 5} -sticky w -columnspan 2

frame .f.ctr -relief flat -border 2
button .f.ctr.clr -text "Clear" -command {ClearInput;ClearOutput}
button .f.ctr.sav -text "Save" -command Save
button .f.ctr.cnv -text "Convert" -command ConvertAndDisplay
checkbutton .f.ctr.kr -text [_ "Keep Raised?"] \
	-command ToggleKeepOnTop -onvalue 1 -offvalue 0 -variable KeepOnTopP

#Uncomment when ShowHelp is ready.
#button .f.ctr.hlp -text "Help" -command {ShowHelp}
button .f.ctr.dis -text "Dismiss" -command {exit 0}

pack .f.ctr.clr -side left  -expand 0 -fill none -padx {10 10} -pady {3 3}
pack .f.ctr.sav -side left  -expand 0 -fill none -padx {10 10} -pady {3 3}
pack .f.ctr.cnv -side left  -expand 0 -fill none -padx {10 10} -pady {3 3}
pack .f.ctr.dis -side right -expand 0 -fill none -padx {10 10} -pady {3 3}
pack .f.ctr.kr  -side right -expand 0 -fill none -padx {10 80} -pady {3 3}
#Uncomment when ShowHelp is ready.
#pack .f.ctr.hlp -side right -expand 0 -fill none -padx {10 35} -pady {3 3}

frame .f.par
frame .f.par.del -relief flat -border 2

spinbox .f.par.del.ggrpsbx -width 1 -state readonly -from 0 -to 5 
label   .f.par.del.ggrplab -text "General Group Size"
spinbox .f.par.del.fgrpsbx -width 1 -state readonly -from 0 -to 5 
label   .f.par.del.fgrplab -text "First Group Size"
spinbox .f.par.del.dchsbx  -width 1  -values {, . " " "'"}  
label   .f.par.del.dchlab -text "Separator Character"
.f.par.del.ggrpsbx set $GeneralGroupSize
.f.par.del.fgrpsbx set $FirstGroupSize
.f.par.del.dchsbx set $SeparatorCharacter

grid .f.par.del.ggrplab -row 0 -column 0 -sticky w -pady {2 2}
grid .f.par.del.ggrpsbx -row 0 -column 1 -sticky e -pady {2 2}
grid .f.par.del.fgrplab -row 1 -column 0 -sticky w -pady {2 2}
grid .f.par.del.fgrpsbx -row 1 -column 1 -sticky e -pady {2 2}
grid .f.par.del.dchlab  -row 2 -column 0 -sticky w -pady {2 2}
grid .f.par.del.dchsbx  -row 2 -column 1 -sticky e -pady {2 2}

checkbutton .f.par.adt -variable AutodetectNumberSystemP -onvalue 1 -offvalue 0 \
    -text "Autodetect Number System?" -selectcolor red

#checkbutton .f.par.rtb -variable Uninum_Generate_Roman_With_Bar_P -onvalue 1 -offvalue 0 \
    -text "Roman Numerals With Bar?" -selectcolor red

frame .f.par.bas
spinbox .f.par.bas.ibasbx -width 2 -state readonly -from 1 -to 36 
spinbox .f.par.bas.obasbx -width 2 -state readonly -from 1 -to 36 
label .f.par.bas.ibalab -text "Input Base"
label .f.par.bas.obalab -text "Output Base"
.f.par.bas.ibasbx set $InputBase
.f.par.bas.obasbx set $OutputBase

grid .f.par.bas.ibalab -row 0 -column 0 -sticky w -pady {1 3}
grid .f.par.bas.ibasbx -row 0 -column 1 -sticky e -pady {1 3}
grid .f.par.bas.obalab -row 1 -column 0 -sticky w -pady {3 1}
grid .f.par.bas.obasbx -row 1 -column 1 -sticky e -pady {3 1}

pack .f.par.adt -side left -padx {10 1} -expand 1 -fill x -anchor nw
pack .f.par.bas -side left -padx {10 1} -expand 1 -fill x -anchor nw
pack .f.par.del -side right -padx {10 1} -expand 1 -fill x -anchor ne



#grid .f.par.adt -row 0 -column 0 -sticky w -padx {3 20}
#grid .f.par.bas -row 1 -column 1 -sticky w -padx {3 20}
#grid .f.par.del -row 1 -column 2 -sticky e -padx {20 3}

pack .f.io  -side top -pady {3 7} -expand 1 -fill x 
pack .f.par -side top -pady {7 7} -expand 1 -fill x
pack .f.ctr -side top -pady {3 7} -expand 1 -fill x 

#grid .f.io  -row 0 -column 0 -sticky w
#grid .f.par -row 1 -column 0 -sticky w
#grid .f.ctr -row 2 -column 0 -sticky w

pack .f

.f.io.output configure -state disabled
wm title . [format "NumberConverter %s  \[libuninum %s\]" $Version [uninum_version]]