home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / smtscr.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  3KB  |  142 lines
  1.  
  2. program smoothtextscroll;
  3. { hardware smooth text scroll, by Bas van Gaalen, and Sven van Heel,
  4.   Holland, PD }
  5. uses crt;
  6. const vidseg:word=$b800; lines=8; txt:string=' Bas was here...  ';
  7. var fofs,fseg:word; ofs:byte;
  8.  
  9. procedure getfont; assembler;
  10. asm
  11.   push bp
  12.   mov ax,1130h
  13.   mov bh,1
  14.   int 10h
  15.   mov fseg,es
  16.   mov fofs,bp
  17.   pop bp
  18. end;
  19.  
  20. procedure vertrace; assembler;
  21. asm
  22.   mov dx,03dah
  23.  @vert1:
  24.   in al,dx
  25.   test al,8
  26.   jnz @vert1
  27.  @vert2:
  28.   in al,dx
  29.   test al,8
  30.   jz @vert2
  31. end;
  32.  
  33. procedure setaddress(ad:word); assembler;
  34. asm
  35.   mov dx,3d4h
  36.   mov al,0ch
  37.   mov ah,[byte(ad)+1]
  38.   out dx,ax
  39.   mov al,0dh
  40.   mov ah,[byte(ad)]
  41.   out dx,ax
  42. end;
  43.  
  44. procedure setsmooth(smt:byte); assembler;
  45. asm
  46.   mov dx,03c0h
  47.   mov al,13h+32
  48.   out dx,al
  49.   inc dx
  50.   in al,dx
  51.   and al,11110000b
  52.   mov ah,smt
  53.   or al,ah
  54.   dec dx
  55.   out dx,al
  56. end;
  57.  
  58. procedure setup(ad:word); assembler;
  59. asm
  60.   mov dx,3d4h
  61.   mov al,18h
  62.   mov ah,[byte(ad)]
  63.   out dx,ax
  64.   mov al,7
  65.   out dx,al
  66.   inc dx
  67.   in al,dx
  68.   dec dx
  69.   mov ah,[byte(ad)+1]
  70.   and ah,00000001b
  71.   shl ah,4
  72.   and al,11101111b
  73.   or al,ah
  74.   mov ah,al
  75.   mov al,7
  76.   out dx,ax
  77.  
  78.   mov al,9
  79.   out dx,al
  80.   inc dx
  81.   in al,dx
  82.   dec dx
  83.   mov ah,[byte(ad)+1]
  84.   and ah,00000010b
  85.   shl ah,5
  86.   and al,10111111b
  87.   or al,ah
  88.   mov ah,al
  89.   mov al,9
  90.   out dx,ax
  91.  
  92.   mov dx,03c0h
  93.   mov al,10h+32
  94.   out dx,al
  95.   inc dx
  96.   in al,dx
  97.   and al,11011111b
  98.   or al,00100000b
  99.   dec dx
  100.   out dx,al
  101. end;
  102.  
  103. procedure bordercut;
  104. begin
  105.    port[$3d4] := $11;
  106.    port[$3d5] := port [$3d5] and $7f;
  107.  
  108.    port[$3d4] := 1;     { display end }
  109.    port[$3d5] := 78;
  110.    port[$3d4] := 5;     { end hor retrace }
  111.    port[$3d5] := 1;
  112.    port[$3d4] := $11;
  113.    port[$3d5] := port [$3d5] or $80;
  114. end;
  115.  
  116. var x,y,i,ch:word; cx,txtidx:byte;
  117. begin
  118.   textmode(co80);
  119.   getfont;
  120.   setup(lines*16);
  121.   setaddress((25-lines)*80);
  122.   bordercut;
  123.   gotoxy(4,1); writeln('Hey, a smooth textscroll...'); { note the pos! }
  124.   x:=0; cx:=0; txtidx:=1; i:=8;
  125.   repeat
  126.     vertrace;
  127.     setsmooth(x); ofs:=ofs mod 4;
  128.     x:=(3+x) mod 9;
  129.     if x=3 then begin
  130.       ch:=byte(txt[txtidx]) shl 3;
  131.       for y:=0 to lines-1 do begin
  132.         move(mem[$b800:(25-lines+y)*160+4],mem[$b800:(25-lines+y)*160+2],158);
  133.         if boolean((mem[fseg:fofs+ch+y] shr i) and 1) then
  134.           memw[vidseg:(25-lines+y)*160+158]:=$1fdb else
  135.           memw[vidseg:(25-lines+y)*160+158]:=$1020;
  136.       end;
  137.       i:=(i-1) mod 8; if i=0 then txtidx:=1+txtidx mod length(txt);
  138.     end;
  139.   until keypressed;
  140.   textmode(lastmode);
  141. end.
  142.