'''WISH Binary Viewer''' Original site is offline. Internet archive version:
https://web.archive.org/web/20140316162728/http://www.pa-mcclamrock.com/papenguinspacks.html#wishbinvu
Original site is offline. Internet archive version:
https://web.archive.org/web/20140316162728/http://www.pa-mcclamrock.com/papenguinspacks.html#wishbinvu%|%https://web.archive.org/web/20140316162728/http://www.pa-mcclamrock.com/papenguinspacks.html#wishbinvu%|%
'''WISH Binary Viewer 2009''' is an ultra-light, super-simple binary file viewer, inspired by George Peter Staplin's "[A Little Hex Editor Widget]." It can open and display a file in any combination of hexadecimal codes, binary codes, decimal codes, and text content (ASCII or ISO Latin-1). There are simple copy, search, and save functions too; if you insist, and you're sure you know what you're doing, you can use WISH Binary Viewer as a simple hexadecimal editor for binary files.
'''WISH Binary Viewer 2009''' is available in a "tar.gz" package including the program, documentation, and a simple installation script for Linux/Unix operating systems, as well as a .PET package ready for single-click installation on Puppy Linux.
[DPG]: The Internet Archive does not include the tar.gz file, but it does have the .pet package. I installed puppy linux in a VM and recovered the source.
https://pastebin.com/eaLDKBqY
======
#!/usr/bin/env wish
# WISH Binary Viewer 2009
# (the second public release of WISH Binary Viewer)
# by David McClamrock <[email protected]>
# 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]
if {[file exists $colordir] == 0} {
set nocolors [catch {file copy [file join $libdir colorschemes] $wishdir} outage]
if {$nocolors} {
tk_messageBox -message $outage -type ok
}
}
# 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
}
======
<<categories>> Application | Binary Data