home *** CD-ROM | disk | FTP | other *** search
- unit plotlib;
-
- { Written by Bob Harbour / CP Systems
-
- This is a library of routines to drive a Tektronix 4662 flatbed plotter.
- It is written in Turbo Pascal V4.0. You can use it for yourself but if
- you plan to sell it or otherwise include it in something for sale please
- contact me. All of the plotter relevant information was obtained from the
- Tektronix manual.
- The data is passed around in a record ( type datablock ) to organize it.
- The record contains the following fields :
-
- xdata, ydata : datarray; data point storage area
- npoints : integer; number of points in array
- Xmin, Xmax, Ymin, Ymax : real; limits of data in array
- Xscale, Yscale : real; plot scaling parameters
-
- datarray = array [ 1..1000 ] of real;
-
- The xdata, ydata and npoints fields must be filled in but the routine
- limits will fill in the min and max fields and scalecalc will fill in
- the scale fields. All of these fields must be filled in prior to calling
- either of the plot routines lineplot or dashplot.
- There are routines here to generate linear plots, semi-logarithmic plots
- and log-log plots. These are ready to call complete with labeling.
- The primatives are available so that special plotting requirements can
- be accomodated easily. There are routines for titling in several formats.
- The 4662 plotter requires data in an integer format which are Absolute.
- The plotting routines scale the real data to the absolute format required
- by the plotter. The plotter accepts data as ascii characters so the
- integer data must be converted by vectorgen to an ascii string.
- Below is a list of the externally available routines and a short description
- of what they do.
- The plotter is connected to serial port COM2. }
-
-
-
-
- interface
-
- {----------------------------------------------------------------------------}
-
- uses crt;
- {$M 32768,0,655360} { increase stack size }
-
- type vecstring = string [5];
- linestring = string [ 40 ];
- datarray = array [ 1..1000 ] of real;
-
- datablock = record
- xdata, ydata : datarray; { data point storage area }
- npoints : integer; { number of points in array }
- Xmin, Xmax, Ymin, Ymax : real; { limits of data in array }
- Xscale, Yscale : real; { plotting parameters }
- end;
-
-
- var aux : text;
-
- { ========== procedures and functions in unit ============================}
-
- procedure vectorgen ( x, y :integer; var outstring : vecstring );
- { generate a vector string from input parameters x and y }
-
- procedure wait ( x,y : integer );
- { calculate length of vector and wait proper amount of time to prevent plotter
- buffer overrun. Assumes full sized plotter area, can be sped up if plotting
- is always done on smaller paper by changing the global constants actualX , Y
- to the smaller paper size }
-
-
- procedure moveto ( x, y : integer );
- { move pen to position x,y }
-
- procedure drawto ( x, y : integer );
- { draw line to position x,y. note that this routine will repeat unneeded
- bytes if used repetitivly for graphing, filling up the plotter buffer }
-
-
- procedure writechar ( x, y, theta : integer; charstr : linestring );
- { writes alpha characters starting at position x, y and at angle theta, with
- x and y in plotter address integers and theta in degrees }
-
- procedure deswrite ( x,y : integer; charstr : linestring );
- { writes a descending vertical string starting at x,y in absolute plotter
- coordinates }
-
- procedure vtitle ( x : integer; charstr : linestring );
- { writes title in a descending vertical strip starting at x with x in
- absolute plotter coordinates, Y is chosen by routine to center the title }
-
- procedure htitle ( y : integer; charstr : linestring );
- { prints a horizontal title centered in X on plot at vertical pos Y in
- absolute plotter coordinates }
-
-
- procedure limits ( var plotdata : datablock );
- { finds the minimum and maximum values for X and Y in the databblock
- and inserts them in the appropriate fields }
-
- procedure scalecalc ( square :boolean; var plotdata : datablock );
- { calculates the scale factor from the min and max values in the block
- if square, the x and y scale factors will be equal and set to the
- smaller of the two. Must be called after mins and maxes are determined }
-
- procedure edlimits ( var plotdata : datablock );
- { shows user the values in min and max for both axes and allows them to be
- changed. Note that the max values cannot be made less than the ones in the
- data block when called and the min values cannot be made greater so it is
- important to call limits before calling this routine. }
-
- procedure showlimits ( var plotdata : datablock );
- { shows values in limit fields and scale fields. mostly for debugging }
-
- procedure lineplot ( var plotdata : datablock );
- { plots solid line through all points in data array }
-
- procedure dashplot ( var plotdata : datablock );
- { plots dashed line through all points in data array, drawing the vectors
- from originating from odd number points and leaving open the vectors
- originating from even number points. Even and odd refering to the array
- indices }
-
-
- procedure lineargrid ( var plotdata : datablock );
- { prints a grid of linear divisions on plot. must be called after limits
- and scalecalc in order to have the correct values for the line positioning }
-
- procedure linearaxes ( var plotdata : datablock );
- { draws the axes into the graph at the zero lines if they are in the range
- plotted else puts the axes at the edges of the plot. requires the min and
- max and scale data in the incoming block to operate }
-
- procedure lincal ( var plotdata : datablock );
- { writes the mins and maxes in the corners of a linear plot }
-
-
- procedure semiloggrid ( var griddata : datablock );
- { plots the semi-log axes or grid from the limits in griddata }
-
- procedure semilogcal ( var plotdata : datablock );
- { writes the mins and maxes in the corners of the plot on a semilog plot }
-
-
- procedure logloggrid ( var griddata : datablock );
- { plots the log-log grid from the limits in griddata }
-
- procedure loglogcal ( var plotdata : datablock );
- { writes the mins and maxes in the corners of the plot on a log-log plot }
-
-
- procedure linearplot ( var plotstuff : datablock; Hname,Vname : linestring; grid,square : boolean );
- { plots the data in plotstuff on a linear graph. Writes Hname and Vname in the
- appropriate margins and writes the limits in the margins too. If grid, a
- regular graph paper type grid is drawn, else a line at the zeros or closest
- to zero on graph is drawn. If square, scale factors are forced to the minimum
- of X or Y and both are equal. useful for circles or true geometries }
-
- procedure semilogplot ( var plotstuff : datablock; Hname,Vname : linestring );
- { generates a semi-logarithmic plot of the data in plotstuff. Writes string in
- Vname and H name in the margins of the plot. X data is transformed to log
- before plotting }
-
- procedure logplot ( var plotstuff : datablock; Hname,Vname : linestring );
- { generates a log log plot of the data in plotstuff. titles in Hname and Vname
- and data in both axes is transformed to log before plotting }
-
- {--------------------------------------------------------------------------}
-
-
- implementation
-
- { control characters and plotter commands and constants }
- const esc = #$1B; { ascii control characters }
- del = #$7F;
- gs = #$1D;
- us = #$1F;
- cr = #$0D;
- bel = #$07;
- device = 'A'; { plotter address set in dip sw }
- plotteron = 'E'; { plotter command characters }
- plotteroff = 'F';
- plotreset = 'N';
- alphareset = 'V';
- alpharotate = 'J';
- comma = ',';
-
- plotXmax = 4095; { extreme right side of plotter }
- plotXmin = 0; { extreme left side of plotter }
- plotYmax = 2731; { extreme top side of plotter }
- plotYmin = 0; { extreme bottom side of pltter }
-
- axesXmax = 3900; { right margin of plot area }
- axesXmin = 600; { left margin of plot area }
- axesYmax = 2550; { top margin }
- axesYmin = 600; { bottom margin }
-
- lineheight = 88; { plotter default line spacing }
- charwidth = 56; { default character width }
-
- actualX = 10.0; { length in inches of plot surface}
- actualY = 8.0; { height in inches of plot surface}
-
- {-----------------------------------------------------------------------------}
-
- var lastX, lastY : integer;
- scaleX, scaleY : real;
-
- { ============================================================================}
-
-
- function log ( x : real ) : real;
- { calculates the base 10 logarithm of x }
-
- begin
- log := ln ( x ) / ln ( 10.0 );
- end;
-
-
-
- function pow ( x : real ) : real;
- { calculates 10 ** x }
-
- begin
- pow := exp ( x * ln ( 10.0));
- end;
-
-
-
- procedure vectorgen ( x, y :integer; var outstring : vecstring );
- { generate a vector string from input parameters x and y }
-
- const Hioffset = $20;
- LoXoffset = $40;
- LoYoffset = $60;
- XloYoffset = $60;
-
- var HiX, LoX, vlX, HiY, LoY, vlY, XloY : integer;
-
- begin
- if x > plotXmax then x := plotXmax; { range check incomming data }
- if x < plotXmin then x := plotXmin;
- if y > plotYmax then y := plotYmax;
- if y < plotYmin then y := plotYmin;
-
- HiX := x div 128; { split off the most significant part }
- LoX := x mod 128; { get less significant part }
- vlX := LoX mod 4; { get least significant part }
- LoX := LoX div 4; { remove least significant part }
-
- HiY := y div 128; { repeat process for Y variable now }
- LoY := y mod 128;
- vlY := LoY mod 4;
- LoY := LoY div 4;
-
- XloY := vlX + ( 4 * vlY ); { compose extra byte for ls 2 bits x,y }
-
- outstring := chr ( HiY + Hioffset ); { fill output string now }
- outstring := outstring + chr ( XloY + XloYoffset );
- outstring := outstring + chr ( LoY + LoYoffset );
- outstring := outstring + chr ( HiX + Hioffset );
- outstring := outstring + chr ( LoX + LoXoffset );
- end;
-
-
-
- procedure wait ( x,y : integer );
- { calculate length of vector and wait proper amount of time to prevent plotter
- buffer overrun. Assumes full sized plotter area, can be sped up if plotting
- is always done on smaller paper by changing the global constants actualX , Y
- to the smaller paper size }
-
-
- var Xcomp, Ycomp, delta, time : real;
- wtime : word;
-
- begin { find vector length }
- Xcomp := ( lastX - x ) * scaleX; { get X component }
- Ycomp := ( lastY - y ) * scaleY;
- delta := sqrt ( sqr ( Xcomp ) + sqr ( Ycomp )); { python theorem }
-
- lastX := x; { swap new end to old end }
- lastY := y; { for next vector }
-
- if delta < 0.05 { select calculation meth }
- then time := 0.0 { these constants came from}
- else if delta < 0.3 { interpolating the curves }
- then time := 166.0 * delta + 25.0 { in the tektronix manual }
- else if delta < 1.0 { time is in miliseconds }
- then time := 115.0 * delta + 30.0
- else if delta < 2.55
- then time := 70.0 * delta + 70.0
- else time := ( delta - 2.55 ) * 61.5 + 240;
- if time > 0.5 { see if any time to wait }
- then begin
- wtime := round ( time );
- delay ( wtime ); { wait for the plotter }
- end;
- end;
-
-
- procedure moveto ( x, y : integer );
- { move pen to position x,y }
- var destination : vecstring;
-
- begin
- vectorgen ( x, y, destination );
- write ( aux, gs, destination );
- end;
-
-
-
- procedure drawto ( x, y : integer );
- { draw line to position x,y. note that this routine will repeat unneeded
- bytes if used repetitivly for graphing, filling up the plotter buffer }
-
- var destination : vecstring;
-
- begin
- vectorgen ( x, y, destination );
- write ( aux, gs, bel, destination );
- end;
-
-
-
- procedure writechar ( x, y, theta : integer; charstr : linestring );
- { writes alpha characters starting at position x, y and at angle theta, with
- x and y in plotter address integers and theta in degrees }
-
- begin
- moveto ( x, y ); { move pen to lower left of ch }
- write ( aux, esc, device, alpharotate, theta ); { set angle }
- write ( aux, us, charstr ) { send string to the plotter }
- end;
-
-
-
-
- procedure deswrite ( x,y : integer; charstr : linestring );
- { writes a descending vertical string starting at x,y in absolute plotter
- coordinates }
-
- var i, stop : integer;
-
- begin
- moveto ( x, y );
- stop := length ( charstr ); { findout how many ch }
- write ( aux, esc, device, alpharotate, '0' ); { set to horizontal }
- write ( aux, us );
- for i := 1 to stop do { write chars one/line }
- write ( aux, charstr [ i ], cr );
- end;
-
-
-
- procedure vtitle ( x : integer; charstr : linestring );
- { writes title in a descending vertical strip starting at x with x in
- absolute plotter coordinates, Y is chosen by routine to center the title }
-
- var y, n : integer;
-
- begin
- n := length ( charstr ); { findout how many ch }
- y:= ( axesYmax + axesYmin + ( n * lineheight )) div 2;
- deswrite ( x,y, charstr ); { go print it }
- end;
-
-
-
- procedure htitle ( y : integer; charstr : linestring );
- { prints a horizontal title centered in X on plot at vertical pos Y in
- absolute plotter coordinates }
-
- var x :integer;
-
- begin
- x := ( axesXmax + axesXmin - ( length ( charstr ) * charwidth )) div 2 ;
- writechar ( x, y, 0, charstr ); { write it }
- end;
-
-
- procedure limits ( var plotdata : datablock );
- { fills in the limits for the data }
-
- const
- maxreal = 1.7E37;
- minreal = - maxreal;
-
- var i : integer;
-
- begin
- with plotdata do { setup to access the data block }
- begin
- Xmax := minreal; { init to extreme opposite values }
- Xmin := maxreal;
- Ymax := minreal;
- Ymin := maxreal;
-
- for i := 1 to npoints do { scan for largest and smallest }
- begin
- if xdata [ i ] > Xmax
- then Xmax := xdata [ i ];
-
- if xdata [ i ] < Xmin
- then Xmin := xdata [ i ];
-
- if ydata [ i ] > Ymax
- then Ymax := ydata [ i ];
-
- if ydata [ i ] < Ymin
- then Ymin := ydata [ i ];
- end;
-
- end;
- end;
-
-
- procedure scalecalc ( square :boolean; var plotdata : datablock );
- { calculates the scale factor from the min and max values in the block
- if square, the x and y scale factors will be equal and set to the
- smaller of the two. Must be called after mins and maxes are determined }
-
- var tempX, tempY : real;
-
- begin
- with plotdata do
- begin
- tempX := axesXmax - axesXmin;
- tempY := axesYmax - axesYmin;
- { calculate scaling factors }
- xscale := tempX / ( Xmax - Xmin ) ;
- yscale := tempY / ( Ymax - Ymin ) ;
-
- if square { if square, make scale factors = }
- then begin if xscale < yscale
- then yscale := xscale;
- if yscale < xscale
- then xscale := yscale;
- end;
- end;
- end;
-
-
-
- function getnum ( numstr : linestring ) : real;
- { checks string for non numeric characters and converts the remaining string
- to a real number. }
-
- var i, strlength, code : integer;
- temp : real;
- tempstr : linestring;
- begin
- repeat
- i := 1; { set up to find first number }
- strlength := length ( numstr );
- while not ( numstr [ i ] in [ '+','-','0'..'9' ] ) and (i <= strlength) do
- i := i + 1; { find first numeric }
-
- if i <= strlength
- then begin
- tempstr := copy ( numstr ,i ,strlength );
- val ( tempstr, temp, code );{ convert it }
- if code <> 0
- then begin write ( 'Please re-enter new value : ');
- readln ( numstr );
- end;
- end
-
- else begin write ( 'Please re-enter new value : ');
- readln ( numstr );
- code := 1; { set dummy value }
- end;
-
- until code = 0;
-
- getnum := temp; { assign function value}
- end;
-
-
- procedure edlimits ( var plotdata : datablock );
- { displays mins and maxes and allows the user to edit them }
-
- var instring : linestring;
- command : string [ 4 ];
- temp : real;
-
- begin
- with plotdata do
- repeat { until instring ='' }
-
- writeln ('Xmax = ',Xmax,' Ymax = ',Ymax );
- writeln ('Xmin = ',Xmin,' Ymin = ',Ymin );
- writeln;
- write ('Enter : parameter new_value or return to continue : ');
- readln ( instring );
-
- if instring <> '' { is there a string there ?}
- then
- begin
- command := copy ( instring, 1, 4 );
-
- if (command = 'ymin') or (command = 'Ymin')
- then begin
- temp := getnum ( instring );
- if temp <= Ymin { is change legal? }
- then Ymin := temp { yes, do it }
- else writeln ('New value too large!');
- end
-
- else if (command = 'ymax') or (command = 'Ymax')
- then begin
- temp := getnum ( instring );
- if temp >= Ymax { is change legal? }
- then Ymax := temp { yes, do it }
- else writeln ('New value too small!');
- end
-
-
- else if (command = 'xmin') or (command = 'Xmin')
- then begin
- temp := getnum ( instring );
- if temp <= Xmin { is change legal? }
- then Xmin := temp { yes, do it }
- else writeln ('New value too large!');
- end
-
-
- else if (command = 'xmax') or (command = 'Xmax')
- then begin
- temp := getnum ( instring );
- if temp >= Xmax
- then Xmax := temp
- else writeln ('New value too small!');
- end
-
- else writeln ('Invalid parameter name ');
- end;
- until instring = '';
-
- end;
-
-
-
-
-
- procedure showlimits ( var plotdata : datablock );
- { displays the contents of the min and max and scale factors for block
- passed in }
-
- begin with plotdata do
- begin
- writeln ( 'Xmax = ',Xmax,' Xmin = ',Xmin,' X scale = ',xscale );
- writeln ( 'Ymax = ',Ymax,' Ymin = ',Ymin,' Y scale = ',yscale );
- end;
- end;
-
-
-
-
- procedure lineplot ( var plotdata : datablock );
- { plots solid line through all points in data array }
-
- var i, x, y :integer;
- destination : vecstring;
- firstpair : boolean;
-
- begin
- firstpair := true; { indicate first pair transmitted }
- with plotdata do { get access to data and limits }
- begin
- for i := 1 to npoints do { do whole array of points }
- begin
- { calculate plotter coords from data }
- x := round (( xdata [ i ] - Xmin ) * xscale ) + axesXmin;
- y := round (( ydata [ i ] - Ymin ) * yscale ) + axesYmin;
- vectorgen ( x, y, destination ); { generate output string }
-
- if firstpair { see if first point sent }
- then begin { yes, send whole command }
- write ( aux, gs, destination );
- firstpair := false; { reset flag }
- end
- else
- write ( aux, destination );
-
- wait ( x,y ); { wait for plotter to draw}
-
- end;
- end;
- end;
-
-
- procedure dashplot ( var plotdata : datablock );
- { plots dashed line through all points in data array, drawing the vectors
- from originating from odd number points and leaving open the vectors
- originating from even number points. Even and odd refering to the array
- indices }
-
- var i, x, y :integer;
- destination : vecstring;
- odd : boolean;
-
- begin
- odd := true; { indicate odd pair to transmit }
- with plotdata do { get access to data and limits }
- begin
- for i := 1 to npoints do { do whole array of points }
- begin
- { calculate plotter coords from data }
- x := round (( xdata [ i ] - Xmin ) * xscale ) + axesXmin;
- y := round (( ydata [ i ] - Ymin ) * yscale ) + axesYmin;
-
- vectorgen ( x, y, destination ); { generate output string }
-
- if odd { see if odd or even }
- then begin { odd, move to it }
- write ( aux, gs, destination );
- odd := false; { toggle flag }
- end
- else
- begin { even, draw to this one }
- write ( aux, destination );
- odd := true; { toggle flag }
- end;
-
- wait ( x,y ); { wait for plotter to draw}
-
- end;
- end;
- end;
-
-
- procedure lineargrid ( var plotdata : datablock );
- { prints a grid of linear divisions on plot. must be called after limits
- and scalecalc in order to have the correct values for the line positioning }
-
- const Hlines = 11; { number of horizontal lines }
- Vlines = 11;
- var griddata : datablock;
- Xrange, Yrange, Xincrement, Yincrement, X, Y : real;
- i, firstY, lastY :integer;
- odd : boolean;
-
- begin
- with plotdata do
- begin
- griddata.Xmax := Xmax; { copy this data over }
- griddata.Xmin := Xmin;
- griddata.Xscale := Xscale;
- griddata.Ymax := Ymax;
- griddata.Ymin := Ymin;
- griddata.Yscale := Yscale;
-
- Xrange := Xmax - Xmin; { Get stuff out of this block }
- Yrange := Ymax - Ymin;
- end;
-
- Xincrement := Xrange / ( Vlines - 1 ); { determine the spacing of lines }
- Yincrement := Yrange / ( Hlines - 1 );
-
- with griddata do { start filling the grid data }
- begin
- X := Xmin; { init the counters }
- Y := Ymin;
- odd := true; { init the flag }
-
- for i := 1 to ( Hlines * 2 ) do { generate the horizontal lines }
- begin
- if odd
- then begin { begin a written vector }
- xdata [ i ] := Xmin; { put data into the data block }
- ydata [ i ] := Y;
- odd := false; { toggle flag }
- end
- else begin { start an unwritten vector }
- xdata [ i ] := Xmax;
- ydata [ i ] := Y;
- Y:= Y + Yincrement; { advance to next line up }
- odd := true; { toggle flag }
- end;
- end; { horizontal lines are done }
-
- firstY := ( hlines * 2 ) + 1; { first vertical line beginning }
- lastY := ( hlines * 2 ) + 1 + ( vlines *2 ); { last point for vert }
-
- for i := firstY to lastY do { generate vertical lines now }
- if odd
- then begin { generate a written vector }
- xdata [ i ] := X;
- ydata [ i ] := Ymin;
- odd := false; { toggle flag }
- end
- else begin { generate an unwritten vector }
- xdata [ i ] := X;
- ydata [ i ] := Ymax;
- X := X + Xincrement; { set up for next line }
- odd := true; { toggle flag }
- end;
- { last of vertical lines }
-
- npoints := lastY; { tell it how many points }
- end; { with griddata }
- dashplot ( griddata ); { draw the lines }
- end;
-
-
-
- procedure linearaxes ( var plotdata : datablock );
- { draws the axes into the graph at the zero lines if they are in the range
- plotted else puts the axes at the edges of the plot. requires the min and
- max and scale data in the incoming block to operate }
-
- const ticsize = 0.01; { size of scale tick marks }
- numXtics = 10;
- numYtics = 10;
-
- var axesdata : datablock;
- i : integer;
- ticdev, x, y, xincrement, yincrement, xrun, yrun : real;
-
- begin
- with plotdata do
- begin
- axesdata.Xmin := Xmin; { copy required parameters }
- axesdata.Xmax := Xmax;
- axesdata.Ymin := Ymin;
- axesdata.Ymax := Ymax;
- axesdata.Xscale := Xscale;
- axesdata.Yscale := Yscale;
- end;
-
- with axesdata do
- begin { find where to put axes }
- if ( Ymax * Ymin ) < 0.0 { is Ymin < 0 < Ymax ? }
- then y := 0.0 { yes, put axis on it }
- else if Ymin >= 0.0 { no, is graph above the X axis }
- then y := Ymin { yes, put axis at the bottom }
- else y := Ymax; { no, put axis at the top }
-
- if ( Xmax * Xmin ) < 0.0 { is Xmin < 0 < Xmax ? }
- then x := 0.0 { yes, put axis on it }
- else if Xmin >= 0.0 { no, is graph right of Y axis }
- then x := Xmin { yes, put axis on left side }
- else x := Xmax; { no, put axis at the left }
-
-
- xincrement := ( Xmax - Xmin ) / numXtics; { calculate spacing }
- yincrement := ( Ymax - Ymin ) / numYtics;
-
- xrun := x; { initialize running variable }
- yrun := y;
-
- while ( xrun - xincrement ) > Xmin do { back up close to edge }
- xrun := xrun - xincrement;
-
- while ( yrun - yincrement ) > Ymin do
- yrun := yrun - yincrement;
-
- { set up to put X axis in }
- ticdev := ( Ymax - Ymin ) * ticsize; { scale the tics to the graph }
-
- npoints := 1; { init counter / index }
- xdata [ npoints ] := Xmin; { start at left edge }
- Ydata [ npoints ] := y;
-
- while xrun <= Xmax do
- begin { cross whole graph }
- npoints := npoints + 1;
- xdata [ npoints ] := xrun;
- ydata [ npoints ] := y;
-
- npoints := npoints + 1; { place top half of tic }
- xdata [ npoints ] := xrun;
- ydata [ npoints ] := y + ticdev;
-
- npoints := npoints + 1; { place bottom half of tic }
- xdata [ npoints ] := xrun;
- ydata [ npoints ] := y - ticdev;
-
- npoints := npoints + 1; { move back to the axis }
- xdata [ npoints ] := xrun;
- ydata [ npoints ] := y;
-
- xrun := xrun + xincrement; { advance to next tic }
- end;
-
- npoints := npoints +1;
- xdata [ npoints ] := Xmax; { make sure axis goes to edge }
- ydata [ npoints ] := y;
-
- end; { with axesdata }
-
- lineplot ( axesdata ); { draw x axis }
-
- with axesdata do
- begin
- npoints := 1; { init counter / index }
- ticdev := ( Xmax - Xmin ) * ticsize;
-
- xdata [ npoints ] := x; { start at bottom edge }
- ydata [ npoints ] := Ymin;
-
- while yrun <= Ymax do
- begin { cross whole graph }
- npoints := npoints + 1;
- xdata [ npoints ] := x;
- ydata [ npoints ] := yrun;
-
- npoints := npoints + 1; { place right half of tic }
- xdata [ npoints ] := x + ticdev;
- ydata [ npoints ] := yrun;
-
- npoints := npoints + 1; { place left half of tic }
- xdata [ npoints ] := x - ticdev;
- ydata [ npoints ] := yrun;
-
- npoints := npoints + 1; { move back to the axis }
- xdata [ npoints ] := x;
- ydata [ npoints ] := yrun;
-
- yrun := yrun + yincrement; { advance to next tic }
- end;
-
- npoints := npoints + 1; { make sure axis goes to edge }
- xdata [ npoints ] := x;
- ydata [ npoints ] := Ymax;
-
- end; { with axesdata }
-
- lineplot ( axesdata ); { draw y axis }
- end;
-
-
-
-
-
-
-
-
- procedure lincal ( var plotdata : datablock );
- { writes the mins and maxes in the corners of a linear plot }
-
- var x,y,n : integer;
- outstring : linestring;
-
- begin
- with plotdata do
- begin
- str ( Ymax:5, outstring ); { get string version of 1st }
- n := length ( outstring ); { how many chars }
- x := axesXmin - ( n + 1 ) * charwidth; { calc where to print it }
- y := axesYmax - lineheight div 2;
- writechar ( x,y,0,outstring ); { write it }
-
- str ( Ymin:5, outstring ); { get string version of 2nd }
- n := length ( outstring ); { how many chars }
- x := axesXmin - ( n + 1 ) * charwidth; { calc where to print it }
- y := axesYmin - lineheight div 2;
- writechar ( x,y,0,outstring ); { write it }
-
- str ( Xmin:5, outstring ); { get string version of 3rd }
- n := length ( outstring ); { how many chars }
- x := axesXmin - (( n * charwidth ) div 2 ); { calc where to put it }
- y := axesYmin - 2 * lineheight;
- writechar ( x,y,0, outstring ); { write it }
-
- str ( Xmax:4, outstring ); { get string version of 4th }
- n := length ( outstring ); { how many chars }
-
- x := axesXmax - (( n * charwidth ) div 2 ); { calc where to put it }
- if ( x + ( n + 1 ) * charwidth ) > plotXmax { make sure it fits }
- then x := plotXmax - ( n + 2 ) * charwidth; { no, make it fit! }
-
- y := axesYmin - 2 * lineheight;
- writechar ( x,y,0, outstring ); { write it }
- end;
- end;
-
-
-
-
- procedure semiloggrid ( var griddata : datablock );
- { plots the semi-log axes or grid from the limits in griddata }
-
- const hlines = 11;
-
- var hiX,loX, dectemp, decade, units, x, yrange, yincrement, y : real;
- i, n : integer;
-
- begin
- with griddata do
- begin
- i := 1; { init index counter }
- hiX := Xmax;
- loX := Xmin;
- decade := loX;
-
- { generate vertical lines first }
- while decade < hiX do { generate the decade loop }
- begin
- dectemp := pow ( decade ); { keep this out of the loop }
- units := 1.0;
-
- while units <= 9.0 do
- begin
- x:= log ( units * dectemp);
- xdata [ i ] := x;
- ydata [ i ] := Ymin;
- i := i + 1; { increment index }
-
- xdata [ i ] := x;
- ydata [ i ] := Ymax;
- i := i + 1;
-
- units := units + 1.0; { increment units }
- end;
-
- decade := decade + 1.0; { increment power of ten }
- end;
-
- if x < Xmax { is log axis complete ? }
- then begin
- xdata [ i ] := Xmax; { no, put in last line }
- ydata [ i ] := Ymax;
- i := i + 1;
- xdata [ i ] := Xmax;
- ydata [ i ] := Ymin;
- i := i + 1;
- end;
-
- { now do the horizontal lines }
- yrange := Ymax - Ymin;
- yincrement := Yrange / ( hlines - 1 ); { calculate the spacing }
- y := Ymin; { init the running pointer }
-
- for n := 1 to hlines do
- begin
- xdata [ i ] := Xmax; { generate line vectors }
- ydata [ i ] := y;
- i := i + 1; { increment index counter }
-
- xdata [ i ] := Xmin;
- ydata [ i ] := y;
- i := i + 1;
- y := y + yincrement; { set up for next line }
- end;
-
- npoints := i - 1; { save point count in block }
-
- end; { with }
-
- dashplot ( griddata ); { draw the vectors }
- end;
-
-
-
-
-
-
- procedure semilogcal ( var plotdata : datablock );
- { writes the mins and maxes in the corners of the plot on a semilog plot }
-
- var x,y,n,temp : integer;
- outstring, digstring : linestring;
-
- begin
- with plotdata do
- begin
- str ( Ymax:5, outstring ); { get string version of 1st }
- n := length ( outstring ); { how many chars }
- x := axesXmin - ( n + 1 ) * charwidth; { calc where to print it }
- y := axesYmax - lineheight div 2;
- writechar ( x,y,0,outstring ); { write it }
-
- str ( Ymin:5, outstring ); { get string version of 2nd }
- n := length ( outstring ); { how many chars }
- x := axesXmin - ( n + 1 ) * charwidth; { calc where to print it }
- y := axesYmin - lineheight div 2;
- writechar ( x,y,0,outstring ); { write it }
-
- outstring := '10 E'; { start horizontal label }
- temp := round ( Xmin );
- str ( temp, digstring ); { get string version }
- outstring := outstring + digstring;
- n := length ( outstring ); { how many chars }
- x := axesXmin - (( n * charwidth ) div 2 ); { calc where to put it }
- y := axesYmin - 2 * lineheight;
- writechar ( x,y,0, outstring ); { write it }
-
- outstring := '10 E';
- temp := round ( Xmax );
- str ( temp, digstring ); { get string version }
- outstring := outstring + digstring;
- n := length ( outstring ); { how many chars }
-
- x := axesXmax - (( n * charwidth ) div 2 ); { calc where to put it }
- if ( x + ( n + 1 ) * charwidth ) > plotXmax { make sure it fits }
- then x := plotXmax - ( n + 2 ) * charwidth; { no, make it fit! }
-
- y := axesYmin - 2 * lineheight;
- writechar ( x,y,0, outstring ); { write it }
- end;
- end;
-
-
-
- procedure loglogcal ( var plotdata : datablock );
- { writes the mins and maxes in the corners of the plot on a log-log plot }
-
- var x,y,n,temp : integer;
- outstring, digstring : linestring;
-
- begin
- with plotdata do
- begin
- outstring := '10 E'; { get first part of label }
- temp := round ( Ymax ); { get value for exponent }
- str (temp, digstring ); { get string version of exp }
- outstring := outstring + digstring; { combine them }
- n := length ( outstring ); { how many chars }
- x := axesXmin - ( n + 1 ) * charwidth; { calc where to print it }
- y := axesYmax - lineheight div 2;
- writechar ( x,y,0,outstring ); { write it }
-
- outstring := '10 E'; { get first part of label }
- temp := round ( Ymin ); { get value for exponent }
- str (temp, digstring ); { get string version of exp }
- outstring := outstring + digstring; { combine them }
- n := length ( outstring ); { how many chars }
- x := axesXmin - ( n + 1 ) * charwidth; { calc where to print it }
- y := axesYmin - lineheight div 2;
- writechar ( x,y,0,outstring ); { write it }
-
- outstring := '10 E'; { start horizontal label }
- temp := round ( Xmin );
- str ( temp, digstring ); { get string version }
- outstring := outstring + digstring;
- n := length ( outstring ); { how many chars }
- x := axesXmin - (( n * charwidth ) div 2 ); { calc where to put it }
- y := axesYmin - 2 * lineheight;
- writechar ( x,y,0, outstring ); { write it }
-
- outstring := '10 E';
- temp := round ( Xmax );
- str ( temp, digstring ); { get string version }
- outstring := outstring + digstring;
- n := length ( outstring ); { how many chars }
-
- x := axesXmax - (( n * charwidth ) div 2 ); { calc where to put it }
- if ( x + ( n + 1 ) * charwidth ) > plotXmax { make sure it fits }
- then x := plotXmax - ( n + 2 ) * charwidth; { no, make it fit! }
-
- y := axesYmin - 2 * lineheight;
- writechar ( x,y,0, outstring ); { write it }
- end;
- end;
-
-
-
- procedure logloggrid ( var griddata : datablock );
- { plots the log-log grid from the limits in griddata }
-
- var dectemp, decade, units, x, y : real;
- i, n : integer;
-
- begin
- with griddata do
- begin
- i := 1; { init index counter }
- decade := Xmin;
-
- { generate vertical lines first }
- while decade < Xmax do { generate the decade loop }
- begin
- dectemp := pow ( decade ); { keep this out of the loop }
- units := 1.0;
-
- while units <= 9.0 do
- begin
- x:= log ( units * dectemp);
- xdata [ i ] := x;
- ydata [ i ] := Ymin;
- i := i + 1; { increment index }
-
- xdata [ i ] := x;
- ydata [ i ] := Ymax;
- i := i + 1;
-
- units := units + 1.0; { increment units }
- end;
-
- decade := decade + 1.0; { increment power of ten }
- end;
-
- if x < Xmax { is log axis complete ? }
- then begin
- xdata [ i ] := Xmax; { no, put in last line }
- ydata [ i ] := Ymax;
- i := i + 1;
- xdata [ i ] := Xmax;
- ydata [ i ] := Ymin;
- i := i + 1;
- end;
-
- { now do the horizontal lines }
- decade := Ymin;
-
- while decade < Ymax do { generate the decade loop }
- begin
- dectemp := pow ( decade ); { keep this out of the loop }
- units := 1.0;
-
- while units <= 9.0 do
- begin
- y:= log ( units * dectemp);
- xdata [ i ] := Xmin;
- ydata [ i ] := y;
- i := i + 1; { increment index }
-
- xdata [ i ] := Xmax;
- ydata [ i ] := y;
- i := i + 1;
-
- units := units + 1.0; { increment units }
- end;
-
- decade := decade + 1.0; { increment power of ten }
- end;
-
- if y < Ymax { is log grid complete ? }
- then begin
- xdata [ i ] := Xmax; { no, put in last line }
- ydata [ i ] := Ymax;
- i := i + 1;
- xdata [ i ] := Xmin;
- ydata [ i ] := Ymax;
- i := i + 1;
- end;
-
-
- npoints := i - 1; { save point count in block }
-
- end; { with }
-
- dashplot ( griddata ); { draw the vectors }
- end;
-
-
-
- procedure logplot ( var plotstuff : datablock; Hname,Vname : linestring );
- { generates a log log plot of the data in plotstuff }
-
- var gridstuff : datablock;
- temp : real;
- i : integer;
- label exit;
- begin
- limits ( plotstuff ); { find the mins and maxs }
-
- if plotstuff.Xmin <= 0.0 { make sure legal for log }
- then begin writeln ('Xmin <= 0, can''t take log for log plot');
- goto exit;
- end;
-
- if plotstuff.Ymin <= 0.0 { make sure legal for log }
- then begin writeln ('Ymin <= 0, can''t take log for log plot');
- goto exit;
- end;
-
- edlimits ( plotstuff ); { allow user chance to change }
-
- if plotstuff.Xmin <= 0.0 { make sure legal for log }
- then begin writeln ('Xmin <= 0, can''t take log for log plot');
- goto exit;
- end;
-
- if plotstuff.Ymin <= 0.0 { make sure legal for log }
- then begin writeln ('Ymin <= 0, can''t take log for log plot');
- goto exit;
- end;
-
- with plotstuff do
- begin { set up mins and maxes so grid comes out right }
-
- temp := log ( Xmin );
- if temp >= 0.0
- then Xmin := int ( temp ) { get the plotting min for >1 }
- else if frac ( temp ) = 0.0 { or for 0 < Xmin < 1 }
- then Xmin := int ( temp )
- else Xmin := int ( temp ) - 1.0;
-
- temp := log ( Xmax );
- Xmax := int ( temp ); { and max }
- if frac ( temp ) > 0.0
- then Xmax := Xmax + 1.0; { if any decimal part,use whole }
-
- temp := log ( Ymin );
- if temp >= 0.0
- then Ymin := int ( temp ) { get the plotting min for >1 }
- else if frac ( temp ) = 0.0 { or for 0 < Ymin < 1 }
- then Ymin := int ( temp )
- else Ymin := int ( temp ) - 1.0;
-
- temp := log ( Ymax );
- Ymax := int ( temp ); { and max }
- if frac ( temp ) > 0.0
- then Ymax := Ymax + 1.0; { if any decimal part,use whole }
-
- gridstuff.Ymax := Ymax; { copy the Y limits over }
- gridstuff.Ymin := Ymin;
- gridstuff.Xmax := Xmax; { copy the X limits over }
- gridstuff.Xmin := Xmin;
- writeln('converting data array ');
- for i := 1 to npoints do
- begin
- xdata [ i ] := log ( xdata [ i ] ); { translate linear to log }
- ydata [ i ] := log ( ydata [ i ] );
- end;
-
- scalecalc ( false, plotstuff ); { figure out the scale factors }
- gridstuff.xscale := xscale; { copy the scale factors over }
- gridstuff.yscale := yscale;
- end;
-
- writeln (' generating grid coords ');
- logloggrid ( gridstuff ); { draw the grid }
- lineplot ( plotstuff ); { plot the transformed data }
- loglogcal ( plotstuff ); { put the limits on the graph }
- Htitle ( 200,Hname ); { put names on the axes }
- Vtitle ( 200,Vname );
- exit : end;
-
-
-
-
- procedure semilogplot ( var plotstuff : datablock; Hname,Vname : linestring );
- { generates a semi-logarithmic plot of the data in plotstuff }
-
- var gridstuff : datablock;
- temp : real;
- i : integer;
-
- label exit;
-
- begin
- limits ( plotstuff ); { find the mins and maxs }
-
- if plotstuff.Xmin <= 0.0 { make sure legal for log }
- then begin writeln ('Xmin <= 0, can''t take log for semilog plot');
- goto exit;
- end;
-
- edlimits ( plotstuff ); { allow user chance to change }
-
- if plotstuff.Xmin <= 0.0 { make sure legal for log }
- then begin writeln ('Xmin <= 0, can''t take log for semilog plot');
- goto exit;
- end;
-
- with plotstuff do
- begin
-
- temp := log ( Xmin );
- if temp >= 0.0
- then Xmin := int ( temp ) { get the plotting min for >0 }
- else if frac ( temp ) = 0.0 { or for negative }
- then Xmin := int ( temp )
- else Xmin := int ( temp ) - 1.0;
-
- temp := log ( xmax );
- Xmax := int ( temp ); { and max }
- if frac ( temp ) > 0.0
- then Xmax := Xmax + 1.0; { if any decimal part,use whole }
-
- gridstuff.Ymax := Ymax; { copy the Y limits over }
- gridstuff.Ymin := Ymin;
- gridstuff.Xmax := Xmax; { copy the X limits over }
- gridstuff.Xmin := Xmin;
-
- writeln ('converting X data to log ');
- for i := 1 to npoints do
- xdata [ i ] := log ( xdata [ i ] ); { translate linear to log }
-
- scalecalc ( false, plotstuff ); { figure out the scale factors }
- gridstuff.xscale := xscale; { copy the scale factors over }
- gridstuff.yscale := yscale;
- end;
-
- semiloggrid ( gridstuff ); { draw the grid }
- lineplot ( plotstuff ); { plot the transformed data }
- semilogcal ( plotstuff ); { put the limits on the graph }
- Htitle ( 200,Hname ); { put names on the axes }
- Vtitle ( 200,Vname );
- exit : end;
-
-
-
- procedure linearplot ( var plotstuff : datablock; Hname,Vname : linestring; grid,square : boolean );
- { plots the data in plotstuff on a linear graph. Writes Hname and Vname in the
- appropriate margins and writes the limits in the margins too. If grid, a
- regular graph paper type grid is drawn, else a line at the zeros or closest
- to zero on graph is drawn. If square, scale factors are forced to the minimum
- of X or Y and both are equal. useful for circles or true geometries }
-
- begin
- limits ( plotstuff ); { scan for mins and maxes }
- edlimits ( plotstuff ); { allow user to change limits }
- scalecalc ( false, plotstuff ); { calculate the scale factors }
-
- if grid { use grid or axes ? }
- then lineargrid ( plotstuff )
- else linearaxes ( plotstuff );
-
- lineplot ( plotstuff ); { plot the data itself }
- lincal ( plotstuff ); { put values at the axes }
- vtitle ( 200,Vname); { put labels on the axes }
- htitle ( 200,Hname);
- end;
-
-
-
-
- begin { initialization }
- assign ( aux, 'com1' ); { open the file for plotter i/o }
- rewrite ( aux );
- write ( aux, esc, device, plotteron );
-
- lastX := plotXmax; { init previous position vars }
- lastY := plotYmax;
- scaleX := actualX / ( plotXmax - plotXmin ); { inches / integer }
- scaleY := actualY / ( plotYmax - plotYmin );
-
- end.