{$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.