{+++++++++++++++++++++++++++++++++++++++++++++}
{+ Por: |[QuArK]|                            +}
{+                                           +}
{+ Puedes encontrarme en el canal #pascal    +}
{+ o #freepascal del irc hispano. Este       +}
{+ c¢digo es de libre distribuci¢n, si       +}
{+ cambias algo de ‚l, espero ser nombrado   +}
{+ en los cr‚ditos  ;)                       +}
{+                                           +}
{+ Nota: Este programa funciona con TPascal  +}
{+       7.0, pero da fallos con freepascal  +}
{+       en la rutina de carga de caracters. +}
{+                                           +}
{+++++++++++++++++++++++++++++++++++++++++++++}
Uses Dos, Crt;

Const
 LTCL    : Byte = 2;                       { Color de las letras por defecto }

Var
 OAT     : Byte;
 CD      : Integer;
 TT      : String;
 MX      : Byte;
 MY      : Byte;

procedure HC; Assembler; Asm mov ax, $0100; mov cx, $2607; int $10; end;
procedure SC; Assembler; Asm mov ax, $0100; mov cx, $0506; int $10; end;

procedure LoadMatrixChars;
Const numnewChars = 17;
Type
  ByteArray = Array[0..15] of Byte;
  CharArray = Array[1..numnewChars] of
    Record
      CharNum : Byte;
      CharData : ByteArray;
    end;
Const newChars : CharArray = (
   (CharNum : 1;
    CharData : ($DE,$DE,$C0,$C0,$C0,$C0,$C0,$DE,$DE,$C0,$C0,$C0,$C0,$C0,$60,$3E)),
   (Charnum : 2;
    CharData : ($00,$00,$00,$40,$20,$38,$24,$13,$2C,$30,$40,$80,$00,$00,$00,$00)),
   (Charnum : 3;
    CharData : ($00,$E3,$E3,$E3,$E3,$60,$60,$60,$60,$30,$30,$18,$18,$0C,$07,$03)),
   (Charnum : 4;
    CharData : ($00,$02,$04,$1C,$F8,$78,$38,$18,$08,$08,$04,$04,$04,$02,$02,$01)),
   (Charnum : 5;
    CharData : ($01,$01,$03,$03,$7F,$FF,$03,$03,$03,$03,$03,$03,$03,$06,$FC,$F8)),
   (Charnum : 6;
    CharData : ($80,$80,$C5,$C5,$FF,$C5,$FF,$C5,$C1,$C0,$C0,$C0,$C0,$60,$3F,$1F)),
   (Charnum : 9;
    CharData : ($80,$96,$DB,$DB,$DB,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$C0,$60,$3F,$1F)),
   (Charnum :11;
    CharData : ($00,$10,$10,$10,$10,$10,$10,$FF,$1E,$1E,$1C,$1C,$18,$18,$10,$00)),
   (Charnum :12;
    CharData : ($01,$3F,$7F,$03,$03,$03,$03,$03,$7F,$3F,$03,$03,$03,$03,$7F,$FE)),
   (Charnum :14;
    CharData : ($08,$08,$FF,$68,$18,$08,$08,$08,$08,$08,$08,$0C,$FF,$08,$FF,$08)),
   (Charnum :15;
    CharData : ($00,$00,$FC,$FE,$03,$03,$00,$FF,$00,$00,$FF,$FF,$00,$00,$00,$00)),
   (Charnum :16;
    CharData : ($01,$02,$3E,$46,$46,$4A,$4A,$4A,$52,$52,$52,$62,$62,$7C,$40,$80)),
   (Charnum :17;
    CharData : ($74,$CC,$CC,$AC,$AC,$AC,$AC,$AC,$9C,$9C,$7F,$04,$04,$04,$04,$04)),
   (Charnum :18;
    CharData : ($18,$18,$FC,$FF,$63,$60,$60,$60,$60,$60,$60,$60,$30,$18,$0F,$03)),
   (Charnum :19;
    CharData : ($18,$18,$FC,$FF,$63,$60,$60,$60,$7E,$7F,$60,$60,$30,$18,$0F,$03)),
   (Charnum :20;
    CharData : ($00,$00,$FF,$FF,$C3,$C3,$C0,$60,$66,$3C,$38,$18,$3C,$66,$03,$01)),
   (Charnum :21;
    CharData : ($02,$06,$0A,$12,$22,$22,$46,$86,$FF,$FE,$06,$06,$06,$06,$04,$00))
    );
Var
  r : Registers;
  i : Byte;
begin
  for i := 1 to numnewChars do
    With r do
      begin
        { Carga un conjunto de car cteres alfanumericos especificos }
        ah := $11;
        al := $0;
        bh := $10;
        bl := 0;
        cx := 1;
        dx := NewChars[i].CharNum;
        es := seg(NewChars[i].CharData);
        bp := ofs(NewChars[i].CharData);
        intr($10,r);
      end;
end;


procedure MatrixSaveScr(X1,Y1,XA,YA,LC,DN,CL,DL:Byte);
{+++++++++++++++++++++++++++++++++++++}
{+ X1. Coordenadas de empiezo en X.  +}
{+ Y1. Coordenadas de empiezo en Y.  +}
{+ XA. Longitud del eje X.           +}
{+ YA. Longitud del eje Y.           +}
{+ LC. Letters color.                +}
{+ DN. Density.                      +}
{+ CL. Chain long.                   +}
{+ DL. Delay.                        +}
{+                                   +}
{+++++++++++++++++++++++++++++++++++++}
Const
  Chrs   : Array [1..17] of Byte = (1,2,3,4,5,6,9,11,12,14,15,16,17,18,19,20,21);
Var
  XX, CNT     : Byte;
  T1, T2      : Byte;
  RndCh       : Byte;
  LCC         : Byte;
  Procedure Scroll(L2S,RT,RB,CB,CT,FA:Byte); assembler;
  Asm
    mov ah, 07h; mov al, L2S; mov bh, FA;
    mov ch, RT; mov cl, CB; mov dh, RB;
    mov dl, CT; int 10h;
  end;
  Procedure WXY(X,Y,F,B:Byte;M:Char);
  begin
    TextColor(F); TextBackGround(B);
    GotoXY(X, Y); Write(M);
  end;
begin
  Cnt:=0; RndCh:=1; DN:=DN+1; XX:=0; CNT:=0; LCC:=0; T1:=0; T2:=0;
  Randomize;
  repeat
    RndCh := Random(17)+1;
    T1    := Random(DN);
    T2    := Random(CL)+1;
    Cnt   := Cnt + 1;
    if (Cnt >= CL) then
      begin
        Randomize;
        CL  := Random(10)+1;
        XX  := Random(XA);
        Cnt := 0;
      end;
    if (Cnt = 1) then LCC:=LC+8 else LCC:=LC;
    Scroll(1, Y1-1, (Y1+YA)-2, (X1+XX)-1, (X1+XX)-1, 0);
    WXY(X1+XX, Y1, LCC, 0, Chr(Chrs[RndCh]));
    if (T1 = 0) then Scroll(T2, Y1-1, (Y1+YA)-2, (X1+XX)-1, (X1+XX)-1, 0);
    Delay(DL);
  until KeyPressed;
end;


begin
  if (ParamCount <> 0) then
    begin
      TT:=ParamStr(1);
      if (TT <> '') and (Ord(TT[1]) >= 48) and (Ord(TT[1]) <= 57) and (Length(TT) = 1) then Val(TT[1],LTCL,CD);
    end;
  OAT:=TextAttr;
  TextMode(Co80); TextColor(7); TextBackGround(0); ClrScr;
  My:=25; Mx:=80;
  LoadMatrixChars; HC;

  MatrixSaveScr(1,1,MX,MY,LTCL,3,5,10);

  TextAttr:=OAT;
  Textmode(co80); TextAttr:=OAT; SC;
end.