{Hi Dudes...

Dunno if you can do anything with this code; It sure is crappy!
Anywayzz, this kinda looks nice on my computer but I'm not sure
on how the timing will be on other systems... Might cause a
helluvalot of flicker...

Well, what can I say? Have Phun 8-)}

Program LooksLikeSomeTextModeEffectsToMe_YeahIGuessSo;

{$X+,E-,N-,I-,S-,R-,O-}

Type BigChar=Array[1..3,1..3] of Byte;
     MoveRecord = Record
                   XPos,YPos : Integer;
                   XSpeed,YSpeed : Integer;
                   Counter : Word;
                  End;

Const BigFont : Array[1..40] of BigChar = (
      ((192,196,182),(195,196,191),(188,032,188)), {A}
      ((192,196,182),(195,196,191),(193,196,183)), {B}
      ((192,196,190),(187,032,032),(193,196,190)), {C}
      ((192,190,187),(187,032,187),(193,196,183)), {D}
      ((192,196,190),(195,190,032),(193,196,190)), {E}
      ((192,196,190),(195,190,032),(188,032,032)), {F}
      ((192,196,190),(187,194,182),(193,196,183)), {G}
      ((189,032,189),(195,196,191),(188,032,188)), {H}
      ((194,196,190),(032,187,032),(194,196,190)), {I}
      ((192,196,182),(195,196,191),(188,032,198)), {J}
      ((192,196,182),(195,196,191),(188,032,198)), {K}
      ((189,032,032),(187,032,032),(193,196,190)), {L}
      ((192,196,182),(187,189,187),(188,188,188)), {M}
      ((192,196,182),(187,032,187),(188,032,188)), {N}
      ((192,196,182),(187,032,187),(193,196,183)), {O}
      ((192,196,182),(187,032,187),(187,194,183)), {P}
      ((192,196,182),(195,196,191),(188,032,198)), {Q}
      ((192,196,182),(195,196,198),(188,032,197)), {R}
      ((192,196,190),(193,196,182),(194,196,183)), {S}
      ((194,196,190),(032,187,032),(032,188,032)), {T}
      ((189,032,189),(187,032,187),(193,196,183)), {U}
      ((189,032,187),(188,032,187),(194,196,183)), {V}
      ((189,189,189),(187,188,187),(193,196,183)), {W}
      ((189,032,189),(192,196,183),(188,032,187)), {X}
      ((189,032,189),(193,196,183),(032,188,032)), {Y}
      ((192,196,182),(195,196,191),(188,032,198)), {Z}
      ((032,032,032),(032,032,032),(185,185,185)), {...}
      ((032,187,032),(032,188,032),(032,185,032)), {!}
      ((192,196,182),(187,186,187),(193,196,183)), {0}
      ((194,182,032),(032,187,032),(194,196,190)), {1}
      ((194,196,182),(192,196,183),(193,196,190)), {2}
      ((194,196,182),(032,194,191),(194,196,183)), {3}
      ((189,032,189),(193,196,191),(032,032,188)), {4}
      ((192,196,190),(193,196,182),(194,196,183)), {5}
      ((192,196,190),(195,196,182),(193,196,183)), {6}
      ((194,196,182),(032,032,187),(032,032,188)), {7}
      ((192,196,182),(195,196,191),(193,196,183)), {8}
      ((192,196,182),(193,196,191),(194,196,183)), {9}
      ((032,032,032),(194,196,190),(032,032,032)), {-}
      ((032,032,032),(032,032,032),(032,032,032)));{ }

      ScrWidth : Word = 160;
      StartDat : Array[0..15] of Byte = (8,0,1,2,3,4,5,6,7,6,5,4,3,2,1,0);
      BarRes   = 270;
      BarRad   = 260 Div 2;
      Mes      : String = '';

      ScrollMessage : String = 'Hi there possoms! howst hanging. How about some simple TextMode Scroller.    ';
      ScrollOfs     : Byte = 9;
      ScrollPos     : Byte = 0;
      CharOfs       : Byte = 2;


Var BarCols  : Array[0..399] of Byte;
    Bars     : Array[1..4] of Record
                               StartCol : Byte;
                               YPos     : Integer;
                              End;
    BarPos   : Array[1..BarRes] of Integer;
    MyPal    : Array[0..767] of Byte;
    MoveMes,MoveSplit : MoveRecord;

Procedure CharMap; Assembler;
Asm
  db      0,0,0,0,0,0,192,240,248,252,252,60,60,60,60,60           {¿}
  db      60,60,60,60,60,252,252,248,240,192,0,0,0,0,0,0           {Ù}
  db      24,60,60,60, 60,60,60,60, 60,60,60,24, 0,0,0,0
  db      0,0,0,0, 60,126,255,255, 255,255,126,60, 0,0,0,0
  db      96,240,240,248, 248,120,124,60, 60,62,30,31, 31,15,15,6
  db      60,60,60,60,60,60,60,60,60,60,60,60,60,60,60,60
  db      60,60,60,60,60,60,60,60,60,60,60, 24, 0,0,0,0
  db      0,0,0,0, 24,60,60,60,60,60,60,60,60,60,60,60
  db      0,0,0,0,0,0,254,255,255,254,0,0,0,0,0,0           {->}
  db      60,60,60,60,60,124,252,252,252,252,124,60,60,60,60,60
  db      0,0,0,0,0,0,3,15,31,63,62,62,60,60,60,60          {Ú}
  db      60,60,60,60,62,62,63,31,15,3,0,0,0,0,0,0          {À}
  db      0,0,0,0,0,0,127,255,255,127,0,0,0,0,0,0           {<-}
  db      60,60,60,60,60,62,63,63, 63,63,62,60, 60,60,60,60 {Ã}
  db      0,0,0,0,0,0,255,255,255,255,0,0,0,0,0,0           {Ä}
  db      240,120,120,120,120,120,60,60, 60,60,60,24, 0,0,0,0   {\}
  db      60,60,60,60,60,252,252,248,240,224,224,240,240,240,240,240
End;

Procedure SetCharset; Assembler;
Asm
 Push Bp
 mov ax,cs                       { Set character set for logo }
 mov es,ax
 mov bp,cs:offset charmap
 mov ax,1100h
 mov bx,1000h
 mov cx,17
 mov dx,182
 int 10h
 Pop Bp
End;

Procedure Standard_Palette; Assembler;  { DP ][ Ext. Compatible }
Asm
db 0,0,0,0,0,42,0,42,0,0,42,42,42,0,0,42,0,42,42,21,0,42,42
db 42,21,21,21,21,21,63,21,63,21,21,63,63,63,21,21,63,21,63,63,63,21,63
db 63,63,59,59,59,55,55,55,52,52,52,48,48,48,45,45,45,42,42,42,38,38,38
db 35,35,35,31,31,31,28,28,28,25,25,25,21,21,21,18,18,18,14,14,14,11,11
db 11,8,8,8,63,0,0,59,0,0,56,0,0,53,0,0,50,0,0,47,0,0,44
db 0,0,41,0,0,38,0,0,34,0,0,31,0,0,28,0,0,25,0,0,22,0,0
db 19,0,0,16,0,0,63,54,54,63,46,46,63,39,39,63,31,31,63,23,23,63,16
db 16,63,8,8,63,0,0,63,42,23,63,38,16,63,34,8,63,30,0,57,27,0,51
db 24,0,45,21,0,39,19,0,63,63,54,63,63,46,63,63,39,63,63,31,63,62,23
db 63,61,16,63,61,8,63,61,0,57,54,0,51,49,0,45,43,0,39,39,0,33,33
db 0,28,27,0,22,21,0,16,16,0,52,63,23,49,63,16,45,63,8,40,63,0,36
db 57,0,32,51,0,29,45,0,24,39,0,54,63,54,47,63,46,39,63,39,32,63,31
db 24,63,23,16,63,16,8,63,8,0,63,0,0,63,0,0,59,0,0,56,0,0,53
db 0,1,50,0,1,47,0,1,44,0,1,41,0,1,38,0,1,34,0,1,31,0,1
db 28,0,1,25,0,1,22,0,1,19,0,1,16,0,54,63,63,46,63,63,39,63,63
db 31,63,62,23,63,63,16,63,63,8,63,63,0,63,63,0,57,57,0,51,51,0,45
db 45,0,39,39,0,33,33,0,28,28,0,22,22,0,16,16,23,47,63,16,44,63,8
db 42,63,0,39,63,0,35,57,0,31,51,0,27,45,0,23,39,54,54,63,46,47,63
db 39,39,63,31,32,63,23,24,63,16,16,63,8,9,63,0,1,63,0,0,63,0,0
db 59,0,0,56,0,0,53,0,0,50,0,0,47,0,0,44,0,0,41,0,0,38,0
db 0,34,0,0,31,0,0,28,0,0,25,0,0,22,0,0,19,0,0,16,60,54,63
db 57,46,63,54,39,63,52,31,63,50,23,63,47,16,63,45,8,63,42,0,63,38,0
db 57,32,0,51,29,0,45,24,0,39,20,0,33,17,0,28,13,0,22,10,0,16,63
db 54,63,63,46,63,63,39,63,63,31,63,63,23,63,63,16,63,63,8,63,63,0,63
db 56,0,57,50,0,51,45,0,45,39,0,39,33,0,33,27,0,28,22,0,22,16,0
db 16,63,58,55,63,56,52,63,54,49,63,53,47,63,51,44,63,49,41,63,47,39,63
db 46,36,63,44,32,63,41,28,63,39,24,60,37,23,58,35,22,55,34,21,52,32,20
db 50,31,19,47,30,18,45,28,17,42,26,16,40,25,15,39,24,14,36,23,13,34,22
db 12,32,20,11,29,19,10,27,18,9,23,16,8,21,15,7,18,14,6,16,12,6,14
db 11,5,10,8,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
db 0,0,0,0,0,0,49,10,10,49,19,10,49,29,10,49,39,10,49,49,10,39,49
db 10,29,49,10,19,49,10,10,49,12,10,49,23,10,49,34,10,49,45,10,42,49,10
db 31,49,10,20,49,11,10,49,22,10,49,33,10,49,44,10,49,49,10,43,49,10,32
db 49,10,21,49,10,10,63,63,63
End;

Function KeyPressed : Boolean; Assembler;
Asm
 Mov Ah,0Bh
 Int 21h
End;

Procedure WriteBigMessage(X,Y,Color:Byte; Message:String);
Var B,D    : Byte;
    ScrOfs : Word;

Const TransTab : Array[0..255] of Byte =
      (32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32, {15}
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32, {31}
       40,28,32,32,32,32,32,32,32,32,32,32,32,39,27,32, {47}
       29,30,31,32,33,34,35,36,37,38,32,32,32,32,32,32, {63}
       32, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, {79}
       16,17,18,19,20,21,22,23,24,25,26,32,32,32,32,32, {95}
       32, 1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15, {111}
       16,17,18,19,20,21,22,23,24,25,26,32,32,32,32,32, {127}
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,
       32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32);

Begin
 Mes:=Message;
 D:=Length(Mes);
 If D=0 then Exit;
 ScrOfs:=(Y-1)*ScrWidth+2*X+2;

  Asm
    Mov Ax,$B800              { Set starting address on screen }
    Mov Es,Ax
    Mov Di,ScrOfs

    Mov B,1                   { Start with first character ;-) }
   @StringLoop:
    Xor Bh,Bh
    Mov Bl,B
    Mov Al,Ds:[Offset Mes+Bx] { Get Next Character from String }
    Mov Bx,Offset TransTab
    XLat                      { And translate into real value }

    Dec Al
    Mov Bl,9
    Mul Bl
    Mov Si,Offset BigFont     { Character offset in Font-Table }
    Add Si,Ax

    Mov Ah,Color
    Mov Dx,3
   @FontColumn:               { Loop three Rows... }
    Mov Cx,3
   @FontRow:                  { and three columns }
    LodsB
    StosW
    Loop @FontRow
    Add Di,ScrWidth
    Sub Di,6
    Dec Dx
    Jnz @FontColumn

    Mov Ax,3                  { prepare screen address for next character }
    Mul ScrWidth
    Sub Di,Ax
    Add Di,8

    Inc B
    Mov Al,D
    Cmp B,Al
    Jng @StringLoop
   End;
End;

Procedure WriteCenteredBig(Y,Color:Byte; Message:String);
Begin
 WriteBigMessage(((ScrWidth Div 4)+2)-(Length(Message)*2),Y,Color,Message);
End;

Procedure MakePal;
Var A:Word;
Begin
 For A:=0 to 255 do
  Begin
   Mypal[A]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3];
   Mypal[A+256]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3+1];
   Mypal[A+512]:=Mem[Seg(Standard_Palette):Ofs(Standard_Palette)+A*3+2];
  End;
End;

Procedure SetupBars;
Var V : Integer;
Begin
  For V:=1 To BarRes Do
   BarPos[V]:=Round(BarRad*Sin((2*Pi/BarRes)*V))+BarRad+1;
 For V:=1 to 4 do
  With Bars[V] do
   Begin
    StartCol:=V*16;
    if v=3 then startcol:=96;
    if v=4 then startcol:=144;
    if v=5 then startcol:=160;
    YPos:=14*V;
   End;
 For V:=304 to 319 do Barcols[V]:=(15-(V mod 16))+160;
 For V:=320 to 335 do Barcols[V]:=V mod 16+160;
End;

Procedure UpdateBars;
Var V,U,Y : Integer;
Begin
  For V:=1 To 4 do
   For U:=0 to 31 do BarCols[barpos[Bars[V].YPos]+U]:=0;
 For V:=1 To 4 do
  Begin
   Inc(Bars[V].YPos);
    If Bars[V].YPos>BarRes then Bars[V].YPos:=1;
   Y:=BarPos[Bars[V].YPos];
   For U:=0 to 15 do BarCols[Y+U]:=Bars[V].StartCol+15-U;
   For U:=16 to 31 do BarCols[Y+U]:=Bars[V].StartCol+U-16;
  End;
End;

Procedure ColorBars; Assembler;
Asm
  MOV DX,$03DA
  In AL,DX
  MOV DX,$03C0   { assume color nr 0 = default Text background.. }
  MOV AL,$20+0   { set color nr 0 .. }
  OUT DX,AL
  MOV AL,0       { .. to DAC color 0 }
  OUT DX,AL

  Xor SI,SI
  CLI
  MOV DX,$03DA
  MOV AH,8
@Wau: in AL,DX
  TEST AL,AH
  JNZ @Wau       { wait Until out of retrace }
@Wai: in AL,DX
  TEST AL,AH
  JZ @Wai        { wait Until inside retrace }
@Doline:
  STI
  Mov Bl,[Offset BarCols+Si]
  Mov Di,Offset MyPal
  Add Di,Bx

  MOV DX,$03C8  { point to DAC[0] }
  MOV AL,0
  OUT DX,AL

  CLI
  MOV DX,$03DA
@Whu: in AL,DX
  RCR AL,1
  JC @Whu       { wait Until out of horizontal retrace }
@Whi: in AL,DX
  RCR AL,1
  JNC @Whi      { wait Until inside retrace }

  Inc Si        { line counter }
                { prepare For color effect }

  MOV DX,$03C9
  Mov Al,[Di]
  OUT DX,Al   { Dynamic Red }
  Mov Al,[Di+256]
  OUT DX,AL   { Dynamic Green }
  mov Al,[Di+512]
  OUT DX,AL   { Dynamic Blue }

  CMP SI,296  { Paint just about 3/4 screen }
  JBE  @doline
  STI
End;

PROCEDURE Split(Row:Integer);
BEGIN
     ASM
        mov dx,$3d4
        mov ax,row
        mov bh,ah
        mov bl,ah
        and bx,201h
        mov cl,4
        shl bx,cl
        mov ah,al
        mov al,18h
        out dx,ax
        mov al,7
        cli
        out dx,al
        inc dx
        in al,dx
        sti
        dec dx
        mov ah,al
        and ah,0efh
        or ah,bl
        mov al,7
        out dx,ax
        mov al,9
        cli
        out dx,al
        inc dx
        in al,dx
        sti
        dec dx
        mov ah,al
        and ah,0bfh
        shl bh,1
        shl bh,1
        or ah,bh
        mov al,9
        out dx,ax
     END;
END;

Procedure FastWrite(Col,Row,Attrib:Byte; Str:String);
Var MemPos : Word;
    A      : Byte;
Begin
 MemPos:=(Col*2)+(Row*ScrWidth)-ScrWidth-2;
 A:=Length(Str);
  For A:=1 to Length(Str) do
   Begin
    MemW[$B800:MemPos]:=Ord(Str[A])+Attrib*256;
    MemPos:=MemPos+2;
   End;
End;

Procedure CenterWrite(Y,Color:Byte;Mes:String);
Begin
 FastWrite(41-((Length(Mes)-1) Div 2),Y,Color,Mes);
End;

Procedure CursorOff; Assembler;
Asm
  Mov Ax,0100h
  Mov Cx,2000h
  Int 10h
End;

Procedure CursorOn; Assembler;
Asm
  Mov Ax,0100h
  Mov Cx,0607h
  Int 10h
End;

Procedure ScrollText(Nr:Word); Assembler;
Asm
  mov ax,nr
  mov cx,$40
  mov es,cx
  mov cl,es:[$85]
  div cl
  mov cx,ax
  mov dx,es:[$63]
  push dx
  mov al,$13
  cli
  out dx,al
  inc dx
  in al,dx
  sti
  mul cl
  shl ax,1
  mov es:[$4e],ax
  pop dx
  mov cl,al
  mov al,$c
  out dx,ax
  mov al,$d
  mov ah,cl
  out dx,ax
  mov ah,ch
  mov al,8
  out dx,ax
End;


Function ReadKey : Char; Assembler;
Asm
 Mov Ah,07h
 Int 21h
End;

Procedure SetHorizOfs(Count:Byte);
Var I : Byte;
Begin
 I:=Port[$3DA];
 Port[$3C0]:=$33;
 Port[$3C0]:=StartDat[Count Mod 16];
End;

Procedure Sync; Assembler;
Asm
  Mov Dx,3DAh
@LoopIt:
  In Al,Dx
  Test Al,8
  Jz @LoopIt
End;

Procedure DoubleWidth; Assembler;
Asm
 Mov Dx,3D4h
 Mov Ax,5013h
 Out Dx,Ax
 Mov ScrWidth,320
End;

Procedure SetPELReset; Assembler;
Asm
 Mov Dx,3DAh
 In Al,Dx
 Mov Dx,3C0h
 Mov Al,30h
 Out Dx,Al
 Mov Al,2Ch
 Out Dx,Al
End;

Procedure SetView(X,Y:Word);
Var PelPos:Byte;
Begin
 PelPos:=StartDat[X Mod 9];
 X:=(X Div 9)+(Y Div 16)*160;
  Asm
    Mov Dx,3D4h    { Set Screen offset in bytes:}
    Mov Bx,X
    Mov Ah,Bh
    Mov Al,0Ch
    Out Dx,Ax
    Mov Ah,Bl
    Inc Al
    Out Dx,Ax

    Mov Al,8       { Set Y-Offset within Character-Row: }
    Mov Bx,Y
    And Bl,15
    Mov Ah,Bl
    Out Dx,Ax

    Mov Dx,3C0h    { Set X-Offset within Character-Column: }
    Mov Al,33h
    Out Dx,Al
    Mov Al,PelPos
    Out Dx,Al
 End;
End;

Procedure UpDateScroller;
Begin
 If ScrollOfs=9 then
  Begin
   ScrollOfs:=0;

   Move(Mem[$B800:14*320+2],Mem[$B800:14*320],3*320-2);
   Inc(CharOfs);
   If CharOfs=4 then
    Begin
     Inc(ScrollPos);
     WriteBigMessage(84-CharOfs,15,14,ScrollMessage[ScrollPos]);
     If ScrollPos=Length(ScrollMessage) Then ScrollPos:=0;
     CharOfs:=0;
    End;
  End
 else
  Inc(ScrollOfs,9);
 SetHorizOfs(ScrollOfs);
End;



Begin
 CursorOff;
 FillChar(Mem[$B800:0000],4000,0);

  With MoveMes do
   Begin
    YPos:=110;
    YSpeed:=2;
    XPos:=40*8;
    XSpeed:=3;
    Counter:=0;
   End;

  With MoveSplit Do
   Begin
    YPos:=295;
    YSpeed:=2;
   End;

 DoubleWidth;
 SetPelReset;
 ScrollText(MoveMes.YPos);
 Split(MoveSplit.YPos);
 Setupbars;
 MakePal;
 SetCharSet;
 Sync;
 CenterWrite(1,14,#194'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'#190);
 WriteBigMessage(1,2,4,'GAME - Gotta Get it!');
 CenterWrite(5,14,#194'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ'#190);

  Repeat
    With MoveMes do
     Begin
       If (YPos>80) and (YPos<200) then
        Inc(YPos,YSpeed)
       else
        Begin
         YSpeed:=-YSpeed;
         YPos:=YPos+YSpeed;
        End;
      Counter:=1-Counter;
       If Odd(Counter) then
        Begin
         If (XPos<40*8) or (XPos>40*8+150) then XSpeed:=-XSpeed;
         Inc(XPos,XSpeed);
        End;
     End;

    With MoveSplit do
     Begin
       If (YPos>290) and (YPos<325) then
        Inc(YPos,YSpeed)
       else
        Begin
         YSpeed:=-YSpeed;
         YPos:=YPos+YSpeed;
        End;
     End;

   UpdateBars;
   ScrollText(MoveMes.YPos);
   UpDateScroller;
   Split(MoveSplit.YPos);
   ColorBars;
  Until KeyPressed;

  While KeyPressed do Readkey;
 Split(400);
 SetView(0,0);
 ScrollText(0);
  Asm
   Mov Ax,3
   Int 10h
  End;
 FastWrite(1,1,15,'Bye from World of Wonders!');
 Writeln;
 CursorOn;
End.