Training, Open Source computer languages
PerlPHPPythonMySQLApache / TomcatTclRubyJavaC and C++LinuxCSS 
Search for:
Home Accessibility Courses Diary The Mouth Forum Resources Site Map About Us Contact
 
For 2023 (and 2024 ...) - we are now fully retired from IT training.
We have made many, many friends over 25 years of teaching about Python, Tcl, Perl, PHP, Lua, Java, C and C++ - and MySQL, Linux and Solaris/SunOS too. Our training notes are now very much out of date, but due to upward compatability most of our examples remain operational and even relevant ad you are welcome to make us if them "as seen" and at your own risk.

Lisa and I (Graham) now live in what was our training centre in Melksham - happy to meet with former delegates here - but do check ahead before coming round. We are far from inactive - rather, enjoying the times that we are retired but still healthy enough in mind and body to be active!

I am also active in many other area and still look after a lot of web sites - you can find an index ((here))
file conversion

Posted by rosskettles (rosskettles), 17 June 2005
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

Posted by admin (Graham Ellis), 17 June 2005
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?]

Posted by rosskettles (rosskettles), 17 June 2005
It's a 512 x 512 8 bit greyscale image.

Thanks,
Ross

Posted by admin (Graham Ellis), 18 June 2005
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!

Posted by rosskettles (rosskettles), 20 June 2005
I don't really understand what your code does  .  Would be great if you could explain it!

Posted by admin (Graham Ellis), 20 June 2005
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.

Posted by rosskettles (rosskettles), 21 June 2005
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

Posted by rosskettles (rosskettles), 21 June 2005
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 !!


Posted by rosskettles (rosskettles), 21 June 2005
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}


Posted by rosskettles (rosskettles), 21 June 2005
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  

Posted by rosskettles (rosskettles), 21 June 2005
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?

Posted by admin (Graham Ellis), 21 June 2005
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

Posted by rosskettles (rosskettles), 21 June 2005
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

Posted by admin (Graham Ellis), 22 June 2005
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.

Posted by rosskettles (rosskettles), 22 June 2005
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!!

Posted by rosskettles (rosskettles), 22 June 2005
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.

Posted by rosskettles (rosskettles), 22 June 2005
Fixed it myselft using:

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


Posted by rosskettles (rosskettles), 22 June 2005
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!!



Posted by rosskettles (rosskettles), 22 June 2005
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.

Posted by rosskettles (rosskettles), 22 June 2005
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

Posted by rosskettles (rosskettles), 22 June 2005
probably easier to read in 8 bytes, then skip back 4.

Posted by rosskettles (rosskettles), 23 June 2005
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


Posted by admin (Graham Ellis), 23 June 2005
Delighted that it's working ... the next one will be much easier  

Graham



This page is a thread posted to the opentalk forum at www.opentalk.org.uk and archived here for reference. To jump to the archive index please follow this link.

You can Add a comment or ranking to this page

© WELL HOUSE CONSULTANTS LTD., 2024: Well House Manor • 48 Spa Road • Melksham, Wiltshire • United Kingdom • SN12 7NY
PH: 01144 1225 708225 • FAX: 01144 1225 793803 • EMAIL: info@wellho.net • WEB: http://www.wellho.net • SKYPE: wellho