#------------------------------------------------------------------------
#
# Copyright (c) 1997-1998 by Cornell University.
# 
# See the file "license.txt" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------
# pnmlib.vm
# 
# This library provides convinient function for reading and writing
# PPM/PGM/PBM files.  It should be used for convinient only.  The
# resulting code when using this library might not be optimized.
#

package require DvmBasic
package require DvmPnm

proc write_ppm {hdr r g b filename} {

    set bp [bitparser_new]
    set bs [bitstream_new [expr 20+3*[byte_get_width $r]*[byte_get_height $r]]]
    bitparser_wrap $bp $bs

    set file [open ${filename} w]
    fconfigure $file -translation binary -buffersize 65536

    pnm_hdr_set_width $hdr [byte_get_width $r]
    pnm_hdr_set_height $hdr [byte_get_height $r]
    pnm_hdr_set_type $hdr ppm-bin
    pnm_hdr_set_maxval $hdr 255
    pnm_hdr_encode $hdr $bp

    ppm_encode $r $g $b $bp
    bitstream_channel_write $bs $file 0 

    close $file
    bitparser_free $bp
    bitstream_free $bs
}


proc read_ppm {filename} {

    set inf   [open $filename r]
    fconfigure $inf -translation binary -buffersize 65536

    set hdr   [pnm_hdr_new]
    set inbs  [bitstream_new [file size $filename]]
    set inbp  [bitparser_new]
    bitparser_wrap $inbp $inbs
    bitstream_channel_read $inbs $inf 0

    pnm_hdr_parse $inbp $hdr

    set w [pnm_hdr_get_width $hdr]
    set h [pnm_hdr_get_height $hdr]
    set rr [byte_new $w $h]
    set gg [byte_new $w $h]
    set bb [byte_new $w $h]
    ppm_parse $inbp $rr $gg $bb

    close $inf
    bitparser_free $inbp
    bitstream_free $inbs
    return [list $hdr $rr $gg $bb]
}


proc read_pgm {name} {
    set inf   [open $name r]
    fconfigure $inf -translation binary -buffersize 65536

    set hdr   [pnm_hdr_new]
    set inbs  [bitstream_new [file size $name]]
    set inbp  [bitparser_new]
    bitstream_channel_read $inbs $inf 0
    bitparser_wrap $inbp $inbs

    pnm_hdr_parse $inbp $hdr

    set w [pnm_hdr_get_width $hdr]
    set h [pnm_hdr_get_height $hdr]
    set buf [byte_new $w $h]

    pgm_parse $inbp $buf

    close $inf
    bitstream_free $inbs
    bitparser_free $inbp
    return [list $hdr $buf]
}


proc write_pgm {hdr buf name} {
    set outf  [open $name w]
    fconfigure $outf -translation binary -buffersize 65536

    set w [pnm_hdr_get_width $hdr]
    set h [pnm_hdr_get_height $hdr]

    set outbp [bitparser_new]
    set outbs [bitstream_new [expr $w*$h+20]]
    bitparser_wrap $outbp $outbs

    pnm_hdr_encode $hdr $outbp
    pgm_encode $buf $outbp
    bitstream_channel_write $outbs $outf 0

    close $outf
    bitparser_free $outbp
    bitstream_free $outbs
}

proc read_pbm_8 {name} {
    set inf   [open $name r]
    fconfigure $inf -translation binary -buffersize 65536

    set hdr   [pnm_hdr_new]
    set inbs  [bitstream_new [file size $name]]
    set inbp  [bitparser_new]
    bitstream_channel_read $inbs $inf 0
    bitparser_wrap $inbp $inbs

    pnm_hdr_parse $inbp $hdr

    set w [pnm_hdr_get_width $hdr]
    set h [pnm_hdr_get_height $hdr]
    set buf [bit_new $w $h]

    pbm_parse_8 $inbp $buf

    close $inf
    bitstream_free $inbs
    bitparser_free $inbp
    return [list $hdr $buf]
}


proc write_pbm_8 {hdr buf name} {
    set outf  [open $name w]
    fconfigure $outf -translation binary -buffersize 65536

    set w [pnm_hdr_get_width $hdr]
    set h [pnm_hdr_get_height $hdr]
    pnm_hdr_set_type $hdr "pbm-bin"

    set outbp [bitparser_new]
    set outbs [bitstream_new [expr ($w/8)*$h+20]] 
    bitparser_wrap $outbp $outbs

    pnm_hdr_encode $hdr $outbp
    pbm_encode_8 $buf $outbp
    bitstream_channel_write $outbs $outf 0

    close $outf
    bitparser_free $outbp
    bitstream_free $outbs
}