home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / egavga.swg / 0105_Screen Sweep.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-05  |  2.1 KB  |  85 lines
  1. {
  2.  WA> I was wondering if anyone could help me out here.  What I
  3.  WA> would like is a program that sweeps my screen clear or to a
  4.  WA> color then self terminates. Something similar to a radar
  5.  WA> sweep.  I have a limited knowledge of TP 7.
  6.  
  7. I guess everyone who programs in Pascal has a limited knowledge of TP.
  8.  
  9. Anyway, this is what I just made:
  10.  
  11. --- cut here --- }
  12.  
  13. program screensweep;
  14. uses crt;
  15. const vseg : word = $b800; fillchar = 32;
  16. var x,i,maxx,maxy : integer;
  17.  
  18. procedure retrace;
  19. begin
  20.   while (port[$3da] and 8) <> 0 do;
  21.   while (port[$3da] and 8) = 0 do;
  22. end;
  23.  
  24. procedure plot(x,y : integer); begin
  25.   mem[vseg:y*160+x+x] := fillchar; end;
  26.  
  27. procedure line(x,y,x2,y2 : integer);
  28. var d,dx,dy,ai,bi,xi,yi : integer;
  29. begin
  30.   if x < x2 then begin xi := 1; dx := x2-x; end
  31.   else begin xi := -1; dx := x-x2; end;
  32.   if y < y2 then begin yi := 1; dy := y2-y; end
  33.   else begin yi := -1; dy := y-y2; end;
  34.   plot(x,y);
  35.   if dx > dy then begin
  36.     ai := (dy-dx)*2; bi := dy*2; d := bi-dx;
  37.     repeat
  38.       if d >= 0 then begin inc(y,yi); inc(d,ai); end else inc(d,bi);
  39.       inc(x,xi); plot(x,y);
  40.     until x = x2;
  41.   end
  42.   else begin
  43.     ai := (dx-dy)*2; bi := dx*2; d := bi-dy;
  44.     repeat
  45.       if d >= 0 then begin inc(x,xi); inc(d,ai); end else inc(d,bi);
  46.       inc(y,yi); plot(x,y);
  47.     until y = y2;
  48.   end;
  49. end;
  50.  
  51. begin
  52.   if lastmode = 7 then vseg := $b000;
  53.   maxx := lo(windmax); maxy := hi(windmax);
  54.  
  55.   { fill the screen with characters added by G.DAVIS}
  56.   for i := 1 to SUCC(maxy) do
  57.   begin
  58.   gotoxy(1,i);
  59.   for x := 1 to SUCC(maxx) do write(Chr(X+32));
  60.   end;
  61.  
  62.   for i := 0 to maxx do begin
  63.     retrace;
  64.     line(maxx div 2,maxy div 2,i,0);
  65.   end;
  66.   for i := 0 to maxy do begin
  67.     retrace;
  68.     line(maxx div 2,maxy div 2,maxx,i);
  69.   end;
  70.   for i := maxx downto 0 do begin
  71.     retrace;
  72.     line(maxx div 2,maxy div 2,i,maxy);
  73.   end;
  74.   for i := maxy downto 0 do begin
  75.     retrace;
  76.     line(maxx div 2,maxy div 2,0,i);
  77.   end;
  78. end.
  79.  
  80. --- cut here ---
  81.  
  82. The line-routine was taken from Sean Palmers 320x240-mode-x unit (just a little
  83. re-idented. ;-))
  84.  
  85.