old/PAS/LIGHTING.PAS

{$A-,B-,D+,E+,F+,G+,I-,L-,N+,O-,P-,Q-,R-,S+,T+,V+,X+}
{$M 16384,0,655360}

uses crt;
type rgb = record
            r,g,b : byte;
           end;

    pal = array[byte] of rgb;

    arr = array[1..320*200] of byte;
var
    vbuff: arr absolute $a000:0000;

procedure setallrgbpalette(p:pal);assembler;
asm
   mov  ax,1012h
   mov  bx,0
   mov  cx,256
   les  dx,dword ptr p
   int  10h
end;

procedure initpalette;
Var i,k:integer;
    p:pal;
begin
  for i := 0 to 127 do
      with p[i] do
           begin
              r:=i div 2;
              g:=0;
              b:=0;
           end;
  for i := 63 to 63+127 do
      with p[i] do
           begin
              g:=(i-63) div 2;
              b:=0;
           end;
  for i := 128 to 255 do
      with p[i] do
           begin
              b:=(i-128) div 2;
              r:=63;
           end;
  for i := 63+128 to 255 do
      with p[i] do
              g:=63;

  for i:=0 to 255 do
with p[i] do
           begin
              k:=r;
              r:=b;
              b:=k;
           end;

  setallrgbpalette(p);

end;

procedure ingr;assembler;
 asm
  mov al,false
  mov directvideo,al;
  mov ax,13h
  int 10h
 end;

const nc=150;
procedure draw;
var i,j:integer;
offs,beg:word;

begin
repeat
beg:=(random(100)+50)*320+random(160)+80;
offs:=beg;
  for i:=1 to nc do
      begin
        offs:=offs+random(3)-1;
        vbuff[offs]:=255;
{        vbuff[320+200*320-offs]:=255;
}        offs:=offs+random(3)-1;
        vbuff[offs]:=255;
{        vbuff[320+200*320-offs]:=255;
}        offs:=offs+random(3)-1;
        vbuff[offs]:=255;
{        vbuff[320+200*320-offs]:=255;
}        offs:=offs+random(2)*320;
      end;

        asm

          mov ax,0a000h
          mov es,ax
          xor si,si

          mov cx,320*200
          xor ah,ah
          xor dl,dl
@moe:     inc si
          mov al,es:[si+1]
          mov dl,es:[si-1]
          add ax,dx
          mov dl,es:[si+320]
          add ax,dx
          mov dl,es:[si-320]
          add ax,dx
          cmp ax,100
          jb  @e
          sub ax,5
     @e:  shr ax,2
          mov es:[si],al
          loop @moe
        end;
until keypressed;
end;

BEGIN
   ingr;
     initpalette;
   repeat
     draw;
   until false;
END.