Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] View of /trunk/sml3d/src/image-io/netpbm-util.sml
ViewVC logotype

View of /trunk/sml3d/src/image-io/netpbm-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 319 - (download) (annotate)
Thu Oct 2 20:30:46 2008 UTC (11 years ago) by jhr
File size: 2759 byte(s)
  Rename directory to reflect purpose
(* netpbm-util.sml
 *
 * COPYRIGHT (c) 2008 John Reppy (http://cs.uchicago.edu/~jhr)
 * All rights reserved.
 *
 * Common code for reading and writing Netpbm file headers.
 *)

structure NetpbmUtil : sig

    datatype format = PBM | PGM | PPM

    val readHeader : {err : string -> unit, inS : BinIO.instream} -> {
	    fmt : format, wid : int, ht : int, maxval : int
	  }

    val writeHeader : {
	    outS : BinIO.outstream,
	    fmt : format,
	    wid : int, ht : int, maxval : int
	  } -> unit

  end = struct

    structure SIO = BinIO.StreamIO

  (* the formats:
   *	P4 = PBM
   *	P5 = PGM
   *	P6 = PPM
   *	P7 = PAM -- not supported yet
   *)
    datatype format = PBM | PGM | PPM

    fun readHeader {err, inS} = let
	  fun error msg = (err msg; raise Fail msg)
	  val strm = BinIO.getInstream inS
	  fun getc strm = (case SIO.input1 strm
		 of NONE => error "unexpected EOF"
		  | SOME(b, strm) => (Byte.byteToChar b, strm)
		(* end case *))
	  fun skipWS strm = let
		val (c, strm') = getc strm
		in
		  if (Char.isSpace c)
		    then skipWS strm'
		  else if (c = #"#")
		    then let (* comment *)
		      fun skipToEOL strm = (case getc strm
			     of (#"\n", strm) => skipWS strm
			      | (#"\r", strm) => skipWS strm
			      | (_, strm) => skipToEOL strm
			    (* end case *))
		      in
			skipToEOL strm
		      end
		  else strm
		end
	  fun getInt (strm, field) = (
		case Int.scan StringCvt.DEC (SOME o getc) (skipWS strm)
		 of NONE => error ("missing "^field)
		  | SOME(n, strm) => (n, strm)
		(* end case *))
	  val (c1, strm) = getc strm
	  val (c2, strm) = getc strm
	  fun getHdr fmt = let
		val (wid, strm) = getInt (strm, "width")
		val (ht, strm) = getInt (strm, "height")
		val sz = wid*ht
		val (maxVal, strm) = if (fmt = PBM)
		      then (1, strm)
		      else getInt (strm, "max. value")
		val (_, strm) = getc strm
		in
		  BinIO.setInstream(inS, strm);
		  {fmt = fmt, wid = wid, ht = ht, maxval = maxVal}
		end
	  in
	    case (c1, c2)
	     of (#"P", #"1") => error "plain PBM not supported"
	      | (#"P", #"2") => error "plain PGM not supported"
	      | (#"P", #"3") => error "plain PPM not supported"
	      | (#"P", #"4") => getHdr PBM
	      | (#"P", #"5") => getHdr PGM
	      | (#"P", #"6") => getHdr PPM
	      | (#"P", #"7") => error "PAM format not supported"
	      | _ => error "unrecognized header"
	    (* end case *)
	  end

    fun writeHeader {outS, fmt, wid, ht, maxval} = let
	  fun pr s = BinIO.output(outS, Byte.stringToBytes s)
	  in
	    case fmt
	     of PBM => pr "P4\n"
	      | PGM => pr "P5\n"
	      | PPM => pr "P6\n"
	    (* end case *);
	    pr(concat[Int.toString wid, " ", Int.toString ht, "\n"]);
	    if (fmt <> PBM) then pr(Int.toString maxval ^ "\n") else ()
	  end

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0