home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / WGRAPH.MOD < prev   
Text File  |  1996-11-08  |  28KB  |  801 lines

  1. IMPLEMENTATION MODULE WGraph;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Graph module For GWindows.              *)
  6.         (*                                                      *)
  7.         (*  Programmer:         S.P.Lontis, P. Moylan.          *)
  8.         (*  Last edited:        8 November 1996                 *)
  9.         (*  Status:                                             *)
  10.         (*      Working on XDS version.                         *)
  11.         (*                                                      *)
  12.         (*      This started as a copy of the Lontis version,   *)
  13.         (*      but by now I've modified it a fair bit.         *)
  14.         (*                                                      *)
  15.         (*      Have converted the formatting to my standards,  *)
  16.         (*      but still need to work through things like      *)
  17.         (*      the program logic, confusing names, etc.        *)
  18.         (*                                                      *)
  19.         (*      The algorithm for labelling logarithmic scales  *)
  20.         (*      looks unsatisfactory to me.                     *)
  21.         (*                                                      *)
  22.         (********************************************************)
  23.  
  24. FROM Storage IMPORT
  25.     (* proc *)  ALLOCATE, DEALLOCATE;
  26.  
  27. FROM TaskControl IMPORT
  28.     (* type *)  Lock,
  29.     (* proc *)  CreateLock, Obtain, Release;
  30.  
  31. FROM MATHLIB IMPORT
  32.     (* proc *)  Log;
  33.  
  34. FROM Conversions IMPORT
  35.     (* proc *)  LongRealToF, atoi;
  36.  
  37. FROM GWindows IMPORT
  38.     (* type *)  Window,
  39.     (* proc *)  Line2, PutPixel2, GString;
  40.  
  41. (************************************************************************)
  42.  
  43. TYPE
  44.     str = ARRAY[0..10] OF CHAR;   (* string type *)
  45.  
  46.     (********************************************************************)
  47.     (*                                                                  *)
  48.     (* A Graph is implemented as a pointer to a record with fields:     *)
  49.     (*  Win             the window in which the graph is written        *)
  50.     (*  GT              graph type: linear, bar, etc.                   *)
  51.     (*  xs, ys          the bottom left corner of the rectangle in      *)
  52.     (*                  which the graph is written (in window-relative  *)
  53.     (*                  coordinates                                     *)
  54.     (*  xe, ye          the top right corner of the rectangle           *)
  55.     (*  xscale, yscale  scale factors used to convert the real user     *)
  56.     (*                  data into the screen ranges (xs..xe), (ys..ye)  *)
  57.     (*  minx, maxx      the range of x values that can be plotted       *)
  58.     (*  miny, maxy      the range of y values than can be plotted       *)
  59.     (*  lastx, lasty    the last point added to the graph               *)
  60.     (*  LT              line type: dots, joined, vertical, normal       *)
  61.     (*  MT              marker type: diamond, plus, etc.                *)
  62.     (*  NextGraph       used to hold all the graphs together in a       *)
  63.     (*                  linked list.  I'm not yet sure why.             *)
  64.     (*  found           set to TRUE when the first point is added to    *)
  65.     (*                  the graph                                       *)
  66.     (*                                                                  *)
  67.     (********************************************************************)
  68.  
  69.     Graph = POINTER TO GraphInstance;
  70.     GraphInstance = RECORD
  71.                         Win: Window;
  72.                         GT: GraphType;
  73.                         xs, ys, xe, ye: CARDINAL;
  74.                         xscale, yscale,
  75.                         minx, maxx,
  76.                         miny, maxy: LONGREAL;
  77.                         lastx, lasty: INTEGER;
  78.                         LT: LineType;
  79.                         MT: MarkType;
  80.                         NextGraph: Graph;
  81.                         found: BOOLEAN;
  82.                     END (* RECORD *);
  83.  
  84. (************************************************************************)
  85.  
  86. VAR
  87.     (* Lock to protect critical sections.  I presume that the           *)
  88.     (* only critical section problem is with the linked list of graphs. *)
  89.     (* The only reason for linking all graphs together is for the       *)
  90.     (* CloseDown procedure.                                             *)
  91.  
  92.     GraphAccess: Lock;
  93.  
  94.     (* Reference to the head of the linked list *)
  95.  
  96.     TopGraph: Graph;
  97.  
  98. (************************************************************************)
  99. (*                      MISCELLANEOUS UTILITIES                         *)
  100. (*                                                                      *)
  101. (*  N.B. It's not clear why most of these should be needed.  I'll have  *)
  102. (*  to look more carefully at how scales are labelled.                  *)
  103. (*                                                                      *)
  104. (************************************************************************)
  105.  
  106. PROCEDURE TenToPower(n: INTEGER): LONGREAL;
  107.  
  108.     (* Returns the value 10^n.  *)
  109.  
  110.     BEGIN
  111.         RETURN atoi (10.0, n);
  112.     END TenToPower;
  113.  
  114. (************************************************************************)
  115.  
  116. PROCEDURE Scale (VAR (*INOUT*) mantissa: LONGREAL;
  117.                         VAR (*INOUT*) exponent: INTEGER;
  118.                         power: CARDINAL;  lower, upper: LONGREAL);
  119.  
  120.     (* Adjusts mantissa so that lower <= mantissa < upper, while        *)
  121.     (* keeping the quantity (mantissa * 10^exponent) invariant. To save *)
  122.     (* some calculation, the caller must ensure that upper = 10^power   *)
  123.     (* and lower = 10^(-power).                                         *)
  124.  
  125.     BEGIN
  126.         WHILE mantissa >= upper DO
  127.             INC (exponent, power);  mantissa := lower*mantissa;
  128.         END (* WHILE *);
  129.  
  130.         WHILE mantissa < lower DO
  131.             DEC (exponent, power);  mantissa := upper*mantissa;
  132.         END (* WHILE *)
  133.  
  134.     END Scale;
  135.  
  136. (************************************************************************)
  137.  
  138. PROCEDURE FindExponent (number: LONGREAL;  VAR (*OUT*) exponent: INTEGER);
  139.  
  140.     (* Separates the first argument into a mantissa and exponent part,  *)
  141.     (* so that  number = mantissa * 10^exponent.  Returns the exponent. *)
  142.  
  143.     VAR mantissa: LONGREAL;
  144.  
  145.     BEGIN
  146.         IF number = 0.0 THEN exponent := 1
  147.         ELSE
  148.             mantissa := number;  exponent := 0;
  149.             Scale (mantissa, exponent, 64, 1.0E-64, 1.0E64);
  150.             Scale (mantissa, exponent, 16, 1.0E-16, 1.0E16);
  151.             Scale (mantissa, exponent, 4, 1.0E-4, 1.0E4);
  152.             Scale (mantissa, exponent, 1, 1.0E-1, 1.0E1);
  153.         END (* IF *);
  154.  
  155.         (* Not sure why the following modification is included. But     *)
  156.         (* then I'm not sure either why this procedure is needed!       *)
  157.  
  158.         IF (exponent<0) THEN DEC(exponent, 1) END (* IF *)
  159.  
  160.     END FindExponent;
  161.  
  162. (************************************************************************)
  163.  
  164. PROCEDURE RealToStr (x: LONGREAL;  decplace: CARDINAL;
  165.                         VAR (*OUT*) string: ARRAY OF CHAR;
  166.                         VAR (*OUT*) count: CARDINAL);
  167.  
  168.     (* Converts the Real value x into a string; decplace specifies      *)
  169.     (* the maximum number of places to allow after the decimal point.   *)
  170.     (* On return, count gives the number of characters used.            *)
  171.  
  172.     BEGIN
  173.         count := HIGH(string) + 1;
  174.         LongRealToF (x, count, decplace, TRUE, string);
  175.     END RealToStr;
  176.  
  177. (************************************************************************)
  178.  
  179. PROCEDURE PrintLogScale (G: Graph;  xaxis: BOOLEAN;  incr: LONGREAL;
  180.                                         offset, Numbits: CARDINAL);
  181.  
  182.     (* Draws a labelled logarithmic scale.  The logic of this           *)
  183.     (* procedure is still quite obscure to me, and I'm still in the     *)
  184.     (* process of changing the unhelpful variable names and trying to   *)
  185.     (* put in a few comments.                                           *)
  186.     (* The labelling happens only at multiples of 10.  Depending on the *)
  187.     (* minimum values and increment, and depending also on roundoff     *)
  188.     (* error, the labelling might not be done at all.  This seems to me *)
  189.     (* to be a fairly unsatisfactory situation, which perhaps calls for *)
  190.     (* a completely different algorithm.                                *)
  191.  
  192.     VAR exponent: INTEGER;  xy, xybase, count: CARDINAL;
  193.         value, z, k, step, max, temp1, logmin, scale: LONGREAL;
  194.         label: str;
  195.         w: Window;
  196.  
  197.     BEGIN
  198.         WITH G^ DO
  199.             IF xaxis THEN
  200.                 value := minx;  max := maxx;
  201.                 logmin := Log(minx);  scale := xscale;
  202.                 xybase := xs;
  203.             ELSE
  204.                 value := miny;  max := maxy;
  205.                 logmin := Log(miny);  scale := yscale;
  206.                 xybase := ys;
  207.             END (*IF*);
  208.             w := Win;
  209.         END (*WITH*);
  210.  
  211.         FindExponent (value, exponent);
  212.  
  213.         (* Compute z := 10^exponent     *)
  214.  
  215.         IF exponent >= 0 THEN
  216.             z := TenToPower(exponent)
  217.         ELSE
  218.             z := 1.0 / TenToPower(-exponent)
  219.         END (* IF *);
  220.  
  221.         (* Initially step = incr*10^exponent and k = 10.0*10^exponent.  *)
  222.         (* As we go around the loop step and k are updated together, so *)
  223.         (* we have the invariant step = (incr/10.0) * k.                *)
  224.  
  225.         step := incr*z;  k := 10.0*z;
  226.  
  227.         (* Beyond this point the variable z is used only once, in a     *)
  228.         (* comparison.  Its value is not altered.  The value of k is    *)
  229.         (* however altered each time around the loop.                   *)
  230.  
  231.         WHILE value <= max DO
  232.  
  233.             temp1 := Log(value) - logmin;
  234.  
  235.             (* logmin is not used beyond this point.    *)
  236.  
  237.             (* Compute xy := xybase + scale*Log(value/min)      *)
  238.  
  239.             xy := xybase + VAL(CARDINAL, scale*temp1 + 0.5);
  240.  
  241.             (* Put the tick mark.       *)
  242.  
  243.             WITH G^ DO
  244.                 IF xaxis THEN
  245.                     Line2 (w, xy, ys-offset, xy, ys-offset-2)
  246.                 ELSE
  247.                     Line2 (w, xs-offset-2, xy, xs-offset, xy)
  248.                 END (*IF*);
  249.             END (*WITH*);
  250.  
  251.             (* Note k >= z always, so depending on the relationship     *)
  252.             (* between value and z (which is not yet clear) it is       *)
  253.             (* possible that the comparison below can be simplified.    *)
  254.             (* What is clear is that we are putting the labelling only  *)
  255.             (* when value is a multiple of 10.  By the way, the         *)
  256.             (* equality comparison is somewhat untrustworthy since it   *)
  257.             (* is sensitive to rounding error.                          *)
  258.  
  259.             IF (value = k) OR (value = z) THEN
  260.                 RealToStr (value, Numbits, label, count);
  261.                 IF xaxis THEN
  262.                     GString (w, xy-4*count, G^.ys-offset-13, label);
  263.                 ELSE
  264.                     GString (w, G^.xs-8*count-6-offset, xy-4, label);
  265.                 END (* IF *)
  266.             END (* IF *);
  267.  
  268.             (* Update the step each time we pass a multiple of 10.      *)
  269.  
  270.             IF value >= k THEN
  271.                 step := 10.0*step;  k := 10.0*k;
  272.             END (* IF *);
  273.  
  274.             value := value + step;
  275.  
  276.         END (*WHILE*);
  277.  
  278.     END PrintLogScale;
  279.  
  280. (************************************************************************)
  281.  
  282. PROCEDURE PrintLinearScale (G: Graph;  xaxis: BOOLEAN;  incr: LONGREAL;
  283.                         offset, Numbits: CARDINAL;  WriteNumbers: BOOLEAN);
  284.  
  285.     (* Prints a linear scale for the graph, with incr distance between  *)
  286.     (* the markers.  Numbers are written iff WriteNumbers is TRUE.      *)
  287.     (* This procedure draws the tick marks and (if specified) the       *)
  288.     (* labelling, but not the actual axis line.                         *)
  289.  
  290.     VAR value, limit, nextmark, start, scale: LONGREAL;
  291.         xy, xybase, NumOfChar: CARDINAL;
  292.         text: str;
  293.  
  294.     BEGIN
  295.         WITH G^ DO
  296.  
  297.             IF xaxis THEN
  298.                 limit := maxx;  start := minx;
  299.                 scale := xscale;  xybase := xs;
  300.             ELSE
  301.                 limit := maxy;  start := miny;
  302.                 scale := yscale;  xybase := ys;
  303.             END (* IF *);
  304.             value := start;
  305.  
  306.             WHILE value <= limit DO
  307.  
  308.                 (* Find the position of the next marker point on the    *)
  309.                 (* axis i.e.  nextmark := (value-start)*scale.          *)
  310.  
  311.                 nextmark := value - start;
  312.                 xy := xybase + VAL(CARDINAL, scale*nextmark + 0.5);
  313.  
  314.                 IF xaxis THEN
  315.                     Line2 (Win, xy, ys-offset, xy, ys-offset-2)
  316.                 ELSE
  317.                     Line2 (Win, xs-offset-3, xy, xs-offset, xy)
  318.                 END (* IF *);
  319.  
  320.                 IF WriteNumbers THEN
  321.  
  322.                     (* Convert value to string *)
  323.  
  324.                     RealToStr (value, Numbits, text, NumOfChar);
  325.  
  326.                     (* Display the value under or beside the marker.    *)
  327.  
  328.                     IF xaxis THEN
  329.                         GString (Win, xy-4*NumOfChar, ys-offset-13, text);
  330.                     ELSE
  331.                         GString (Win, xs-offset-8*NumOfChar-6, xy-4, text);
  332.                     END (*IF*);
  333.  
  334.                 END (* IF *);
  335.  
  336.                 value := value + incr;
  337.  
  338.             END (* WHILE *)
  339.  
  340.         END (* WITH *)
  341.  
  342.     END PrintLinearScale;
  343.  
  344. (************************************************************************)
  345.  
  346. PROCEDURE BarGraphMarkers (G: Graph;  yoffset: CARDINAL);
  347.  
  348.     (* Draws the tick marks on the X axis of a bar graph.  The axis is  *)
  349.     (* a distance yoffset screen points below the graph y origin.       *)
  350.  
  351.     VAR xcurrent, increment: CARDINAL;
  352.  
  353.     BEGIN
  354.         WITH G^ DO
  355.  
  356.             xcurrent:= xs + VAL(CARDINAL, 0.5*minx + 0.5);
  357.             increment := VAL(CARDINAL, maxx + minx + 0.5);
  358.  
  359.             WHILE xcurrent <= xe DO
  360.                 Line2 (Win, xcurrent, ys-yoffset, xcurrent, ys-yoffset-3);
  361.                 INC (xcurrent, increment)
  362.             END (* WHILE *)
  363.  
  364.         END (*WITH*);
  365.  
  366.     END BarGraphMarkers;
  367.  
  368. (************************************************************************)
  369.  
  370. PROCEDURE DrawXAxis (G: Graph;  xinc: LONGREAL;  yoffset, DecPlaces: CARDINAL;
  371.                                                 numbering: BOOLEAN);
  372.  
  373.     (* Draws the x-axis for a graph; xinc is the distance between tick  *)
  374.     (* marks, and yoffset gives the distance that the axis will lie     *)
  375.     (* below the line y=ys (ys is defined in OpenGraph).  The option    *)
  376.     (* yoffset <> 0 allows for the case where more than one graph       *)
  377.     (* occupies the same window, since the graphs may have different    *)
  378.     (* scales.  DecPlaces gives the number of decimal places that will  *)
  379.     (* be used.  If numbering is FALSE, the axis is drawn but not       *)
  380.     (* labelled.                                                        *)
  381.  
  382.     BEGIN
  383.         WITH G^ DO
  384.  
  385.             (* Draw x-axis line *)
  386.  
  387.             Line2 (Win, xs, ys-yoffset, xe, ys-yoffset);
  388.  
  389.             IF GT = bar THEN
  390.                 BarGraphMarkers (G, yoffset);
  391.             ELSIF GT = linear THEN
  392.                 PrintLinearScale (G,TRUE,xinc,yoffset,DecPlaces,numbering)
  393.             ELSIF (GT=loglog) OR (GT=loglinear) THEN
  394.                 PrintLogScale (G, TRUE, xinc, yoffset, DecPlaces)
  395.             END (* IF *);
  396.  
  397.         END (* WITH *)
  398.  
  399.     END DrawXAxis;
  400.  
  401. (************************************************************************)
  402.  
  403. PROCEDURE DrawYAxis (G: Graph;  yinc: LONGREAL;  xoffset, DecPlaces: CARDINAL;
  404.                                                 numbering: BOOLEAN);
  405.  
  406.     (* Draws the y-axis for a graph; yinc is the space between tick     *)
  407.     (* marks, and xoffset gives the distance that the axis will lie to  *)
  408.     (* the left of the line x=xs (xs is defined in OpenGraph).          *)
  409.     (* DecPlaces gives the number of decimal places that will be used.  *)
  410.     (* If numbering is FALSE, the axis is drawn but not labelled.       *)
  411.  
  412.     BEGIN
  413.         WITH G^ DO
  414.  
  415.             Line2 (Win, xs-xoffset, ys, xs-xoffset, ye);
  416.  
  417.             IF (GT=linear) OR (GT=loglinear) OR (GT=bar) THEN
  418.                 PrintLinearScale (G, FALSE, yinc, xoffset,
  419.                                                 DecPlaces, numbering)
  420.             ELSIF GT=loglog THEN
  421.                 PrintLogScale (G, FALSE, yinc, xoffset, DecPlaces)
  422.             END (* IF *);
  423.  
  424.         END (* WITH *);
  425.  
  426.     END DrawYAxis;
  427.  
  428. (************************************************************************)
  429.  
  430. PROCEDURE DrawAxes (G: Graph;
  431.         xinc: LONGREAL;  yoffset, xdecplaces: CARDINAL;  numberx: BOOLEAN;
  432.         yinc: LONGREAL;  xoffset, ydecplaces: CARDINAL;  numbery: BOOLEAN);
  433.  
  434.     (* Draws both the X and Y axes.  See the definitions of             *)
  435.     (* DrawXAxis and DrawYAxis above.                                   *)
  436.  
  437.     BEGIN
  438.         DrawXAxis (G, xinc, yoffset, xdecplaces, numberx);
  439.         DrawYAxis (G, yinc, xoffset, ydecplaces, numbery);
  440.     END DrawAxes;
  441.  
  442. (************************************************************************)
  443.  
  444. PROCEDURE OpenGraph (VAR (*OUT*) G: Graph;  w: Window;  GrphType: GraphType;
  445.                     LnType: LineType; xst, yst, xen, yen: CARDINAL;
  446.                     xmin, ymin, xmax, ymax: LONGREAL;  Mark: MarkType);
  447.  
  448.     (* Initialises a Graph, adding it to the top of the Graph stack.    *)
  449.  
  450.     BEGIN
  451.         NEW(G);
  452.         WITH G^ DO
  453.  
  454.             (* Add Graph to start of the stack *)
  455.  
  456.             Obtain (GraphAccess);
  457.             NextGraph := TopGraph;
  458.             TopGraph := G;
  459.             Release (GraphAccess);
  460.             Win := w;
  461.  
  462.             (* Set up graph variables *)
  463.  
  464.             GT := GrphType;  LT := LnType;
  465.             minx := xmin;  miny := ymin;
  466.             maxx := xmax;  maxy := ymax;
  467.             xs := xst;  ys := yst;
  468.             xe := xen;  ye := yen;
  469.             MT := Mark;
  470.             found := FALSE;
  471.  
  472.             (* Calculate the mapping values xscale and yscale. *)
  473.  
  474.             IF GT <> bar THEN
  475.                 IF (GT<>loglinear) AND (GT<>loglog) THEN
  476.  
  477.                     (* xscale = Float(xe-xs) / (maxx-minx)      *)
  478.  
  479.                     xscale := VAL(LONGREAL, xe - xs) / (maxx - minx);
  480.  
  481.                 ELSE
  482.  
  483.                     (* xscale:= (xe-xs)/(Log(maxx)-Log(minx)) *)
  484.                     (* Used to be xscale:= (xe-xs-5)/(Log(maxx)-Log(minx)) *)
  485.  
  486.                     xscale := VAL(LONGREAL,xe-xs) / (Log(maxx) - Log(minx));
  487.  
  488.                 END (* IF *);
  489.             END (* IF *);
  490.  
  491.             IF GT <> loglog THEN
  492.  
  493.                 (* yscale = Float(ye-ys) / (maxy-miny)  *)
  494.  
  495.                 yscale := VAL(LONGREAL,ye - ys) / (maxy - miny);
  496.  
  497.             ELSE
  498.  
  499.                 (* yscale:= (ye-ys)/(Log(maxy)-Log(miny)) *)
  500.  
  501.                 yscale := VAL(LONGREAL,ye-ys) / (Log(maxy) - Log(miny));
  502.  
  503.             END (*IF*);
  504.  
  505.         END (*WITH*)
  506.  
  507.     END OpenGraph;
  508.  
  509. (*************************************************************************)
  510.  
  511. PROCEDURE DrawMarker (G: Graph;  x, y: INTEGER);
  512.  
  513.     (* Puts a marker at point (x,y).  The coordinates are window-relative. *)
  514.  
  515.     BEGIN
  516.  
  517.         WITH G^ DO
  518.             CASE MT OF
  519.                 none:   IF (LT=dots) THEN
  520.                             PutPixel2 (Win, x, y)
  521.                         END (* IF *);
  522.               |
  523.                 square: Line2 (Win, x-2, y+1, x+2, y+1);
  524.                         Line2 (Win, x+2, y+1, x+2, y-1);
  525.                         Line2 (Win, x+2, y-1, x-2, y-1);
  526.                         Line2 (Win, x-2, y-1, x-2, y+1);
  527.               |
  528.                 plus:   Line2 (Win, x, y+2, x, y-2);
  529.                         Line2 (Win, x-3, y, x+3, y);
  530.               |
  531.                 cross:  Line2 (Win, x-2, y+2, x+2, y-2);
  532.                         Line2 (Win, x+2, y+2, x-2, y-2);
  533.               |
  534.                 diamond: Line2 (Win, x, y+2, x+3, y);
  535.                         Line2 (Win, x+3, y, x, y-2);
  536.                         Line2 (Win, x, y-2, x-3, y);
  537.                         Line2 (Win, x-3, y, x, y+2);
  538.  
  539.             END (* CASE *);
  540.         END (* WITH *);
  541.  
  542.     END DrawMarker;
  543.  
  544. (***********************************************************************)
  545.  
  546. PROCEDURE XScaled (G: Graph;  x0: LONGREAL): CARDINAL;
  547.  
  548.     (* Convert the number x0 in the range  (xmin <= x <= xmax) to a     *)
  549.     (* value that is relative to the graph's screen range (xs to xe).   *)
  550.  
  551.     (* USED ONLY BY PROCEDURE Scaled, BELOW.    *)
  552.  
  553.     VAR temp: LONGREAL;
  554.  
  555.     BEGIN
  556.         WITH G^ DO
  557.             IF (GT=loglog) OR (GT=loglinear) THEN
  558.  
  559.                 (* Use a log mapping. *)
  560.  
  561.                 temp := xscale * (Log(x0) - Log(minx));
  562.  
  563.             ELSE
  564.  
  565.                 (* use a linear mapping *)
  566.  
  567.                 temp := xscale * (x0 - minx);
  568.  
  569.             END (* IF *);
  570.  
  571.             RETURN xs + VAL(CARDINAL, temp+0.5);
  572.  
  573.         END (* WITH *)
  574.  
  575.     END XScaled;
  576.  
  577. (************************************************************************)
  578.  
  579. PROCEDURE YScaled (G: Graph;  y0: LONGREAL): CARDINAL;
  580.  
  581.     (* Convert the number y0 in the range (ymin <= y <= ymax) to a      *)
  582.     (* value that is relative to the graph's screen range (ys to ye).   *)
  583.  
  584.     VAR temp: LONGREAL;
  585.  
  586.     BEGIN
  587.         WITH G^ DO
  588.             IF (GT=loglog) THEN
  589.  
  590.                 (* use a Log mapping *)
  591.  
  592.                 temp := yscale * (Log(y0) - Log(miny));
  593.  
  594.             ELSE
  595.  
  596.                 (* use a linear mapping *)
  597.  
  598.                 temp := yscale * (y0 - miny);
  599.  
  600.             END (* IF *);
  601.  
  602.             RETURN ys + VAL(CARDINAL, temp+0.5);
  603.  
  604.         END (* WITH *)
  605.  
  606.     END YScaled;
  607.  
  608. (************************************************************************)
  609.  
  610. PROCEDURE Scaled (G: Graph;  VAR (*OUT*) xscaled, yscaled: CARDINAL;
  611.                                                         x0, y0: LONGREAL);
  612.  
  613.     (* Scale the values of (x0,y0). See definition above of XScaled     *)
  614.     (* and YScaled.                                                     *)
  615.  
  616.     BEGIN
  617.         xscaled := XScaled (G, x0);
  618.         yscaled := YScaled (G, y0);
  619.     END Scaled;
  620.  
  621. (************************************************************************)
  622.  
  623. PROCEDURE ClipPoint (G: Graph;  VAR (*INOUT*) x, y: LONGREAL);
  624.  
  625.     (* Lets the values saturate to the permissible ranges for G.        *)
  626.  
  627.     BEGIN
  628.         WITH G^ DO
  629.             IF x < minx THEN x := minx
  630.             ELSIF x > maxx THEN x := maxx;
  631.             END (* IF *);
  632.             IF y < miny THEN y := miny
  633.             ELSIF y > maxy THEN y := maxy
  634.             END (* IF *);
  635.         END (* WITH *)
  636.     END ClipPoint;
  637.  
  638. (************************************************************************)
  639.  
  640. PROCEDURE AddPoint (G: Graph;  x, y: LONGREAL);
  641.  
  642.     VAR ix, iy: CARDINAL;
  643.  
  644.     BEGIN
  645.         WITH G^ DO
  646.  
  647.             (* Clip point (x,y) if necessary. *)
  648.  
  649.             ClipPoint (G, x, y);
  650.  
  651.             (* scale the point (x,y) *)
  652.  
  653.             Scaled (G, ix, iy, x, y);
  654.  
  655.             (* Display the scaled point (ix,iy) *)
  656.  
  657.             CASE LT OF
  658.                 joined: IF found THEN Line2 (Win, lastx, lasty, ix, iy)
  659.                         END (* IF *);
  660.               |
  661.                 dots:   ;
  662.               |
  663.                 vertical: Line2 (Win, ix, iy, ix, ys);
  664.             END (* CASE *);
  665.             DrawMarker (G, ix, iy);
  666.  
  667.             (* Remember the last point drawn *)
  668.  
  669.             found := TRUE;  lastx := ix;  lasty := iy;
  670.  
  671.         END (* WITH *)
  672.  
  673.     END AddPoint;
  674.  
  675. (************************************************************************)
  676.  
  677. PROCEDURE DrawLines(G: Graph;  x, y: ARRAY OF LONGREAL);
  678.  
  679.     VAR i: CARDINAL;
  680.  
  681.     BEGIN
  682.         FOR i := 0 TO HIGH(x) DO
  683.             AddPoint (G, x[i], y[i])
  684.         END (* FOR *)
  685.     END DrawLines;
  686.  
  687. (************************************************************************)
  688.  
  689. PROCEDURE DrawLine (G: Graph; x0, y0, x1, y1: LONGREAL);
  690.  
  691.     (* Used for drawing discontinuous lines.  The line is drawn between *)
  692.     (* (x0,y0) and (x1,y1) relative to graph G.                         *)
  693.  
  694.     VAR xstart, ystart, xend, yend: CARDINAL;
  695.  
  696.     BEGIN
  697.         ClipPoint (G, x0, y0);
  698.         ClipPoint (G, x1, y1);
  699.         Scaled (G, xstart, ystart, x0, y0);
  700.         Scaled (G, xend, yend, x1, y1);
  701.         Line2 (G^.Win, xstart, ystart, xend, yend);
  702.         DrawMarker (G, xstart, ystart);
  703.         DrawMarker (G, xend, yend)
  704.     END DrawLine;
  705.  
  706. (************************************************************************)
  707.  
  708. PROCEDURE BarGraph (G: Graph;  y: ARRAY OF LONGREAL;
  709.                                         del: CARDINAL;  Bt: BarType);
  710.  
  711.     (* Displays a BarGraph of the vector y.  Parameter del gives the    *)
  712.     (* number of stripes per bar, in the case of striped fill patterns. *)
  713.  
  714.     VAR index, BarStartPt, BarEndPt, incr, y1, barinc, i: CARDINAL;
  715.         temp2, incr2, barwidth, bargap: LONGREAL;
  716.  
  717.     BEGIN
  718.         barwidth := G^.minx+0.5;        (* width of a bar               *)
  719.         bargap := G^.maxx;              (* distance between two bars    *)
  720.  
  721.         barinc := VAL(CARDINAL, barwidth) DIV del;
  722.  
  723.         (* incr := bargap + barwidth  *)
  724.  
  725.         incr2 := bargap + barwidth;
  726.         incr := VAL(CARDINAL, incr2);
  727.  
  728.         WITH G^ DO
  729.             BarStartPt := xs;
  730.             index := 0;
  731.             WHILE index <= HIGH(y) DO
  732.  
  733.                 y1 := YScaled (G, y[index]);
  734.                 temp2 := VAL(LONGREAL,BarStartPt) + barwidth;
  735.                 BarEndPt := VAL(CARDINAL, temp2);
  736.  
  737.                 (* Draw one Bar of the Bar Graph *)
  738.  
  739.                 Line2 (Win, BarStartPt, ys, BarStartPt, y1);
  740.                 Line2 (Win, BarStartPt, y1, BarEndPt, y1);
  741.                 Line2 (Win, BarEndPt, y1, BarEndPt, ys);
  742.  
  743.                 (* Add pattern to the Bar Graph *)
  744.  
  745.                 IF (Bt<>Four) THEN
  746.                     IF (Bt=Two) THEN
  747.                         Line2 (Win, BarStartPt, ys, BarEndPt, y1);
  748.                         Line2 (Win, BarEndPt, ys, BarStartPt, y1)
  749.                     ELSE
  750.                         IF (Bt=One)OR(Bt=Five) THEN
  751.                             i:= BarStartPt + barinc;
  752.                             WHILE (i<BarEndPt) DO
  753.                                 Line2 (Win, i, ys, i, y1);
  754.                                 INC(i, barinc)
  755.                             END (* WHILE *)
  756.                         END (* IF *);
  757.                         IF (Bt=Three)OR(Bt=Five) THEN
  758.                             i := ys + barinc;
  759.                             WHILE (i<y1) DO
  760.                                 Line2 (Win, BarStartPt, i, BarEndPt, i);
  761.                                 INC(i, barinc)
  762.                             END (* WHILE *)
  763.                         END (* IF *)
  764.                     END (* IF *)
  765.                 END (* IF *);
  766.  
  767.                 INC (BarStartPt, incr); INC (index)
  768.  
  769.             END (* WHILE *)
  770.         END (* WITH *)
  771.  
  772.     END BarGraph;
  773.  
  774. (***********************************************************************)
  775.  
  776. PROCEDURE CloseGraphs;
  777.  
  778.     (* Destroys all Graphs Created. *)
  779.  
  780.     VAR following: Graph;
  781.  
  782.     BEGIN
  783.         Obtain (GraphAccess);
  784.         WHILE TopGraph <> NIL DO
  785.             following := TopGraph^.NextGraph;
  786.             DISPOSE (TopGraph);
  787.             TopGraph := following;
  788.         END (*WHILE*);
  789.         Release (GraphAccess);
  790.     END CloseGraphs;
  791.  
  792. (***********************************************************************)
  793.  
  794. BEGIN
  795.     TopGraph := NIL;
  796.     CreateLock (GraphAccess);
  797. FINALLY
  798.     CloseGraphs;
  799. END WGraph.
  800.  
  801.