#!/usr/bin/wish
#
# tkshop - trivial, cross-platform shopping list helper
#
# dave@grox.net - Sat Dec 28 10:17:20 EST 2002
#
# based on tkpwdb:
# dave.capella@cornell.edu - Sat Dec 21 03:26:22 EST 2002
#
# May be freely distributed and used as long as this header is retained.
# All modifications must be clearly indicated.
#
# The author makes no promise of technical support. However, bug reports,
# suggestions, questions, and comments are welcome. All will be answered
# via electronic mail as time allows.
#
# NO WARRANTY OF ANY KIND EXPRESSED OR IMPLIED. USE AT YOUR OWN RISK.
#
############################################################

############################################################
# load data from disk
#
proc getdb {dbfile } {
	global db stores curStore total

	set db {}
	set stores {}
	set curStore "All Stores"

	set fd [ open $dbfile r ]
	set buf [ read $fd ]
	close $fd

	foreach line [ split $buf "\n" ] {
		if { [ string length $line ] } {

			# parse the fields from the line
			set fields [split $line : ]
			set store [lindex $fields 0]
			set item [lindex $fields 1]
			catch { [unset amt] }
			if { [scan [lindex $fields 2] "%f" amt] == 0 } {
				set amt .00
			}
			set aisle [lindex $fields 3]
			catch { [unset quant] }
			if { [scan [lindex $fields 4] "%d" quant] == 0 } {
				set quant 0
			}

			set total [ expr $total + ( $amt * $quant ) ]
			lappend stores $store
			set s [join [list $store $item $amt $aisle $quant] ":"]
			lappend db $s
		}
	}

	set stores [ lsort -unique -dictionary $stores ]
	set curStore [ lindex $stores 0 ]
	return $db
}

############################################################
# write data to disk
#
proc putdb {} {
	global db dbfile

	# add the data for each record
	#
	set buf {}
	foreach line $db {
		if [ string length $line ] {
			append buf "$line\n"
		}
	}

	set fd [ open $dbfile w ]
	puts $fd $buf
	close $fd
}

############################################################
# view and edit entries - main window
#
proc listwin {} {
	global db stores curStore listbox_map listbox_cursel item
	global lb_list total sortby viewby

	eval destroy [winfo children .]

	# app menu
	#
	frame .mf -relief raised
	pack .mf -side top -fill x

	menubutton .mf.file -text "tkShop" -menu .mf.file.m
	menu .mf.file.m -tearoff 0
	.mf.file.m add command -label "Save" -command putdb
	.mf.file.m add command -label "Quit" -command exit

	menubutton .mf.edit -text "Entry" -menu .mf.edit.m
	menu .mf.edit.m -tearoff 0
	.mf.edit.m add command -label "View" -command {
		set selection [.frame.list curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set item [lindex $db $idx]
			showrec View
			tkwait window .recwin
			listwin
		}
	}
	.mf.edit.m add command -label "Add" -command {
		set item {}
		showrec Add
		tkwait window .recwin
		lappend db $item
		listwin
	}
	.mf.edit.m add command -label "Edit" -command {
		set selection [.frame.list curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set item [lindex $db $idx]
			showrec Edit
			tkwait window .recwin
			set db [lreplace $db $idx $idx $item]
			listwin
		}
	}
	.mf.edit.m add command -label "Delete" -command {
		set selection [.frame.list curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set db [lreplace $db $idx $idx]
			listwin
		}
	}

	menubutton .mf.sort -text "Sort" -menu .mf.sort.m
	menu .mf.sort.m -tearoff 0
	.mf.sort.m add command -label "Aisle" -command {
		set sortby "aisle"
		set db [ lsort -command sortcmd $db ] 
		listwin
	}
	.mf.sort.m add command -label "Amount" -command {
		set sortby "amount"
		set db [ lsort -command sortcmd $db ] 
		listwin
	}
	.mf.sort.m add command -label "Item" -command {
		set sortby "name"
		set db [ lsort -command sortcmd $db ] 
		listwin
	}

	menubutton .mf.show -text "Show" -menu .mf.show.m
	menu .mf.show.m -tearoff 0
	.mf.show.m add command -label "All" -command {set viewby "All" ; listwin}
	.mf.show.m add command -label "Needed" -command {set viewby "Needed" ; listwin}

	menubutton .mf.store -text $curStore -menu .mf.store.m
	menu .mf.store.m -tearoff 0
	.mf.store.m add command -label "All Stores" -command {set curStore "All Stores" ; listwin}

	pack .mf.file .mf.edit .mf.sort .mf.show .mf.store -side left
	#
	# end: app menu

	label .l -text "Total: \$$total"
	pack .l -side top

	frame .frame
	pack .frame -side right -expand yes -fill y

	label .frame.l -text "Aisle # Item                      Amount    "
	pack .frame.l -side top -fill x
	scrollbar .frame.scroll -command ".frame.list yview"
	listbox .frame.list -yscroll ".frame.scroll set" -setgrid 1 -height 12 \
		-width 40 -background white -selectmode single -listvar lb_list
	pack .frame.scroll -side right -fill y
	pack .frame.list -side left -expand 1 -fill both

	fill_listbox
	.l configure -text "Total: \$$total"
	foreach s $stores {
		.mf.store.m add command -label "$s" -command "set curStore $s ; listwin"
	}

	bind .frame.list <<ListboxSelect>>  { set listbox_cursel [%W curselection] }
#	bind .frame.list <Double-Button-1>  {
#		set listbox_cursel [%W curselection]
#		set selection [%W curselection]
#		if [expr [llength $selection] == 1 ] {
#			set idx [lindex $listbox_map $selection]
#			set item [lindex $db $idx]
#			showrec View
#			tkwait window .recwin
#			listwin
#		}
#	}
	# toggle quantity needed field between 1 and 0
	bind .frame.list <Double-Button-1>  {
		set listbox_cursel [%W curselection]
		set selection [%W curselection]
		if [expr [llength $selection] == 1 ] {
			set idx [lindex $listbox_map $selection]
			set rec [split [lindex $db $idx] ":"]
			if { [lindex $rec 4] == "1" } {
				set rec [lreplace $rec 4 4 0]
			} else {
				set rec [lreplace $rec 4 4 1]
			}
			set s [join $rec ":"]
			set db [lreplace $db $idx $idx $s]
			listwin
		}
	}

}

############################################################
# insert category (store) of entries into list box from db
#
proc fill_listbox {} {
	global db curStore listbox_map stores lb_list total viewby

	set db_idx 0
	set stores {}
	set listbox_map {}
	set lb_list {}
	set total 0

	foreach item $db {
		set fields [ split $item : ]
			set store [ lindex $fields 0 ]
			set nam [ lindex $fields 1 ]
			scan [ lindex $fields 2 ] "%f" amt
			set aisle [ lindex $fields 3 ]
			scan [ lindex $fields 4 ] "%2d" quant
		# only insert items in the current store or 'All Stores'
		# and if view "All" or if item needed (quantity > 0)
		set is_store "[string equal $store $curStore ] || [string equal "All Stores" $curStore]"
		set is_needed "[string equal $viewby "All"] || [expr $quant > 0]"
		if { [expr $is_store > 0] && [expr $is_needed > 0] } {
			# this mess 'cos tcl's built-in format command
			# won't accurately line up columns
			set n [format {%.02f} $amt]
			set l [string length $n]
			set spacer ""
			if {$l < 5} {
				for {set i $l} {$i < 5} {incr i} { set spacer " $spacer" }
			}
			set n [join [list "$" $spacer $n] ""]
			set s [format {[%2s] %2d %-25.25s %s} $aisle $quant $nam $n]
			lappend lb_list $s
			lappend listbox_map $db_idx

			# add to total - total is only for displayed store
			set total [ expr $total + ( $amt * $quant ) ]
		}
		# generate the list of stores from the first field
		lappend stores [ lindex $fields 0 ]

		incr db_idx
	}
	set stores [ lsort -unique -dictionary $stores ]
}

############################################################
# view and edit entries - main window
#
proc showrec {mode} {
	global db dbfile store system account password
	global notes stores curStore tcl_platform item

	catch {destroy .recwin}
	toplevel .recwin
	wm title .recwin "tkshop: Record"

	set fields [split $item :]
	
	frame .recwin.buttons
	pack .recwin.buttons -side bottom -fill x -pady 2m
	button .recwin.buttons.ok -text Okay -command {
		set store [.recwin.store.entry get]
		set name [.recwin.name.entry get]
		set amount [.recwin.amount.entry get]
		set aisle [.recwin.aisle.entry get]
		set quantity [.recwin.quantity.entry get]
		set item "$store:$name:$amount:$aisle:$quantity"
		destroy .recwin
		return $item
		}
	pack .recwin.buttons.ok -side top -expand 1

	frame .recwin.store -bd 2
	entry .recwin.store.entry -relief sunken -width 30
	.recwin.store.entry insert 0 [lindex $fields 0]
	label .recwin.store.label -text Store
	pack .recwin.store.entry -side right
	pack .recwin.store.label -side left

	frame .recwin.name -bd 2
	entry .recwin.name.entry -relief sunken -width 30
	.recwin.name.entry insert 0 [lindex $fields 1]
	label .recwin.name.label -text Item
	pack .recwin.name.entry -side right
	pack .recwin.name.label -side left

	frame .recwin.amount -bd 2
	entry .recwin.amount.entry -relief sunken -width 30
	.recwin.amount.entry insert 0 [lindex $fields 2]
	label .recwin.amount.label -text Amount
	pack .recwin.amount.entry -side right
	pack .recwin.amount.label -side left

	frame .recwin.aisle -bd 2
	entry .recwin.aisle.entry -relief sunken -width 30
	.recwin.aisle.entry insert 0 [lindex $fields 3]
	label .recwin.aisle.label -text Aisle
	pack .recwin.aisle.entry -side right
	pack .recwin.aisle.label -side left

	frame .recwin.quantity -bd 2
	entry .recwin.quantity.entry -relief sunken -width 30
	.recwin.quantity.entry insert 0 [lindex $fields 4]
	label .recwin.quantity.label -text Quantity
	pack .recwin.quantity.entry -side right
	pack .recwin.quantity.label -side left

	if [string equal $mode View] {
		.recwin.store.entry configure -state disabled -relief ridge
		.recwin.name.entry configure -state disabled -relief ridge
		.recwin.amount.entry configure -state disabled -relief ridge
		.recwin.aisle.entry configure -state disabled -relief ridge
		.recwin.quantity.entry configure -state disabled -relief ridge
	}

	pack .recwin.store .recwin.name .recwin.amount .recwin.aisle .recwin.quantity \
		-side top -fill x

	focus .recwin.store.entry
}

############################################################
# display a message in a window
#
proc msg { txt } {
	catch { destroy .msgwin }
	toplevel .msgwin
	label .msgwin.l -text $txt
	button .msgwin.b -text ok -command { destroy .msgwin }
	pack .msgwin.l .msgwin.b
}

############################################################
# sort data by arbitrary field
#
proc sortcmd { first second } {
	global sortby
	set s1 [split $first :] 
	set s2 [split $second :] 
	if [string equal $sortby "aisle"] {
		# force numeric sort
		if { ! [string is digit [lindex $s1 3] ] ||\
			[string length [lindex $s1 3]] < 1 } {
			set a1 "00"
		} else {
			set a1 [format "%02d" [lindex $s1 3]]
		}
		if { ! [string is digit [lindex $s2 3] ] || \
			[string length [lindex $s2 3]] < 1 } {
			set a2 "00"
		} else {
			set a2  [format "%02d" [lindex $s2 3]]
		}
		return [string compare $a1 $a2]
	} elseif [string equal $sortby "amount"] {
		# force numeric sort
		set a1 [format "%02.02f" [lindex $s1 2]]
		for {set i [string length $a1] } {$i < 5} {incr i} {
			set a1 [join [list "0" $a1] ""]
		}
		set a2  [format "%02.02f" [lindex $s2 2]]
		for {set i [string length $a2] } {$i < 5} {incr i} {
			set a2 [join [list "0" $a2] ""]
		}
		return [string compare $a1 $a2]
	} else {
		return [string compare [lindex $s1 1] [lindex $s2 1]]
	}
}

#####################################################################
# globals
# i know, ya ain't s'posed ta, but this is a tiny program, after all.
#
set db {}
set stores {}
set curStore ""
set listbox_map {}
set item {}
set lb_list {}
set total 0
set sortby "aisle"
set viewby "All"
set numfields 5

############################################################
# main
############################################################

# for the ipaq - it's a small screen.
# 
if { $tcl_platform(machine) == "armv4l" } {
	option add "*Font" "-*-*-*-*-*-*-7-*-*-*"
} elseif { $tcl_platform(os) == "Linux" } {
	option add "*Font" "fixed"
} elseif { [string equal -length 7 $tcl_platform(os) "Windows"] } {
	option add "*Font" "Courier"
	# debug
	#msg "platform: $tcl_platform(os)"
	#tkwait window .msgwin
}

# initialize the default location for the data file
#
if { $tcl_platform(os) == "Windows NT" } {
	set dbfile [file join $env(HOMEDRIVE) $env(HOMEPATH) .tkshop]
} elseif { $tcl_platform(os) == "macintosh" } {
	set dbfile [file join $env(PREF_FOLDER) tkshop]
} else {
	set dbfile [file join $env(HOME) .tkshop]
}

# but see if it's overridden on the command line
# we accept 2 cases:
# 1. no args - use default file, .tkshop, in $HOME
# 2. 1 arg - file name to open
#
if { $argc } {
	set dbfile [lindex $argv 1]
	if [ expr ! [ file isfile $argv ] ] {
		msg "Cannot use the file: $argv"
		tkwait window .msgwin
		exit
	}
}

set db [ lsort -dictionary [ getdb $dbfile ] ]
listwin