WISH Binary Viewer
Original site is offline. Internet archive version: 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.
#!/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 }