(* Copyright (C) 1995 UNICAMP.  See notice at the end of this file.  *)

MODULE PSPlot;  (* Version 95-04-16-stolfi *)

IMPORT Wr, Fmt, Text, PSWrite, Thread, FileWr, OSError;

REVEAL
  File = PubFile BRANDED OBJECT
      wr: Wr.T;
      xMinPS, xMaxPS, xPagePS: LONG;
      yMinPS, yMaxPS, yPagePS: LONG;
      
      xMin, xMax, xScale: LONG;
      yMin, yMax, yScale: LONG;
      nX, nY: CARDINAL;
      
      draw: BOOL; (* TRUE to draw figure outlines *)
      fill: BOOL; (* TRUE to paint figure interiors *)
     
      drawingStarted: BOOL := FALSE; (* OK to issue drawing commands *)

      (* The following parameters track the state of the Postscript file: *)

      lineColor: Color;
      lineWidth: REAL;
      lineSolid: BOOL;
      lineDashPattern: REF ARRAY OF REAL;
      lineDashSkip: REAL;
 
      fillColor: Color;
      
      textColor: Color;
      fontName: TEXT;
      fontSize: REAL;

    OVERRIDES

      setScale := SetScale;
      setLineColor := SetLineColor;
      setLineWidth := SetLineWidth;
      setLineSolid := SetLineSolid;
      setLineDashed := SetLineDashed;
      
      setFillColor := SetFillColor;
      
      setTextColor := SetTextColor;

      label := Label;
      segment := Segment;
      rectangle := Rectangle;
      circle := Circle;
      ellipse := Ellipse;
      triangle := Triangle;

      setGridSize := SetGridSize;
      gridCell := GridCell;
      coordLine := CoordLine;
      gridLines := GridLines;
      frame := Frame;

      comment := Comment;
    END;
  
  EPSFile = PubEPSFile BRANDED OBJECT
    OVERRIDES
      open := EPSOpen;
      close := EPSClose;
    END;
  
  PSFile = PubPSFile BRANDED OBJECT
      nPages: CARDINAL;
      yCaptionPS: LONG;
      pageStarted: BOOL := FALSE;    (* "beginPage" called *)
    OVERRIDES
      open := PSOpen;
      beginPage := BeginPage;
      beginDrawing := BeginDrawing;
      endDrawing := EndDrawing;
      endPage := EndPage;
      caption := Caption;
      close := PSClose;
    END;

CONST
  MillimetersPerPoint: LONG = 25.4d0 / 72.0d0;

PROCEDURE Gray(v: REAL): Color =
  BEGIN
    RETURN Color{v, v, v}
  END Gray;

PROCEDURE EPSOpen (f: EPSFile; name: TEXT; xSize, ySize: LONG): EPSFile =
  <* FATAL OSError.E *>
  BEGIN
    <* ASSERT f.wr = NIL *>
    f.wr := FileWr.Open(name);
    f.xPagePS := xSize;
    f.yPagePS := ySize;
    WITH 
      xMinPS = 25.4d0, xMaxPS = xMinPS + xSize,
      yMinPS = 25.4d0, yMaxPS = yMinPS + ySize
    DO
      PSWrite.EPSFileHeader(f.wr, xMinPS, xMaxPS, yMinPS, yMaxPS);
      DoBeginDrawing(f, xMinPS, xMaxPS, yMinPS, yMaxPS);
    END;
    f.drawingStarted := TRUE;
    RETURN f
  END EPSOpen;

PROCEDURE EPSClose(f: File) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    DoEndDrawing(f);
    PSWrite.EPSFileTrailer(f.wr);
    Wr.Close(f.wr);
    f.drawingStarted := FALSE;
    f.wr := NIL
  END EPSClose;
  
PROCEDURE PSOpen (f: PSFile; name: TEXT; xPageSize, yPageSize: LONG): PSFile =
  <* FATAL OSError.E *>
  BEGIN
    <* ASSERT f.wr = NIL *>
    f.wr := FileWr.Open(name);
    f.nPages := 0;
    f.xPagePS := xPageSize;
    f.yPagePS := yPageSize;
    PSWrite.PSFileHeader(f.wr);
    f.pageStarted := FALSE;
    f.drawingStarted := FALSE;
    RETURN f
  END PSOpen;

PROCEDURE BeginPage(f: PSFile) =
  BEGIN
    <* ASSERT f.wr # NIL *>
    <* ASSERT NOT f.pageStarted *>
    INC(f.nPages);
    PSWrite.PSPageHeader(f.wr, Fmt.Int(f.nPages), "");
    f.pageStarted := TRUE;
    f.drawingStarted := FALSE;
  END BeginPage;
  
PROCEDURE BeginDrawing(f: PSFile; xSize, ySize, xCenter, yCenter: LONG) =
  BEGIN
    <* ASSERT f.wr # NIL *>
    <* ASSERT f.pageStarted *>
    <* ASSERT NOT f.drawingStarted *>
    WITH
      xMinPS = xCenter - xSize/2.0d0,
      xMaxPS = xMinPS + xSize,
      yMinPS = yCenter - ySize/2.0d0,
      yMaxPS = yMinPS + ySize
    DO
      DoBeginDrawing(f, xMinPS, xMaxPS, yMinPS, yMaxPS);
      (* Place caption just below drawing area: *)
      f.yCaptionPS := - 1.0d0;
      f.drawingStarted := TRUE
    END;
  END BeginDrawing;
  
PROCEDURE EndDrawing(f: PSFile) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    DoEndDrawing(f);
    f.drawingStarted := FALSE
  END EndDrawing;

PROCEDURE EndPage(f: PSFile) =
  BEGIN
    <* ASSERT f.pageStarted *>
    IF f.drawingStarted THEN f.endDrawing() END;
    PSWrite.PSPageTrailer(f.wr);
    f.pageStarted := FALSE
  END EndPage;

PROCEDURE PSClose(f: PSFile) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    <* ASSERT f.wr # NIL *>
    IF f.pageStarted THEN f.endPage() END;
    WITH pages = Fmt.Int(f.nPages) DO
      PSWrite.PSFileTrailer(f.wr, pages)
    END;
    Wr.Close(f.wr);
    f.wr := NIL
  END PSClose;
  
PROCEDURE Caption(
    f: PSFile; 
    txt: TEXT;
    font: TEXT; 
    size: REAL; 
    xAlign: REAL;
  ) =
  VAR start, stop, length: INTEGER;
  BEGIN
    <* ASSERT f.drawingStarted *>
    DoSetFont(f, font, size);
    WITH
      xCaptionPS = FLOAT(xAlign, LONG) * (f.xMaxPS - f.xMinPS)
    DO
      length := Text.Length(txt);
      start := 0;
      WHILE start < length DO
        stop := Text.FindChar(txt, '\n', start);
        IF stop = -1 THEN stop := length END;
        PSWrite.Label(f.wr, 
          Text.Sub(txt, start, stop - start),
          xCaptionPS, f.yCaptionPS, 
          xAlign := xAlign, yAlign := 1.0, angle := 0.0
        );
        f.yCaptionPS := f.yCaptionPS - FLOAT(size, LONG) * MillimetersPerPoint;
        start := stop + 1;
      END
    END
  END Caption;

PROCEDURE Comment(f: File; txt: TEXT) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    PSWrite.Comment(f.wr, txt);
  END Comment;

PROCEDURE Frame(f: File) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    PSWrite.Frame(f.wr);
  END Frame;

PROCEDURE SetLineColor(f: File; READONLY color: Color) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH 
      visible = (color[0] >= 0.0 AND color[1] >= 0.0 AND color[2] >= 0.0)
    DO
      IF visible AND color # f.lineColor THEN
        PSWrite.SetLineColor(f.wr, color[0], color[1], color[2]);
        f.lineColor := color;
      END;
      f.draw := visible
    END
  END SetLineColor;

PROCEDURE SetLineWidth(f: File; width: REAL) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    IF width # f.lineWidth THEN
      PSWrite.SetLineWidth(f.wr, width);
      f.lineWidth := width
    END
  END SetLineWidth;

PROCEDURE SetLineDashed(f: File; READONLY pattern: ARRAY OF REAL; skip: REAL := 0.0) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH 
      solid = DashPatternIsSolid(pattern)
    DO
      IF NOT SameDashPattern(
          f.lineSolid, f.lineDashPattern^, f.lineDashSkip, 
          solid, pattern, skip
        ) 
      THEN
        PSWrite.SetLineDashPattern(f.wr, pattern, skip);
        (* 
          The code below avoids unnecessary reallocation of "f.lineDashPattern"
          when alternating between a solid pattern and a dashed one.
          The penalty is that "f.lineDashPattern" may not track the 
          true setting of the dash pattern in the Postscript file
          when both are solid.  That should not cause any harm...
        *)
        IF NOT solid THEN
          IF f.lineDashPattern = NIL 
          OR NUMBER(pattern) # NUMBER(f.lineDashPattern^) THEN
            f.lineDashPattern := NEW(REF ARRAY OF REAL, NUMBER(pattern))
          END;
          f.lineDashPattern^ := pattern;
        END;
        f.lineDashSkip := skip;
        f.lineSolid := solid;
      END
    END
  END SetLineDashed;

PROCEDURE SetLineSolid(f: File) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    IF NOT f.lineSolid THEN
      PSWrite.SetLineDashPattern(f.wr, ARRAY OF REAL {}, 0.0);
      f.lineSolid := TRUE
    END
  END SetLineSolid;
  
PROCEDURE SetFillColor(f: File; READONLY color: Color) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH 
      visible = (color[0] >= 0.0 AND color[1] >= 0.0 AND color[2] >= 0.0)
    DO
      IF visible AND color # f.fillColor THEN
        PSWrite.SetFillColor(f.wr, color[0], color[1], color[2]);
        f.fillColor := color;
      END;
      f.fill := visible
    END
  END SetFillColor;

PROCEDURE SetTextColor(f: File; READONLY color: Color) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH 
      visible = (color[0] >= 0.0 AND color[1] >= 0.0 AND color[2] >= 0.0)
    DO
      <* ASSERT visible *>
      IF color # f.textColor THEN
        PSWrite.SetTextColor(f.wr, color[0], color[1], color[2]);
        f.textColor := color;
      END
    END
  END SetTextColor;

PROCEDURE SetScale(f: File; axis: Axis; min, max: LONG) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    CASE axis OF
    | Axis.X => 
        f.xMin := min; f.xMax := max; 
        f.xScale := (f.xMaxPS - f.xMinPS)/(f.xMax - f.xMin);
    | Axis.Y =>
        f.yMin := min; f.yMax := max;
        f.yScale := (f.yMaxPS - f.yMinPS)/(f.yMax - f.yMin);
    END
  END SetScale;
  
PROCEDURE SetGridSize(f: File; xn, yn: CARDINAL) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    <* ASSERT xn > 0 *>
    <* ASSERT yn > 0 *>
    PSWrite.SetGridSize(f.wr, xn, yn)
  END SetGridSize;
  
PROCEDURE Label(
    f: File;
    txt: TEXT; 
    x, y: LONG; 
    xAlign, yAlign: REAL := 0.0; 
    angle: REAL := 0.0;
    font: TEXT := "Courier";
    size: REAL := 10.0;
  ) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    DoSetFont(f, font, size);
    WITH
      xPS = f.xScale * (x - f.xMin),
      yPS = f.yScale * (y - f.yMin)
    DO
      PSWrite.Label(f.wr, txt, xPS, yPS, xAlign, yAlign, angle)
    END
  END Label;

PROCEDURE Segment (f: File; xa, ya, xb, yb: LONG) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH
      psxa = f.xScale * (xa - f.xMin),
      psya = f.yScale * (ya - f.yMin),
      psxb = f.xScale * (xb - f.xMin),
      psyb = f.yScale * (yb - f.yMin)
    DO
      PSWrite.Segment(f.wr, psxa, psya, psxb, psyb)
    END;
  END Segment;  

PROCEDURE Rectangle(f: File; xlo, xhi, ylo, yhi: LONG) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH
      psxlo = f.xScale * (xlo - f.xMin),
      psxhi = f.xScale * (xhi - f.xMin),
      psylo = f.yScale * (ylo - f.yMin),
      psyhi = f.yScale * (yhi - f.yMin)
    DO
      PSWrite.Rectangle(f.wr, psxlo, psxhi, psylo, psyhi, f.fill, f.draw)
   END
  END Rectangle;

PROCEDURE Triangle (f: File; xa, ya, xb, yb, xc, yc: LONG) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH
      psxa = f.xScale * (xa - f.xMin),
      psya = f.yScale * (ya - f.yMin),
      psxb = f.xScale * (xb - f.xMin),
      psyb = f.yScale * (yb - f.yMin),
      psxc = f.xScale * (xc - f.xMin),
      psyc = f.yScale * (yc - f.yMin)
    DO
      PSWrite.Triangle(f.wr, psxa, psya, psxb, psyb, psxc, psyc, f.fill, f.draw)
    END
  END Triangle;

PROCEDURE Circle (f: File; xc,yc: LONG; radius: REAL) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH
      psxc = f.xScale * (xc - f.xMin),
      psyc = f.yScale * (yc - f.yMin),
      psradius = FLOAT(radius, LONG)
    DO
      PSWrite.Circle(f.wr, psxc, psyc, psradius, f.fill, f.draw)
    END
  END Circle;
  
PROCEDURE Ellipse(f: File; xc,yc, xa,ya, xb,yb: LONG) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    WITH
      psxc = f.xScale * (xc - f.xMin),
      psyc = f.yScale * (yc - f.yMin),
      psxa = f.xScale * xa,
      psya = f.yScale * ya,
      psxb = f.xScale * xb,
      psyb = f.yScale * yb
    DO
      PSWrite.Ellipse(f.wr, psxc, psyc, psxa, psya, psxb, psyb, f.fill, f.draw)
    END
  END Ellipse;

PROCEDURE GridCell (f: File; xi, yi: CARDINAL) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    PSWrite.GridCell(f.wr, xi, yi, f.fill, f.draw)
  END GridCell;

PROCEDURE CoordLine (f: File; axis: Axis; coord: LONGREAL) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    IF axis = Axis.X THEN
      PSWrite.CoordLine(f.wr, PSWrite.Axis.X, f.xScale * (coord - f.xMin))
    ELSE
      PSWrite.CoordLine(f.wr, PSWrite.Axis.Y, f.yScale * (coord - f.yMin))
    END;
  END CoordLine;

PROCEDURE GridLines (f: File) = 
  BEGIN
    <* ASSERT f.drawingStarted *>
    PSWrite.GridLines(f.wr)
  END GridLines;

(*** INTERNAL PROCEDURES ***)

PROCEDURE SameDashPattern(
    sola: BOOL; READONLY pata: ARRAY OF REAL; skipa: REAL;
    solb: BOOL; READONLY patb: ARRAY OF REAL; skipb: REAL
  ): BOOL =
  BEGIN
    IF sola AND solb THEN
      RETURN TRUE
    ELSIF sola # solb THEN
      RETURN FALSE
    ELSE
      RETURN pata = patb AND skipa = skipb
    END
  END SameDashPattern;
  
PROCEDURE DashPatternIsSolid(READONLY pattern: ARRAY OF REAL): BOOL =
  VAR sum: LONG := 0.0d0;
      i: CARDINAL := 1;
  BEGIN
    IF NUMBER(pattern) = 0 THEN RETURN TRUE END;
    IF NUMBER(pattern) = 1 THEN RETURN FALSE END;
    REPEAT
      sum := sum + FLOAT(pattern[i], LONG);
      i := (i + 2) MOD NUMBER(pattern)
    UNTIL i = 1;
    RETURN sum = 0.0d0
  END DashPatternIsSolid;

PROCEDURE DoBeginDrawing(f: File; xMinPS, xMaxPS, yMinPS, yMaxPS: LONG) =
  BEGIN
    <* ASSERT NOT f.drawingStarted *>
    
    PSWrite.BeginDrawing(f.wr, xMinPS, xMaxPS, yMinPS, yMaxPS);
    f.xMinPS := xMinPS; f.xMaxPS := xMaxPS;
    f.yMinPS := yMinPS; f.yMaxPS := yMaxPS;

    PSWrite.RoundJoinAndCaps(f.wr);

    f.xMin := 0.0d0; f.xMax := 1.0d0;
    f.xScale := (f.xMaxPS - f.xMinPS)/(f.xMax - f.xMin);

    f.yMin := 0.0d0; f.yMax := 1.0d0;
    f.yScale := (f.yMaxPS - f.yMinPS)/(f.yMax - f.yMin);
    
    f.nX := 1; f.nY := 1;
    PSWrite.SetGridSize(f.wr, f.nX, f.nY);
    
    f.lineColor := Color{0.0, 0.0, 0.0};
    f.draw := TRUE;
    PSWrite.SetLineColor(f.wr, f.lineColor[0], f.lineColor[1], f.lineColor[2]);
    
    f.fillColor := Color{0.5, 0.5, 0.5};
    f.fill := TRUE;
    PSWrite.SetFillColor(f.wr, f.fillColor[0], f.fillColor[1], f.fillColor[2]);
    
    f.textColor := Color{0.5, 0.5, 0.5};
    PSWrite.SetTextColor(f.wr, f.textColor[0], f.textColor[1], f.textColor[2]);
    
    f.lineWidth := 0.0;
    PSWrite.SetLineWidth(f.wr, f.lineWidth);
    
    f.lineSolid := TRUE;
    f.lineDashPattern := NEW(REF ARRAY OF REAL, 0);
    f.lineDashSkip := 0.0;
    PSWrite.SetLineDashPattern(f.wr, f.lineDashPattern^, f.lineDashSkip);

    f.drawingStarted := TRUE
  END DoBeginDrawing;
  
PROCEDURE DoEndDrawing(f: File) =
  BEGIN
    <* ASSERT f.drawingStarted *>
    PSWrite.EndDrawing(f.wr);
    f.drawingStarted := FALSE
  END DoEndDrawing;
  
PROCEDURE DoSetFont(f: File; font: TEXT; size: REAL) =
  BEGIN
    IF font # f.fontName OR size # f.fontSize THEN
      PSWrite.SetFont(f.wr, font, size);
      f.fontName := font;
      f.fontSize := size;
    END;
  END DoSetFont;

BEGIN
END PSPlot.
(****************************************************************************)
(*                                                                          *)
(* Copyright (C) 1995 Universidade Estadual de Campinas (UNICAMP)           *)
(*                                                                          *)
(* Authors:                                                                 *)
(*   Jorge Stolfi        - CS Dept, UNICAMP <stolfi@dcc.unicamp.br>         *)
(*                                                                          *)
(* This file can be freely used, distributed, and modified, provided that   *)
(*   this copyright and authorship notice is included in every copy or      *)
(*   derived version.                                                       *)
(*                                                                          *)
(* DISCLAIMER: This software is offered ``as is'', without any guarantee    *)
(*   as to fitness for any particular purpose.  Neither the copyright       *)
(*   holder nor the authors or their employers can be held responsible for  *)
(*   any damages that may result from its use.                              *)
(*                                                                          *)
(****************************************************************************)