Writing PPM files

[Code moved from Writing PNG Files so that it is correctly titled and there is a place for the other if someone comes along with the nerve to write it.]

Arjen Markus An unfinished script, it does draw lines and writes PNG files (well the type known as "P6"). My intentions were and are to create a small package that will allow you to draw pictures without the support of Tk. It will rely on work by Richard Suchenwirth (strimj - string image routines) and David Zolli (aka kroc) - already on the Wiki.

Note: the current stuff is not very fast :(

DLR This is a PPM writer, not PNG? RS thinks so too - PNG is compressed, GIF-like.

 # ppm.tcl --
 #    Create PPM files without the use of Tk
 #
 # Note:
 #    It uses the following tricks:
 #    - level 256 is reserved for filling operations
 #    - there is an invisible border around the image for
 #      filling operations with ovals and polygons partly outside
 #      the image
 #

 # PPM --
 #    Namespace for the package
 #
 namespace eval ::PPM {
    variable image_id 0
 }

 # createImage --
 #    Create an image and fill it with black pixels
 #
 # Arguments:
 #    width     Width in pixels
 #    height    Height in pixels
 #
 # Result:
 #    Name of a new command to handle the image
 #
 # Side effect:
 #    New command created and variable in namespace
 #
 proc ::PPM::createImage { width height } {
    variable image_id
    variable image$image_id

    set act_width [expr {$width+2}]
    set act_height [expr {$height+2}]

    set total_length [expr {$act_width*$act_height*3}]
    set image$image_id [binary format "a$total_length" ""]

    set cmd image$image_id
    interp alias {} $cmd {} ::PPM::imageHandle $cmd $act_width $act_height
    incr image_id

    return $cmd
 }

 # imageHandle --
 #    Handle the image
 #
 # Arguments:
 #    image         Name of the image variable
 #    act_width     (Actual) width in pixels
 #    act_height    (Actual) height in pixels
 #    command       The command to execute
 #    args          Arguments to the command
 #
 # Result:
 #    Depends on the command
 #
 # Side effect:
 #    Depends on the command
 #
 proc ::PPM::imageHandle { image act_width act_height command args } {
    variable $image
    upvar 0  $image img

    if { $command == "save" } {
       set outfile [open [lindex $args 0] "w"]
       puts $outfile "P6"
       puts $outfile [expr {$act_width-2}]
       puts $outfile [expr {$act_height-2}]
       puts -nonewline $outfile "254 "

       set linewidth [expr {3*$act_width}]
       for { set j 1 } { $j < $act_height-1 } { incr j } {
          puts "$j $linewidth"
          set bgnpos [expr {3+$j*$linewidth}]
          set endpos [expr {$bgnpos+$linewidth-7}]
          puts -nonewline $outfile [string range $img $bgnpos $endpos]
       }
       close $outfile
    }
 }

 proc ::PPM::setpixel {imageName act_width act_height i j r g b} {
    upvar 0 ::PPM::$imageName image

    set posb [expr {3*$act_width*$j+3*$i+3}]
    set pose [expr {3*$act_width*$j+3*$i+5}]
    set image [string replace $image $posb $pose [format %s%s%s $r $g $b]]
 }

 #for { set j 0 } { $j < $height } { incr j } {
 #   puts $j
 #   for { set i 0 } { $i < $width } { incr i } {
 #      setpixel image $i $j \u1 \u1 \u1
 #   }
 #}

 set img [::PPM::createImage 200 200]
 puts $img

 for { set i 0 } { $i < 200 } { incr i } {
    ::PPM::setpixel $img 202 202 $i $i \uff \uff \uff
 }
 for { set i 0 } { $i < 200 } { incr i } {
    ::PPM::setpixel $img 202 202 $i 10 \uff \u0 \u0
 }

 $img save "test.ppm"