;;; -*- Mode: Lisp -*-
;;;
;;; $Header: /home/gene/library/website/docsrc/fps/RCS/graph1.lisp,v 395.1 2008/04/20 17:25:46 gene Exp $
;;;
;;; Copyright (c) 2006 Gene Michael Stover.  All rights reserved.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301
;;; USA
;;;

(defpackage "COM.CYBERTIGGYR.GENE.FPS.GRAPH1"
  (:use "COMMON-LISP"))
(in-package "COM.CYBERTIGGYR.GENE.FPS.GRAPH1")

(export 'graph0)

(defstruct (point2 (:type list)) x y)

(defun load-points (pn)
  (with-open-file (strm pn)
    (do ((lst nil (cons x lst))
	 (x (read strm nil strm) (read strm nil strm)))
	((eq x strm) lst))))

(defun min-x (points)
  "Return the minimum X value for the graph."
  (min 0 (reduce #'min points :key #'point2-x)))

(defun max-x (points)
  "Return the maximum X value for the graph."
  (max 0 (reduce #'max points :key #'point2-x)))

(defun min-y (points)
  "Return the minimum X value for the graph."
  (min 0 (reduce #'min points :key #'point2-y)))

(defun max-y (points)
  "Return the maximum X value for the graph."
  (max 0 (reduce #'max points :key #'point2-y)))

(defun inch (n)
  "Given a number of inches, return the number of PostScript
points.  There are 72 PostScript points in an inch."
  (* 72 n))

(defun mm (n)
  "Given millimeters, return PostScript points.  There are 72
PostScript points in an inch.  There are 51/144 PostScript
points in a millimeter."
  (inch (/ n 25.5)))

(defun cm (n)
  "Given a number of centimeters, return the number of
PostScript points."
  (inch (/ n 2.55)))

(defun kBoxLowX ()
  "Return the coordinate of the left side of the image
area in PostScript user space points."
  72)

(defun kBoxUppX (width)
  "Return the location of the right edge of the image in
PostScript user space points.  WIDTH is centimeters."
  ;; To get the right edge, we start with the left edge
  ;; and add the width.  Remember to convert the width
  ;; from centimeters to PostScript user space points.
  (first
   (multiple-value-list
       (round (+ (kBoxLowX) (cm width))))))

(defun kBoxUppY ()
  "Return the coordinate of the upper side of the image
area in PostScript user space points."
  ;; We assume the paper is 11 inches tall, & we leave
  ;; a 1-inch border between the top of the paper &
  ;; the top of the image.
  (inch 10))

(defun kBoxLowY (height)
  "Return the coordinates of the bottom side of the image
area in PostScript user space points.  HEIGHT is in
centimeters."
  (first
   (multiple-value-list
       (round (- (kBoxUppY) (cm height))))))

(defvar *border-around-graph* 4
  "Border between graphing area & image area, in millimeters")

(defun ps-number (n)
  "Give this function a number & it gives you a string which
you print into a PostScript program.  The string you get will
always encode an integer or a real number, whichever is appropriate.
Even if N is a ratio (which Lisp can do but PostScript can't),
you will get an encoded real number."
  (cond ((integerp n) (format nil "~D" n))
	;; This next case is an attempt to recognize a non-integer
	;; which can be treated as an integer.  I think this will
	;; always work, but if it doesn't, no harm done because it
	;; won't hurt to treat the number as a real.
	((equalp n (round n)) (format nil "~D" n))
	;; Finaly, we don't have an integer, & we don't have a
	;; ratio or real which happens to have an integral value.
	;; So we bite the bullet & encode a real number.
	(t (format nil "~,10E" n))))

(defun print-library0 (strm)
  "To STRM, print a library of PostScript functions.  This is
Library 0, the lowest level library, because it does not depend
on any of the parameters or arguments which are specific to
drawing the graph."
  (format strm "~%    %")
  (format strm "~%    % Given inches, return points.")
  (format strm "~%    % Stack: inches => points")
  (format strm "~%    %")
  (format strm "~%    /inch {")
  (format strm "~%        72 mul")
  (format strm "~%    } def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Given centimeters, return points.")
  (format strm "~%    % There are 480/17 points in a centimeter.")
  (format strm "~%    % I multiply, then divide, by integers in the")
  (format strm "~%    % hope of taking advantage of the rare case")
  (format strm "~%    % in which we have an integral number of")
  (format strm "~%    % points.")
  (format strm "~%    %")
  (format strm "~%    /cm {")
  (format strm "~%        480 mul 17 div")
  (format strm "~%    } def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Given millimeters, return points.")
  (format strm "~%    % There are 48/17 points in a millimeter.")
  (format strm "~%    %")
  (format strm "~%    /mm {")
  (format strm "~%        48 mul 17 div")
  (format strm "~%    } def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Make a box path.  Creates a new path for it.")
  (format strm "~%    % Does not stroke or fill it.")
  (format strm "~%    % Stack: min-x min-y max-x max-y => -")
  (format strm "~%    %")
  (format strm "~%    /newpath-box {")
  (format strm "~%        4 dict begin")
  (format strm "~%            /max-y exch def")
  (format strm "~%	      /max-x exch def")
  (format strm "~%	      /min-y exch def")
  (format strm "~%	      /min-x exch def")
  (format strm "~%")
  (format strm "~%	    newpath")
  (format strm "~%	        min-x min-y moveto")
  (format strm "~%		max-x min-y lineto")
  (format strm "~%		max-x max-y lineto")
  (format strm "~%		min-x max-y lineto")
  (format strm "~%		closepath")
  (format strm "~%        end")
  (format strm "~%    } def")
  strm)

(defun print-parameters (strm)
  "Print parameter for the graph.  The parameters rarely
change.  In fact, this implementation of the function
outputs a hard-coded string.  So these parameters never
change unless I change this function."
  (format strm "~%    %")
  (format strm "~%    % Paper's height in PostScript points.  We assume the")
  (format strm "~%    % page is 11 inches high; that's common in the")
  (format strm "~%    % United States.")
  (format strm "~%    % The units are PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /PageHeight 11 inch def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Width of the margin between the edge of the paper &")
  (format strm "~%    % the edge of the image.  Any edge.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /Margin 1 inch def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % I draw a box around the entire image.  This is the")
  (format strm "~%    % thickness of the line which forms the box.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /BoxLineWidth 1 def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Width of the border between the image's edge & the")
  (format strm "~%    % graphing area's AXIS edges.  An \"axis edge\" is an")
  (format strm "~%    % edge which has an axis.  The left edge is an axis")
  (format strm "~%    % edge.  The bottom edge is an axis edge.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /BorderAxis 6 mm def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Width of the border between the image's edge & the")
  (format strm "~%    % graphing area's NON-axis edges.  An \"axis edge\" is")
  (format strm "~%    % an edge which has an axis.  The top edge is a non-")
  (format strm "~%    % axis edge.  The right edge is a non-axis edge.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /BorderNonAxis 4 mm def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The line width of the axes.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /AxisLineWidth 2 def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Number of tick marks on an axis.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /TicksPerAxis 5 def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % ONE HALF of the length of a tick mark on an axis.")
  (format strm "~%    % So why is if HALF of the tick's length instead of")
  (format strm "~%    % the length?  I originally used the tick length, but")
  (format strm "~%    % every time I used it, I had to divide it by two.")
  (format strm "~%    % So we save a few cycles & have a little less code")
  (format strm "~%    % just by redefining tihs constant from TickLength to")
  (format strm "~%    % TickHalfLength.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /TickHalfLength 1 mm def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The width of the line forming an axis.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /TickLineWidth 1 def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The width of the lines connecting the dots.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /DotLineWidth 1 def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The radius of the dots.")
  (format strm "~%    % The unit is PostScript points.")
  (format strm "~%    %")
  (format strm "~%    /DotRadius 2 def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The size of the font for labels.")
  (format strm "~%    %")
  (format strm "~%    /LabelFontSize 10 def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The font for the labels.")
  (format strm "~%    %")
  (format strm "~%    /LabelFont")
  (format strm "~%        /Helvetica findfont")
  (format strm "~%        LabelFontSize scalefont")
  (format strm "~%    def")
  strm)

(defun print-arguments (lst height width min-x min-y max-x max-y strm)
  "Print the PostScript definitions of the graph's arguments.
The arguments probably change from one graph to another, so
they are not like the parameters, which rarely change."
  (format strm "~%    %")
  (format strm "~%    % The width of the image.")
  (format strm "~%    %")
  (format strm "~%    /ImageWidth ~A cm def" (ps-number width))
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The height of the image.")
  (format strm "~%    %")
  (format strm "~%    /ImageHeight ~A cm def" (ps-number height))
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The list of data points.  It is sorted from lowest X")
  (format strm "~%    % to highest X.  It assumes that each value of X is")
  (format strm "~%    % unique.  It's a list (array).  There is one element")
  (format strm "~%    % for each data point.  Each data point element has")
  (format strm "~%    % exactly two elements: X & Y, in that order.  The X")
  (format strm "~%    % is at index 0; the Y is at index 1.")
  (format strm "~%    %")
  (format strm "~%    /Data [ ~{[ ~A ~A ]~^~&            ~} ] def"
	  (mapcar #'ps-number
		  (reduce #'append
			  (sort (copy-list lst) #'< :key #'point2-x))))
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The lowest value of the X axis.")
  (format strm "~%    %")
  (format strm "~%    /DataMinX ~A def" (ps-number min-x))
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The highest value of the X axis.")
  (format strm "~%    %")
  (format strm "~%    /DataMaxX ~A def" (ps-number max-x))
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The lowest value of the Y axis.")
  (format strm "~%    %")
  (format strm "~%    /DataMinY ~A def" (ps-number min-y))
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % The highest value of the Y axis.")
  (format strm "~%    %")
  (format strm "~%    /DataMaxY ~A def" (ps-number max-y))
  strm)

(defun print-library1 (strm)
  "Print a library of PostScript programs like I did with
PRINT-LIBRARY0.  Unlike Library 0, this library depends on
parameters & arguments for the graph."
  (format strm "~%    %")
  (format strm "~%    % The left edge of the image.  It's easy to compute.")
  (format strm "~%    % It's just the width of the Margin.")
  (format strm "~%    %")
  (format strm "~%    /ImageMinX Margin def")

  (format strm "~%    %")
  (format strm "~%    % The right edge of the image.  It is Width cm from")
  (format strm "~%    % the left edge.")
  (format strm "~%    %")
  (format strm "~%    /ImageMaxX ImageMinX ImageWidth add def")

  (format strm "~%    %")
  (format strm "~%    % The upper edge of the image.  We figure this before")
  (format strm "~%    % the lower limit on Y because we want to place the")
  (format strm "~%    % image at the top of the page.  Since this PostScript")
  (format strm "~%    % program is encapsulated, the actual position on the")
  (format strm "~%    % page is meaningless when we generate the production")
  (format strm "~%    % document, but it's easier for on-screen debugging if")
  (format strm "~%    % the image is higher on the page.")
  (format strm "~%    %")
  (format strm "~%    /ImageMaxY PageHeight Margin sub def")

  (format strm "~%    %")
  (format strm "~%    % The lower edge of the image.  It is the upper edge")
  (format strm "~%    % less the height.")
  (format strm "~%    %")
  (format strm "~%    /ImageMinY ImageMaxY ImageHeight sub def")

  (format strm "~%    %")
  (format strm "~%    % The left-most edge of the graphing area on the")
  (format strm "~%    % paper.  It is Border points to the right of the")
  (format strm "~%    % left-most edge of the image area.  The graphing")
  (format strm "~%    % area is contained within the image area.")
  (format strm "~%    %")
  (format strm "~%    /GraphMinX ImageMinX BorderAxis add def")
  (format strm "~%    %")
  (format strm "~%    % The right-most edge of the graphing area on the")
  (format strm "~%    % paper.  It is Border points to the left of the")
  (format strm "~%    % right-most edge of the image area.  The graphing")
  (format strm "~%    % area is contained within the image area.")
  (format strm "~%    %")
  (format strm "~%    /GraphMaxX ImageMaxX BorderNonAxis sub def")
  (format strm "~%    %")
  (format strm "~%    % The top edge of the graphing area on the")
  (format strm "~%    % paper.  It is Border points below the")
  (format strm "~%    % top edge of the image area.  The graphing")
  (format strm "~%    % area is contained within the image area.")
  (format strm "~%    %")
  (format strm "~%    /GraphMaxY ImageMaxY BorderNonAxis sub def")
  (format strm "~%    %")
  (format strm "~%    % The bottom edge of the graphing area on the")
  (format strm "~%    % paper.  It is Border points above the")
  (format strm "~%    % bottom edge of the image area.  The graphing")
  (format strm "~%    % area is contained within the image area.")
  (format strm "~%    %")
  (format strm "~%    /GraphMinY ImageMinY BorderAxis add def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Draw both axes.")
  (format strm "~%    % Creates its own, new path.  Strokes that path.")
  (format strm "~%    % Uses some of the parameters to determine the")
  (format strm "~%    % thickness of the axis, the thickness of the ticks,")
  (format strm "~%    % & the length of the ticks.")
  (format strm "~%    % Does not save the graphics state.  (Should it save")
  (format strm "~%    % the graphics state?)")
  (format strm "~%    % Stack: min-x max-x min-y max-y => -")
  (format strm "~%    %")
  (format strm "~%    /draw-axis {")
  (format strm "~%        15 dict begin")
  (format strm "~%            /max-y exch def")
  (format strm "~%            /min-y exch def")
  (format strm "~%            /max-x exch def")
  (format strm "~%            /min-x exch def")
  (format strm "~%")
  (format strm "~%            newpath")
  (format strm "~%                % Draw the two lines for the axes.  The X")
  (format strm "~%                % axis has one line, & the Y axis has")
  (format strm "~%                % another. These lines get their own path,")
  (format strm "~%                % separate from that of the tick marks,")
  (format strm "~%                % because their line width color could")
  (format strm "~%                % differ from those of the tick marks.")
  (format strm "~%                min-x max-y moveto")
  (format strm "~%                min-x min-y lineto")
  (format strm "~%                max-x min-y lineto")
  (format strm "~%                AxisLineWidth setlinewidth")
  (format strm "~%            0 setgray")
  (format strm "~%            stroke")
  (format strm "~%")
  (format strm "~%            % Draw the tick marks on both axes.  There")
  (format strm "~%            % are TicksPerAxis of them on each axis.")
  (format strm "~%            /x min-x def")
  (format strm "~%            /delta-x max-x min-x sub TicksPerAxis div def")
  (format strm "~%            /y min-y def")
  (format strm "~%            /delta-y max-y min-y sub TicksPerAxis div def")
  (format strm "~%            newpath")
  (format strm "~%            0 1 TicksPerAxis {")
  (format strm "~%                % Draw the tick mark on the X axis.")
  (format strm "~%                    x min-y TickHalfLength add moveto")
  (format strm "~%                    x min-y TickHalfLength sub lineto")
  (format strm "~%                % Draw the tick mark on the Y axis.")
  (format strm "~%                    min-x TickHalfLength sub y moveto")
  (format strm "~%                    min-x TickHalfLength add y lineto")
  (format strm "~%                % Increment X & Y for the next time.")
  (format strm "~%                    /x x delta-x add def")
  (format strm "~%                    /y y delta-y add def")
  (format strm "~%            } for")
  (format strm "~%            TickLineWidth setlinewidth")
  (format strm "~%            0 setgray")
  (format strm "~%            stroke")
  (format strm "~%        end")
  (format strm "~%    } def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Given a coordiate in Data space, the range for")
  (format strm "~%    % Data space, & the range for Graph space, return")
  (format strm "~%    % the coordinate in Graph space.")
  (format strm "~%    % Stack: Value DataMin DataMax GraphMin GraphMax =>")
  (format strm "~%    %        Graph")
  (format strm "~%    %")
  (format strm "~%    /xlate-data-to-user-1 {")
  (format strm "~%        10 dict begin")
  (format strm "~%            /GraphMax exch def")
  (format strm "~%            /GraphMin exch def")
  (format strm "~%            /DataMax exch def")
  (format strm "~%            /DataMin exch def")
  (format strm "~%            /Value exch def")
  (format strm "~%")
  (format strm "~%            % Get relative location in Data space.")
  (format strm "~%            Value DataMin sub")
  (format strm "~%            DataMax DataMin sub")
  (format strm "~%            div")
  (format strm "~%            % Convert to offset within Graph space.")
  (format strm "~%            GraphMax GraphMin sub mul")
  (format strm "~%            % Add GraphMin to convert it to an actual")
  (format strm "~%            % in Graph space.")
  (format strm "~%            GraphMin add")
  (format strm "~%        end")
  (format strm "~%    } def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Given a Data point, return its coordinates in")
  (format strm "~%    % PostScript usre space.")
  (format strm "~%    % The Data point is specified as a two-element")
  (format strm "~%    % array.")
  (format strm "~%    % Stack: [x y] => -")
  (format strm "~%    %")
  (format strm "~%    /xlate-data-to-user {")
  (format strm "~%        aload pop % stack: x y")
  (format strm "~%        % Convert the Y value.")
  (format strm "~%        DataMinY DataMaxY GraphMinY GraphMaxY")
  (format strm "~%        xlate-data-to-user-1")
  (format strm "~%        % Convert the X value.")
  (format strm "~%        exch          % stack: y x")
  (format strm "~%        DataMinX DataMaxX GraphMinX GraphMaxX")
  (format strm "~%        xlate-data-to-user-1")
  (format strm "~%        exch          % stack: x y")
  (format strm "~%    } def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Move the drawing location to the data point.")
  (format strm "~%    % The data points are in their own coordinate space;")
  (format strm "~%    % they are not in PostScript user space.")
  (format strm "~%    % The Data point is specified as a two-element")
  (format strm "~%    % array.")
  (format strm "~%    % Stack: [x y] => -")
  (format strm "~%    %")
  (format strm "~%    /moveto-data {")
  (format strm "~%        xlate-data-to-user moveto")
  (format strm "~%    } def");
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Given a Data point, draw it.")
  (format strm "~%    % Stack: [x y] => -")
  (format strm "~%    %")
  (format strm "~%    /draw-data {")
  (format strm "~%        newpath")
  (format strm "~%            xlate-data-to-user DotRadius 0 360 arc")
  (format strm "~%        0 setgray")
  (format strm "~%        fill")
  (format strm "~%    } def")
  (format strm "~%")
  (format strm "~%    %")
  (format strm "~%    % Draw the curve between the data points.")
  (format strm "~%    % Stack: [ [x0 y0] [x1 y1] ...[xn yn] ] => -")
  (format strm "~%    %")
  (format strm "~%    /draw-data-curve {")
  (format strm "~%        newpath")
  (format strm "~%            % Move the drawing location to the first")
  (format strm "~%            % point.")
  (format strm "~%            dup 0 get xlate-data-to-user moveto")
  (format strm "~%            % Draw the line segments.")
  (format strm "~%            dup { xlate-data-to-user lineto } forall")
  (format strm "~%        DotLineWidth setlinewidth")
  (format strm "~%        0.5 setgray")
  (format strm "~%        stroke")
  (format strm "~%    } def")
  strm)

(defun print-fixed (strm)
  "Print the unchanging part of the PostScript program.  It
doesn't change because it uses the parameters & arguments
which we've already output.
I could also have called this function PRINT-MAIN."
  (format strm "~%    %")
  (format strm "~%    % ~A begins" 'print-fixed)
  (format strm "~%    %")

  (format strm "~%    % Draw a box around the entire image")
  (format strm "~%    ImageMinX ImageMinY ImageMaxX ImageMaxY newpath-box")
  (format strm "~%    BoxLineWidth setlinewidth")
  (format strm "~%    0 setgray")
  (format strm "~%    stroke")

  (format strm "~%    % Draw both axes.")
  (format strm "~%    GraphMinX GraphMaxX GraphMinY GraphMaxY draw-axis")

  (format strm "~%    %%")
  (format strm "~%    %% Draw the labels on the X axis.")
  (format strm "~%    %%")
  (format strm "~%    % Label X at the origin.")
  (format strm "~%    DataMinX 10 string cvs")
  (format strm "~%    LabelFont setfont")
  (format strm "~%    dup stringwidth")
  (format strm "~%    /wy exch def      % string's height")
  (format strm "~%    /wx exch def      % string's width")
  (format strm "~%    GraphMinX GraphMinY LabelFontSize sub 2 sub moveto")
  (format strm "~%    show")
  (format strm "~%    % Label X at its highest value.")
  (format strm "~%    DataMaxX 10 string cvs")
  (format strm "~%    LabelFont setfont")
  (format strm "~%    dup stringwidth")
  (format strm "~%    /wy exch def      % string's height")
  (format strm "~%    /wx exch def      % string's width")
  (format strm "~%    GraphMaxX wx sub GraphMinY LabelFontSize sub 2 sub")
  (format strm "~%    moveto")
  (format strm "~%    show")

  (format strm "~%    %%")
  (format strm "~%    %% Draw the labels on the Y axis.")
  (format strm "~%    %%")
  (format strm "~%    % Label Y at the origin.")
  (format strm "~%    DataMinY 10 string cvs")
  (format strm "~%    LabelFont setfont")
  (format strm "~%    dup stringwidth")
  (format strm "~%    /wy exch def      % string's height, ignored")
  (format strm "~%    /wx exch def      % string's width")
  (format strm "~%    GraphMinX wx sub 3 sub GraphMinY moveto")
  (format strm "~%    show")
  (format strm "~%    % Label Y at its highest value.")
  (format strm "~%    DataMaxY 10 string cvs")
  (format strm "~%    LabelFont setfont")
  (format strm "~%    dup stringwidth")
  (format strm "~%    /wy exch def      % string's height, ignored")
  (format strm "~%    /wx exch def      % string's width")
  (format strm "~%    GraphMinX wx sub 3 sub GraphMaxY LabelFontSize sub")
  (format strm "~%    moveto")
  (format strm "~%    show")

  (format strm "~%    Data draw-data-curve")
  (format strm "~%    Data { dup draw-data } forall")

  (format strm "~%    % ~A ends" 'print-fixed)
  strm)
  
(defvar *default-width*  10
  "Width, in centimeters.  By default, it is 16 centimeters which is
about the width of the printable area of a 8.5 inch by 11 inch piece
of paper, which is a common paper size in the United States.")

(defvar *default-height* (/ (* 2 *default-width*) 3)
  "Height, in centimeters.  By default, it is 2/3 of the width.")

(defun graph0 (lst pathname &key (height *default-height*)
		   (width *default-width*)
		   (min-x (min-x lst)) (min-y (min-y lst))
		   (max-x (max-x lst)) (max-y (max-y lst)))
  (with-open-file (strm pathname :direction :output :if-exists :rename)
    (format strm "%!PS-Adobe-3.0 EPSF-3.0")
    (format strm "~%%%Creator: Gene Michael Stover")
    (format strm "~%%%Title: ~A" (namestring pathname))
    (multiple-value-bind
	(ss mm hh dd mo yy) (decode-universal-time
			     (get-universal-time))
      (format strm "~%%%CreationDate: ~D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D"
	      yy mo dd hh mm ss))
    (format strm "~%%%DocumentData: Clean7Bit")
    (format strm "~%%%LanguageLevel: 1")
    (format strm "~%%%Pages: 1")
    (format strm "~%%%BoundingBox: ~D ~D ~D ~D"
	    (kBoxLowX) (kBoxLowY height)
	    (kBoxUppX width) (kBoxUppY))
    (format strm "~%%%EndComments")
    (format strm "~%%%BeginProlog")
    (format strm "~%100 dict begin")
    (print-library0 strm)
    (print-parameters strm)
    (print-arguments lst height width min-x min-y max-x max-y strm)
    (print-library1 strm)
    (format strm "~%%%EndProlog")
    (format strm "~%%%Page: 1 1")
    (print-fixed strm)
    (format strm "~%    % Is \"showpage\" necessary in an Encapsulated")
    (format strm "~%    % PostScript program?")
    (format strm "~%    % showpage")
    (format strm "~%%%Trailer")
    (format strm "~%end")
    (format strm "~%%%EOF")
    (format strm "~%")
    (truename strm)))

(defun demo0000 ()
  (graph0 '((10 9) (8 7) (6 5) (4 3)) "demo0000.eps"))

(defun demo0001 ()
  (graph0 (mapcar #'(lambda (x) (list x (expt x 3)))
		  '(-1 -1/2 -1/3 -1/7 0 1/33 1/7 1/5 1/3 1/2 1))
	  "demo0001.eps"))

;;; --- end of file ---