Hi, I'm new to the forums, and new to tcl.  I'm also a crap programmer.

I'm trying to write a program which will convert a .raw image file, into a .rle file.

What I need to do is to:

split the .raw file into 4 byte words.  Invert these words.  Runlength encode this new file.

Has anyone done something similar to this before?  Can anyone point me in the right direction?

Thanks,
Ross

You probably want to use a "binary format" or "binary scan" to get the information out and decode it ....

Now ... I think of "run length encoding" as a description of a technique rather than an exact specification.  Shouldn't be too hard to provide an example, but before I do I'm wondering if you have a more detailed spec?

[Note for the reader who's new to this ... run length encoding typically takes as stream of identical values and compresses it by giving a series of counts and values.  Thus 10 10 10 10 20 20 10 10 10 10 would encode to 4 10 2 20 4 10.  To help provide a program, I need to know how long each of the elements that may repeat is - is it a black and white image (1 bit), a 256 colour image (8 bytes) or some other value?]

It's a 512 x 512 8 bit greyscale image.

Thanks,
Ross

OK ... so if it's an 8 bit image then you're encoding bytes by byte. There's a whole lot of other parameters associated with RLE algorithms such as how "wide" the count is on the output and whether it's signed or unsigned.  Also the question of headers within the graphic formats (if any).  Here's a piece of code (I'm unable to test it as I don't have an appropriate input file) that does the analysis you need and prints the encoding information to stdout.  

Code:

set in [open "abc.raw" "r"] set latest 12345 set count 0 while 1 {   binary scan [read $in 4] aaaa a b c d   foreach byte {$d $c $b $a} {        if {$byte == $latest} {                incr count        } else {                puts "$count $latest" ;# Should check and supress initial 0 count                set count 1                set latest $byte        } } puts "$count $latest"

You'll need to add code to open the output file and write to it, code to deal with the re-encoding and to handle the condition that the "number of occurrences" exceeds the maximum number that can be held in the output format.

I woudl be very interested to see an example of thsi completed - rosskettles, can you please post a follow up when you've tweaked the code to match your spec so that we can see the thread completed ... many thanks!

I don't really understand what your code does  .  Would be great if you could explain it!

Code:

# Run length encode a file, swapping over blocks of 4 bytes # opein input file set in [open "abc.raw" "r"] # Initialise variables so that we have something to compare to set latest 12345 set count 0 while 1 {   # Read in 4 bytes and reverse them   # Need to add check for end of data   binary scan [read $in 4] aaaa a b c d   # Loop through each of the four bytes we have   foreach byte {$d $c $b $a} {   # If it's the same as the previous byte, count it        if {$byte == $latest} {                incr count        } else {     # and if it's different, output the previous byte count   # and value, the store the new byte with a count of 1 so far                if {$count > 0} {puts "$count $latest"}                set count 1                set latest $byte        } } puts "$count $latest"

I've added some further comments; if you need details of what every command and every parameter does, I suggest you have a look at something such as Brent Welch's book which has huge detail of the individual calls.

Thank you very much for your reply.  I do have welch's book, but as I say, i'm not that good a programmer!

Here's the code I've got so far.(changed some of your's graham)
Code:

;#Run length encode a file, swapping over blocks of 4 bytes. set in [open "test1.raw" r+] ;#initialise variables set latest 12345 set count 0 set totalcount 262144 ;#512 x 512 ;#while the 'totalcount' is more than the last 4 bytes the program will run. while "$totalcount > 4" { ;#read in hexadecimal values. binary scan [read $in 4] HHHH a b c d set totalcount "[expr $totalcount - 4]"       foreach byte {$d $c $b $a} { ;#this compares each byte with the previous one.            if {$byte==$latest && $count < 16} { ;#if they are the same, add one to count, set 'latest' to value just compared.            incr count            set latest "$byte"            } else {            puts "$count $latest" ;#count goes back to 1 if there is a difference between them or if count is more than 15.            set latest "$byte"            set count 1                         }             }   } close $in

I've modifyed some of the code, the [current!] problem I have is that this line:
Quote:

if {$byte==$latest && $count < 16}

doesn't work, even when $byte does == $latest AND $count is less than 16.  I made count < 16, owing to it being hex, and F being the biggest value.  But not really knowing how to do this correctly I just put in the decimal value!
*edit, 16 should be 15 dur! doesn't matter just now though

woohoo!  fixed it.  This code works  

Quote:

if {"[expr $byte==$latest]" && $count < 15} {

although the program seems to run forever.  (i'm doing one test, and I'm at totalcount = -374644 !!


Problem solved by changing the while, to a for loop  .

Now the task of writing to a new file.  Any ideas anyone?

Code:

for {set totalcount 262144} {$totalcount > 4} {incr totalcount -4}

ok, the output of my program is: first the decimal value of count (I need a hex out) and then the variable of latest.(so instead of giving the value of that variable, the output of 'latest' is for example $b).  I need the format to be; 0x[count][lastest], e.g 0xF0, 0xFF et cetera  

ok, have done this:

Code:

set var1 [format %x $count] puts $out "$var1" set var2 [format %x $byte] puts $out "$var2

count comes out as a hex code, but there's an error in var2, as $byte returns whatever variable it's at [e.g $b] and not the actual value.  How do you sort that?

Trying to keep up with all your posts .... I'm running a Perl course today; will have a look at any outstanding queries on this thread overnight

- Graham

Quote:

Trying to keep up with all your posts .... I'm running a Perl course today; will have a look at any outstanding queries on this thread overnight

Yeah I've been quite busy!!

I've basically answered a lot of my questions as I've gone throughout the day, but the last post is where i'm stuck just now.  Probably something very simple, but I just have no idea.

Cheers,
Ross

on 06/21/05 at 16:37:48, rosskettles wrote:

ok, have done this: Code: set var1 [format %x $count] puts $out "$var1" set var2 [format %x $byte] puts $out "$var2 count comes out as a hex code, but there's an error in var2, as $byte returns whatever variable it's at [e.g $b] and not the actual value.  How do you sort that?

It looks to me that you've probably written $b into your "byte" variable earlier in your script then, rather that the actual value ... so the problem is probably elswehere in the code and not in the quoted piece.

Directly answering your question, though, you may find that the subst command does what you want - it takes a piece of Tcl in a variable, performs it and returns the result.

Thanks Graham.

Using the subst command like this:
Code:

subst "$[set byte]"        puts $out "$subst"

           

results in '$$b' being put out (or $c etc).

Also tried:

puts $out [subst "$[set byte]"]

And various other random orders.  Still not working!!

Tried this:
Code:

if {"[$byte==\$d]"} { set var2 [format %x $d] puts "$var2"

So the if statement will physicaly check if $d ($byte) is equal to the string $d.  But apparently this is an invalid command name "$d==$d".  

hmm.

Fixed it myselft using:

Code:

if {"[expr $byte==\$d]"} {

New problem has arisen.

I want to now:

Check if we're at the start of the file
If yes then
binary scan 4 a b c d
else
skip 4 scan 4 a b c d
then
skip 4 scan 4 e f g h

This would solve the problem I currently have of not being able to look far enough ahead because:

when you read in:

a b c d

then change to

d c b a

and compare

d with c
c with b
a with ??

can then do

a with h

as soon as a has been read I need it to skip 4 and load a b c d again.

Hmmm. need your help!!



Another option, which I think might be more doable:

Read in 5 bytes,

a b c d e

then
foreach {d c b a}

You compare a with e

then skip back a position in the file and read another 5 bytes. e becomes a by default.

Don't know how to skip though.

Ha, had a good think about that, and it won't work.

A new idea is to:

read 4, skip forwards 3, read 1,skip backwards 4.

that way I'm back ready to read the next 4, and the 8th one again.

Still can't figure out the how to skip, trying like this:

binary scan "$in" x3

probably easier to read in 8 bytes, then skip back 4.

Graham, thanks for all your advice.  I probably couldn't have done this without you.(well, maybe eventually!)  

The program works!

Now I need to write a file to un-compress the file back to .raw.

Here's the code(still to sort it out neatly):
Code:

;#swap over blocks of 4 bytes. set in [open "testfull.raw" r+] set out [open "testfullout.raw" w] ;#while the 'totalcount' is more than the last 4 bytes the program will run. for {set totalcount 262144} {$totalcount > 16} {incr totalcount -16} { binary scan [read $in 16] aaaaaaaaaaaaaaaa a b c d e f g h i j k l m n o p puts -nonewline $out "$d$c$b$a$h$g$f$e$l$k$j$i$p$o$n$m" } close $in close $out

To compress to rle:
Code:

;#open the switched file ready for compression to rle. set in [open "custom.raw" r+] set out [open "encoded.rle" w] set count 1 set start 1 while {![eof $in]} { ;#read in hexadecimal values. if {"[expr $start==1]"} { binary scan [read $in 4] hhhh a b c d set start 0 if {"[expr 0x$a==0x$b]"} { incr count } else { set var1 [format %x $count] puts -nonewline $out " 0x$var1$a" set count 1} if {"[expr 0x$b==0x$c]"} { incr count } else { set var1 [format %x $count] puts -nonewline $out " 0x$var1$b" set count 1} } binary scan [read $in 2] hh a b if {"[expr 0x$c==0x$d && $count < 15]"} { incr count } else { set var1 [format %x $count] puts -nonewline $out " 0x$var1$c" set count 1} if {"[expr 0x$d==0x$a && $count < 15]"} { incr count } else { set var1 [format %x $count] puts -nonewline $out " 0x$var1$d" set count 1} if {"[expr 0x$a==0x$b && $count < 15]"} { incr count } else { set var1 [format %x $count] puts -nonewline $out " 0x$var1$a" set count 1} binary scan [read $in 2] hh c d if {"[expr 0x$b==0x$c && $count < 15]"} { incr count } else { set var1 [format %x $count] puts -nonewline $out " 0x$var1$b" set count 1} } close $in close $out

Delighted that it's working ... the next one will be much easier  

Graham

---