[[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" <> Graphics|File|Image Processing