{************************************************************************ * * * Copyright 1984 by * * Thomas E. Speer * * All rights reserved * * * * This file provides the ability to draw graphics characters, * * plot axes, and do whole rectangular grids. * * * ************************************************************************} {------------------------------------------------------------------------} PROCEDURE chset( xsize, ysize, theta: REAL ); { This procedure sets the character size and orientation inputs: xsize horizontal size of character ysize vertical size of character theta clockwise rotation of character (0 := upright) outputs: none returned } VAR t: REAL; BEGIN chxsz := xsize; chysz := ysize; chrot := theta; t := theta/57.29578; scale[3] := cos( t ); scale[4] := sin( t ); END; {------------------------------------------------------------------------} FUNCTION posang ( angle:REAL ):REAL; { This function returns an angle that is in the range 0 to 360 deg. inputs: angle angle to be converted outputs: posang converted angle } BEGIN IF ( (angle < 360.0) AND (angle >= 0.0)) THEN posang := angle ELSE BEGIN angle := angle - 360.0 * Trunc(angle/360.0); IF (angle < 0.0 ) THEN angle := angle + 360.; posang := angle; END END; {------------------------------------------------------------------------} PROCEDURE ticend( rmin,rmax, dr:REAL; VAR pr1,pr2:REAL ); { This function calculates endpoints which are multiples of dr and lie between rmin and rmax. inputs: rmin,rmax range of values along axis dr increment used for axis outputs: *pr1,*pr2 new values corresponding to rmin,rmax } VAR r1,r2:REAL; BEGIN r1 := Trunc( rmin/dr) * dr; r2 := Trunc( rmax/dr) * dr; IF ( (r1 < 0.0) OR (r2 < 0.0) ) THEN BEGIN IF ((r1>0.0) OR (r2>0.0)) THEN BEGIN pr1 := r1; pr2 := r2; END ELSE BEGIN IF ((dr<0.0) AND (r1>rmin)) THEN r1 := r1 + dr; IF ((dr>0.0) AND (r2>rmax)) THEN r2 := r2 - dr; END END ELSE BEGIN IF ((dr>0.0) AND (r1 0.18) THEN dx := 2.; IF (dxmant > 0.40) THEN dx := 5.; IF (dxmant > 0.88) THEN dx := 10.0; dx := dx * exp( ln10*dxexp ) * xlen/Abs( xlen ); dxlog := xlen; { how many digits in numbers? } IF (x1 <> 0.0) THEN BEGIN t := Abs( x1); IF (t > dxlog) THEN dxlog :=t; END; IF (x2 <> 0.0) THEN BEGIN t := Abs( x2); IF (t > dxlog) THEN dxlog := t; END; dxlog := ln(dxlog)/ln10; IF (dxlog > 0.0 ) THEN lblnum := Trunc( dxlog + 1.0 ) ELSE lblnum := 0; dxlog := Abs( xlen); { now get f format spec } IF (x1 <> 0.0) THEN BEGIN t := Abs( x1); IF (t < dxlog) THEN dxlog := t; END; IF (x2 <> 0.0) THEN BEGIN t := Abs( x2); IF (t < dxlog) THEN dxlog := t; END; t := Abs( dx); IF (t < dxlog) THEN dxlog := t; dxlog := ln(dxlog)/ln10; IF (dxlog < 0.0) THEN lbldec := Trunc( -dxlog + 1.0 ) ELSE lbldec := 0; lblnum := lblnum + lbldec + 2; dxdy := dx; END END; {------------------------------------------------------------------------} PROCEDURE gchar( cx,cy:REAL ;charin:CHAR ); { This procedure will plot a graphic character at an arbitrary size and orientation. inputs: cx,cy coordinates for lower left corner of char. charin character to be plotted outputs: none returned Note: The elements of tchar have a specific format. The lower 4 bits contain the Y coordinate, the next 3 bits the X coordinate, and the high bit indicates whether or not the byte corresponds to a move or a line ("pen up" or "pen down"). The value 255 signals the end of the sequence of segments for a character. } CONST tchar:ARRAY [1..721] of BYTE = ( { 721 elements } 255, 56, 181, 51, 178, 255, 40, 166, 72, 198, 255, 40, 162, 72, 194, 6, 230, 4, 228, 255, 56, 178, 87, 151, 134, 149, 213, 228, 211, 147, 255, 104, 130, 8, 168, 166, 134, 136, 68, 228, 226, 194, 196, 255, 98, 151, 168, 184, 199, 198, 148, 147, 162, 178, 212, 255, 6, 151, 152, 136, 135, 151, 255, 72, 182, 180, 194, 255, 40, 182, 180, 162, 255, 21, 213, 39, 195, 71, 163, 255, 55, 179, 21, 213, 255, 17, 162, 163, 147, 146, 162, 255, 21, 213, 255, 34, 163, 147, 146, 162, 255, 88, 146, 255, 40, 200, 214, 212, 194, 162, 148, 150, 168, 255, 38, 184, 178, 34, 194, 255, 23, 168, 200, 215, 214, 147, 146, 210, 255, 23, 168, 200, 215, 214, 197, 212, 211, 194, 162, 147, 255, 72, 194, 55, 148, 212, 255, 88, 152, 150, 198, 213, 211, 194, 162, 147, 255, 87, 200, 168, 151, 147, 162, 194, 211, 212, 197, 165, 148, 255, 24, 216, 162, 255, 37, 197, 212, 211, 194, 162, 147, 148, 165, 150, 151, 168, 200, 215, 214, 197, 255, 19, 162, 194, 211, 215, 200, 168, 151, 150, 165, 197, 214, 255, 23, 167, 166, 150, 151, 20, 164, 163, 147, 148, 255, 17, 162, 163, 147, 146, 162, 22, 166, 165, 149, 150, 255, 87, 149, 211, 255, 22, 214, 20, 212, 255, 23, 213, 147, 255, 23, 168, 200, 215, 214, 180, 50, 177, 255, 23, 168, 200, 215, 211, 194, 162, 147, 148, 165, 181, 178, 255, 2, 184, 226, 20, 212, 255, 5, 197, 212, 211, 194, 130, 136, 200, 215, 214, 197, 255, 87, 200, 152, 135, 131, 146, 194, 211, 255, 2, 136, 200, 214, 212, 194, 130, 255, 88, 136, 130, 210, 53, 133, 255, 88, 136, 130, 53, 133, 255, 87, 200, 152, 135, 131, 146, 194, 211, 213, 181, 255, 2, 136, 88, 210, 85, 133, 255, 40, 200, 56, 178, 34, 194, 255, 20, 147, 162, 178, 195, 200, 56, 216, 255, 8, 130, 88, 133, 210, 255, 24, 146, 210, 255, 2, 136, 181, 232, 226, 255, 2, 136, 226, 232, 255, 7, 152, 216, 231, 227, 210, 146, 131, 135, 255, 2, 136, 200, 215, 214, 197, 133, 255, 7, 152, 216, 231, 228, 194, 146, 131, 135, 68, 226, 255, 2, 136, 200, 215, 214, 197, 133, 53, 210, 255, 87, 200, 152, 135, 134, 149, 197, 212, 211, 194, 146, 131, 255, 8, 232, 56, 178, 255, 24, 147, 162, 194, 211, 216, 255, 8, 178, 232, 255, 8, 146, 181, 210, 232, 255, 8, 226, 104, 130, 255, 24, 180, 178, 88, 180, 255, 8, 232, 130, 226, 255, 88, 184, 178, 210, 255, 24, 210, 255, 24, 184, 178, 146, 255, 22, 184, 214, 255, 0, 224, 255, 102, 215, 216, 232, 231, 215, 255, 5, 150, 182, 197, 195, 178, 146, 131, 148, 196, 67, 210, 255, 24, 146, 194, 211, 212, 197, 149, 255, 85, 165, 148, 147, 162, 210, 255, 88, 210, 162, 147, 148, 165, 213, 255, 82, 162, 147, 148, 165, 197, 212, 148, 255, 87, 200, 184, 167, 162, 21, 197, 255, 17, 160, 176, 193, 197, 165, 148, 147, 162, 194, 255, 18, 152, 21, 181, 196, 194, 255, 50, 181, 55, 184, 255, 18, 145, 160, 176, 193, 197, 71, 200, 255, 24, 146, 20, 199, 37, 210, 255, 40, 184, 178, 34, 194, 255, 2, 133, 4, 149, 165, 180, 178, 52, 197, 213, 228, 226, 255, 18, 149, 20, 165, 197, 212, 210, 255, 20, 165, 197, 212, 211, 194, 162, 147, 148, 255, 16, 149, 197, 212, 211, 194, 146, 255, 80, 213, 165, 148, 147, 162, 210, 255, 18, 149, 20, 165, 181, 196, 255, 19, 162, 194, 211, 196, 164, 149, 166, 198, 213, 255, 40, 163, 178, 194, 211, 212, 22, 182, 255, 21, 147, 162, 194, 211, 213, 83, 226, 255, 21, 178, 213, 255, 21, 162, 180, 194, 213, 255, 21, 194, 18, 197, 255, 21, 178, 85, 178, 161, 144, 255, 21, 213, 146, 210, 255, 72, 184, 167, 166, 149, 164, 163, 178, 194, 255, 48, 184, 255, 40, 184, 199, 198, 213, 196, 195, 178, 162, 255, 7, 152, 168, 198, 214, 231, 255 ); ichar:ARRAY [1..95] of INTEGER = ( { 95 elements } 1, 2, 7, 12, 21, 32, 45, 57, 64, 69, 74, 81, 86, 93, 96, 102, 105, 115, 121, 130, 142, 148, 158, 171, 175, 192, 205, 216, 228, 232, 237, 241, 250, 263, 269, 281, 290, 298, 305, 311, 322, 329, 336, 345, 351, 355, 361, 366, 376, 384, 396, 406, 419, 424, 431, 435, 441, 446, 452, 457, 462, 465, 470, 474, 477, 484, 497, 505, 512, 520, 529, 537, 548, 555, 560, 569, 576, 582, 595, 603, 613, 621, 629, 636, 647, 656, 665, 669, 675, 680, 687, 692, 702, 705, 715 ); VAR schar,cmd,ix,iy: BYTE; i: INTEGER; x,y,t: REAL; BEGIN schar := Ord(charin) AND 127; IF (schar >= 32) THEN BEGIN i := schar - 31; i := ichar[i]; WHILE tchar[i] < 255 DO BEGIN cmd := tchar[i]; i := i + 1; iy := cmd AND 15; ix := cmd AND 112; ix := ix DIV 16; x := ix * chxsz / 7.0; y := iy * chysz / 9.0; t := x; x := cx + scale[3]*t - scale[4]*y; y := cy + scale[4]*t + scale[3]*y; IF (cmd < 128) THEN gmove( x,y ) ELSE vector( x,y ) END END END; {------------------------------------------------------------------------} PROCEDURE gwrite(x,y:REAL ;chars:textline; nchar:INTEGER); { This function plots a string of graphic characters with the preset orientation and size. inputs: x,y coordinates for start of string (bottom left corner) chars string to be plotted outputs: none returned } VAR i: INTEGER; BEGIN FOR i := 1 TO nchar DO BEGIN gchar( x, y, chars[i] ); x := x + chxsz*scale[3]; y := y + chxsz*scale[4]; END END; {------------------------------------------------------------------------} PROCEDURE axis(r1,r2,dri,sx1,sy1,sx2,sy2,ticlen,ticang: REAL; lblnum,lbldec: INTEGER; lblang: REAL); { This procedure plots and labels a linear graph axis inputs: r1 real world value at start of axis r2 real world value at end of axis dri real world increment for labels sx1,sy1 screen coordinates of start of axis sx2,sy2 screen coordinates at end of axis ticlen length of tic marks (screen units 0.0-->1.0) ticang angle between horizontal and tic marks lblnum number of characters in labels lbldec number of digits right of decimal place lblang angle between horizontal and labels outputs: none returned } VAR angtic,anglbl,lentic,xlen,ylen,rlen,dr,rtic,rend,xtic,ytic, angtst,xlabel,ylabel,t,radian,x,y,dtic: REAL; alabel: STRING[20]; stemp: STRING[6]; BEGIN radian := 57.29578; IF ((dri = 0.0) OR (r2-r1 = 0.0)) THEN BEGIN Write(CON, 'Zero value for real length or increment. Axis not plotted'); END ELSE BEGIN IF (lblnum < 7) THEN lblnum := 7; IF ( ((r1<0.0) OR (r2<0.0)) AND (lblnum<8) ) THEN lblnum := 8; angtic := ticang; IF (ticlen < 0.0) THEN angtic := -angtic; angtic := posang (angtic); anglbl := posang (lblang); lentic := Abs( ticlen ); xlen := sx2-sx1; ylen := sy2-sy1; rlen := r2-r1; dr := Abs( dri ) * Abs( rlen )/rlen; ticend(r1,r2,dr,rtic,rend); angtst := posang(angtic - anglbl); angtic := angtic/radian; anglbl := anglbl/radian; xtic := lentic * cos( angtic ); ytic := lentic * sin( angtic ); scale[3] := cos( anglbl ); scale[4] := sin( anglbl ); { calculate offsets for labels } IF ( (angtst < 45.0) OR { tic is "left" of label } (angtst >= 315.0) ) THEN BEGIN xlabel := ( chxsz*scale[3] + chysz*scale[4])/2.0; ylabel := (-chysz*scale[3] - chxsz*scale[4])/2.0; END ELSE IF ( angtst < 135.0) THEN BEGIN { tic is "below" label } t := (lblnum-lbldec-1) * chxsz; xlabel := -t*scale[3] - chysz*scale[4]/2.0; ylabel := -t*scale[4] + chysz*scale[3]/2.0; END ELSE IF ( angtst < 225.0) THEN BEGIN { tic is "right" of label } t := ( lblnum + 0.5 ) *chxsz; xlabel := -scale[4]*chysz/2.0 - t*scale[3]; ylabel := -scale[3]*chysz/2.0 - t*scale[4]; END ELSE IF ( angtst < 315.0) THEN BEGIN { tic is "above" label } t := (lblnum-lbldec-1) * chxsz; xlabel := -t*scale[3] + chysz*scale[4]*1.5; ylabel := -t*scale[4] - chysz*scale[3]*1.5; END; { Draw Axis } segmnt( sx1,sy1, sx2,sy2 ); WHILE ((dr<0.0)AND(rtic>=rend)) OR ((dr>0.0)AND(rtic<=rend)) DO BEGIN dtic := (rtic-r1)/rlen; x := xlen*dtic + sx1; y := ylen*dtic + sy1; gmove(x,y); x := x + xtic; y := y + ytic; vector(x,y); x := x + xlabel; y := y + ylabel; Str(rtic:lblnum:lbldec, alabel); gwrite(x, y, alabel, lblnum); rtic := rtic + dr; END; { clean up static storage } t := chrot/radian; scale[3] := cos( t ); scale[4] := sin( t ); END END; {-------------------------------------------------------------------------} PROCEDURE graph(xmini,xmaxi:REAL; nx:INTEGER; ymini,ymaxi:REAL;ny:INTEGER; sxl,sxr,syb,syt:REAL); { This procedure plots and labels a graph and establishes scale factors for future use. inputs: xmini,xmaxi min & max real world values for x axis nx approximate no. of intervals on x axis ymini,ymaxi min & max real world values for y axis ny approximate no. of intervals on y axis sxl,sxr screen left & right coord. for graph area syb,syt screen bottom & top coord. for graph area outputs: none returned } VAR dx,dy,tic,xdot,ydot,dxydot,xydot,ticnd: REAL; lblnum,lbldec: INTEGER; BEGIN { Set Scale Factors } xmin := xmini; ymin := ymini; xmax := xmaxi; ymax := ymaxi; swindo(sxl,sxr,syb,syt); { Draw Axes } dx := dxdy(xmin,xmax,nx,lblnum,lbldec); nxchar := lblnum; axis(xmin,xmax,dx, sxl,syb,sxr,syb, chysz/2.,270.0, lblnum,lbldec,0.0); dy := dxdy(ymin,ymax,ny,lblnum,lbldec); nychar := lblnum; axis(ymin,ymax,dy, sxl,syb,sxl,syt, chxsz/2.,180.0, lblnum,lbldec,90.0); { Do Vertical Dotted Lines } ticend(xmin,xmax,dx,tic,ticnd); dxydot := dy/5.0; IF (tic = xmin) THEN tic := tic + dx; WHILE ((dx>0.0)AND(tic<=ticnd)) OR ((dx<0.0)AND(tic>=ticnd)) DO BEGIN xdot := sx(tic); tic := tic + dx; xydot := ymin + dxydot; WHILE ((dxydot>0.0)AND(xydot<=ymax)) OR ((dxydot<0.0)AND(xydot>=ymax)) DO BEGIN ydot := sy(xydot); xydot := xydot + dxydot; point( xdot,ydot ); END END; { Do Horizontal Dotted Lines } ticend(ymin,ymax,dy,tic,ticnd); dxydot := dx/5.0; IF (tic = ymin) THEN tic := tic + dy; WHILE ((dy>0.0)AND(tic<=ticnd)) OR ((dy<0.0)AND(tic>=ticnd)) DO BEGIN ydot := sy(tic); tic := tic + dy; xydot := xmin + dxydot; WHILE ((dxydot>0.0)AND(xydot<=xmax)) OR ((dxydot<0.0)AND(xydot>=xmax)) DO BEGIN xdot := sx(xydot); xydot := xydot + dxydot; point( xdot,ydot ); END END END; {-------------------------------------------------------------------------}