home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / GFXFX2.ZIP / SCR_SPRL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-14  |  1.5 KB  |  50 lines
  1.  
  2. {$r-} { Test with R+ and note the difference! }
  3.  
  4. program spiral_scroll; { SCR_SPRL.PAS }
  5. { Spiral scroll - an oldy a-la Amiga - kinda shocky, by Bas van Gaalen }
  6. uses u_vga,u_kb;
  7. const txt:string=' Howdy folks, this is a scroll like in the Amiga days...   ';
  8. var
  9.   stab:array[0..255] of byte; { sine table }
  10.   ctab:array[0..255] of byte; { color table }
  11.  
  12. procedure spiral;
  13. var
  14.   bitmap:array[0..319] of byte;
  15.   x:word;
  16.   i,j,ch,txtidx,chrlin:byte;
  17. begin
  18.   fillchar(bitmap,sizeof(bitmap),0);
  19.   txtidx:=0; j:=0;
  20.   repeat
  21.     ch:=byte(txt[txtidx]); txtidx:=1+txtidx mod length(txt);
  22.     for chrlin:=0 to 7 do begin
  23.       move(bitmap[1],bitmap[0],sizeof(bitmap)-1); { scroll bitmap 'up' }
  24.       bitmap[319]:=mem[seg(font^):ofs(font^)+ch shl 3+chrlin]; { add bitpattern }
  25.       vretrace;
  26.       for x:=0 to 319-8 do { loop to clear all char-lines }
  27.         for i:=0 to 7 do mem[u_vidseg:stab[(x+j) mod 255]*320+x+i]:=0;
  28.       dec(j,1);
  29.       for x:=0 to 319-8 do { loop to write all char-lines }
  30.         for i:=0 to 7 do begin { loop to extend bits to pixels }
  31.           if ((bitmap[x] shl i) and 128)=128 then
  32.             mem[u_vidseg:stab[(x+j) mod 255]*320+x+i]:=ctab[(x+j) mod 255]
  33.           else mem[u_vidseg:stab[(x+j) mod 255]*320+x+i]:=0;
  34.         end;
  35.     end;
  36.   until keypressed;
  37. end;
  38.  
  39. var i:byte;
  40. begin
  41.   setvideo($13);
  42.   getfont(font8x8);
  43.   for i:=0 to 255 do begin
  44.     stab[i]:=round(sin(i*4*pi/255)*20)+50;
  45.     if cos(i*4*pi/255)>0 then ctab[i]:=11 else ctab[i]:=3;
  46.   end;
  47.   spiral;
  48.   setvideo(u_lm);
  49. end.
  50.