home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol194 / graf1.pas < prev    next >
Pascal/Delphi Source File  |  1984-10-17  |  16KB  |  495 lines
  1. {$-V}
  2. {****************************************************************************
  3.  *                                                                          *
  4.  *              PLOT Version 3.3 Compatible Pascal Library                  *
  5.  *                                                                          *
  6.  *                  Copyright 1984 by Thomas E. Speer                       *
  7.  *                       All rights reserved.                               *
  8.  *         Released to the Public Domain for Non-commercial use only        *
  9.  *                                                                          *
  10.  *             This file contains procedures and functions for              *
  11.  *             access to the lowest level graphics functions.               *
  12.  *                                                                          *
  13.  ****************************************************************************}
  14.  
  15.  
  16. {-------------------------------------------------------------------------}
  17. {                 global graphics variables and constants                 }
  18. CONST
  19.     BUFFSIZE = 255;
  20.     FIXVAL   = 32767;
  21.  
  22. TYPE
  23.     filename = STRING[11];
  24.     bufftype = STRING[ BUFFSIZE ];
  25.     textline = STRING[ 80 ];
  26.     vecfile  = TEXT;
  27.  
  28. VAR
  29.     buffer: bufftype;
  30.     colour, nxchar, nychar, nxline, nbuff : INTEGER;
  31.     xmin,  xmax,  ymin,  ymax, sxleft, sxrt, sybot, sytop: REAL;
  32.     scale: ARRAY [1..4] of REAL;
  33.     chxsz, chysz, chrot, xpos, ypos: REAL;
  34.     vecunit :vecfile;
  35. {                 global graphics variables and constants                 }
  36.  
  37. {-------------------------------------------------------------------------}
  38. FUNCTION rx( sxi:REAL ):REAL;
  39. {       This function does a linear conversion between the real world
  40.         and screen X coordinates.
  41.         inputs:
  42.                         sxi     screen Y coordinate
  43.         outputs:
  44.                         rx      real world coordinate
  45. }
  46. BEGIN
  47.     rx := scale[1] * (sxi-sxrt) + xmin;
  48. END;
  49.  
  50. {-------------------------------------------------------------------------}
  51. FUNCTION ry( syi:REAL ):REAL;
  52. {       This function does a linear conversion between the real world
  53.         and screen Y coordinates.
  54.         inputs:
  55.                         syi     screen Y coordinate
  56.         outputs:
  57.                         ry      real world coordinate
  58. }
  59. BEGIN
  60.     ry := scale[2] * (syi-sybot) + ymin;
  61. END;
  62.  
  63. {-------------------------------------------------------------------------}
  64. FUNCTION sx( rxi:REAL ):REAL;
  65. {       This function does a linear conversion from the real to the
  66.         screen x coordinates.
  67.         inputs:
  68.                 rx      real world coordinate
  69.         outputs:
  70.                 sx      screen x coordinate
  71. }
  72. BEGIN
  73.     sx := (rxi - xmin)/scale[1] + sxleft;
  74. END;
  75.  
  76. {-------------------------------------------------------------------------}
  77. FUNCTION sy( ryi:REAL ):REAL;
  78. {       This function does a linear conversion from the real to the
  79.         screen y coordinates.
  80.         inputs:
  81.                 ry      real world coordinate
  82.         outputs:
  83.                 sy      screen y coordinate
  84. }
  85. BEGIN
  86.     sy := (ryi - ymin)/scale[2] + sybot;
  87. END;
  88.  
  89. {-------------------------------------------------------------------------}
  90. PROCEDURE swindo ( sxlti,sxrti,syboti,sytopi:REAL );
  91. {       This procedure sets the screen window
  92.         inputs:         sxlti   value at left   edge of window (screen units)
  93.                         sxrti   value at right  edge of window (screen units)
  94.                         syboti  value at bottom edge of window (screen units)
  95.                         sytopi  value at top    edge of window (screen units)
  96.         outputs:
  97.                         none returned
  98. }
  99. VAR
  100.     t:REAL;
  101.  
  102. BEGIN
  103.     sxleft := sxlti;
  104.     sxrt   := sxrti;
  105.     sybot  := syboti;
  106.     sytop  := sytopi;
  107.  
  108.     t := sxrt - sxleft;
  109.     IF ( sytop - sybot < t) THEN t := sytop - sybot;
  110.     IF ( t < 0.0001 ) THEN
  111.         Write(CON, 'Screen window too small.  Size =', t )
  112.     ELSE IF ( (xmax - xmin = 0) OR (ymax - ymin = 0) ) THEN
  113.         Write(CON,'Real window has 0 size.  Scale factors not calculated')
  114.     ELSE BEGIN
  115.         scale[1] := (xmax - xmin)/(sxrt - sxleft);
  116.         scale[2] := (ymax - ymin)/(sytop - sybot);
  117.     END
  118. END;
  119.     
  120. {-------------------------------------------------------------------------}
  121. PROCEDURE rwindo( xmini, xmaxi, ymini, ymaxi:REAL );
  122. {       This procedure sets the real world window for scaling purposes
  123.         inputs:
  124.                         xmini   value at left   edge of window (user units)
  125.                         xmaxi   value at right  edge of window (user units)
  126.                         ymini   value at bottom edge of window (user units)
  127.                         ymaxi   value at top    edge of window (user units)
  128.         outputs:
  129.                         none returned
  130. }
  131. BEGIN
  132.     xmin := xmini;
  133.     xmax := xmaxi;
  134.     ymin := ymini;
  135.     ymax := ymaxi;
  136.     
  137.     swindo( sxleft, sxrt, sybot, sytop );
  138. END;
  139.  
  140. {-------------------------------------------------------------------------}
  141. PROCEDURE concat2(VAR strng1:bufftype; nchar1:INTEGER; VAR strng2:bufftype;
  142.                 nchar2:INTEGER; VAR strng3:bufftype);
  143. {     This procedure concatenates portions of strng1 and strng2 into strng3
  144.         inputs:
  145.                 strng1  string for first postion
  146.                 nchar1  number of characters in strng1
  147.                 strng2  string for second position
  148.                 nchar2  number of characters in strng1
  149.         outputs:
  150.                 strng3  concatenated string
  151. }
  152. BEGIN
  153.     strng3 := Concat( Copy(strng1,1,nchar1), Copy(strng2,1,nchar2) );
  154. END;
  155.  
  156. {------------------------------------------------------------------------}
  157. PROCEDURE buffout(VAR outunit:vecfile; outbuf:bufftype; size:INTEGER);
  158. {       This procedure writes the buffer to the indicated file.
  159.         inputs:
  160.                 outunit file pointer for output
  161.                 outbuf  string (may contain '/0' characters!)
  162.                 size    number of characters to send out
  163.         outputs:
  164.                 none returned
  165. }
  166. VAR
  167.     i: INTEGER;
  168.     c: CHAR;
  169.  
  170. BEGIN
  171.     FOR i := 1 TO size DO BEGIN
  172.         c := Copy( outbuf,i,1 );
  173.         Write( outunit, c);
  174.     END
  175. END;
  176.  
  177. {-------------------------------------------------------------------------}
  178. PROCEDURE writecmd ( cmd:bufftype; cmdlen:INTEGER );
  179. {       This procedure adds a command to the buffer and writes it if full.
  180.         inputs:
  181.                 cmd     input command string
  182.                 cmdlen  length of command string
  183.         outputs:
  184.                 none returned
  185. }
  186. BEGIN
  187.     IF (cmdlen + nbuff < BUFFSIZE) THEN BEGIN
  188.         concat2 (buffer, nbuff, cmd, cmdlen, buffer);
  189.         nbuff := nbuff + cmdlen;
  190.         END
  191.     ELSE BEGIN
  192.         buffout( vecunit, buffer, nbuff);
  193.         nbuff := 0;
  194.         buffer:= '';
  195.         concat2 (buffer, nbuff, cmd, cmdlen, buffer);
  196.         nbuff := cmdlen;
  197.     END
  198. END;
  199.  
  200.  
  201. {------------------------------------------------------------------------}
  202. PROCEDURE erase;
  203. {       This procedure causes the picture to be set to the currently selected
  204.         color.
  205.         inputs:
  206.                 none
  207.         outputs:
  208.                 none returned
  209. }
  210. BEGIN
  211.     writecmd ( 'E', 1);
  212. END;
  213.  
  214. {------------------------------------------------------------------------}
  215. PROCEDURE fill( x1, y1, x2, y2, yf:REAL);
  216. {       This procedure fills in a solid area between a line segment and
  217.         a horizontal line.
  218.         inputs:
  219.                 x1,y1   coordinates for start of line segment
  220.                 x2,y2   coordinates for end   of line segment
  221.                 yf      height of horizonal level
  222.         outputs:
  223.                 none returned
  224. }
  225. VAR
  226.     fxy: INTEGER;
  227.     cmd: STRING[11];
  228.  
  229. BEGIN
  230.     cmd := 'F';
  231.     fxy := Trunc( x1 * FIXVAL);                 { convert to fixed point }
  232.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  233.     cmd := cmd + Chr((fxy DIV 256) MOD 256);    { load high byte of integer }
  234.     fxy := Trunc( y1 * FIXVAL);                 { convert to fixed point }
  235.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  236.     cmd := cmd + Chr((fxy DIV 256) MOD 256);    { load high byte of integer }
  237.     fxy := Trunc( x2 * FIXVAL);                 { convert to fixed point }
  238.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  239.     cmd := cmd + Chr((fxy DIV 256) MOD 256);    { load high byte of integer }
  240.     fxy := Trunc( y2 * FIXVAL);                 { convert to fixed point }
  241.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  242.     cmd := cmd + Chr((fxy DIV 256) MOD 256);    { load high byte of integer }
  243.     fxy := Trunc( yf * FIXVAL);                 { convert to fixed point }
  244.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  245.     cmd := cmd + Chr((fxy DIV 256) MOD 256);    { load high byte of integer }
  246.  
  247.     writecmd( cmd, 11 );
  248.     xpos := x2;
  249.     ypos := y2;
  250. END;
  251.  
  252. {------------------------------------------------------------------------}
  253. PROCEDURE segmnt(x1,y1,x2,y2:REAL);
  254. {       This function plots a line segment from (x1,y1) to (x2,y2).
  255.         inputs:
  256.                 x1,y1   coordinates for start of segment
  257.                 x2,y2   coordiantes for end   of segment
  258.         outputs:
  259.                 none returned.
  260. }
  261. VAR
  262.     fxy:INTEGER;
  263.     cmd:STRING[9];
  264.  
  265. BEGIN
  266.     cmd := 'D';
  267.     fxy := Trunc( x1 * FIXVAL);                 { convert to fixed point }
  268.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  269.     cmd := cmd + Chr((fxy DIV 256) MOD 256);      { load high byte of integer }
  270.     fxy := Trunc( y1 * FIXVAL);                 { convert to fixed point }
  271.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  272.     cmd := cmd + Chr((fxy DIV 256) MOD 256);      { load high byte of integer }
  273.     fxy := Trunc( x2 * FIXVAL);                 { convert to fixed point }
  274.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  275.     cmd := cmd + Chr((fxy DIV 256) MOD 256);      { load high byte of integer }
  276.     fxy := Trunc( y2 * FIXVAL);                 { convert to fixed point }
  277.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  278.     cmd := cmd + Chr((fxy DIV 256) MOD 256);      { load high byte of integer }
  279.  
  280.     writecmd(cmd, 9);
  281.  
  282.     xpos := x2;
  283.     ypos := y2;
  284. END;
  285.  
  286. {-------------------------------------------------------------------------}
  287. PROCEDURE gmove( x,y:REAL );
  288. {       This function moves the present coordinates to a new location
  289.         without plotting.
  290.         inputs:
  291.                 x,y     coordinates for new location
  292.         outputs:
  293.                 none returned
  294. }
  295. VAR
  296.     fxy: INTEGER;
  297.     cmd: STRING[5];
  298.  
  299. BEGIN    
  300.     cmd := 'M';
  301.     fxy := Trunc (x * FIXVAL);                  { convert to fixed point }
  302.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  303.     cmd := cmd + Chr((fxy DIV 256) MOD 256);      { load high byte of integer }
  304.     fxy := Trunc( y * FIXVAL);                  { convert to fixed point }
  305.     cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  306.     cmd := cmd + Chr((fxy DIV 256) MOD 256);      { load high byte of integer }
  307.     
  308.     writecmd( cmd, 5 );
  309.     xpos := x;
  310.     ypos := y;
  311. END;
  312.  
  313. {------------------------------------------------------------------------}
  314. PROCEDURE vector( x,y:REAL );
  315. {       This procedure plots a line segment from the present position
  316.         to the given coordinates
  317.         inputs:
  318.                 x,y     coordinates for end of segment
  319.         outputs:
  320.                 none returned
  321. }
  322. VAR
  323.     fxy:INTEGER;
  324.     cmd:STRING[5];
  325.     
  326. BEGIN
  327.     cmd := 'I';
  328.     fxy := Trunc( x * FIXVAL);                { convert to fixed point }
  329.     cmd := cmd + Chr(fxy MOD 256);            { load low  byte of integer }
  330.     cmd := cmd + Chr((fxy DIV 256) MOD 256);  { load high byte of integer }
  331.     fxy := Trunc( y * FIXVAL);                { convert to fixed point }
  332.     cmd := cmd + Chr(fxy MOD 256);            { load low  byte of integer }
  333.     cmd := cmd + Chr((fxy DIV 256) MOD 256);  { load high byte of integer }
  334.  
  335.     writecmd( cmd, 5 );
  336.     xpos := x;
  337.     ypos := y
  338. END;
  339.  
  340. {------------------------------------------------------------------------}
  341. PROCEDURE color(code: INTEGER);
  342. {       This procedure sets the color to be used in plotting
  343.         inputs:
  344.                 code    new color code
  345.         outputs:
  346.                 none returned
  347. }
  348. VAR
  349.     cmd: STRING[2];
  350.  
  351. BEGIN
  352.     colour := code;
  353.     cmd := 'C' + Chr(code MOD 256);
  354.     
  355.     writecmd ( cmd, 2 );
  356. END;
  357.  
  358. {------------------------------------------------------------------------}
  359. PROCEDURE gprint;
  360. {       This procedure causes the picture to be printed
  361.         inputs:
  362.                 none
  363.         outputs:
  364.                 none returned
  365. }
  366. BEGIN
  367.     writecmd ( 'O', 1 );
  368. END;
  369.  
  370. {-------------------------------------------------------------------------}
  371. PROCEDURE grfini;
  372. {       This procedure terminates the plot and closes the file.
  373.         inputs:
  374.                 none
  375.         outputs:
  376.                 none returned
  377. }
  378. BEGIN
  379.     IF (nbuff > BUFFSIZE-2) THEN BEGIN
  380.         buffout( vecunit, buffer, nbuff);
  381.         nbuff := 0;
  382.         buffer := ''
  383.     END;
  384.     nbuff := nbuff + 1;
  385.     buffer := buffer + 'O';
  386.     nbuff := nbuff + 1;
  387.     buffer := buffer + 'Q';
  388.     buffout( vecunit, buffer, nbuff);
  389.     Close( vecunit);
  390. END;
  391.  
  392. {------------------------------------------------------------------------}
  393. PROCEDURE grinit (name: filename);
  394. {       This function initializes the plot package.
  395.         inputs:
  396.                 name    name of disk file for output of vector commands
  397.         outputs:
  398.                 a '0' is returned if unsuccessful in opening file name.
  399. }
  400. VAR
  401.     cmd: STRING[5];
  402.  
  403. BEGIN
  404.     Assign( vecunit, name );
  405.     Rewrite( vecunit );
  406.     nbuff := 0;
  407.     buffer:= '';
  408.     
  409.     { output command stream to initialize memory map }
  410.     cmd := 'C' + Chr(0)+ 'EC' + Chr(127);
  411.     
  412.     writecmd (cmd, 5);
  413.  
  414.     xmin   := 0.0;
  415.     xmax   := 1.0;
  416.     ymin   := 0.0;
  417.     ymax   := 1.0;
  418.     sxleft := 0.0;
  419.     sxrt   := 1.0;
  420.     sybot  := 0.0;
  421.     sytop  := 1.0;
  422.     chxsz  := 0.0125;
  423.     chysz  := 0.02;
  424.     chrot  := 0.0;
  425.     xpos   := 0.0;
  426.     ypos   := 0.0;
  427.     scale[1]:=1.0;
  428.     scale[2]:=1.0;
  429.     scale[3]:=1.0;
  430.     scale[4]:=0.0;
  431.     nxchar  := 0;
  432.     nychar  := 0;
  433.     nxline  := 1;
  434. END;
  435.  
  436. {-------------------------------------------------------------------------}
  437. PROCEDURE gstrng(x, y:REAL; strng:textline);
  438. {       This procedure will plot a string of hardware generated characters
  439.         inputs:
  440.                         x,y     starting coordinates for string
  441.                         strng   string to be plotted
  442.         outputs:
  443.                         none returned
  444. }
  445. VAR
  446.     fx,fy,nchar:INTEGER;
  447.     cmd: STRING[86];
  448.  
  449. BEGIN
  450.     nchar := Length(strng);
  451.  
  452.     IF (nchar > 0) THEN BEGIN
  453.         fx := Trunc (x * FIXVAL);
  454.         fy := Trunc( (y * FIXVAL));
  455.         cmd := 'S';
  456.         cmd := cmd + Chr(fx MOD 256);           { load low  byte of integer }
  457.         cmd := cmd + Chr((fx DIV 256) MOD 256); { load high byte of integer }
  458.         cmd := cmd + Chr(fy MOD 256);           { load low  byte of integer }
  459.         cmd := cmd + Chr((fy DIV 256) MOD 256); { load high byte of integer }
  460.  
  461.         cmd := cmd + strng + Chr(13);
  462.         nchar := nchar + 6;
  463.         writecmd ( cmd, nchar );
  464.     END
  465. END;
  466.  
  467. {-------------------------------------------------------------------------}
  468. PROCEDURE point( x,y:REAL );
  469. {       This function plots a point at the given coordinates
  470.         inputs:
  471.                 x,y     coordinates of point
  472.         outputs:
  473.                 none returned
  474. }
  475. VAR
  476.     fxy:INTEGER;
  477.     cmd:STRING[5];
  478.     
  479. BEGIN
  480.     IF ((Abs(x) <= 1.0) AND (Abs(y) <= 1.0 )) THEN BEGIN
  481.         cmd :='P';
  482.         fxy := Trunc( x * FIXVAL);                  { convert to fixed point }
  483.         cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  484.         cmd := cmd + Chr((fxy DIV 256) MOD 256);    { load high byte of integer }
  485.         fxy := Trunc( y * FIXVAL);                  { convert to fixed point }
  486.         cmd := cmd + Chr(fxy MOD 256);              { load low  byte of integer }
  487.         cmd := cmd + Chr((fxy DIV 256) MOD 256);    { load high byte of integer }
  488.  
  489.         writecmd( cmd, 5 );
  490.         xpos := x;
  491.         ypos := y
  492.     END
  493. END;
  494.  
  495.