ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/GRAPHICS/PLOT/MVIS.ZIP/MVIS.PAS

Pascal/Delphi Source File | 1991-07-01 | 4.7 KB | 159 lines

program visualise_matrix;
{look for the word "tuning" in this file to know what you can
play around with}

uses crt, graph, time;

type
    m2 = array[1..2, 1..2] of double;

procedure waitkey;
var c:char;
begin
     while keypressed do c := readkey;
     c := readkey;
end;

function GetM(var M:m2):boolean;
         {prompt user for 2 x 2 matrix.  If he hits <CR> return true
          (meaning "quit") otherwise return false.}
var
   i, j:integer;
   quit : boolean;
begin
     fillchar(M, sizeof(M), 0);
     RestoreCrtMode;
     write('Enter first row of matrix: ');
     read(M[1, 1], M[1, 2]);
     write('Enter 2nd row of matrix: ');
     read(M[2, 1], M[2, 2]);
     quit := true;
     for i := 1 to 2 do
         for j := 1 to 2 do
             if M[i, j] <> 0.0 then quit := false;
     GetM := quit;
end;

procedure V(M:m2);

     procedure PutAxes;
     begin
          line(GetMaxX div 2, 0, GetMaxX div 2, GetMaxY);
          line(0, GetMaxY div 2, GetMaxX, GetMaxY div 2);
     end;

     procedure PutM(M:m2);
     var s1, s2:string[5];
     begin
          str(M[1, 1]:3:1, s1);
          str(M[1, 2]:3:1, s2);
          OutTextXY(30, GetMaxY-50, s1);
          OutTextXY(70, GetMaxY-50, s2);

          str(M[2, 1]:3:1, s1);
          str(M[2, 2]:3:1, s2);
          OutTextXY(30, GetMaxY-30, s1);
          OutTextXY(70, GetMaxY-30, s2);
     end;

     {Define world coordinate system:}
     const
          XMIN = -10.0; XMAX = 10.0;
          YMIN = -10.0; YMAX = 10.0;

     procedure PutPoint(x, y :double);
     var
        locx, locy : integer;
     begin
          locx := round((x+XMAX)*GetMaxX/(XMAX-XMIN));
          locy := round((YMAX-y)*GetMaxY/(YMAX-YMIN));
          PutPixel(locx, locy, GetMaxColor);
     end;

     procedure PutLine(s:string; x1, y1, x2, y2 : double);
     var
        lx1, lx2, ly1, ly2 : integer;
     begin
          lx1 := round((x1+XMAX)*GetMaxX/(XMAX-XMIN));
          lx2 := round((x2+XMAX)*GetMaxX/(XMAX-XMIN));
          ly1 := round((YMAX-y1)*GetMaxY/(YMAX-YMIN));
          ly2 := round((YMAX-y2)*GetMaxY/(YMAX-YMIN));
          line(lx1, ly1, lx2, ly2);
          OutTextXY(lx2+10, ly2+10, s);
     end;

     procedure Plot(M:m2);
     const
          TWOPI = 6.2830;
          delta = 0.01;
          TIME_PER_PICTURE = 10.0;
          {delta and TIME_PER_PICTURE are your tuning parameters.
          delta controls the resolution.  The number of pixels plotted
          will be 2*pi/delta.  A smaller delta means more resolution, but
          it'll get slower.

          TIME_PER_PICTURE is a lower-bound.  Normally, on fast processors,
          the whole picture is created too quickly.  This program ensures
          that the process of drawing the picture takes ATLEAST
          TIME_PER_PICTURE seconds.  It might take more on a slow machine,
          but it won't take less time than this limit.}
     var
        theta, x, y, tx, ty : double;
        iterations : integer;
        needed, spacing, waste : integer;
        actually, shouldhave : real;
     begin
          PutAxes; PutM(M);
          PutLine('col1', 0.0, 0.0, M[1, 1], M[2, 1]);
          PutLine('col2', 0.0, 0.0, M[1, 2], M[2, 2]);
          if (not keypressed) then delay(1000);
          theta := 0.0;
          iterations := 0;
          needed := round(TWOPI/delta);  {it's going to take so many iterations}
          spacing := needed div 100; {we're going to check on speed 100 times}

          RestartTimer;
          repeat
                inc(iterations);
                if (not keypressed) and ((iterations mod spacing) = 0) then
                begin
                     actually := Elapsed;
                     shouldhave := TIME_PER_PICTURE*iterations/needed;
                     waste := round((shouldhave - actually)*1000);
                     if (waste > 0) then delay(waste);
                end;
                x := cos(theta); y := sin(theta);
                PutPoint(x, y);
                tx := M[1, 1]*x + M[1, 2]*y;
                ty := M[2, 1]*x + M[2, 2]*y;
                PutPoint(tx, ty);
                theta := theta + delta;
          until theta > TWOPI;
          waitkey;
     end;

var
   grDriver : Integer;
   grMode   : Integer;
   ErrCode  : Integer;

begin
     grDriver := Detect;
     InitGraph(grDriver,grMode,'.'); ErrCode := GraphResult;
     if ErrCode = grOk then Plot(M)
     else write('Graphics initialisation failed.');
end;

var
   quit : boolean;
   M : m2;
begin
     clrscr;
     quit := false;
     repeat
           quit := GetM(M);
           if (not quit) then V(M);
     until quit;
     RestoreCrtMode;
end.