#!/bin/sh
# the next line restarts using tclsh \
    exec wish "$0" "$@"
#########################################################
#
# Title: pbtools.tcl
#
# pbtools.tcl is a Tcl/Tk front-end to the palmboy tool gb2pdb for Unix and NT
# Copyright (C) 2001 Paul Chandler.
#
# 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
#
# email: pchandle99@yahoo.com.au
#
# $Log$
#
####################### Package setup ####################
# No packages
######################## Globals #########################
set version "1.0.1"

set options(DialogFont) "Helvetica -12"

set options(username) "Paul Chandler"

# Debug options
set options(debug) 0
set options(paranoid) 0

######################## Generic Functions ###################################
#
##############################################################################
#  Function:
#  openFiles - open files (unix)
#  
#  Description:
#
#  Returns:
#    None
#
#  Comments:
#
proc openFiles {} {
    global options tcl_platform

    set openoptions ""

    # For the type listbox in the open dialog
    set types {
	{{GameBoy ROM Files}       {.gb*} }
	{{All Files}         *      }
    }
    
    # file dialog
    set dir [tk_getOpenFile -title "Select GameBoy ROMs" \
		 -filetypes $types -initialdir [pwd]]

    return $dir
}

##############################################################################
#  Function:
#  actionFiles - transfer the files (unix)
#  
#  Description:
#
#  Returns:
#    None
#
#  Comments:
#
proc actionFiles {action} {
    global options filenametext statustext going

    # No files, do nothing
    if { [info exists options(roms)] == 0 } {
	return
    }

    # New window
    toplevel .xfer

    # Can't input on the main window
    grab set .xfer
    focus .xfer

    frame .xfer.main

    set filenametext ""
    label .xfer.main.label -text "Converting file:" \
	-justify left \
	-font $options(DialogFont)

    label .xfer.main.padding -width 50
    label .xfer.main.padding2
    label .xfer.main.labelfile -textvariable filenametext \
	-font $options(DialogFont)
    label .xfer.main.status -textvariable statustext \
	-font $options(DialogFont)
    button .xfer.main.button -text "Cancel" \
	-justify left \
	-font $options(DialogFont) \
	-width 8 \
	-command {
	    set going 0
	    destroy .xfer
	}


    # Pack everything
    pack .xfer.main -padx 10 -pady 10
    pack .xfer.main.label -side top -anchor w
    pack .xfer.main.padding2
    pack .xfer.main.labelfile
    pack .xfer.main.padding
    pack .xfer.main.status -side left -anchor w
    pack .xfer.main.button -side right -anchor e

    wm title .xfer "Converting files"
    wm resizable .xfer 0 0
    wm protocol .xfer WM_DELETE_WINDOW {
	set going 0
	destroy .xfer
    }

    set going 1
    $action

    # The window's already been destroyed
    if { $going == 0 } { return }
    set going 0

    .xfer.main.button configure -text "Done"
    #.xfer.main.label configure -text "Transfer complete"
    .xfer.main.label configure -text ""
    set filenametext "Transfer Complete"

    tkwait window .xfer

    destroy .xfer
}



##############################################################################
#  Function:
#  convertAction - convert the selected files
#  
#  Description:
#
#  Returns:
#    None
#
#  Comments:
#
set filecount 0
set prevfile ""

proc convertAction {} {

    global options filenametext statustext tcl_platform going

    set count 1
    set nofiles [llength $options(roms)]

    foreach file $options(roms) {

	if { $going == 0 } { break }

	set statustext "File $count of $nofiles"

	# Update the display
	set filenametext [file tail $file]
	
	# Set the output file to be in the current directory
	set outfile "[file rootname [file tail $file]].pdb"

	# The windows gb2pdb seems to only want 8.3 filenames - mangle them
	# Hopefully this is only temporary
	# Remove all those nasty characters
	if { $tcl_platform(platform) == "windows" } {

	    set origfile $file

	    # Find the amount of name to compare 
	    # - spaces are removed and aren't counted in the compare
	    set name [file rootname [file tail $file]]
	    set namecount 0
	    set index 0
	    while { $namecount < 6 && $index < [string length $name] } {
		if { [string index $name $index] != " " } {
		    incr namecount
		}
		incr index
	    }

	    # Get the number, if there are multiples (ie filena~2)
	    set filelist [glob [file dirname $file]/[string range [file rootname [file tail $file]] 0 $namecount]*[file ext $file]]

	    set filecount 1
	    set fileitem 0
	    while { $fileitem < [llength $filelist] } {
		if { $file == [lindex $filelist $fileitem] } {
		    break
		}
		incr filecount
		incr fileitem
	    }

	    # Normal rules don't apply after 4(don't know why)(on 2000 anyway)
	    if { $filecount < 5 } { 
		regsub -all {\ } $file "" file
		regsub -all {\[|\]|\,|\?|\*|\|\<|\>|\$} $file "_" filename
		
		if { [string length [file rootname [file tail $file]]] > 8 } {
		    # TODO: Hack the filename
		    # Take the file name part
		    set fileroot [file rootname [file tail $filename]]

		    regsub -all {\.} $fileroot "" rootname
		    set rootname [string range $rootname 0 5]

		    # set the filename to the first 6 char + ~ + count and 
		    # add dir and extension
		    set filename "[file dirname $filename]/$rootname~$filecount[file ext $filename]"
		    
		    # Next file name will be the next number
		    incr filecount
		    
		}

		set file $filename

	    } else {
		# just copy it to a temporary file
		# should have done this in the first place - too smart for
		# my own good :P
		# oh well, the above is faster anyway
		catch {file copy -force $origfile "palmboy.gb"}
		set file "palmboy.gb"
	    }

	    set outfile "[file rootname [file tail $file]].tmp"
	    set realoutfile "[file rootname [file tail $origfile]].pdb"
	    
	    # Don't repeat if output file already exists
	    if { [file exists $realoutfile] == 1 } {
		set filenametext "Skipping $realoutfile"
		update
		#after 20000
		continue
	    }
	    
	}

	update

	# Convert the file
	set rc [catch {exec gb2pdb $file $outfile} errormsg]
	if { $rc != 0 } {

	    #puts $errormsg
	    
	    # Not fatal by default
	    set fatal 0

	    # Check if gb2pdb is in the path
	    if { $errormsg == "couldn't execute \"gb2pdb\": no such file or directory" } {
		# User friendly message
		set errormsg "Could not find gb2pdb - please make sure it is in your execution path"
		# A fatal error
		set fatal 1
	    } else {
		# Must be a problem with the gameboy rom
		if { [regexp "warning: .*(?=\$)" $errormsg errormsg] == 0 } {
		    regexp "error: .*\$" $errormsg errormsg
		}
		set errormsg [string range $errormsg 0 [expr [string first \n $errormsg] - 1]]
	    }

	    #puts $errormsg
	    #set filenametext "Conversion Failed"
	    # It might one day support longer files
	    if { $tcl_platform(platform) == "windows" } {
		set errortext "There was an error converting the gameboy ROM file \"[file tail $origfile]\"

$errormsg
"
	    } else {
	    set errortext "There was an error converting the gameboy ROM file \"[file tail $file]\"

$errormsg
"
	    }

	    tk_dialog .error "Error Converting files" $errortext "" 0 "OK"

	    # Detected a fatal error
	    if { $fatal == 1 } {
		set going 0
		destroy .xfer
		return
	    }
	}

	# Write it back to it's full name
	if { $tcl_platform(platform) == "windows" } {
	    catch {file copy -force $outfile $realoutfile}
	    catch {file delete -force $outfile}
	}
	incr count

    }

    if { $tcl_platform(platform) == "windows" } {
	catch {file delete -force "palmboy.gb"}
	catch {file delete -force [glob *.tmp]}
    }

}



##############################################################################
#  Function:
#  unixAction - transfer the files (unix)
#  
#  Description:
#
#  Returns:
#    None
#
#  Comments:
#
proc unixAction {} {

    global options filenametext statustext going

    convertAction

    if { $going == 0 } { return }

    set files ""
    foreach file $options(roms) {
	set files "$files \"[file rootname [file tail $file]].pdb\""
    }
    
    .xfer.main.label configure -text "Transfering Files:"
    set filenametext "Please press the HotSync button"

    update
    if { $going == 0 } { return }

    set count 0
    set nofiles [llength $options(roms)]
    set statustext "File $count of $nofiles"
    update
    if { $going == 0 } { return }

    set fp [open "|pilot-xfer -i $files" "r"]

    # Check for failure
    if { $fp == "" } {
	puts "Please ensure that pilot-link is installed on your system and in the search path"
	set filenametext "Transfer failed"
	update
	return
    }

    while {[gets $fp line] >= 0} {
	set statustext "File [expr $count + 1] of $nofiles"

	set filenametext "[file rootname [file tail [lindex $options(roms) $count]]].pdb"
	update
	if { $going == 0 } { break }

	# Increment if pilot link text is something about this file
	if { [string first "$filenametext" $line] != -1 } {
	    incr count
	}
    }
    
    set statustext "File $count of $nofiles"

    catch {close $fp}
}


##############################################################################
#  Function:
#  fileExit - exit
#  
#  Description:
#    Delete the temporary files for windows before leaving
#
#  Returns:
#    None
#
#  Comments:
#
proc fileExit {} {
    global tcl_platform

    if { $tcl_platform(platform) == "windows" } {
	catch {file delete [glob *.tmp]}
    }
    exit
}

##############################################################################
#  Function:
#  helpAbout - Show the about box
#  
#  Description:
#    "The ubiquitous ego box"
#
#  Returns:
#    None
#
#  Comments:
#
proc helpAbout {} {
    
    global version options

    set aboutfont "Helvetica -12"
    toplevel .aboutbox

    label .aboutbox.label1 -text "

PalmBoy Transfer Assistant $version
"\
	-font $aboutfont
    label .aboutbox.label2 -text "PalmBoy Transfer Assistant is a Tcl/Tk front-end to the PalmBoy tool gb2pdb for Unix and NT.
Copyright (C) 2001 Paul Chandler
pchandle99@yahoo.com.au" \
	-wraplength 500 \
	-font $aboutfont
    label .aboutbox.label3 \
	-wraplength 500 \
	-justify left \
	-text "
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

" \
	-font $aboutfont
    button .aboutbox.close -text "Ok" -command "eval destroy .aboutbox" \
	-font $aboutfont -width 10
    pack .aboutbox.label1 .aboutbox.label2 \
	 .aboutbox.label3 -padx 20
    pack .aboutbox.close -pady 20

    wm title .aboutbox "About PalmBoy Transfer Assistant"
    wm resizable .aboutbox 0 0
}

##############################################################################
#  Function:
#  setupDisplay - setup the graphical display
#  
#  Description:
#
#  Returns:
#    None
#
#  Comments:
#
proc setupDisplay {} {

    global options tcl_platform

    # This will fail if DISPLAY is not set to a valid display
    set rc [catch {frame .main -relief flat}]
    if { $rc != 0 } {
	return 1
    }
    
    # A menu
    frame .mainmenu

    menubutton .mainmenu.file -text "File" -underline 0 \
	-font $options(DialogFont) \
	-menu .mainmenu.file.menu
    menubutton .mainmenu.help -text "Help" -underline 0 \
	-font $options(DialogFont) \
	-menu .mainmenu.help.menu

    menu .mainmenu.file.menu
    menu .mainmenu.help.menu

    .mainmenu.file.menu add command -label "Exit" \
	-font $options(DialogFont) \
	-command {
	    fileExit
	}
    .mainmenu.help.menu add command -label "About" \
	-font $options(DialogFont) \
	-command helpAbout

    # Logo
    frame .logo
    label .logo.label \
	-justify left \
	-font $options(DialogFont) \
	-text "
PalmBoy - the Gameboy experience bought to your Palm"

    # Some buttons at the bottom
    frame .buttons -relief flat
    frame .buttons.right -relief flat
    frame .buttons.left -relief flat
    frame .buttons.middle

    # Exit
    button .buttons.right.exit -text "Exit" \
	-font $options(DialogFont) \
	-width 8 \
	-command {
	    fileExit
	}

    # Transfer
    button .buttons.right.transfer -text "Begin Transfer" \
	-font $options(DialogFont) \
	-width 20 \
	-command {
	    if { $tcl_platform(platform) == "windows" } {
		actionFiles convertAction
	    } else {
		actionFiles unixAction
	    }
	}

    button .buttons.middle.addall -text "Add all files in current dir" \
	-font $options(DialogFont) \
	-width 20 \
	-command {
	    # Insert all the files in the current dir
	    set currentList [.main.filelist.listbox.list get 0 end]
	    foreach file [glob -nocomplain [pwd]/*.gb*] {
		# Already there?
		if { [lsearch -exact $currentList [file tail $file]] != -1 } {
		    continue
		}
		lappend options(roms) "$file"
		.main.filelist.listbox.list insert end [file tail $file]
	    }
	}

    button .buttons.left.add -text "Add ROM to transfer list" \
	-font $options(DialogFont) \
	-width 20 \
	-command {
	    # file dialog
	    set dir [openFiles]
	    
	    # User didn't press cancel
	    if { $dir != "" } {

		# Insert all the files in the current dir
		set currentList [.main.filelist.listbox.list get 0 end]
		if { [lsearch -exact $currentList [file tail $dir]] == -1 } {

		    # Add the roms to the filelist
		    lappend options(roms) $dir
		    
		    # Add the roms to the list
		    .main.filelist.listbox.list insert end [file tail $dir]
		}
		cd [file dirname $dir]
	    }
	}

    button .buttons.left.del -text "Delete from transfer list" \
	-font $options(DialogFont) \
	-width 20 \
	-command {
	    # Delete from roms list and listbox
	    set current [.main.filelist.listbox.list curselection]

	    # Delete the last first, so the list is not rearranged
	    set current [lsort -dictionary -decreasing $current]

	    # Delete on item at a time
	    foreach item $current {
		.main.filelist.listbox.list delete $item
		set options(roms) [lreplace $options(roms) $item $item]
	    }
	}

    # Filename list
    frame .main.filelist -relief flat
    frame .main.top -relief flat
    frame .main.top.instructions -relief flat
    frame .main.top.options -relief flat 
    label .main.top.instructions.label \
	-justify left \
	-font $options(DialogFont)

    if { $tcl_platform(platform) == "windows" } {
	.buttons.right.transfer configure -text "Begin Conversion"
	.main.top.instructions.label configure \
	    -text "
Instructions:

1) To prepare Gameboy ROMs file(s) for conversion for Palm Device, click \"Add ROM to transfer list\"
2) To convert the file(s), click the \"Begin Conversion\" button
"
    } else {
	.main.top.instructions.label configure \
	    -text "
Instructions:

1) To select Gameboy ROMs file(s) for transfer to Palm Device, click \"Add ROM to transfer list\"
2) To transfer the file(s), click the \"Begin Transfer\" button
"
    }

    label .main.top.options.userlabel -text "  User" \
	-justify left \
	-font $options(DialogFont)
    button .main.top.options.prefs -text "Preferences" \
	-width 15 \
	-font $options(DialogFont)
    label .main.top.options.padding
    menubutton .main.top.options.user -textvariable options(username) \
	-font $options(DialogFont) \
	-indicatoron 1 \
	-relief sunken \
	-width 15 \
	-menu .main.top.options.user.userlist
    menu .main.top.options.user.userlist
    .main.top.options.user.userlist add command -label "Paul Chandler" \
	-font $options(DialogFont)

    # gb roms list and pdb files list
    label .main.filelist.label -text "To be transfered to device" \
	-justify left \
	-font $options(DialogFont)

    # TODO: Scroll bars
    frame .main.filelist.listbox
    listbox .main.filelist.listbox.list \
	-bg white -width 60 \
	-font $options(DialogFont) \
	-selectmode extended \
	-yscrollcommand ".main.filelist.listbox.mlvs set" \
	-xscrollcommand ".main.filelist.listbox.mlhs set"

    scrollbar .main.filelist.listbox.mlvs -orient vertical \
	-command ".main.filelist.listbox.list yview"
    scrollbar .main.filelist.listbox.mlhs -orient horizontal \
	-command ".main.filelist.listbox.list xview"

    # Packs everything into the parent form and
    # makes a square in the bottom right of the size of the scroll bar width
    grid .main.filelist.listbox.list -column 0 -row 0 -sticky nsew
    grid .main.filelist.listbox.mlvs -column 1 -row 0 -sticky ns
    grid .main.filelist.listbox.mlhs -column 0 -row 1 -sticky ew
    grid columnconfigure .main.filelist.listbox 0 -weight 1
    grid columnconfigure .main.filelist.listbox 1 -weight 0
    grid columnconfigure .main.filelist.listbox 2 -weight 0
    grid rowconfigure .main.filelist.listbox 0 -weight 1


    # Pack the menu
    pack .mainmenu -side top -fill x -expand 1
    pack .mainmenu.file .mainmenu.help -side left

    # Pack the main bit
    pack .logo -side top -anchor w -pady 10 -padx 10
    pack .logo.label -fill x -expand 1 -anchor w
    pack .main -side top -padx 10 -pady 10
    pack .buttons -side bottom -fill x -expand 1 -padx 10 -pady 10
    pack .buttons.right -side right -fill y
    pack .buttons.right.exit -side bottom -anchor e
    pack .buttons.right.transfer -side top -anchor n
    pack .buttons.left -side left
    pack .buttons.left.add -side top -anchor n
    pack .buttons.left.del -side bottom -anchor s
    pack .buttons.middle -side left -fill y
    pack .buttons.middle.addall -side top -anchor n
    pack .main.top
    pack .main.top.instructions -side left -fill x
    pack .main.top.instructions.label -anchor w
    pack .main.top.options -side right -ipadx 10
    #pack .main.top.options.padding
    #pack .main.top.options.prefs -side bottom -anchor s -pady 5
    pack .main.filelist -fill x -expand 1
    pack .main.filelist.label -anchor w
    pack .main.filelist.listbox -fill x -expand 1

    wm title . "PalmBoy Transfer Assistant"
    wm resizable . 0 0
    wm protocol . WM_DELETE_WINDOW {fileExit}

    return 0
}

######################## Main Functions ######################################
#
##############################################################################
#  Function:
#  main - main function
#  
#  Description:
# 
#  Returns:
#
#  Comments:
#
proc main {argc argv} {

    global tcl_platform env options

    if { $tcl_platform(platform) == "unix" && \
	     [info exists env(DISPLAY)] == 0 } {
	puts "The environment variable DISPLAY must be set to run pbtools"
	exit
    }

    if { [setupDisplay] != 0 } {
	puts "The environment variable DISPLAY must be set to a valid X\
display server to run pbtools"
    }

}

######################## Boot strap ###################################
#
# Start the graphic or text based on name executed as
# Allows both text and X versions to be in the same script
#    but executed as different names
#
if { $tcl_version <= 8.0 } {
    puts "pbtools script requires tcl version 8.0 or greater"
    exit
}

main $argc $argv