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/pgm-file-io.sml
ViewVC logotype

View of /trunk/sml3d/src/image-io/pgm-file-io.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 321 - (download) (annotate)
Thu Oct 2 21:54:44 2008 UTC (11 years ago) by jhr
File size: 4372 byte(s)
  Various bug fixes.
(* pgm.sml
 *
 * COPYRIGHT (c) 2008 John Reppy (http://www.cs.uchicago.edu/~jhr)
 * All rights reserved.
 *
 * SML module for reading/writing PGM files.
 *)

signature PGM_FILE_IO =
  sig

    type ubyte = GLTypes.glubyte
    type ushort = GLTypes.glushort
    type 'a image = 'a Image.image2D

    datatype pgm_data
      = PGM8 of ubyte DataBuffer.buffer
      | PGM16 of ushort DataBuffer.buffer

    datatype pgm_image
      = Gray8 of ubyte image
      | Gray16 of ushort image

  (* read a PGM file; if flip is true, then the top and bottom of the image is flipped *)
    val readFile : {file : string, flip : bool} -> {wid : int, ht : int, data : pgm_data}
    val readImage : {file : string, flip : bool} -> pgm_image

    val writeFile : (string * {wid : int, ht : int, data : pgm_data}) -> unit
    val writeImage : (string * pgm_image) -> unit

  end

structure PGMFileIO :> PGM_FILE_IO =
  struct

    structure W8 = Word8
    structure W8V = Word8Vector
    structure DB = DataBuffer

    type ubyte = GLTypes.glubyte
    type ushort = GLTypes.glushort
    type 'a image = 'a Image.image2D

    val w16Tow8 = Word8.fromLarge o Word16.toLarge

    datatype pgm_data
      = PGM8 of ubyte DataBuffer.buffer
      | PGM16 of ushort DataBuffer.buffer

    datatype pgm_image
      = Gray8 of ubyte image
      | Gray16 of ushort image

    fun readFile {file, flip} = ImageIOUtil.withBinIn (file, fn inS => let
	  fun error msg = ImageIOUtil.raiseIO {fnName = "PGMFileIO.readFile", fileName = file} msg
	  val {fmt, wid, ht, maxval} = NetpbmUtil.readHeader {
		  err = fn s => error [s],
		  inS = inS
		}
	  val _ = if fmt <> NetpbmUtil.PGM
		then error ["not PGM file"]
		else ()
	  val sz = wid * ht
	  val bytesPerPixel = if (maxval = 0xff) then 1
		else if (maxval = 0xffff) then 2
		else error ["unsupported maximum pixel value ", Int.toString maxval]
	  val bytesPerRow = wid * bytesPerPixel
(* FIXME: we should add a sanity check to make sure that the buffer size matches
 * the file size before we allocate the buffer.
 *)
	  fun getRaster (buf, set, get) = let
		fun getRow r = let
		      val rowData = BinIO.inputN(inS, bytesPerRow)
		      fun copyData (dstI, srcI) = if (srcI < bytesPerRow)
			    then (
			      set (buf, dstI, get(rowData, srcI));
			      copyData (dstI+1, srcI+bytesPerPixel))
			    else ()
		      in
			if (W8V.length rowData <> bytesPerRow)
			  then error ["incomplete row ", Int.toString r]
			  else copyData (r*wid, 0)
		      end
		fun loop r = if (r < ht)
		      then (getRow r; loop(r+1))
		      else ()
		fun flipLoop r = if (0 <= r)
		      then (getRow r; flipLoop(r-1))
		      else ()
		in
		  if flip then flipLoop(ht-1) else loop 0;
		  buf
		end
	  val data = if (bytesPerPixel = 1)
		then PGM8(getRaster (DB.new(DB.sizeub, sz), DB.setub, ImageIOUtil.get8))
		else PGM16(getRaster (DB.new(DB.sizeus, sz), DB.setus, ImageIOUtil.get16))
	  in
	    {wid=wid, ht=ht, data=data}
	  end)

    fun length (PGM8 buf) = DB.length buf
      | length (PGM16 buf) = DB.length buf

    fun writeFile (fname, {wid, ht, data}) = let
	  val _ = if ((wid < 0) orelse (ht < 0)
		orelse (ht*wid <> length data))
		  then raise Fail "badly formed PGM data"
		  else ()
	  in
	    ImageIOUtil.withBinOut (fname, fn outS => let
	      fun put8 w = BinIO.output1(outS, w)
	      fun put16 w = (
		    put8 (w16Tow8(Word16.>>(w, 0w8)));
		    put8 (w16Tow8 w))
	      in
		case data
		 of PGM8 data => (
		      NetpbmUtil.writeHeader {
			  outS = outS, fmt = NetpbmUtil.PGM,
			  wid = wid, ht = ht, maxval = 0xff
			};
		      DB.app put8 data)
		  | PGM16 data => (
		      NetpbmUtil.writeHeader {
			  outS = outS, fmt = NetpbmUtil.PGM,
			  wid = wid, ht = ht, maxval = 0xffff
			};
		      DB.app put16 data)
		(* end case *)
	      end)
	  end

    fun readImage arg = let
	  val {wid, ht, data} = readFile arg
	  in
	    case data
	     of PGM8 data => Gray8(Image.image2D{wid=wid, ht=ht, data=data})
	      | PGM16 data => Gray16(Image.image2D{wid=wid, ht=ht, data=data})
	    (* end case *)
	  end

    fun writeImage (file, Gray8 img) = writeFile (file, {
	    wid = Image.width2D img,
	    ht = Image.height2D img,
	    data = PGM8(Image.data2D img)})
      | writeImage (file, Gray16 img) = writeFile (file, {
	    wid = Image.width2D img,
	    ht = Image.height2D img,
	    data = PGM16(Image.data2D img)})

  end

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