MODULE ImageFilePPMSpecific EXPORTS ImageFilePPM;

IMPORT PPM;

IMPORT Rd, Wr, Thread, FileWr, FileRd, OSError;
FROM Stdio IMPORT stderr;

TYPE
  ImageParms = RECORD
      name: TEXT;                 (* File name (with extension) *)
      fmv: LONGREAL;              (* = FLOAT(maxVal, LONGREAL) *)
      shift, scale: ChannelParms; (* Mapping parms: file = (real + shift)*scale *)
    END;

REVEAL 
  Writer = WriterPublic BRANDED OBJECT
      wr: Wr.T;                (* The file *)
      Writer: PPM.Writer;      (* Image writer *)
      h: ImageParms;           (* Image parameters *)
    OVERRIDES
      open := WriterOpen;
      put := WriterPut;
      close := WriterClose;
    END;
  
PROCEDURE WriterOpen(
    f: Writer;
    name: TEXT; 
    NX, NY: CARDINAL;
    READONLY a, s: ChannelParms;
    VAR absError, relError: ChannelParms;
    READONLY maxVal := ChannelRanges{DefaultMaxVal, ..};
  ): Writer RAISES {Thread.Alerted, Wr.Failure, OSError.E} =
  BEGIN
    WITH 
      fileName = name & Extension,
      wr = FileWr.Open(fileName)
    DO
      f.h.name := fileName;
      f.wr := wr;
      <* ASSERT maxVal[0] = maxVal[1] *>
      <* ASSERT maxVal[0] = maxVal[2] *>

      Wr.PutText(stderr, "( writing " & f.h.name & " ... ");
      f.Writer := NEW(PPM.Writer).init(
        f.wr, NX, NY, 
        maxVal := maxVal[0],
        binary := TRUE
      );

      f.h.fmv := FLOAT(maxVal[0], LONGREAL);
      FOR i := 0 TO 2 DO
        WITH 
          lo = a[i] - s[i],
          hi = a[i] + s[i]
        DO
          <* ASSERT hi # lo *>
          f.h.shift[i] := -lo; 
          f.h.scale[i] := f.h.fmv / (hi - lo);
          absError[i] := 1.0d-200 + ABS(s[i]) / f.h.fmv;
          relError[i] := 1.0d-14;
        END
      END
    END;
    RETURN f
  END WriterOpen;
  
PROCEDURE WriterPut(f: Writer; READONLY s: LongRealPixel)
  RAISES {Thread.Alerted, Wr.Failure} =
  VAR v: ARRAY [0..2] OF CARDINAL;
  BEGIN 
    FOR i := 0 TO 2 DO
      WITH
        ss = (s[i] + f.h.shift[i])*f.h.scale[i],
        fv = MAX(0.0d0, MIN(f.h.fmv, ss))
      DO
        v[i] := ROUND(fv)
      END
    END;
    f.Writer.put(v)
  END WriterPut;
  
PROCEDURE WriterClose(f: Writer) =
  <* FATAL Thread.Alerted, Wr.Failure *>
  BEGIN
    f.Writer.finish();
    Wr.Close(f.wr);
    Wr.PutText(stderr, " done. )\n");
  END WriterClose;

REVEAL
  Reader = ReaderPublic BRANDED OBJECT
    rd: Rd.T;              (* The file *)
    Reader: PPM.Reader;    (* Image reader *)
    h: ImageParms;         (* Image parameters *)
  OVERRIDES
    open := ReaderOpen;
    get := ReaderGet; 
    close := ReaderClose;
  END;

PROCEDURE ReaderOpen(
    f: Reader; 
    name: TEXT; 
    VAR NX, NY: CARDINAL;
    READONLY a, s: ChannelParms;
    VAR absError, relError: ChannelParms;
  ): Reader RAISES {Rd.Failure, Thread.Alerted, OSError.E} =
  <* FATAL Wr.Failure *>
  VAR maxVal: CARDINAL;
  BEGIN
    WITH 
      fileName = name & Extension,
      rd = FileRd.Open(fileName)
    DO
      f.rd := rd;
      f.h.name := fileName;
      Wr.PutText(stderr, "( reading " & f.h.name & " ... ");
      f.Reader := NEW(PPM.Reader).init(rd, NX, NY, maxVal := maxVal);
      
      f.h.fmv := FLOAT(maxVal, LONGREAL);
      FOR i := 0 TO 2 DO
        WITH 
          lo = a[0] - s[0],
          hi = a[0] + s[0]
        DO
          <* ASSERT hi # lo *>
          f.h.scale[i] :=  f.h.fmv / (hi - lo);
          f.h.shift[i] := - lo;
          absError[i] := 1.0d-200 + ABS(s[i]) / f.h.fmv;
          relError[i] := 1.0d-14;
        END
      END
    END;
    RETURN f
  END ReaderOpen;

PROCEDURE ReaderGet(f: Reader; VAR s: LongRealPixel)
  RAISES {Rd.Failure, Thread.Alerted} =
  VAR v: ARRAY [0..2] OF CARDINAL;
  BEGIN 
    f.Reader.get(v);
    FOR i := 0 TO 2 DO
      s[i] := (FLOAT(v[i], LONGREAL)/f.h.scale[i]) - f.h.shift[i]
    END
  END ReaderGet;

PROCEDURE ReaderClose(f: Reader) =
  <*FATAL Rd.Failure, Wr.Failure, Thread.Alerted *>
  BEGIN
    f.Reader.finish();
    Rd.Close(f.rd);
    Wr.PutText(stderr, " done. )\n");
  END ReaderClose;

BEGIN    
END ImageFilePPMSpecific.