home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / chartest.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  2KB  |  127 lines
  1.  
  2. { Try to make smoothscrolling textscroll }
  3. { whoops, one of the very firsts. ;-) }
  4.  
  5. program CharTest;
  6.  
  7. uses
  8.   crt,dos,tpfast;
  9.  
  10. const
  11.   Bits   : array[0..7] of byte = (128,64,32,16,8,4,2,1);
  12.   ScrTxt : string = 'Howdy folks, this is a scrolltext...           ';
  13.  
  14. var
  15.   Font8x8Seg,
  16.   Font8x8Ofs  : word;
  17.  
  18. procedure GetFont8x8(var Segment,Offset : word);
  19.  
  20. var
  21.   Reg : Registers;
  22.  
  23. begin
  24.   Reg.AX := $1130;
  25.   Reg.BH := $3;
  26.   Intr($10,Reg);
  27.   Segment := Reg.ES;
  28.   Offset := Reg.BP;
  29. end;
  30.  
  31. procedure Scroll(Segment,Offset : word);
  32.  
  33. var
  34.   TxtPos    : word;
  35.   CharPos,
  36.   I,J,
  37.   Character : byte;
  38.  
  39. begin
  40.   TxtPos := 1;
  41.   repeat
  42.     CharPos := 0;
  43.     Character := ord(ScrTxt[TxtPos]);
  44.     for CharPos := 0 to 7 do begin
  45.  
  46.       {I := 0;
  47.       while I < 159 do begin
  48.         for J := 0 to 15 do mem[$B800:I+(J*160)] := mem[$B800:2+I+(J*160)];
  49.         inc(I,2);
  50.       end;}
  51.  
  52.       {scrollx('l',1,1,80,16,1,white);}
  53.  
  54.       I := 0;
  55.       while I < 15 do begin
  56.         if mem[Font8x8Seg:Font8x8Ofs+(8*Character)+(I div 2)] and Bits[CharPos] <> 0 then begin
  57.           mem[$B800:158+(I*160)] := ord('█');
  58.           mem[$B800:318+(I*160)] := ord('█');
  59.         end
  60.         else begin
  61.           mem[$B800:158+(I*160)] := ord(' ');
  62.           mem[$B800:318+(I*160)] := ord(' ');
  63.         end;
  64.         inc(I,2);
  65.       end;
  66.  
  67.       asm
  68.  
  69.           push ES
  70.           push DS
  71. {
  72.           mov  CX,7
  73.         @Lus1:
  74.           push CX
  75.           mov  BX,CX
  76. }
  77.           mov  DX,$3DA
  78.         @Wait:
  79.           in   AL,DX
  80.           test AL,08h
  81.           jz   @Wait
  82.         @Retr:
  83.           in   AL,DX
  84.           test AL,$08
  85.           jnz  @Retr
  86.  
  87.           mov  SI,2
  88.           mov  DI,0
  89.           mov  CX,16
  90.         @Lus2:
  91.           push CX
  92.           mov  AX,$B800
  93.           mov  ES,AX
  94.           mov  DS,AX
  95.           mov  CX,79
  96.           rep  movsw
  97.  
  98.           {mov  BX,@ScrTxt}
  99.  
  100.           inc  DI
  101.           inc  DI
  102.           inc  SI
  103.           inc  SI
  104.           pop  CX
  105.           loop @Lus2
  106. {          pop  CX
  107.           loop @Lus1
  108. }
  109.           pop DS
  110.           pop ES
  111.       end;
  112.  
  113.     end;
  114.     inc(TxtPos);
  115.     if TxtPos = length(ScrTxt) then TxtPos := 1;
  116.   until keypressed;
  117. end;
  118.  
  119. begin
  120.   textcolor(white); textbackground(black);
  121.   clrscr;
  122.   cursoroff;
  123.   GetFont8x8(Font8x8Seg,Font8x8Ofs);
  124.   Scroll(Font8x8Seg,Font8x8Ofs);
  125.   cursoron;
  126. end.
  127.