home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / bigscrol.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  2KB  |  55 lines
  1.  
  2. program bigscroll;
  3. uses crt;
  4. const vidseg:word=$b800; spd=1; ys=3; xs=5; txt:string=' Large enough?   ';
  5. var virscr:pointer; virseg,fofs,fseg:word;
  6.  
  7. procedure getfont; assembler; asm { gets 8x16 font }
  8.   mov ax,1130h; mov bh,6; int 10h; mov fseg,es; mov fofs,bp; end;
  9.  
  10. procedure retrace; assembler; asm { waits for vertical retrace }
  11.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  12.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  13.  
  14. procedure cls(lvseg:word); assembler; asm { clear segment }
  15.   mov es,[lvseg]; xor di,di; xor ax,ax; mov cx,2*80*48; rep stosw; end;
  16.  
  17. procedure flip(src,dst:word); assembler; asm { copy virt scr to visual scr }
  18.   push ds; mov es,[dst]; mov ds,[src]; xor si,si
  19.   xor di,di; mov cx,2*80*48; rep movsw; pop ds; end;
  20.  
  21. procedure ssl(lvseg:word); assembler; asm { scrolls text screen left }
  22.   push ds; mov es,[lvseg]; mov ds,[lvseg]; xor di,di; mov si,2; mov dx,48
  23.   @l0: mov cx,79; rep movsw; add si,2; add di,2; dec dl; jnz @l0; pop ds; end;
  24.  
  25. procedure scroll;
  26. var s,x,x2,y,y2,ch,txtidx:byte;
  27. begin
  28.   txtidx:=1;
  29.   repeat
  30.     ch:=byte(txt[txtidx]);
  31.     for x:=7 downto 0 do
  32.       for x2:=1 to xs do begin
  33.         retrace;
  34.         for s:=1 to spd do ssl(virseg);
  35.         for y:=0 to 15 do
  36.           if boolean((mem[fseg:fofs+ch*16+y] shr x) and 1) then
  37.             for y2:=0 to ys-1 do memw[virseg:(y*ys+y2)*160+158]:=2011 else
  38.             for y2:=0 to ys-1 do memw[virseg:(y*ys+y2)*160+158]:=32;
  39.         flip(virseg,vidseg);
  40.       end;
  41.     txtidx:=1+txtidx mod length(txt);
  42.   until keypressed;
  43. end;
  44.  
  45. begin
  46.   textmode(co80+font8x8); { needs VGA }
  47.   getfont;
  48.   getmem(virscr,2*80*50);
  49.   virseg:=seg(virscr^);
  50.   cls(virseg);
  51.   scroll;
  52.   freemem(virscr,2*80*50);
  53.   textmode(lastmode);
  54. end.
  55.