Smooth Text Scrolling and Coppers! -TSCROLL.PAS

Here's some source for a simple, yet interesting effect. Should be of some
use. :)

(*----------------------------------------------------------------------------
This program achieves 'scrolling' in text mode by rotating the bit pattern
of a character left or right. By altering one character, any others of the
same ascii code are affected too, so a large scrolling area can be made up
of just one character. The text redefine routine was taken from SWAG, as the
normal way uses BIOS interrupts, which is too slow. Also, there is an
'copper' effect, that gives the illusion of more than 16 colors in text mode,
it works by altering the colors per scanline, and waiting for horizontal
retrace. Also utilized is 9-dot clock to remove the gap between characters,
and pel panning to hide the character wrap around that appears from the last
column to the first. All in all, a nice effect!
----------------------------------------------------------------------------*)

Program TextScroller;
{By Charles Mac Donald, <cg...@hooked.net> Should work on all cards!
 Text scrolling and copper effect example}

{$G+,A+,X+}
uses CRT;

{Patterns for the new text characters}
CONST
     Pattern0 : array [1..16] of byte =
     (240,240,240,240,015,015,015,015,240,240,240,240,015,015,015,015);
     Pattern1 : array [1..16] of byte =
     (102,129,153,036,036,153,129,102,102,129,153,036,036,153,129,102);
     Pattern2 : array [1..16] of byte =
     (102,051,153,204,102,051,153,204,102,051,153,204,102,051,153,204);

var x,y,c,counter : word;
    temp  : array [1..16] of byte;

{Waits for Vertical Retrace}
Procedure VRetrace; assembler;
asm
    mov  dx,3dah
@1: in   al,dx
    and  al,08h
    jnz  @1
@2: in   al,dx
    and  al,08h
    jz   @2
end;

{Write char C at X,Y}
Procedure GoText (x,y,c:word); assembler;
asm
   mov ax,0B800h
   mov es,ax
   xor di,di
   mov bx,[x]
   shl bx,1
   add di,bx
   mov bx,[y]
   mov ax,160
   mul bx
   add di,ax
   mov al,[c].byte
   mov ah,00000111b
   stosw
end;

{Set color C to R,G,B and wait for horizontal retrace}
Procedure CopLine (c,r,g,b : byte); assembler;
asm
   mov  dx,03c8h
   mov  al,[c]     {set color c}
   out  dx,al
   inc  dx
   mov  al,[r]     {set red component r}
   out  dx,al
   mov  al,[g]     {set green component g}
   out  dx,al

   mov  dx,03dah   {wait for horiz. retrace to stop 'snow' effect}
@1:in   al,dx
   and  al,01h
   jnz  @1
@2:in   al,dx
   and  al,01h
   jz   @2

   mov  dx,03c9h
   mov  al,[b]     {set blue compnent b}
   out  dx,al
end;

Procedure ChangeCharacter (var data; character:byte; direction:boolean);
begin
     {Rotate font bit pattern}
     move (data,temp,16);          {Move character data into temp array}
     for x:=0 to 15 do
     asm
        mov bx,[x]
        mov al,byte ptr temp [bx]
        mov cl,[counter.byte]
        cmp [direction],1
        jne @1
        rol al,cl                  {rotate left}
        jmp @2
    @1: ror al,cl                  {rotate right}
    @2: mov byte ptr temp [bx],al
     end;

     {Alter Font}
     PortW [$3C4] := $0402;        {Quick way to change fonts, from SWAG}
     PortW [$3C4] := $0704;
     PortW [$3CE] := $0204;
     PortW [$3CE] := $0005;
     PortW [$3CE] := $0006;
     Move(temp, Mem[SegA000:character * 32], 16);
     PortW [$3C4] := $0302;
     PortW [$3C4] := $0304;
     PortW [$3CE] := $0004;
     PortW [$3CE] := $1005;
     PortW [$3CE] := $0E06;
end;

begin
     TextMode (CO80);
     ClrScr;

     for x:=0 to 79 do
     for y:=0 to 07 do begin
     GoText (x,y+00,177);     {make top row}
     GoText (x,y+08,178);     {make middle row}
     GoText (x,y+16,179);     {make bottom row}
     end;

     gotoxy (33,12);
     writeln ('Scrolling Text!');
     gotoxy (33,13);
     writeln ('Press Any Key..');

     readkey;

     asm                  {Set dot clock to remove gaps between characters}
        mov dx,03c4h      {Port $3c4, the Sequencer}
        mov al,$01        {Index $01, Clocking Mode Register}
        out dx,al
        inc dx
        in  al,dx
        or  al,00000001b  {Enable bit 0, sets Dot Clock from 8 to 9 dots}
        out dx,al         {Notice I set the bits right this time... :)  }

        mov dx,03dah      {Pel pan over one cell to hide wrap-around}
        in  al,dx
        mov dx,03c0h
        mov al,33h
        out dx,al
        mov al,0
        out dx,al

        mov ah,1          {Call BIOS to remove cursor}
        mov cx,1400h
        int 10h
     end;

     repeat

     asm cli end;                                {disable interrupts}

     changecharacter (Pattern0,177,true);        {scroll char over one cell}
     changecharacter (Pattern1,178,false);
     changecharacter (Pattern2,179,true);

     inc (counter);                              {advance scroll counter}

     vretrace;

     for c := 00 to 63 do     copline (7,0,0,c); {make blue copper}
     for c := 63 downto 00 do copline (7,0,0,c);
     for c := 00 to 63 do     copline (7,0,c,0); {make green copper}
     for c := 63 downto 00 do copline (7,0,c,0);
     for c := 00 to 63 do     copline (7,c,0,0); {make red copper}
     for c := 63 downto 00 do copline (7,c,0,0);

     asm sti end;                                {enable interrupts}

     until keypressed;

     asm
     mov ah,1                                    {Call BIOS to restore cursor}
     mov cx,0607h
     int 10h
     end;
end.
-----------------------------------------------------------------------------------
<cg...@hooked.net>