#!/usr/bin/env wish

# WISH Binary Viewer 2009
# (the second public release of WISH Binary Viewer)
# by David McClamrock <mcclamrock@locl.net>
# Inspired by "A Little Hex Editor Widget" by George Peter Staplin

# Copyright  2008 David H. McClamrock
# Freely available under Maximum Use License for Everyone
# You should have received a copy of this license with this program.
# If you didn't, e-mail the author to get one.


##################################


### INITIALIZATION ###


# WISH applications require at least Tcl and Tk 8.5:

set tclo [package vcompare [package require Tcl] 8.5]
set tko [package vcompare [package require Tk] 8.5]
if {$tclo < 0 || $tko < 0} {
	tk_messageBox -message "This program requires Tcl and Tk 8.5 or greater" -type ok
	exit
}
package require Ttk

# Default settings:

set topdir /usr/local
set docdir [file join $topdir doc wishes]
set libdir [file join $topdir lib wishes]
set helpfile [file join $docdir binvuhelp_link.txt] ; # User Help Guide
set licfile [file join $docdir mule_license.txt] ; # License
set version "2009"

# Where program listings and configuration files go
# (Replace old "~/wishes," if any, with new "~/.wishes")

set wishdir [file join $env(HOME) .wishes]
set oldwishdir [file join $env(HOME) wishes]
if {[file exists $wishdir] == 0} {
	if {[file exists $oldwishdir] && [file type $oldwishdir] eq "directory"} {
		file rename $oldwishdir $wishdir
		file link $oldwishdir $wishdir
	} else {
		file mkdir $wishdir
	}
}
set colordir [file join $wishdir colorschemes]

# One or more features may work only on unix platforms (including Linux), 
# so identify the platform:
set platforms [split [array get tcl_platform]]
if {"unix" in $platforms} {
	set platform unix
}

# Set defaults (may be changed by configuration file--see below)

set hexies "" ; # No hex data obtained yet
set curfil "" ; # No file opened yet
set oldcurfil "" ; # No file previously opened either
set search_for "" ; # No search criteria specified yet
set wid(byte) 8 ; # Hex digits for byte offset
set hexo 1 ; # Show hexadecimal representation
set hexexp 1 ; # Expand hex view with spaces between bytes
set hexread 32 ; # Number of hex digits per line
set wid(hexo) [expr {$hexread * 3/2}] ; # Width of widget for hex digits
set bino 0 ; # Don't show binary representation just now
set wid(bino) 0 ; # So, no width for binary representation
set decimo 0 ; # No decimal representation either
set wid(decimo) 0 ; # And no width for it
set texto 1 ; # Show text representation
set wid(texto) 16 ; # Width of widget for text
set iso88591 0 ; # Don't show standard Latin non-ASCII characters as text
set showlist [list byte hex texto] ; # What's to be shown
set boxlist [list .tex(byte) .tex(hex) .tex(texto)] ; # Boxes to show it
set casematch nocase ; # Don't demand case matching in search
set searchway forward ; # Search down, not up
set expert 0 ; # Presume no expert (regular-expression) search
set subchar {~} ; # Character to substitute for non-text bytes
set coloron 0 ; # WISH Color Picker Plus not loaded yet
set helpon 0 ; # Nor WISH User Help

# Read configuration file, if there is one

set binvufig [file join $wishdir binvufig.tcl]
if {[file readable $binvufig]} {
	source $binvufig
}

# Procedure to save configuration:

proc savefig {} {
	global binvufig
	set filid [open $binvufig w]
	set figlines "# WISH Binary Viewer configuration file (binvufig.tcl) \
		\n\nset wid(byte) $::wid(byte) \
		\nset hexo $::hexo \
		\nset hexexp $::hexexp \
		\nset hexread $::hexread \
		\nset wid(hexo) $::wid(hexo) \
		\nset bino $::bino \
		\nset wid(bino) $::wid(bino) \
		\nset decimo $::decimo \
		\nset wid(decimo) $::wid(decimo) \
		\nset texto $::texto \
		\nset wid(texto) $::wid(texto) \
		\nset iso88591 $::iso88591 \
		\nset showlist \[list $::showlist\] \ 
		\nset boxlist \[list $::boxlist\] \
		\nset casematch $::casematch \
		\nset searchway $::searchway \
		\nset subchar $::subchar \
		\nset current_scheme $::current_scheme"
	puts -nonewline $filid $figlines
	close $filid
}

# Hang onto original settings in case you want them back:

set old(hex) $hexo
set old(bin) $bino
set old(dec) $decimo
set old(texto) $texto
set old(iso88591) $iso88591
set old(subchar) $subchar

# Initialize lists of widgets for color display
# (not all may be used by all programs):

set buttlist [list] ; # Buttons
set texlist [list] ; # Text widgets
set entlist [list] ; # Entry widgets
set lublist [list] ; # Listboxes
set spinlist [list] ; # Spinboxes
set winlist [list] ; # Widgets to get window background color when disabled
set headlist [list] ; # Emphasized labels
set lightlist [list] ; # Light labels
set checklist [list] ; # Checkbuttons and radiobuttons

# Integer range generator for "foreach"
# (to do a "for" loop without ugly, awkward "for" code):

proc range {start cutoff finish {step 1}} {
	# If "start" and "finish" aren't integers, do nothing:
	if {[string is integer -strict $start] == 0 || [string is\
		integer -strict $finish] == 0} {
		error "range: Range must contain two integers"
	}
			
	# "Step" has to be an integer too, and
	# no infinite loops that go nowhere are allowed:
	if {$step == 0 || [string is integer -strict $step] == 0} {
		error "range: Step must be an integer other than zero"
	}
	
	# Does the range include the last number?
	switch $cutoff {
		"to" {set inclu 1}
		"no" {set inclu 0}
		default {
			error "range: Use \"to\" for an inclusive range,\
			or \"no\" for a noninclusive range"
		}
	}
		
	# Is the range ascending or descending (or neither)?
	set ascendo [expr $finish - $start]
	if {$ascendo > -1} {
		set up 1
	} else {
		set up 0
	}
	
	# If range is descending and step is positive but doesn't have a "+" sign,
	# change step to negative:
	if {$up == 0 && $step > 0 && [string first "+" $start] != 0} {
		set step [expr $step * -1]
	}
	
	set ranger [list] ; # Initialize list variable for generated range
	switch "$up $inclu" {
		"1 1" {set op "<=" ; # Ascending, inclusive range}
		"1 0" {set op "<" ; # Ascending, noninclusive range}
		"0 1" {set op ">=" ; # Descending, inclusive range}
		"0 0" {set op ">" ; # Descending, noninclusive range}
	}
	
	# Generate a list containing the specified range of integers:
	for {set i $start} "\$i $op $finish" {incr i $step} {
		lappend ranger $i
	}
	return $ranger
}

##################################


### GUI ###


### MAIN WINDOW:

wm title . "WISH Binary Viewer"
set fonto -*-courier-medium-r-normal--12-*-*-*-*-*-*
label .lab(byte) -text "Byte"
label .lab(hexo) -text "Hexadecimal"
label .lab(bino) -text "Binary"
label .lab(decimo) -text "Decimal"
label .lab(texto) -text "Text"
text .tex(byte) -width 8 
text .tex(hexo) -width $wid(hexo)
text .tex(bino) -width $wid(bino)
text .tex(decimo) -width $wid(decimo)
text .tex(texto) -width $wid(texto)
ttk::scrollbar .binbar ; # proc "gridview" (below) makes this work
foreach labo [list .lab(byte) .lab(hexo) .lab(bino) .lab(decimo) .lab(texto)] {
	$labo configure -pady 4 -padx 0 -relief raised
}
foreach texo [list .tex(byte) .tex(hexo) .tex(bino) .tex(decimo) .tex(texto)] {
	$texo configure -height 32 -font $fonto -setgrid 1
	lappend texlist $texo
	bind $texo <FocusIn> {set foco %W}
}
bind . <Control-c> {tk_textCopy $foco}

label .stat -relief sunken

frame .fr
button .help -text "HELP" -command binvuhelp
button .ope -text "Open" -command {filopy pick}
button .view -text "View" -command figbox
button .copy -text "Copy" -command {tk_textCopy $foco}
button .save -text "Save" -command bin_save
button .search -text "Find (F2)" -command findwhat
button .colodisp -text "Color Display" -command colodisp
button .quit -text "Quit" -command shootdown
pack .help .ope .view .copy .save .search .colodisp .quit -in .fr \
	-side left -expand 1 -fill both
foreach butt [list .help .ope .view .copy .save .search .colodisp .quit] {
	lappend buttlist $butt
}

bind . <F2> findwhat

# Procedure to get text widgets to scroll together:

proc rollon {boxes args} {
	foreach box $boxes {
		eval {$box yview} $args
	}
}

### COLOR DISPLAY ###

# Procedure to set up GUI box for configuring color display:

proc colodisp {} {
	global color red green blue whatfig whatbutt colorlist colordir \
		winback winfore selback selfore buttback buttfore textback \
		textfore headback headfore lightback lightfore coloron wishdir \
		libdir current_scheme bogomips
	if {$coloron == 0} {
		source [file join $libdir wishcolorplus.tcl]
		set coloron 1
	}
	wishcolorplus ; # This does all the work--from WISH Color Picker Plus
	wm title .colo "WISH Binary Viewer : WISH Color Picker Plus"
}

# Use WISH User Help for user help guide:

# Procedure for setting up user help display:

proc binvuhelp {} {
	global helpon helpfile libdir
	if {$helpon == 0} {
		source [file join $libdir wishuhelp.tcl]
		set helpon 1
	}
	uhelp ; # Set up user help window--from WISH User Help
	wm title .uhelp "WISH Binary Viewer - User Help"
	set linkup [open $helpfile r]
	set helpcontents [read $linkup]
	close $linkup
	.uhelp.tx insert 1.0 $helpcontents
	helplink .uhelp.tx; # Show links in text--from WISH User Help
	.uhelp.tx mark set insert 1.0
	.uhelp.tx configure -state disabled
}

# Procedure to set up GUI box for configuring view:

proc figbox {} {
	global hexo hexexp bino decimo texto old iso88591 subchar selco
	toplevel .fig
	wm title .fig "Configure View"
	set old(hexo) $hexo
	set old(hexexp) $hexexp
	set old(bino) $bino
	set old(decimo) $decimo
	set old(texto) $texto
	set old(iso88591) $iso88591
	set old(subchar) $subchar
	grid [checkbutton .fig.hex -variable hexo -text\
		"Show hexadecimal codes:" -command fixcod] -sticky news
	grid [radiobutton .fig.exp -variable hexexp -value 1 \
		-text "Expanded (spaces between bytes)"] -sticky news
	grid [radiobutton .fig.com -variable hexexp -value 0 \
		-text "Compressed (no spaces)"] -sticky news
	grid [checkbutton .fig.bin -variable bino \
		-text "Show binary codes"] -sticky news
	grid [checkbutton .fig.dec -variable decimo \
		-text "Show decimal codes"] -sticky news
	grid [checkbutton .fig.tex -variable texto \
		-text "Show text content:" -command fixcod] -sticky news
	grid [radiobutton .fig.iso -variable iso88591 -value 1 \
		-text "Special characters (ISO Latin-1)"] -sticky news
	grid [radiobutton .fig.ascii -variable iso88591 -value 0 \
		-text "Plain (ASCII) characters only"] -sticky news
	frame .fig.frub
	label .fig.sub -text " Substitute for non-text:  "
	entry .fig.char -bg $::textback -fg $::textfore -width 1 -textvariable subchar
	pack .fig.sub .fig.char -in .fig.frub -side left -expand 1 -fill both
	grid .fig.frub -sticky news
	frame .fig.fr
	button .fig.ok -text "OK" -default normal -relief solid -command {
		destroy .fig
		figview
	}
	button .fig.can -text "Cancel" -default normal -command {
		oldcodes
		destroy .fig
	}
	bind .fig <Key-Return> {
		destroy .fig
		figview
	}
	foreach w [list .fig.hex .fig.bin .fig.dec .fig.tex .fig.sub .fig.char] {
		$w configure -font "helvetica 18 bold"	
	}
	pack .fig.ok .fig.can -in .fig.fr -side left -expand 1 -fill both
	grid .fig.fr -sticky news
	focus .fig.char
	
	# Color display:
	foreach reg [list .fig.hex .fig.exp .fig.com .fig.bin .fig.dec .fig.tex \
		.fig.iso .fig.ascii] {
		$reg configure -selectcolor $::textback
	}
	foreach butt [list .fig.ok .fig.can] {
		$butt configure -bg $::buttback -fg $::buttfore
	}
}

# Procedure to disable radiobuttons when no specified codes are to be displayed:

proc fixcod {} {
	global whole
	if {$hexo == 1} {
		.fig.exp configure -state active
		.fig.com configure -state active
	} else {
		.fig.exp configure -state disabled
		.fig.com configure -state disabled
	}
	if {$texto == 1} {
		.fig.iso configure -state active
		.fig.ascii configure -state active
	} else {
		.fig.iso configure -state disabled
		.fig.ascii configure -state disabled
	}
}

# Procedure to set up configuration for view window:

proc figview {} {
	global hexo bino decimo texto wid hexread hexexp curfil \
		newshow showlist old binnies subchar iso88591
		
	# Get ready to save new display variables:
	array unset newshow
	foreach val [list hexo bino decimo texto] {
		set oldwid($val) $wid($val)
		set wid($val) 0
	}
	set hexread 0
	
	# Figure out display window widths:
	if {$bino == 1} {
		if {$decimo == 1 && $hexo == 1} {
			set wid(decimo) 16
			set wid(bino) 36
			set hexread 8
			if {$texto == 1} {
				set wid(texto) 4
			}
		} else {
			set wid(bino) 72
			set hexread 16
			if {$decimo == 1} {
				set wid(decimo) 32
			}
			if {$texto == 1} {
				set wid(texto) 8
			}
		}
		
	} else {
		if {$decimo == 1} {
			if {$hexo == 1} {
				set wid(decimo) 32
				set hexread 16
				if {$texto == 1} {
					set wid(texto) 8
				}
			} else {
				set wid(decimo) 64
				set hexread 32
				if {$texto == 1} {
					set wid(texto) 16
				}
			}
		} else {
			switch "$hexo $texto" {
				"1 1" {
					set hexread 32
					set wid(texto) 16
				}
				"1 0" {
					set hexread 64
				}
				"0 1" {
					set hexread 128
					set wid(texto) 64
				}
				default {
					tk_messageBox -message "Please select one or more of the\
						following view modes:\
						\nHexadecimal codes\
						\nBinary codes\
						\nDecimal codes\
						\nText content" -type ok
					oldcodes
					return
				}
			}
		}
	}
	if {$hexo == 1} {
		if {$hexexp == 1} {
			set wid(hexo) [expr {$hexread * 3/2}]
		} else {
			set wid(hexo) $hexread
		}
	}
	
	# Start setting up list of display windows:
	set showlist [list byte]
	foreach style [list bino decimo hexo texto] {
		if {[set $style] == 1} {
			lappend showlist $style
		}
	}
	
	# Prepare to add or reformat contents of display windows
	# if file is already being displayed (variables in "whole"
	# array will be temporarily set to zero if there is to be
	# no change in display, e.g., "set hexo 0" if
	# hexadecimal display is to remain unchanged):
	if {$curfil ne ""} {
		if {$hexo == 1} {
			set newshow(hexo) 1
			if {$old(hexo) == 1 && $wid(hexo) == $oldwid(hexo)} {
				set hexo 0
			} else {
				.tex(byte) delete 1.0 end
				.tex(hexo) delete 1.0 end
			}
		}
		if {$bino == 1} {
			set newshow(bino) 1
			if {$old(bino) == 1 && $wid(bino) == $oldwid(bino)} {
				set bino 0
			} else {
				.tex(byte) delete 1.0 end
				.tex(bino) delete 1.0 end
			}
		}
		if {$decimo == 1} {
			set newshow(decimo) 1
			if {$old(decimo) == 1 && $wid(decimo) == $oldwid(decimo)} {
				set decimo 0
			} else {
				.tex(byte) delete 1.0 end
				.tex(decimo) delete 1.0 end
			}
		}
		if {$texto == 1} {
			set newshow(texto) 1
			if {$old(texto) == 1 && $wid(texto) == $oldwid(texto) &&\
				$old(iso88591) == $iso88591 && $old(subchar) == $subchar} {
				set texto 0
			} else {
				.tex(byte) delete 1.0 end
				.tex(texto) delete 1.0 end
			}
		}
	}
	gridview
}

# Procedure to set up display:

proc gridview {} {
	global byte hexo bino decimo texto wid showlist \
		boxlist curfil newshow hexread foco
	foreach style [list hexo bino decimo texto]	{
		catch {grid forget .lab($style) .tex($style)}
	}
	grid forget .binbar .fr
	set boxlist [list]
	foreach num [range 0 no [llength $showlist]] {
		set ind [lindex $showlist $num]
		.tex($ind) configure -width $wid($ind)
		grid .lab($ind) -row 0 -column $num -sticky news
		grid .tex($ind) -row 1 -column $num -sticky news
		lappend lablist .lab($ind)
		lappend boxlist .tex($ind)
	}
	grid .binbar -row 0 -column [llength $showlist] -rowspan 2 -sticky news
	.binbar configure -command [list rollon $boxlist]
	foreach box $boxlist {
		$box configure -yscrollcommand ".binbar set"
	}
	grid .stat -row 2 -column 0 -columnspan \
		[expr {[llength $showlist] +1}] -sticky news
	grid .fr -row 3 -column 0 -columnspan \
		[expr {[llength $showlist] +1}] -sticky news
	grid rowconfigure . 1 -weight 1
	set foco [lindex $boxlist 1]
	formalines
	if {[array size newshow] > 0} {
		foreach name [array names newshow] {
			set $name 1
		}
	}
}

# Procedure to set up "Find" box:

proc search_find {} {
	global search_for casematch searchway foco showlist \
		hexo bino decimo texto selco anytries
	toplevel .find
	wm title .find "Find (Regular-expression Search)"
	frame .find.fr0
	label .find.findwhat -text "Find: " -pady 4
	entry .find.enter -width 56 -bg $::textback -fg $::textfore -textvariable search_for
	pack .find.findwhat .find.enter -in .find.fr0\
		-side left -expand 1 -fill both
	grid .find.fr0 -row 0 -column 0 -columnspan 2 -sticky news
	if {$search_for ne ""} {
		set searchlength [string length $search_for]
		.find.enter selection range 0 $searchlength
	}
	
	frame .find.fr1
	label .find.in -text "In: "
	radiobutton .find.bin -text "Binary" -variable foco -value .tex(bin)
	radiobutton .find.dec -text "Decimal" -variable foco -value .tex(dec)
	radiobutton .find.hex -text "Hexadecimal" -variable foco -value .tex(hexo)
	radiobutton .find.texto -text "Text" -variable foco -value .tex(texto)
	pack .find.in .find.bin .find.dec .find.hex .find.texto \
		-in .find.fr1 -side left -expand 1 -fill both
	grid .find.fr1 -row 1 -column 0 -sticky news
	grid [button .find.next -text "Find (F2)" -bg $::buttback -fg $::buttfore \
		-command find_text] -row 1 -column 1 -sticky news
	foreach name [array names whole] {
		if {[lsearch $showlist $name] == -1} {
			.find.$name configure -state disabled
		}
	}
	
	frame .find.fr2
	checkbutton .find.match -text "Match case" -variable casematch \
		-onvalue "exact" -offvalue "nocase"
	radiobutton .find.up -text "Search Up" -variable searchway \
		-value "backward"
	radiobutton .find.down -text "Search Down" -variable searchway \
		-value "forward"
	pack .find.match .find.up .find.down \
		-in .find.fr2 -side left -expand 1 -fill both
	grid .find.fr2 -row 2 -column 0 -sticky news
	grid [button .find.done -text "Done" -bg $::buttback -fg $::buttfore \
		-command {destroy .find}] -row 2 -column 1 -sticky news
	set anytries 0
	bind .find <F2> find_text
	focus .find.enter
	
	# Color display:
	
	foreach ent [list .find.enter] {
		lappend entlist $ent
		$ent configure -bg $::textback -fg $::textfore
	}
	foreach butt [list .find.match .find.up .find.down] {
		$butt configure -bg $::lightback -fg $::lightfore
	}
	foreach reg [list .find.bin .find.dec .find.hex .find.texto \
		.find.match .find.up .find.down] {
		$reg configure -selectcolor $::textback
	}
}


##################################


### PROCEDURES FOR ACTIONS ###

# Procedure to begin or continue search:

proc findwhat {} {
	if {[winfo exists .find]} {
		find_text
	} else {
		search_find
	}
}

# Procedure to open and display binary file:

proc filopy {whence} {
	global curfil oldcurfil boxlist hexies binnies
	if {$whence eq "pick"} {
		set fil [tk_getOpenFile]
		if {$fil == ""} {
			return
		} else {
			if {$curfil ne ""} {
				set oldcurfil $curfil
			}
			set curfil $fil
		}
	}
	foreach box $boxlist {
		$box delete 1.0 end
	}
	wm title . "WISH Binary Viewer: $curfil"
	.stat configure -text "Reading binary file ..."
	update
	set filid [open $curfil r]
	fconfigure $filid -translation binary -encoding binary
	set filin [read $filid]
	close $filid
	.stat configure -text "Scanning binary data ..."
	update
	binary scan $filin H* hexies
	binary scan $filin B* binnies
	.stat configure -text "Formatting display ... may be time-consuming for large files ..."
	update
	formalines
	.stat configure -text "Finished."
	after 1000 {
		.stat configure -text ""
	}
}

# Procedure to save binary file:

proc bin_save {} {
	set f [tk_getSaveFile]
	if {"" == $f} {
		return
	}
	set data [.tex(hexo) get 1.0 "end -1c"]
	set data [string map "{ } {} {\n} {}" $data]
	set fo [open $f w]
	fconfigure $fo -translation binary -encoding binary
	set binout [binary format H* $data]
	puts -nonewline $fo $binout
	close $fo
}

# Procedure to format lines:

proc formalines {} {
	global hexo bino decimo texto hexies hexread hexexp binnies boxlist
	set hexLen [string length $hexies]
	if {$hexLen < 1} {
		return
	}
	set charCount 0
	set lineCount 0
	set binCount 0
	set newbie ""
	set newByte ""
	set newHex ""
	set newBin ""
	set newDec ""
	set newText ""
	set hexhalf [expr $hexread/2]
	switch "$hexo $bino $decimo $texto" {
		"1 1 1 1" {
			
			# Hex, binary, decimal, text
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					append newBin "$binny "
					append newDec "[format %03d 0x$newbie] "
					append newText [textize $newbie]
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex \n
					append newBin \n
					append newDec \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
			.tex(bino) insert end $newBin
			.tex(decimo) insert end $newDec
			.tex(texto) insert end $newText
		}
		"1 1 1 0" {
			
			# Hex, binary, decimal
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					append newBin "$binny "
					append newDec "[format %03d 0x$newbie] "
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex \n
					append newBin \n
					append newDec \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
			.tex(bino) insert end $newBin
			.tex(decimo) insert end $newDec
		}
		"1 1 0 1" {
			
			# Hex, binary, text
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					append newBin "$binny "
					append newText [textize $newbie]
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex \n
					append newBin \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
			.tex(bino) insert end $newBin
			.tex(texto) insert end $newText
		}
		"1 1 0 0" {
			
			# Hex, binary
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					append newBin "$binny "
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex \n
					append newBin \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
			.tex(bino) insert end $newBin
		}
		"1 0 1 1" {
			
			# Hex, decimal, text
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				append newbie [string index $hexies $i]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					append newDec "[format %03d 0x$newbie] "
					append newText [textize $newbie]
					set newbie ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex \n
					append newDec \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
			.tex(decimo) insert end $newDec
			.tex(texto) insert end $newText
		}
		"1 0 1 0" {
			
			# Hex, decimal
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				append newbie [string index $hexies $i]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					append newDec "[format %03d 0x$newbie] "
					set newbie ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex \n
					append newDec \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
			.tex(decimo) insert end $newDec
			
		}
		"1 0 0 1" {
			
			# Hex, text
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				append newbie [string index $hexies $i]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					append newText [textize $newbie]
					set newbie ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
			.tex(texto) insert end $newText
		}
		"1 0 0 0" {
			
			# Hex only
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				append newbie [string index $hexies $i]
				if {[string length $newbie] > 1} {
					append newHex $newbie
					if {$hexexp == 1} {
						append newHex " "
					}
					set newbie ""
				}
				if {$charCount == $hexread} {
					set charcoui 1
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newHex "\n"
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(hexo) insert end $newHex
		}
		"0 1 1 1" {
			
			# Binary, decimal, text
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newBin "$binny "
					append newDec "[format %03d 0x$newbie] "
					append newText [textize $newbie]
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newBin \n
					append newDec \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(bino) insert end $newBin
			.tex(decimo) insert end $newDec
			.tex(texto) insert end $newText
		}
		"0 1 1 0" {
			
			# Binary, decimal
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newBin "$binny "
					append newDec "[format %03d 0x$newbie] "
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newBin \n
					append newDec \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(bino) insert end $newBin
			.tex(decimo) insert end $newDec
		}
		"0 1 0 1" {
			
			# Binary, text
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newBin "$binny "
					append newDec "[format %03d 0x$newbie] "
					append newText [textize $newbie]
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newBin \n
					append newDec \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(bino) insert end $newBin
			.tex(texto) insert end $newText
		}
		"0 1 0 0" {
			
			# Binary only
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				set binCount [expr {$i*4}]
				append newbie [string index $hexies $i]
				append binny [string range $binnies\
					$binCount [expr {$binCount+3}]]
				if {[string length $newbie] > 1} {
					append newBin "$binny "
					append newDec "[format %03d 0x$newbie] "
					append newText [textize $newbie]
					set newbie ""
					set binny ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newBin \n
					append newDec \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(bino) insert end $newBin
			.tex(texto) insert end $newText
		}
		"0 0 1 1" {
			
			# Decimal, text
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				append newbie [string index $hexies $i]
				if {[string length $newbie] > 1} {
					append newDec "[format %03d 0x$newbie] "
					append newText [textize $newbie]
					set newbie ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newDec \n
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(decimo) insert end $newDec
			.tex(texto) insert end $newText
		}
		"0 0 1 0" {
			
			# Decimal only
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				append newbie [string index $hexies $i]
				if {[string length $newbie] > 1} {
					append newDec "[format %03d 0x$newbie] "
					set newbie ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newDec \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(decimo) insert end $newDec
		}
		"0 0 0 1" {
			
			# Text only
			for {set i 0} {$i < $hexLen} {incr i} {
				incr charCount
				append newbie [string index $hexies $i]
				if {[string length $newbie] > 1} {
					append newText [textize $newbie]
					set newbie ""
				}
				if {$charCount == $hexread} {
					set byteline [expr {$lineCount * $hexhalf}]
					append newByte "[format "%08x" $byteline]\n"
					append newText \n
					set charCount 0
					incr lineCount
				}
			}
			if {$charCount != 0} {
				set byteline [expr {$lineCount * $hexhalf}]
				append newByte "[format "%08x" $byteline]"
			}
			.tex(byte) insert end $newByte
			.tex(texto) insert end $newText
		}
		default {
			# Don't do anything
		}
	}
	foreach box $boxlist {
		$box mark set insert 1.0
	}
}

# Procedure to get rid of spaces between bytes:

proc hexcomp {hex} {
	set comline [string map "{ } {}" $hex]
	return $comline
}

# Procedure to "textize" hex codes, if they're "textizable":

proc textize {byte} {
	if {[expr 0x20 <= 0x$byte] && [expr 0x$byte <= 0x7a]} {
		return [binary format H* $byte]
	} elseif {$::iso88591 == 1 && [expr 0xa0 <= 0x$byte]} {
		return [binary format H* $byte]
	} else {
		return $::subchar
	}
}

# Set search direction and case sensitivity, and search for match
# (Variables "present_place" and "findlength"
# are set in "proc find_text," below)

proc whichway {} {
	global casematch searchway search_reg present_place foco place countum
	switch "$casematch $searchway" {
		"nocase forward" {
			set place [$foco search -nocase -forward -regexp \
			-count countum $search_reg $present_place end]
		}
		"exact forward" {
			set place [$foco search -forward -regexp \
			-count countum $search_reg $present_place end]
		}
		"nocase backward" {
			set place [$foco search -nocase -backward -regexp \
			-count countum $search_reg $present_place 1.0]
		}
		"exact backward" {
			set place [$foco search -backward -regexp \
			-count countum $search_reg $present_place 1.0]
		}
	}
}

# Actually find some matching text:

proc find_text {} {
	global present_place search_for search_reg countum place \
		casematch searchway findway foco anytries countum
	focus $foco
	if {$anytries == 0} {
		set anytries 1
		set starting_place [$foco index insert]
		set present_place $starting_place
		set place $starting_place
	}
	set search_reg ""
	set splitfor [split $search_for {}]
	foreach char $splitfor {
		append search_reg "$char\{1\}\\n?"
	}
	whichway
	if {$place eq ""} { 
		tk_messageBox -message "Not Found" \
			-title "Not Found" -type ok
		destroy .find
	} else {
		catch {$foco tag remove sel sel.first sel.last}
		$foco tag add sel $place "$place + $countum chars"
		$foco see $place
		if {$searchway eq "forward"} {
			$foco mark set insert "$place + $countum chars"
		} else {
			$foco mark set insert $place
		}
	}
}

# Procedure to get old settings back:

proc oldcodes {} {
	global hexo bino decimo texto hexexp old iso88591
	set hexo $old(hexo)
	set hexexp $old(hexexp)
	set bino $old(bino)
	set decimo $old(decimo)
	set texto $old(texto)
	set iso88591 $old(iso88591)
}

# Procedure to shut program down correctly, saving configuration:

proc shootdown {} {
	savefig
	exit
}


##################################


# GET GOING:

# Open file from the command line, if you wish;
# otherwise, open blank windows:

figview
if {[info exists argv]} {
	if {[file readable [lindex $argv 0]]} {
		set curfil [lindex $argv 0]
		filopy argux
	}
}

# Load most recently used color scheme, if specified in configuration
# file; if not, load "AntiqueBisque" color scheme as default;
# if not that either, complain:

if {[info exists current_scheme]} {
	source [file join $colordir $current_scheme.tcl]
} elseif {[file readable [file join $colordir AntiqueBisque.tcl]]} {
	source [file join $colordir AntiqueBisque.tcl]
} else {
	tk_messageBox -message "Current color scheme file not found\
	in $colordir" -type ok
}

