CP/M/CPM_CDROM.iso/beehive/utilitys/gifpas.ark/PLOT.PAS

Pascal/Delphi Source File | 1992-03-18 | 5KB | 219 lines

CONST    LineSpacing = #13#27'J'#24;
         GrafMode    = #27'a'#1#27'*'#39;
         PrintReset  = #27'@';
         InitCalled  : Boolean = False;
         xSize       = 1536;
         ySize       = 1024;
         xSizeM1     = 1535;
         ySizeM1     = 1023;

TYPE     xRange  = 0..xSizeM1;
         yRange  = 0..ySizeM1;
         VMA     = ARRAY[yRange,0..2] OF Byte;
         PlotRec = RECORD
                     xB,yB,zB : Real;
                     xM,yM,zM : Real;
                     p,q,s,t  : Real
                   END;

VAR      xPos,yPos : Integer;
         Data3D    : PlotRec;
         VMD       : FILE OF VMA;
         Buff      : VMA;

PROCEDURE InitPlot;
VAR      i,j  : Integer;
BEGIN
  IF NOT InitCalled THEN
    BEGIN
      Assign( VMD,'f:Dummy.$$$' );
      InitCalled := True
    END;
  FillChar(Buff,SizeOf(Buff),#0);
  Rewrite( VMD );
  FOR i := 0 TO (xSizeM1 DIV 24) DO
    Write( VMD,Buff );
  Reset( VMD );
  xPos := 0; yPos := 0
END { InitPlot };

PROCEDURE Plot(x,y : Integer);
VAR      i,j : Integer;
BEGIN
  IF InitCalled AND (0 <= x) AND (x <= xSizeM1) AND (0 <= y) AND (y <= ySizeM1) THEN
    BEGIN
      IF FilePos( VMD ) <> (x DIV 24) THEN
        BEGIN
          Write( VMD,Buff );
          Seek( VMD,x DIV 24 );
          Read(  VMD,Buff );
          Seek( VMD,x DIV 24 )
        END;
      i := (x MOD 24) DIV 8;
      j := x MOD 8;
      Buff[y,i] := Buff[y,i] OR (128 SHR j)
    END
END { Plot };

PROCEDURE InvertDot(x,y : Integer);
VAR      i,j : Integer;
BEGIN
  IF InitCalled AND (0 <= x) AND (x <= xSizeM1) AND (0 <= y) AND (y <= ySizeM1) THEN
    BEGIN
      IF FilePos( VMD ) <> (x DIV 24) THEN
        BEGIN
          Write( VMD,Buff );
          Seek( VMD,x DIV 24 );
          Read(  VMD,Buff );
          Seek( VMD,x DIV 24 )
        END;
      i := (x MOD 24) DIV 8;
      j := x MOD 8;
      Buff[y,i] := Buff[y,i] XOR (128 SHR j)
    END
END { InvertDot };

PROCEDURE Line( x1,y1,x2,y2 : Integer );
VAR      x,y,d,dx,dy,DirX,DirY,i : Integer;
BEGIN
  IF x1 < x2 THEN
    DirX :=  1
  ELSE
    DirX := -1;
  IF y1 < y2 THEN
    DirY :=  1
  ELSE
    DirY := -1;
  x := x1;
  y := y1;
  dx := Abs( x2 - x1 );
  dy := Abs( y2 - y1 );
  IF dx >= dy THEN
    BEGIN
      dy := dy SHL 1;
      d  := dx - dy;
      dx := dx SHL 1;
      FOR i := 0 TO dx SHR 1 DO
        BEGIN
          Plot(x,y);
          IF d > 0 THEN
            BEGIN
              y := y + DirY;
              d := d + dy - dx
            END
          ELSE
            d := d + dy;
          x := x + DirX
        END
    END
  ELSE
    BEGIN
      dx := dx SHL 1;
      d  := dy - dx;
      dy := dy SHL 1;
      FOR i := 0 TO dy SHR 1 DO
        BEGIN
          Plot(x,y);
          IF d > 0 THEN
            BEGIN
              x := x + DirX;
              d  := d + dx - dy
            END
          ELSE
            d := d + dx;
          y := y + DirY
        END
    END
END { Line };

PROCEDURE PlotAbs(x,y : Integer);
BEGIN
  Line(xPos,yPos,x,y);
  xPos := x; yPos := y
END { PlotAbs };

PROCEDURE PlotRel(dx,dy : Integer);
BEGIN
  PlotAbs(xPos + dx, yPos + dy)
END { Plotrel };

PROCEDURE MoveAbs(x,y : Integer);
BEGIN
  xPos := x; yPos := y
END { MoveAbs };

PROCEDURE MoveRel(dx,dy : Integer);
BEGIN
  xPos := xPos + dx; yPos := yPos + dy
END { MoveRel };

PROCEDURE Cursor(x,y: Integer);
BEGIN
  MoveAbs(x,y);
  MoveRel(5,0);
  PlotRel(-10,0);
  MoveRel(5,5);
  PlotRel(0,-10);
  MoveRel(0,5)
END { Cursor };

PROCEDURE Cursor2(x,y: Integer);
BEGIN
  MoveAbs(x,y);
  MoveRel(4,4);
  PlotRel(-8,-8);
  MoveRel(8,0);
  PlotRel(-8,8);
  MoveRel(4,-4)
END { Cursor2 };

PROCEDURE ViewPoint(xBet,yBet,zBet,xFl,yFl,zFl : Real);
BEGIN
  WITH Data3D DO
    BEGIN
      xB := xBet; yB := yBet; zB := zBet;
      xM := xFl;  yM := yFl;  zM := zFl;
      p := Sqrt(Sqr(xM-xB) + Sqr(yM-yB));
      q := Sqrt(Sqr(p) + Sqr(zM-zB));
      IF p = 0 THEN s := 1 ELSE s := (yM-yB)/p;
      IF p = 0 THEN t := 0 ELSE t := (xM-xB)/p
    END
END { ViewPoint };

PROCEDURE Calc3D(x,y,z : Real; VAR u,v,r : Real);
BEGIN
  WITH Data3D DO
    BEGIN
      r := (xM-xB)*(x-xB) + (yM-yB)*(y-yB) + (zM-zB)*(z-zB);
      u := (s*q*(x-xB) - t*q*(y-yB))/r;
      v := (-t*(zM-zB)*(x-xB) - s*(zM-zB)*(y-yB) + p*(z-zB))/r
    END
END { Calc3D };

PROCEDURE EndPlot;
VAR      i,j : Integer;
BEGIN
  IF InitCalled THEN
    BEGIN
      Write( VMD,Buff );
      Reset( VMD );
      WriteLn( LST );
      REPEAT
        Read( VMD,Buff );
        Write( LST, GrafMode, Chr((ySize) MOD 256), Chr((ySize) DIV 256) );
        FOR i := 0 TO ySize-1 DO
          FOR j := 0 TO 2 DO
            Write( LST,Chr(Buff[i,j]) );
        Write( LST, LineSpacing)
      UNTIL EOF( VMD );
      Write( LST, #12, PrintReset );
      Close( VMD )
    END
END { EndPlot };

PROCEDURE DonePlot;
BEGIN
  IF InitCalled THEN
    Erase( VMD )
END { DonePlot };