home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / math / rcdsplay / axislbl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-30  |  9.1 KB  |  215 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
  2. {$M 16384,0,655360}
  3. {*****************************************************************************
  4.   TITLE:    AXISLBL
  5.   VERSION:  2.6
  6.   FUNCTION: Axis labeling routine for use with a graphics window.  This
  7.             routine determines the appropriate spacing for tic-marks on the
  8.             axis and then labels them.
  9.   INPUTS:   Graphics window file, extreme points for both axes, labels for
  10.             both axes.
  11.   OUTPUTS:  Tic marks and labels for both axes.
  12.   AUTHOR:   M. Riebe (Modified by R. Carlson for Turbo Pascal)
  13.   CHANGES:  6/20/85 RJC - New misfuncs version 1.6.
  14.             6/23/85 RJC - New misfuncs version 1.7
  15.             7/1/85  MTR: Cleaned up the tic marks at the beginning and end 
  16.                          of axes.
  17.             9/24/85 RJC - New rcgraf version 1.2.
  18.             9/25/85 RJC - New misfuncs version 1.8.
  19.             10/26/85 RJC: New grafuncs version 2.2 and misfuncs version 2.0.
  20.             11/24/85 RJC: New misfuncs version 2.1.
  21.             12/10/85 MTR: Added some comments in the code and put tic marks
  22.                           on the top and right borders, moved axis labels so
  23.                           that unit multipliers didn't go offscreen.
  24.              1/05/86 RJC: New version of misfuncs (2.2).
  25.              1/17/86 RJC: New version of misfuncs (2.3).
  26.              2/04/86 RJC: Totally revised AXIS to make it more modular.
  27.                           Moved STR40 declaration to misfuncs.
  28.              6/13/86 RJC: New versions.
  29.              7/09/86 RJC: New versions.
  30.              8/26/86 RJC: New versions.
  31.              12/1/86 RJC: New versions.
  32.              5/31/90 RJC: Converted to Turbo Pascal.
  33.              2/15/91 RJC: Added CLRBOX procedure.
  34. *****************************************************************************}
  35.  
  36. UNIT axislbl;
  37.  
  38. INTERFACE
  39.  
  40. USES IOFUNCS; {VERSION 1.1}
  41.  
  42. PROCEDURE axis(LEFT,RIGHT,BOT,TOP:DOUBLE;
  43.                LEFTSC,RIGHTSC,BOTSC,TOPSC:INTEGER;
  44.                xlabel,ylabel:STR40);
  45. PROCEDURE CLRBOX(X0,Y0,X1,Y1:INTEGER; BOX:BOOLEAN);
  46.   {This procedure clears the specified box and draws a box around it if
  47.    BOX is true.}
  48.  
  49. IMPLEMENTATION
  50.  
  51. USES GRAPH,
  52.      MATH;     {VERSION 1.0}
  53.  
  54. {*********************** PROCEDURE CLRBOX ******************************}
  55. PROCEDURE CLRBOX(X0,Y0,X1,Y1:INTEGER; BOX:BOOLEAN);
  56.   {This procedure clears the specified box and draws a box around it if
  57.    BOX is true.}
  58. BEGIN
  59.   SETVIEWPORT(X0,Y0,X1,Y1,CLIPON); CLEARVIEWPORT;
  60.   SETVIEWPORT(0,0,GETMAXX,GETMAXY,CLIPON);
  61.   IF BOX THEN RECTANGLE(X0,Y0,X1,Y1);
  62. END;
  63.  
  64. {******************************************************************************
  65.  TITLE   : PROCEDURE axis(LEFT,RIGHT,BOT,TOP:DOUBLE;
  66.                           LEFTSC,RIGHTSC,BOTSC,TOPSC:INTEGER;
  67.                           xlabel,ylabel:STR40);
  68.  FUNCTION:  Labels x and y axes for a plot contained in a given graphics window,
  69.             and puts tic marks at appropriate spacings for >=5 labeled points
  70.             per axis.
  71.  AUTHOR  : MTR/RJC
  72.  INPUTS  :BOTSC, TOPSC    - bottom & top vertical plot boundaries
  73.           LEFTSC, RIGHTSC - left & right horizontal plot boundaries
  74.  NOTES   : 1. The tick labels are in engineering notation except when the power
  75.               is 3 in which case the numbers are writen out in full.
  76.            2. If a label does not fit on the screen then it is not placed on
  77.               the screen at all.
  78.  CHANGES : 12/10/85 MTR: Added comments in code and tic marks on top and right
  79.                          boundaries, moved axes labels so that multipliers fit
  80.                          on the screen.
  81.             2/04/86 RJC: Totally revised.
  82.             5/31/90 RJC: Translated to Turbo Pascal.
  83. ******************************************************************************}
  84. PROCEDURE AXIS;
  85.  
  86. CONST  MINTICKS=10;   {minimum # of ticks, large and small}
  87.  
  88. VAR
  89.   MANT                   : DOUBLE;  {engineering notation mantissa}
  90.   MINXTICKS              : INTEGER; {min # large ticks between labels}
  91.   MULT                   : LONGINT; {loop counter}
  92.   ST1, ST2               : STR80;   {general usage strings}
  93.   TICKSIZE               : INTEGER; {length of ticks}
  94.   UC                     : DOUBLE;  {tick position in user coord.}
  95.   XDEC, YDEC             : INTEGER; {# digits to right of decimal to display}
  96.   XINCR, YINCR           : DOUBLE;  {tick separation in user coordinates}
  97.   XMAX, XMIN             : DOUBLE;  {max & min of x axis}
  98.   XPOS, YPOS             : INTEGER; {operating point coordinates}
  99.   XPOWER, YPOWER         : LONGINT; {power of 10 for x and y axes}
  100.   YMAX, YMIN             : DOUBLE;  {max & min of y axis}
  101.  
  102.   PROCEDURE CREATSTRINGS(ST:STR40; POWER:LONGINT; VAR ST1,ST2:STR80);
  103.   BEGIN
  104.     ST1:=ST;
  105.     IF POWER<>0 THEN BEGIN
  106.       ST1:=CONCAT(ST1,' X10');
  107.       STR(-1*POWER:5,ST2);
  108.       WHILE ST2[1]=' ' DO DELETE(ST2,1,1);
  109.       END {IF}
  110.     ELSE ST2:='';
  111.   END; {PROCEDURE CREATSTRINGS}
  112.  
  113.   FUNCTION XCOORDSC(UC:DOUBLE):INTEGER; BEGIN
  114.     XCOORDSC:=ROUND( (UC-LEFT)/(RIGHT-LEFT) * (RIGHTSC-LEFTSC) + LEFTSC);
  115.   END; {FUNCTION}
  116.  
  117.   FUNCTION YCOORDSC(UC:DOUBLE):INTEGER; BEGIN
  118.     YCOORDSC:=ROUND( (UC-BOT)/(TOP-BOT) * (TOPSC-BOTSC) + BOTSC);
  119.   END; {FUNCTION}
  120.  
  121. BEGIN
  122.   {determine extreme values}
  123.     IF RIGHT>LEFT THEN BEGIN XMAX:=RIGHT; XMIN:=LEFT; END
  124.     ELSE BEGIN XMAX:=LEFT; XMIN:=RIGHT; END;
  125.     IF TOP>BOT THEN BEGIN YMAX:=TOP; YMIN:=BOT; END
  126.     ELSE BEGIN YMAX:=BOT; YMIN:=TOP; END;
  127.   {calculate appropriate power for both scales}
  128.     IF ABS(LEFT)>ABS(RIGHT) THEN ENGNOT(LEFT,MANT,XPOWER)
  129.     ELSE ENGNOT(RIGHT,MANT,XPOWER);
  130.     IF ABS(TOP)>ABS(BOT) THEN ENGNOT(TOP,MANT,YPOWER)
  131.     ELSE ENGNOT(BOT,MANT,YPOWER);
  132.     IF XPOWER=3 THEN XPOWER:=0; IF YPOWER=3 THEN YPOWER:=0;
  133.   {calculate tick spacing}
  134.     XINCR:=CALCINCR(ABS(LEFT-RIGHT)/(MINTICKS-1));
  135.     YINCR:=CALCINCR(ABS(TOP-BOT)/(MINTICKS-1));
  136.   {calculate # of decimals to be output}
  137.     XDEC:=NUMDEC(2*XINCR/PWROF10(XPOWER));
  138.     YDEC:=NUMDEC(2*YINCR/PWROF10(YPOWER));
  139.   {put overall x label on screen if possible}
  140.     CREATSTRINGS(XLABEL,XPOWER,ST1,ST2);
  141.     SETTEXTJUSTIFY(LEFTTEXT,BOTTOMTEXT);
  142.     SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);  {horizontal text}
  143.     XPOS:=((LEFTSC+RIGHTSC) DIV 2) - ROUND((LENGTH(ST1)+LENGTH(ST2))*4);
  144.     YPOS:=BOTSC+32;    {4 lines below x axis}
  145.     IF (XPOS>=0) AND (YPOS<=GETMAXY) AND
  146.       (XPOS+(LENGTH(ST1)+LENGTH(ST2))*9<=GETMAXX) THEN BEGIN
  147.       MOVETO(XPOS,YPOS); OUTTEXT(ST1);
  148.       XPOS:=GETX; YPOS:=GETY;
  149.       OUTTEXTXY(XPOS,YPOS-8,ST2); {exponent}
  150.       END; {IF}
  151.   {put overall y label on screen if possible}
  152.     CREATSTRINGS(YLABEL,YPOWER,ST1,ST2);
  153.     SETTEXTJUSTIFY(LEFTTEXT,BOTTOMTEXT);
  154.     SETTEXTSTYLE(DEFAULTFONT,VERTDIR,1); {vertical text}
  155.     YPOS:=(BOTSC+TOPSC) DIV 2 + ROUND((LENGTH(ST1)+LENGTH(ST2))*4);
  156.     XPOS:=LEFTSC-(YDEC+8)*8-8;
  157.     IF XPOS<8 THEN XPOS:=8;
  158.     IF (ST2<>'') AND (XPOS<16) THEN XPOS:=16;
  159.     IF (YPOS<=BOTSC) AND (YPOS-(LENGTH(ST1)+LENGTH(ST2))*8>=TOPSC) THEN BEGIN
  160.       MOVETO(XPOS,YPOS); OUTTEXT(ST1);
  161.       XPOS:=GETX-8; YPOS:=GETY-LENGTH(ST1)*8;
  162.       OUTTEXTXY(XPOS,YPOS,ST2);
  163.       END; {IF}
  164.   {calculate minimum # of large ticks between x axis labeled ticks}
  165.     MINXTICKS:=1;
  166.     IF ABS(XMAX)>ABS(XMIN) THEN STR(XMAX/PWROF10(XPOWER):XDEC+8:XDEC,ST1)
  167.     ELSE STR(XMIN/PWROF10(XPOWER):XDEC+8:XDEC,ST1);
  168.     WHILE ST1[1]=' ' DO DELETE(ST1,1,1);
  169.     WHILE ((LENGTH(ST1)+2)*9) >
  170.           (2*XINCR*ABS((RIGHTSC-LEFTSC)/(RIGHT-LEFT))*MINXTICKS)
  171.       DO MINXTICKS:=MINXTICKS+1;
  172.   {add x axis ticks and labels}
  173.     FOR MULT:=ROUND((XMIN-XINCR)/XINCR) TO ROUND((XMAX+XINCR)/XINCR) DO BEGIN
  174.       UC:=MULT*XINCR;
  175.       SETTEXTJUSTIFY(CENTERTEXT,TOPTEXT);
  176.       SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  177.       IF (UC<=XMAX) AND (UC>=XMIN) THEN BEGIN
  178.         IF MULT MOD 2 = 0 THEN BEGIN {large tick}
  179.           TICKSIZE:=6;
  180.           IF (MULT DIV 2) MOD MINXTICKS = 0 THEN BEGIN {label the tick}
  181.             STR(UC/PWROF10(XPOWER):XDEC+8:XDEC,ST1);
  182.             WHILE ST1[1]=' ' DO DELETE(ST1,1,1);
  183.             XPOS:=XCOORDSC(UC); YPOS:=BOTSC+4;
  184.             IF (XPOS+LENGTH(ST1)*4)<GETMAXX THEN OUTTEXTXY(XPOS,YPOS,ST1);
  185.             END; {IF}
  186.           END {IF}
  187.         ELSE TICKSIZE:=3; {small tick}
  188.         XPOS:=XCOORDSC(UC);
  189.         LINE(XPOS,BOTSC,XPOS,BOTSC-TICKSIZE);
  190.         LINE(XPOS,TOPSC,XPOS,TOPSC+TICKSIZE);
  191.         END; {IF}
  192.       END; {FOR}
  193.   {add y axis ticks and labels}
  194.     FOR MULT:=ROUND((YMIN-YINCR)/YINCR) TO ROUND((YMAX+YINCR)/YINCR) DO BEGIN
  195.       UC:=MULT*YINCR;
  196.       SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  197.       SETTEXTJUSTIFY(RIGHTTEXT,CENTERTEXT);
  198.       IF (UC<=YMAX) AND (UC>=YMIN) THEN BEGIN
  199.         IF MULT MOD 2 = 0 THEN BEGIN {large tick}
  200.           TICKSIZE:=6;
  201.           STR(UC/PWROF10(YPOWER):YDEC+8:YDEC,ST1);
  202.           WHILE ST1[1]=' ' DO DELETE(ST1,1,1);
  203.           XPOS:=LEFTSC-8;   YPOS:=YCOORDSC(UC);
  204.           OUTTEXTXY(XPOS,YPOS,ST1);
  205.           END {IF}
  206.         ELSE TICKSIZE:=3; {small tick}
  207.         YPOS:=YCOORDSC(UC);
  208.         LINE(LEFTSC,YPOS,LEFTSC+TICKSIZE,YPOS);
  209.         LINE(RIGHTSC,YPOS,RIGHTSC-TICKSIZE,YPOS);
  210.         END; {IF}
  211.       END; {FOR}
  212. END; {PROCEDURE AXIS}
  213.  
  214. END.
  215.