home *** CD-ROM | disk | FTP | other *** search
/ Hacker Chronicles 2 / HACKER2.BIN / 140.DRAWGRAF.PAS < prev    next >
Pascal/Delphi Source File  |  1988-06-28  |  32KB  |  888 lines
  1. UNIT DrawGraf;
  2.  
  3. INTERFACE
  4. USES
  5.    Graph,
  6. {$IFDEF DOSCrt}
  7.    DOSCrt,
  8. {$ELSE}
  9.    Crt,
  10. {$ENDIF}
  11.    DOS,
  12.    Printer,
  13.    Extended_Reals,
  14.    MathLib0,
  15.    GraphText;
  16.  
  17.  
  18. {----------------------------------------------------------------------------}
  19. {---   Types of plots available for graphs                                ---}
  20. {----------------------------------------------------------------------------}
  21. CONST
  22.    Linear        = 1;
  23.    Logarithmic   = 2;
  24.    LogLin        = 3;
  25.    LinLog        = 4;
  26.  
  27. {----------------------------------------------------------------------------}
  28. {---   Graphics mode variables for graphics system.                       ---}
  29. {----------------------------------------------------------------------------}
  30. VAR
  31.    GraphDriver : INTEGER;
  32.    GraphMode   : INTEGER;
  33.  
  34.  
  35. {----------------------------------------------------------------------------}
  36. {---       DrawGraph graphs data to the screen.                           ---}
  37. {----------------------------------------------------------------------------}
  38. {---                                                                      ---}
  39. {--- INPUT parameters are                                                 ---}
  40. {---      x_ptr : pointer to the x-axis data values                       ---}
  41. {---      y_ptr : pointer to the y-axis data values                       ---}
  42. {---      NumPlotPoints : number of (x,y) points in arrays to plot        ---}
  43. {---      Plot : type of plot to be done (linear, logarithmic, etc.)      ---}
  44. {---      left_x : left edge of area of screen to display plot            ---}
  45. {---      top_y : top edge of area of screen to display plot              ---}
  46. {---      right_x : right edge of area of screen to display plot          ---}
  47. {---      bottom_y : bottom edge of boundary to display plot              ---}
  48. {---      horiz_units : x-axis label                                      ---}
  49. {---      vert_units : y-axis label                                       ---}
  50. {---                                                                      ---}
  51. {--- OUTPUT parameters are                                                ---}
  52. {---      XDelay : distance of first x value from origin                  ---}
  53. {---      YDelay : distance of first y value from origin                  ---}
  54. {---      error : indicates success or failure of DrawGraph, using        ---}
  55. {---              error codes given below.                                ---}
  56. {---                                                                      ---}
  57. {----------------------------------------------------------------------------}
  58. {--- VALID ERROR MESSAGES:                                                ---}
  59. {---      0 : no error                                                    ---}
  60. {---      1 : zero or negative value on log scale                         ---}
  61. {---      2 : insufficient memory to create necessary data arrays         ---}
  62. {---      3 : data out of range of graphing routine                       ---}
  63. {----------------------------------------------------------------------------}
  64.  
  65.  
  66. PROCEDURE DrawGraph ( VAR x_ptr           {untyped parameter};
  67.                       VAR y_ptr           {untyped parameter};
  68.                           NumPlotPoints : INTEGER;
  69.                           Plot          : BYTE;
  70.                           left_x        : INTEGER;
  71.                           top_y         : INTEGER;
  72.                           right_x       : INTEGER;
  73.                           bottom_y      : INTEGER;
  74.                       VAR XDelay        : REAL;
  75.                       VAR YDelay        : REAL;
  76.                           horiz_units   : string;
  77.                           vert_units    : string;
  78.                       VAR error         : BYTE
  79.                     );
  80.  
  81.  
  82.  
  83. PROCEDURE Print_Screen;
  84.  
  85. (****************************************************************************)
  86.  
  87. IMPLEMENTATION
  88.  
  89. CONST
  90.    MaxPlotPoints = 4100;
  91.  
  92. TYPE
  93.    PlotXYArray   = ARRAY [1..MaxPlotPoints] OF REAL;
  94.    PlotXYPtr     = ^PlotXYArray;
  95.  
  96.  
  97. CONST
  98.    MajorTic        = 8;
  99.    MinorTic        = 4;
  100.    MinIntervals    = 2;
  101.    MaxIntervals    = 10;
  102.    MaxDecades      = 5;
  103.    char_size       = 4;
  104.  
  105.    Power           : string [10]
  106.                    = '1000000000';
  107.  
  108.    LogTable        : ARRAY [2..9] OF REAL
  109.                    = (0.3010,                     { log 2 }
  110.                       0.4771,                     { log 3 }
  111.                       0.6021,                     { log 4 }
  112.                       0.6990,                     { log 5 }
  113.                       0.7782,                     { log 6 }
  114.                       0.8451,                     { log 7 }
  115.                       0.9031,                     { log 8 }
  116.                       0.9542);                    { log 9 }
  117.  
  118. TYPE
  119.    SkipType        = 1..5;
  120.    WrkString       = string [20];
  121.    WorldType       = RECORD
  122.                         x_1  : REAL;        { minimum value of x in window   }
  123.                         sx_1 : INTEGER;     { screen coordinate for x_1      }
  124.                         y_1  : REAL;        { minimum value of y in window   }
  125.                         sy_1 : INTEGER;     { screen coordinate for y_1      }
  126.                         x_2  : REAL;        { maximum value of x in window   }
  127.                         sx_2 : INTEGER;     { screen coordinate for x_2      }
  128.                         y_2  : REAL;        { maximum value of y in window   }
  129.                         sy_2 : INTEGER;     { screen coordinate for y_2      }
  130.                      END;   {RECORD}
  131.  
  132. VAR
  133.    XLinear         : BOOLEAN;           { is x axis linear?                  }
  134.    YLinear         : BOOLEAN;           { is y axis linear?                  }
  135.    i               : INTEGER;           { counter variable                   }
  136.    start           : INTEGER;           { first nonnegative point in array   }
  137.    ScaleX          : REAL;              { scale x data to proper range       }
  138.    ScaleY          : REAL;              { scale y data to proper range       }
  139.    FactorX         : INTEGER;           { increment on linear x axis         }
  140.    FactorY         : INTEGER;           { increment on linear y axis         }
  141.    NumIntervalsX   : BYTE;              { num of x intervals to plot         }
  142.    PosIntervalsX   : BYTE;              { num of positive x intervals        }
  143.    NegIntervalsX   : BYTE;              { num of negative x intervals        }
  144.    NumIntervalsY   : BYTE;              { num of y intervals to plot         }
  145.    PosIntervalsY   : BYTE;              { num of positive y intervals        }
  146.    NegIntervalsY   : BYTE;              { num of negative y intervals        }
  147.    NumDecadesX     : BYTE;              { num of x decades to plot           }
  148.    NumDecadesY     : BYTE;              { num of y decades to plot           }
  149.    PlotX           : INTEGER;           { x coordinate to draw char at       }
  150.    PlotY           : INTEGER;           { y coordinate to draw char at       }
  151.    temp            : REAL;              { temp var for swapping coordinates  }
  152.    ZeroX           : INTEGER;           { x coordinate of graph's origin     }
  153.    ZeroY           : INTEGER;           { y coordinate of graph's origin     }
  154.    SkipX           : SkipType;          { how many x tic marks to skip       }
  155.    SkipY           : SkipType;          { how many y tic marks to skip       }
  156.    world           : Worldtype;         { limits of values to be graphed     }
  157.  
  158.  
  159. {----------------------------------------------------------------------------}
  160. {---                                                                      ---}
  161. {---    Low level graphics routines for use in DrawGraph.                 ---}
  162. {---                                                                      ---}
  163. {----------------------------------------------------------------------------}
  164.  
  165. {----------------------------------------------------------------------------}
  166. {-  SetUpWorld matches a world coordinate system to a window on the screen  -}
  167. {----------------------------------------------------------------------------}
  168.  
  169. PROCEDURE SetUpWorld (x1, y1, x2, y2  : REAL;
  170.                       sx1,sy1,sx2,sy2 : INTEGER);
  171.  
  172.    BEGIN   {SetUpWorld}
  173.       WITH world DO BEGIN
  174.          x_1:=x1;   sx_1:=sx1;
  175.          y_1:=y1;   sy_1:=sy1;
  176.          x_2:=x2;   sx_2:=sx2;
  177.          y_2:=y2;   sy_2:=sy2;
  178.       END;   {WITH}
  179.    END;   {SetUpWorld}
  180.  
  181.  
  182. {----------------------------------------------------------------------------}
  183. {-  WhereX converts an independent world coordinate to a screen coordinate  -}
  184. {----------------------------------------------------------------------------}
  185.  
  186. FUNCTION WhereX (x:REAL) : INTEGER;       { finds screen coordinate of x }
  187.  
  188.    BEGIN   {WhereX}
  189.       WITH world DO
  190.          WhereX:=sx_1+round(((x-x_1)/(x_2-x_1))*(sx_2-sx_1));
  191.    END;   {WhereX}
  192.  
  193.  
  194. {----------------------------------------------------------------------------}
  195. {-  WhereY converts a dependent world coordinate to a screen coordinate     -}
  196. {----------------------------------------------------------------------------}
  197.  
  198. FUNCTION WhereY (y:REAL) : INTEGER;       { finds screen coordinate of y }
  199.  
  200.    BEGIN   {WhereY}
  201.       WITH world DO
  202.          WhereY:=sy_1+round(((y-y_1)/(y_2-y_1))*(sy_2-sy_1));
  203.    END;   {WhereY}
  204.  
  205.  
  206. {----------------------------------------------------------------------------}
  207. {-  DrawLine draws a line from world coordinates (x1,y1) to (x2,y2).        -}
  208. {----------------------------------------------------------------------------}
  209.  
  210. PROCEDURE DrawLine (x1, y1, x2, y2 : REAL);
  211.  
  212.    VAR
  213.       sx1 : INTEGER;                              { x1 in screen coordinates }
  214.       sx2 : INTEGER;                              { x2 in screen coordinates }
  215.       sy1 : INTEGER;                              { y1 in screen coordinates }
  216.       sy2 : INTEGER;                              { y2 in screen coordinates }
  217.  
  218.    BEGIN   {DrawLine}
  219.       sx1:=WhereX (x1);
  220.       sy1:=WhereY (y1);
  221.       sx2:=WhereX (x2);
  222.       sy2:=WhereY (y2);
  223.       Line (sx1,sy1,sx2,sy2);
  224.    END;   {DrawLine}
  225.  
  226.  
  227. {----------------------------------------------------------------------------}
  228. {-  Drop searches data for the first nonnegative data point on both the x-  -}
  229. {-  and y-axes. If either axis is logarithmic, then that nonnegative data   -}
  230. {-  point becomes the first point to be graphed.                            -}
  231. {----------------------------------------------------------------------------}
  232.  
  233. PROCEDURE Drop (    x     : PlotXYPtr;
  234.                     y     : PlotXYPtr;
  235.                     Plot  : BYTE;
  236.                 VAR start : INTEGER);
  237.  
  238.    VAR
  239.       i    : INTEGER;                 { number of nonpositive x elements  }
  240.       j    : INTEGER;                 { number of nonpositive y elements  }
  241.  
  242.    BEGIN   {Drop}
  243.       start:=1;
  244.       i:=1;
  245.       j:=1;
  246.       IF NOT XLinear THEN
  247.          WHILE x^[i] <= 0 DO inc(i,1);
  248.       IF NOT YLinear THEN
  249.          WHILE y^[j] <= 0 DO inc(j,1);
  250.       CASE Plot of
  251.          1: start:=1;
  252.          2: IF i >= j
  253.                THEN start:=i
  254.                ELSE start:=j;
  255.          3: start:=i;
  256.          4: start:=j;
  257.       END;   {CASE}
  258.    END;   {Drop}
  259.  
  260.  
  261. {----------------------------------------------------------------------------}
  262. {-  MinMaxLin finds the minimum and maximum values on a single axis of the  -}
  263. {-  input data to be displayed on a linear graph.                           -}
  264. {----------------------------------------------------------------------------}
  265.  
  266. PROCEDURE MinMaxLin ( VAR min          : REAL;
  267.                       VAR max          : REAL;
  268.                       VAR Scale        : REAL;
  269.                       VAR Factor       : INTEGER;
  270.                       VAR NumIntervals : BYTE;
  271.                       VAR PosIntervals : BYTE;
  272.                       VAR NegIntervals : BYTE;
  273.                       VAR Error        : BYTE
  274.                     );
  275.  
  276.    CONST
  277.       MaxPower  = 21;
  278.       StepSize  : array [1..9] of INTEGER
  279.                 = (1,2,5,10,20,50,100,200,500);
  280.  
  281.    VAR
  282.       OKAY      : BOOLEAN;            { Done with loop yet?               }
  283.       i         : INTEGER;            { Counter variable                  }
  284.       delta     : REAL;               { Max - min                         }
  285.       MinFudge  : BOOLEAN;            { Fudge factor for min computations }
  286.       MaxFudge  : BOOLEAN;            { Fudge factor for max computations }
  287.  
  288.    BEGIN   {MinMaxLin}
  289.       delta:=abs(max-min);
  290.       i:=MaxPower+3;
  291.       REPEAT
  292.          dec (i,3);
  293.          IF i < -MaxPower THEN BEGIN
  294.             Error:=3;
  295.             Exit;
  296.          END;   {IF}
  297.          Scale:=exp10(i);
  298.       UNTIL ((5 <= (delta/Scale)) AND ((delta/Scale) < 5000));
  299.       MinFudge:=false;
  300.       MaxFudge:=false;
  301.       IF (abs(min/Scale) > MaxInt) THEN BEGIN
  302.          min:=min/1000;
  303.          MinFudge:=true;
  304.       END;   {IF}
  305.       IF (abs(max/Scale) > MaxInt) THEN BEGIN
  306.          max:=max/1000;
  307.          MaxFudge:=true;
  308.       END;   {IF}
  309.       IF min < 0
  310.          THEN min:=pred(trunc(min/Scale))
  311.          ELSE min:=     trunc(min/Scale);
  312.       IF max < 0
  313.          THEN max:=     trunc(max/Scale)
  314.          ELSE max:=succ(trunc(max/Scale));
  315.       IF max < 0
  316.          THEN max:=0
  317.       ELSE IF min > 0
  318.          THEN min:=0;
  319.       IF MinFudge THEN min:=min*1000;
  320.       IF MaxFudge THEN max:=max*1000;
  321.  
  322.       i:=1;
  323.       NumIntervals:=10;
  324.       OKAY:=false;
  325.       REPEAT
  326.          Factor:=StepSize[i];
  327.          IF ((NumIntervals*Factor) >= (max-min))
  328.             THEN OKAY:=true
  329.             ELSE i:=succ(i);
  330.       UNTIL (OKAY OR (i = 10));
  331.       min:=min*Scale;
  332.       max:=max*Scale;
  333.       IF (min >= 0)
  334.          THEN BEGIN
  335.             PosIntervals:=NumIntervals;
  336.             NegIntervals:=0;
  337.             min:=0;
  338.             max:=NumIntervals*Factor*Scale;
  339.          END   {THEN}
  340.       ELSE IF (max <= 0)
  341.          THEN BEGIN
  342.             PosIntervals:=0;
  343.             NegIntervals:=NumIntervals;
  344.             min:=-NumIntervals*Factor*Scale;
  345.             max:=0;
  346.          END   {ELSE IF}
  347.       ELSE   {min < 0 < max}
  348.          BEGIN
  349.             PosIntervals:=trunc(max/(max-min)*NumIntervals+1);
  350.             NegIntervals:=trunc(min/(min-max)*NumIntervals+1);
  351.             NumIntervals:=PosIntervals+NegIntervals;
  352.             min:=-NegIntervals*Factor*Scale;
  353.             max:= PosIntervals*Factor*Scale;
  354.          END;   {ELSE}
  355.    END;   {MinMaxLin}
  356.  
  357.  
  358. {----------------------------------------------------------------------------}
  359. {-  MinMaxLog finds the minimum and maximum values on a single axis of the  -}
  360. {-  input data to be displayed on a logarithmic graph.                      -}
  361. {----------------------------------------------------------------------------}
  362.  
  363. PROCEDURE MinMaxLog ( VAR min        : REAL;
  364.                       VAR max        : REAL;
  365.                       VAR Scale      : REAL;
  366.                       VAR NumDecades : BYTE
  367.                     );
  368.  
  369.    BEGIN   {MinMaxLog}
  370.       IF min > 0 THEN IF min < 1
  371.          THEN min:=exp10(pred(trunc(log(min))))
  372.          ELSE min:=exp10     (trunc(log(min)));
  373.       IF max > 0 THEN IF max < 1
  374.          THEN max:=exp10     (trunc(log(max)))
  375.          ELSE max:=exp10(succ(trunc(log(max))));
  376.       IF (min = 0) THEN min:=max*exp10(-MaxDecades);
  377.       NumDecades:=round(log(max)-log(min));
  378.       IF NumDecades > MaxDecades THEN BEGIN
  379.          min:=exp10(round(log(max)-MaxDecades));
  380.          NumDecades:=MaxDecades;
  381.       END;   {IF}
  382.       Scale:=min;
  383.    END;   {MinMaxLog}
  384.  
  385.  
  386. {----------------------------------------------------------------------------}
  387. {-  Skip determines the number of tic marks to skip labelling on a linear   -}
  388. {-  axis; e.g. if SkipNum = 4, then every fourth tic mark is labelled.      -}
  389. {----------------------------------------------------------------------------}
  390.  
  391. PROCEDURE Skip (     d       : INTEGER;
  392.                      s       : INTEGER;
  393.                      i       : INTEGER;
  394.                  VAR SkipNum : SkipType
  395.                );
  396.  
  397.    BEGIN   {Skip}
  398.       IF      ((d<=s/5) AND (i>=4))
  399.          THEN SkipNum:=5
  400.       ELSE IF ((d<=s/4) AND (i>=6))
  401.          THEN SkipNum:=4
  402.       ELSE IF ((d<=s/3) AND (i>=8))
  403.          THEN SkipNum:=3
  404.       ELSE IF ((d<=s/2) AND (i>=10))
  405.          THEN SkipNum:=2
  406.       ELSE SkipNum:=1;
  407.    END;   {Skip}
  408.  
  409.  
  410. {----------------------------------------------------------------------------}
  411. {-  LinearAxis draws a linear axis                                          -}
  412. {----------------------------------------------------------------------------}
  413.  
  414. PROCEDURE LinearAxis ( axis         : char;
  415.                        min          : REAL;
  416.                        max          : REAL;
  417.                        Scale        : REAL;
  418.                        Factor       : INTEGER;
  419.                        NumIntervals : BYTE;
  420.                        PosIntervals : BYTE;
  421.                        NegIntervals : BYTE;
  422.                        units        : string
  423.                      );
  424.    VAR
  425.       i            : INTEGER;
  426.       j            : INTEGER;
  427.       Plot1        : INTEGER;
  428.       Plot2        : INTEGER;
  429.       OutScale     : INTEGER;
  430.       OutX         : INTEGER;
  431.       OutY         : INTEGER;
  432.       OutFactor    : WrkString;
  433.       XAXIS        : BOOLEAN;
  434.       z1           : INTEGER;
  435.       z2           : INTEGER;
  436.       z3           : INTEGER;
  437.       z4           : INTEGER;
  438.       for_limit    : INTEGER;
  439.       OK_to_Draw   : BOOLEAN;
  440.       outstr       : string [20];
  441.  
  442.    BEGIN   {LinearAxis}
  443.       XAXIS:=(UpCase(axis) = 'I');
  444.       WITH world DO IF XAXIS
  445.          THEN BEGIN
  446.             z1:=sx_1; z2:=sx_2; z3:=sy_1; z4:=sy_2;
  447.          END
  448.          ELSE BEGIN
  449.             z1:=sy_1; z2:=sy_2; z3:=sx_1; z4:=sx_2;
  450.          END;
  451.       IF XAXIS
  452.          THEN BEGIN
  453.             Plot1:=WhereX (0);
  454.             Line (Plot1,z3,Plot1,z4);
  455.             Line (z1,z3,z2,z3);
  456.             Line (z1,z4,z2,z4);
  457.             PlotX:=Plot1;
  458.             PlotY:=z3+char_height;
  459.             ZeroX:=Plot1;
  460.          END
  461.          ELSE BEGIN
  462.             Plot1:=WhereY (0);
  463.             Line (z3,Plot1,z4,Plot1);
  464.             Line (z3,z1,z3,z2);
  465.             Line (z4,z1,z4,z2);
  466.             PlotX:=z3-4*char_width;
  467.             PlotY:=Plot1-(char_height div 2);
  468.             ZeroY:=Plot1;
  469.          END;
  470.       OutTextXY (PlotX,PlotY,'0');
  471.       FOR j:=1 TO 2 DO BEGIN
  472.          for_limit:=PosIntervals+(j-1)*(NegIntervals-PosIntervals);
  473.          FOR i:=1 TO for_limit DO BEGIN
  474.             Plot2:=Plot1+(3-2*j)*round(i*(z2-z1)/NumIntervals);
  475.             Str ((3-2*j)*i*Factor,OutFactor);
  476.             IF XAXIS
  477.                THEN BEGIN
  478.                   Line (Plot2,z3,Plot2,z3-MajorTic);
  479.                   Line (Plot2,z4,Plot2,z4+MajorTic);
  480.                   PlotX:=Plot2-(Length(OutFactor) div 2)*char_width;
  481.                   PlotY:=z3+char_height;
  482.                   OK_to_Draw:=(i mod SkipX = 0);
  483.                END   {THEN}
  484.                ELSE BEGIN
  485.                   Line (z3,Plot2,z3+MajorTic,Plot2);
  486.                   Line (z4,Plot2,z4-MajorTic,Plot2);
  487.                   PlotX:=z3-(3+j)*char_width;
  488.                   PlotY:=Plot2-(char_height div 2);
  489.                   OK_to_Draw:=(i mod SkipY = 0);
  490.                END;
  491.             IF OK_to_Draw THEN OutTextXY (PlotX,PlotY,OutFactor);
  492.          END;   {FOR i}
  493.       END;   {FOR j}
  494.       IF XAXIS
  495.          THEN BEGIN
  496.             OutX:=((z1+z2) div 2)-4*char_width;
  497.             OutY:=z3+3*char_height;
  498.          END   {THEN}
  499.          ELSE BEGIN
  500.             OutX:=z3-(10+MaxDecades)*char_width;
  501.             OutY:=(z1+z2-char_height) div 2;
  502.          END;   {ELSE}
  503.       OutScale:=round(log(Scale));
  504.       Str (OutScale,OutFactor);
  505.       PlotX:=OutX;
  506.       PlotY:=OutY;
  507.       IF OutFactor <> '0' THEN BEGIN
  508.          outstr:='(x10   )';
  509.          OutTextXY (PlotX,PlotY,outstr);
  510.          PlotX:=OutX;
  511.          PlotY:=OutY-(char_height div 2);
  512.          outstr:='    '+OutFactor;
  513.          OutTextXY (PlotX,PlotY,outstr);
  514.          IF XAXIS
  515.             THEN BEGIN
  516.                PlotX:=OutX+12*char_width;
  517.                PlotY:=OutY;
  518.             END   {THEN}
  519.             ELSE BEGIN
  520.                PlotX:=OutX;
  521.                PlotY:=OutY+2*char_height;
  522.             END;   {ELSE}
  523.       END;   {THEN}
  524.       OutTextXY (PlotX,PlotY,units);
  525.    END;   {LinearAxis}
  526.  
  527.  
  528. {----------------------------------------------------------------------------}
  529. {-  LogAxis draws a logarithmic axis                                        -}
  530. {----------------------------------------------------------------------------}
  531.  
  532. PROCEDURE LogAxis ( axis       : char;
  533.                     min        : REAL;
  534.                     max        : REAL;
  535.                     Scale      : REAL;
  536.                     NumDecades : BYTE;
  537.                     units      : string
  538.                   );
  539.  
  540.    VAR
  541.       i         : INTEGER;
  542.       j         : INTEGER;
  543.       k         : INTEGER;
  544.       Plot1     : INTEGER;
  545.       Plot2     : INTEGER;
  546.       NewPlot   : INTEGER;
  547.       OutX      : INTEGER;
  548.       OutY      : INTEGER;
  549.       OutScale  : INTEGER;
  550.       OutFactor : Wrkstring;
  551.       outstr    : WrkString;
  552.       z1        : INTEGER;
  553.       z2        : INTEGER;
  554.       z3        : INTEGER;
  555.       z4        : INTEGER;
  556.       XAXIS     : BOOLEAN;
  557.  
  558.    BEGIN   {LogAxis}
  559.       XAXIS:=(UpCase(axis) = 'I');
  560.       WITH world DO IF XAXIS
  561.          THEN BEGIN
  562.             z1:=sx_1; z2:=sx_2; z3:=sy_1; z4:=sy_2;
  563.          END
  564.          ELSE BEGIN
  565.             z1:=sy_1; z2:=sy_2; z3:=sx_1; z4:=sx_2;
  566.          END;
  567.       IF XAXIS
  568.          THEN BEGIN
  569.             Line (z1,z3,z2,z3);
  570.             Line (z1,z4,z2,z4);
  571.          END
  572.          ELSE BEGIN
  573.             Line (z3,z1,z3,z2);
  574.             Line (z4,z1,z4,z2);
  575.          END;
  576.       Plot1:=z1;
  577.       FOR i:=1 TO NumDecades+1 DO BEGIN
  578.          NewPlot:=round(z1+i*(z2-z1)/NumDecades);
  579.          FOR k:=1 TO i DO OutFactor[k]:=power[k];
  580.          OutFactor[0]:=char(i);
  581.          IF XAXIS
  582.             THEN BEGIN
  583.                Line (Plot1,z3,Plot1,z3-MajorTic);
  584.                Line (Plot1,z4,Plot1,z4+MajorTic);
  585.                PlotX:=Plot1-(i*char_width) div 2;
  586.                PlotY:=z3+char_height;
  587.             END
  588.             ELSE BEGIN
  589.                Line (z3,Plot1,z3+MajorTic,Plot1);
  590.                Line (z4,Plot1,z4-MajorTic,Plot1);
  591.                PlotX:=z3-(MaxDecades+1)*char_width;
  592.                PlotY:=Plot1;
  593.             END;
  594.          OutTextXY (PlotX,PlotY,OutFactor);
  595.          IF i <= NumDecades THEN FOR j:=2 TO 9 DO BEGIN
  596.             Plot2:=round(Plot1+(NewPlot-Plot1)*LogTable[j]);
  597.             IF XAXIS
  598.                THEN BEGIN
  599.                   Line (Plot2,z3,Plot2,z3-MinorTic);
  600.                   Line (Plot2,z4,Plot2,z4+MinorTic);
  601.                END
  602.                ELSE BEGIN
  603.                   Line (z3,Plot2,z3+MinorTic,Plot2);
  604.                   Line (z4,Plot2,z4-MinorTic,Plot2);
  605.                END;
  606.          END;   {FOR j}
  607.          Plot1:=NewPlot;
  608.       END;   {FOR i}
  609.       IF XAXIS
  610.          THEN BEGIN
  611.             OutX:=(z1+z2) div 2 - 4*char_width;
  612.             OutY:=z3+3*char_height;
  613.          END
  614.          ELSE BEGIN
  615.             OutX:=z3-(10+MaxDecades)*char_width;
  616.             OutY:=(z1+z2+char_height) div 2;
  617.          END;
  618.       OutScale:=round(log(Scale));
  619.       Str (OutScale,OutFactor);
  620.       PlotX:=OutX;
  621.       PlotY:=OutY;
  622.       IF OutFactor <> '0' THEN BEGIN
  623.          outstr:='(x10   )';
  624.          OutTextXY (PlotX,PlotY,outstr);
  625.          PlotX:=OutX;
  626.          PlotY:=OutY-(char_height div 2);
  627.          outstr:='    '+OutFactor;
  628.          OutTextXY (PlotX,PlotY,outstr);
  629.          IF XAXIS
  630.             THEN BEGIN
  631.                PlotX:=OutX+12*char_width;
  632.                PlotY:=OutY;
  633.             END   {THEN}
  634.             ELSE BEGIN
  635.                PlotX:=OutX;
  636.                PlotY:=OutY+2*char_height;
  637.             END;   {ELSE}
  638.       END;   {THEN}
  639.       OutTextXY (PlotX,PlotY,units);
  640.    END;   {LogAxis}
  641.  
  642.  
  643. {----------------------------------------------------------------------------}
  644. {-  LinearScale scales the linear axis data to the world coordinate system  -}
  645. {----------------------------------------------------------------------------}
  646.  
  647. PROCEDURE LinearScale ( VAR z     : PlotXYPtr;
  648.                         VAR min   : REAL;
  649.                         VAR max   : REAL;
  650.                             Scale : REAL;
  651.                             N     : INTEGER
  652.                       );
  653.  
  654.    VAR i : INTEGER;
  655.  
  656.    BEGIN   {LinearScale}
  657.       FOR i:=1 TO N DO
  658.          z^[i]:=z^[i]/Scale;
  659.       min:=min/Scale;
  660.       max:=max/Scale;
  661.    END;   {LinearScale}
  662.  
  663.  
  664. {----------------------------------------------------------------------------}
  665. {-  LogScale scales the logarithmic data to the world coordinate system     -}
  666. {----------------------------------------------------------------------------}
  667.  
  668. PROCEDURE LogScale ( VAR z     : PlotXYPtr;
  669.                      VAR min   : REAL;
  670.                      VAR max   : REAL;
  671.                          Scale : REAL;
  672.                          N     : INTEGER
  673.                    );
  674.  
  675.    VAR i : INTEGER;
  676.  
  677.    BEGIN   {LogScale}
  678.       FOR i:=1 TO N DO BEGIN
  679.          IF (z^[i] < min) THEN z^[i]:=min;
  680.          z^[i]:=log(z^[i]/Scale);
  681.       END;   {FOR}
  682.       min:=log(min/Scale);
  683.       max:=log(max/Scale);
  684.    END;   {LogScale}
  685.  
  686.  
  687. {----------------------------------------------------------------------------}
  688. {-  GraphArray actually plots the data on the screen                        -}
  689. {----------------------------------------------------------------------------}
  690.  
  691. PROCEDURE GraphArray (x : PlotXYPtr;
  692.                       y : PlotXYPtr;
  693.                       N : INTEGER);
  694.  
  695.    VAR
  696.       new_x : INTEGER;
  697.       new_y : INTEGER;
  698.       old_x : INTEGER;
  699.       old_y : INTEGER;
  700.       i     : INTEGER;
  701.  
  702.    BEGIN   {GraphArray}
  703.       new_x:=WhereX (x^[1]);
  704.       new_y:=WhereY (y^[1]);
  705.       FOR i:=2 TO N DO BEGIN
  706.          old_x:=new_x;
  707.          old_y:=new_y;
  708.          new_x:=WhereX (x^[i]);
  709.          new_y:=WhereY (y^[i]);
  710.          Line (old_x,old_y,new_x,new_y);
  711.       END;   {FOR}
  712.    END;   {GraphArray}
  713.  
  714.  
  715. {----------------------------------------------------------------------------}
  716.  
  717.  
  718. PROCEDURE DrawGraph ( VAR x_ptr           {untyped parameter};
  719.                       VAR y_ptr           {untyped parameter};
  720.                           NumPlotPoints : INTEGER;
  721.                           Plot          : BYTE;
  722.                           left_x        : INTEGER;
  723.                           top_y         : INTEGER;
  724.                           right_x       : INTEGER;
  725.                           bottom_y      : INTEGER;
  726.                       VAR XDelay        : REAL;
  727.                       VAR YDelay        : REAL;
  728.                           horiz_units   : string;
  729.                           vert_units    : string;
  730.                       VAR error         : BYTE
  731.                     );
  732.  
  733.    VAR
  734.       x    : PlotXYPtr;
  735.       y    : PlotXYPtr;
  736.       minx : REAL;
  737.       maxx : REAL;
  738.       miny : REAL;
  739.       maxy : REAL;
  740.  
  741.    BEGIN   {DrawGraph}
  742.       x:=PlotXYPtr (x_ptr);
  743.       y:=PlotXYPtr (y_ptr);
  744.       error:=0;
  745.       SetTextStyle (SmallFont,HorizDir,char_size);
  746.       left_x:=left_x+(11+MaxDecades)*char_width;
  747.       bottom_y:=bottom_y-3*char_height;
  748.       XLinear:=((Plot = Linear) OR (Plot = LinLog));
  749.       YLinear:=((Plot = Linear) OR (Plot = LogLin));
  750.       XDelay:=x^[1];
  751.       YDelay:=0;
  752.       FOR i:=1 TO NumPlotPoints DO BEGIN
  753.          x^[i]:=x^[i]-XDelay;
  754.          y^[i]:=y^[i]-YDelay;
  755.       END;   {FOR}
  756.       Drop (x,y,Plot,start);
  757.  
  758.       FOR i:=start TO NumPlotPoints DO BEGIN
  759.          x^[i-start+1]:=x^[i];
  760.          y^[i-start+1]:=y^[i];
  761.       END;   {FOR}
  762.       NumPlotPoints:=NumPlotPoints-start+1;
  763.       minx:=x^[1];
  764.       maxx:=x^[1];
  765.       miny:=y^[1];
  766.       maxy:=y^[1];
  767.       FOR i:=2 TO NumPlotPoints DO BEGIN
  768.          IF minx > x^[i]
  769.             THEN minx:=x^[i]
  770.          ELSE IF maxx < x^[i]
  771.             THEN maxx:=x^[i];
  772.          IF miny > y^[i]
  773.             THEN miny:=y^[i]
  774.          ELSE IF maxy < y^[i]
  775.             THEN maxy:=y^[i];
  776.       END;   {FOR}
  777.  
  778.       {--- If error in logarithmic data then exit procedure ---}
  779.       IF (NOT XLinear) AND (minx <= 0) THEN error:=1;
  780.       IF (NOT YLinear) AND (miny <= 0) THEN error:=1;
  781.       IF (error <> 0) THEN EXIT;
  782.  
  783.       IF XLinear
  784.          THEN MinMaxLin (minx,maxx,ScaleX,FactorX,NumIntervalsX,
  785.                          PosIntervalsX,NegIntervalsX,Error)
  786.          ELSE MinMaxLog (minx,maxx,ScaleX,NumDecadesX);
  787.       IF YLinear
  788.          THEN MinMaxLin (miny,maxy,ScaleY,FactorY,NumIntervalsY,
  789.                          PosIntervalsY,NegIntervalsY,Error)
  790.          ELSE MinMaxLog (miny,maxy,ScaleY,NumDecadesY);
  791.  
  792.       {--- If data is out of range then exit procedure ---}
  793.       IF (error <> 0) THEN EXIT;
  794.  
  795.       SetUpWorld (minx,miny,maxx,maxy,left_x,bottom_y,right_x,top_y);
  796.       IF XLinear
  797.          THEN BEGIN
  798.             Skip        ((right_x-left_x),GetMaxX,NumIntervalsX,SkipX);
  799.             LinearAxis  ('i',minx,maxx,ScaleX,FactorX,NumIntervalsX,
  800.                          PosIntervalsX,NegIntervalsX,horiz_units);
  801.             LinearScale (x,minx,maxx,ScaleX,NumPlotPoints);
  802.          END   {THEN}
  803.          ELSE BEGIN
  804.             LogAxis   ('i',minx,maxx,ScaleX,NumDecadesX,horiz_units);
  805.             LogScale  (x,minx,maxx,ScaleX,NumPlotPoints);
  806.          END;   {THEN}
  807.       IF YLinear
  808.          THEN BEGIN
  809.             Skip        ((bottom_y-top_y),GetMaxY,NumIntervalsY,SkipY);
  810.             LinearAxis  ('d',miny,maxy,ScaleY,FactorY,NumIntervalsY,
  811.                          PosIntervalsY,NegIntervalsY,vert_units);
  812.             LinearScale (y,miny,maxy,ScaleY,NumPlotPoints);
  813.          END   {THEN}
  814.          ELSE BEGIN
  815.             LogAxis   ('d',miny,maxy,ScaleY,NumDecadesY,vert_units);
  816.             LogScale  (y,miny,maxy,ScaleY,NumPlotPoints);
  817.          END;   {ELSE}
  818.       WITH world DO
  819.          SetUpWorld (minx,miny,maxx,maxy,sx_1,sy_1,sx_2,sy_2);
  820.       GraphArray (x,y,NumPlotPoints);
  821.    END;   {DrawGraph}
  822.  
  823.  
  824. {----------------------------------------------------------------------------}
  825.  
  826.  
  827. PROCEDURE Print_Screen;
  828.  
  829.    CONST
  830.       FormFeed = #12;         { formfeed for an Epson-compatible printer     }
  831.  
  832.    VAR
  833.       Reg : Registers;        { variable to read/write to the 8088 registers }
  834.  
  835.    BEGIN   {Print_Screen}
  836.       Intr ($5,Reg);
  837.       WriteLn (lst,FormFeed);
  838.    END;   {Print_Screen}
  839.  
  840. (****************************************************************************)
  841.  
  842. VAR
  843.    Error : INTEGER;
  844.  
  845.  
  846. PROCEDURE CgaDriverProc; external;
  847. {$L \pascal4\graphix\CGA.OBJ }
  848.  
  849. PROCEDURE EgaVgaDriverProc; external;
  850. {$L \pascal4\graphix\EGAVGA.OBJ }
  851.  
  852. PROCEDURE HercDriverProc; external;
  853. {$L \pascal4\graphix\HERC.OBJ }
  854.  
  855. PROCEDURE SmallFontProc; external;
  856. {$L c:\pascal4\graphix\LITT.OBJ }
  857.  
  858.  
  859. PROCEDURE Abort(Msg : string);
  860.  
  861.    BEGIN   {Abort}
  862.       Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  863.       Halt(1);
  864.    END;   {Abort}
  865.  
  866. BEGIN   {Initialization section}
  867.    { Register all the drivers }
  868.    IF RegisterBGIdriver (@CGADriverProc)    < 0 THEN Abort('CGA');
  869.    IF RegisterBGIdriver (@EGAVGADriverProc) < 0 THEN Abort('EGA/VGA');
  870.    IF RegisterBGIdriver (@HercDriverProc)   < 0 THEN Abort('Herc');
  871.  
  872.    { Register all the fonts }
  873.    IF RegisterBGIfont   (@SmallFontProc)    < 0 THEN Abort('Small');
  874.  
  875.    GraphDriver := Detect;                  { autodetect the hardware }
  876.    DetectGraph (GraphDriver, GraphMode);   { activate graphics }
  877.    IF GraphDriver = grNotDetected THEN BEGIN       { any errors? }
  878.       GraphDriver:=CGA;
  879.       GraphMode  :=CGAHi;
  880.    END;   {IF}
  881.    InitGraph (GraphDriver,GraphMode,'');
  882.    IF GraphResult <> grOk THEN BEGIN       { any errors? }
  883.       WriteLn ('Graphics initialization error: ', GraphErrorMsg(GraphDriver));
  884.       Halt(1);
  885.    END;
  886.    RestoreCrtMode;
  887.    Exec ('\command.com,','/c graphics');
  888. END.   {UNIT DrawGraf}