49 lines
1.3 KiB
Tcl
49 lines
1.3 KiB
Tcl
package require Tcl 8.5
|
|
|
|
proc crunch {ascii} {
|
|
binary scan $ascii B* bitstring
|
|
# crunch: remove the extraneous leading 0 bit
|
|
regsub -all {0(.{7})} $bitstring {\1} 7bitstring
|
|
set padded "$7bitstring[string repeat 0 [expr {8 - [string length $7bitstring]%8}]]"
|
|
return [binary format B* $padded]
|
|
}
|
|
|
|
proc expand {binary} {
|
|
binary scan $binary B* padded
|
|
# expand the 7 bit segments with their leading 0 bit
|
|
set bitstring "0[join [regexp -inline -all {.{7}} $padded] 0]"
|
|
return [binary format B* $bitstring]
|
|
}
|
|
|
|
proc crunch_and_write {ascii filename} {
|
|
set fh [open $filename w]
|
|
fconfigure $fh -translation binary
|
|
puts -nonewline $fh [crunch $ascii]
|
|
close $fh
|
|
}
|
|
|
|
proc read_and_expand {filename} {
|
|
set fh [open $filename r]
|
|
fconfigure $fh -translation binary
|
|
set input [read $fh [file size $filename]]
|
|
close $fh
|
|
return [expand $input]
|
|
}
|
|
|
|
set original "This is an ascii string that will be crunched, written, read and expanded."
|
|
puts "my ascii string is [string length $original] bytes"
|
|
|
|
set filename crunched.out
|
|
crunch_and_write $original $filename
|
|
|
|
set filesize [file size $filename]
|
|
puts "the file containing the crunched text is $filesize bytes"
|
|
|
|
set expanded [read_and_expand $filename]
|
|
|
|
if {$original eq $expanded} {
|
|
puts "the expanded string is the same as the original"
|
|
} else {
|
|
error "not the same"
|
|
}
|