home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / BEEHIVE / UTILITYS / GIFPAS.ARK / TVPLOT.PAS < prev   
Pascal/Delphi Source File  |  1992-03-18  |  3KB  |  118 lines
  1. CONST    xSize        = 512;
  2.          ySize        = 256;
  3.  
  4. TYPE     xRange  = 0..xSize;
  5.          yRange  = 0..ySize;
  6.          PlotRec = RECORD
  7.                      xB,yB,zB : Real;
  8.                      xM,yM,zM : Real;
  9.                      p,q,s,t  : Real
  10.                    END;
  11.  
  12. VAR      xPos,yPos : Integer;
  13.          Data3D    : PlotRec;
  14.  
  15. PROCEDURE InitPlot;
  16. BEGIN
  17.   Write( #27#27'GZP0;' );
  18.   xPos := 0; yPos := 0
  19. END { InitPlot };
  20.  
  21. FUNCTION xScale(x: Integer):Integer;
  22. BEGIN
  23.   xScale := Round(512.0/xSize*x)
  24. END;
  25.  
  26. FUNCTION yScale(y: Integer):Integer;
  27. BEGIN
  28.   yScale := Round(256.0/ySize*y)
  29. END;
  30.  
  31. PROCEDURE Plot(x,y : Integer);
  32. BEGIN
  33.   IF (0 <= x) AND (x <= xSize-1) AND (0 <= y) AND (y <= ySize-1) THEN
  34.     BEGIN
  35.       Write( 'M',xScale(x),' ',yScale(y),';J0 0;' );
  36.     END
  37. END { Plot };
  38.  
  39. PROCEDURE Line( x1,y1,x2,y2 : Integer );
  40. VAR      x,y,z,dx,dy,dz,i1,i2 : Integer;
  41. BEGIN
  42.   Write( 'M',xScale(x1),' ',yScale(y1),';D',xScale(x2),' ',yScale(y2),';' );
  43. END { Line };
  44.  
  45. PROCEDURE PlotAbs(x,y : INTEGER);
  46. BEGIN
  47.   Line(xPos,yPos,x,y);
  48.   xPos := x; yPos := y
  49. END { PlotAbs };
  50.  
  51. PROCEDURE PlotRel(dx,dy : Integer);
  52. BEGIN
  53.   PlotAbs(xPos + dx, yPos + dy)
  54. END { Plotrel };
  55.  
  56. PROCEDURE MoveAbs(x,y : Integer);
  57. BEGIN
  58.   xPos := x; yPos := y
  59. END { MoveAbs };
  60.  
  61. PROCEDURE MoveRel(dx,dy : Integer);
  62. BEGIN
  63.   xPos := xPos + dx; yPos := yPos + dy
  64. END { MoveRel };
  65.  
  66. PROCEDURE Cursor(x,y: Integer);
  67. BEGIN
  68.   MoveAbs(x,y);
  69.   MoveRel(5,0);
  70.   PlotRel(-10,0);
  71.   MoveRel(5,5);
  72.   PlotRel(0,-10);
  73.   MoveRel(0,5)
  74. END { Cursor };
  75.  
  76. PROCEDURE Cursor2(x,y: Integer);
  77. BEGIN
  78.   MoveAbs(x,y);
  79.   MoveRel(4,4);
  80.   PlotRel(-8,-8);
  81.   MoveRel(8,0);
  82.   PlotRel(-8,8);
  83.   MoveRel(4,-4)
  84. END { Cursor2 };
  85.  
  86. PROCEDURE ViewPoint(xBet,yBet,zBet,xFl,yFl,zFl : Real);
  87. BEGIN
  88.   WITH Data3D DO
  89.     BEGIN
  90.       xB := xBet; yB := yBet; zB := zBet;
  91.       xM := xFl;  yM := yFl;  zM := zFl;
  92.       p := Sqrt(Sqr(xM-xB) + Sqr(yM-yB));
  93.       q := Sqrt(Sqr(p) + Sqr(zM-zB));
  94.       IF p = 0 THEN s := 1 ELSE s := (yM-yB)/p;
  95.       IF p = 0 THEN t := 0 ELSE t := (xM-xB)/p
  96.     END
  97. END { ViewPoint };
  98.  
  99. PROCEDURE Calc3D(x,y,z : Real; VAR u,v,r : Real);
  100. BEGIN
  101.   WITH Data3D DO
  102.     BEGIN
  103.       r := (xM-xB)*(x-xB) + (yM-yB)*(y-yB) + (zM-zB)*(z-zB);
  104.       u := (s*q*(x-xB) - t*q*(y-yB))/r;
  105.       v := (-t*(zM-zB)*(x-xB) - s*(zM-zB)*(y-yB) + p*(z-zB))/r
  106.     END
  107. END { Calc3D };
  108.  
  109. PROCEDURE EndPlot;
  110. BEGIN
  111.   WriteLn( 'M450 0;BReady' );
  112.   REPEAT UNTIL KeyPressed;
  113.   Write( 'ZA' )
  114. END { EndPlot };
  115.  
  116. PROCEDURE DonePlot;
  117. BEGIN
  118. END { DonePlot };