uses crt,gfx3,dos;


CONST
      XSize = 28;
      YSize = 31;
TYPE
        Letter = Array[1..xsize,1..ysize] of Byte;
        Letters = Array[' '..']'] of Letter;


VAR Font : ^Letters;
    messages:array[1..20] of string;
    I:Word;
    timer:longint absolute $40:$6c;
    Times:Word;
    Cur:Word;
    CurMessage:String;
    Counter:Word;




Procedure SetupRWriter;
VAR f:file;
    loop1:char;
    loop2,loop3:integer;
BEGIN
  getmem (font,sizeof (font^));
    Assign (f,'BOLDS');
    reset (f,1);
    blockread (f,font^,sizeof (font^));
    close (f);
END;

PROCEDURE showletter(c:char;x,y:integer);
var l1,l2:integer;
begin
  for l1:=1 to xsize do
    for l2:=1 to ysize do
      if (l2+y>0) and (l2+y<199) and (l1+x>0) and (l1+x<320) And
      (font^[c,l1,l2]<>0) then
       putpixel(l1+x,l2+y,63,vaddr);
end;


procedure Showmsg(Str:string;X,Y:INTEGER);
var i:integer;
begin
 for i:=1 to length(str) do
  begin
   showletter(str[i],X+xsize*(i-1),Y);
  end;
end;


Procedure Noise4(Where:Word);
Var o:word;
    Seq:integer;
    Fx:integer;
Begin
Fx:=0;
 For o:=0 to 15999 do
  Begin
   Inc(Fx);
   If Fx=319 Then Fx:=0;
   If Fx=0 Then Seq:=Random(5);     {<-----------}
   If Random(Seq)=1 then
    Begin
     Mem[Where:o]:=Mem[Where:o]+2;
     Mem[Where:o+15999]:=Mem[Where:o+15999]+2;
     Mem[Where:o+31999]:=Mem[Where:o+31999]+2;
     Mem[Where:o+47999]:=Mem[Where:o+47999]+2;
    End;
  End;
End;




Procedure Smooth(Where:Word);assembler;
Var M:Word;
Asm
 Mov Es,Where
 Xor Di,Di
 Xor Ah,ah
 Xor bh,bh
 Xor Ch,Ch
 Xor Dh,Dh
 @MainLoop:
  Inc Di
  Dec Di
  Mov Al,Es:[Di]
  Add Di,2
  Mov Bl,Es:[Di]
  Add Di,320
  Mov Cl,Es:[Di]
  Sub Di,2
  Mov Dl,Es:[Di]
  Sub Di,319
  Mov M,Ax
  Add M,Bx
  Add M,Cx
  Add M,Dx
  Shr M,2
  Mov Ax,M
  Mov Es:[Di],Al
  Xor Ah,Ah

  Cmp Di,63678
 Jne @MainLoop
End;


begin
 setmcga;
 setupvirtual;
 SetupRWriter;
 messages[1]:='IF';
 messages[2]:='YOU';
 messages[3]:='CAN';
 messages[4]:='READ';
 messages[5]:='THIS';
 messages[6]:='FUCKEN';
 messages[7]:='WRITER';
 messages[8]:='YOU';
 messages[9]:='ARE';
 messages[10]:='A';
 messages[11]:='FUCKEN';
 messages[12]:='GENIUS';




 cls(sega000,0);
 cls32(vaddr,0);
 For i:=0 to 63 do Pal(i,i,i,i);

 Timer:=0;
 Times:=20;
 Cur:=1;
 repeat
  If Timer>20 Then
   Begin
    Inc(Cur);
    Timer:=0;
    If Cur>12 Then Cur:=1;
    Counter:=0;
   End;
  CurMessage:=Messages[Cur];
  Inc(Counter);
  If Counter mod 5=1 Then
   showmsg(CurMessage,Random(320-Length(CurMessage)*XSize),
  Random(100-YSize)+70);
  HLine(0,319,199,0,Vaddr);
  Putpixel(319,199,0,Vaddr);
  Smooth(Vaddr);Smooth(Vaddr);Smooth(Vaddr);Smooth(Vaddr);
  Noise4(Vaddr);
  Putpixel(319,198,0,Vaddr);
  WaitRetrace;
  flip32(vaddr,sega000);
 until (keypressed);
 flip(vaddr,vga);
 settext;
end.