{$g+}
var
x,y,xp,yp,j,time,sini : integer;
d,a,pos,z,qx,qy : word;
mkerroin:longint;
q1,q2 : byte;
p,mp : pointer;
precalc : array[0..32000] of word;
sta,addr : word;
seed : word;
function mandel(sx,sy:longint):byte;
{ SI=X, DI=Y, AX,DX=MULS, BX=X2, CX=Y2}
var
iters : byte;
bailout : longint;
begin
asm;
db 66h; mov si,word ptr sx
db 66h; mov di,word ptr sy
mov iters,31
mov dx,4
db 66h; shl dx,24
db 66h; mov word ptr bailout,dx
@alku:
db 66h; mov ax,di
db 66h; imul ax
db 66h; db $f; db $ac; db $d0; db 24;
db 66h; mov cx,ax
db 66h; mov ax,si
db 66h; imul ax
db 66h; db $f; db $ac; db $d0; db 24;
db 66h; mov bx,ax
db 66h; mov ax,si
db 66h; imul di
db 66h; db $f; db $ac; db $d0; db 24;
db 66h; shl ax,1
db 66h; add ax,word ptr sy
db 66h; mov di,ax
db 66h; mov ax,word ptr sx
db 66h; add ax,bx
db 66h; sub ax,cx
db 66h; mov si,ax
db 66h; mov ax,bx
db 66h; add ax,cx
db 66h; cmp ax,word ptr bailout
jg @stop
dec iters
jnz @alku
@stop:
mov al,iters
mov @result,al
end;
end;
procedure rotate(p:pointer;xadd,yadd:integer);
var
y,xa1,xa2,ya1,ya2 : integer;
begin
xa1:= -xadd*160;
xa2:= -yadd*160;
ya1:= yadd*100+128*256;
ya2:= -xadd*100+128*256;
asm;
mov ax,$a000
mov es,ax
push ds
mov y,199
lds di,p
xor di,di
mov cx,ya1
mov dx,ya2
@yloop:
push cx
push dx
add cx,xa1
add dx,xa2
mov si,80
@xloop:
add cx,xadd
add dx,yadd
mov bx,dx
mov bl,ch
mov al,[bx]
add cx,xadd
add dx,yadd
mov bx,dx
mov bl,ch
mov ah,[bx]
db 66h; shl ax,16
add cx,xadd
add dx,yadd
mov bx,dx
mov bl,ch
mov al,[bx]
add cx,xadd
add dx,yadd
mov bx,dx
mov bl,ch
mov ah,[bx]
db 66h; rol ax,16
db 66h; mov es:[di],ax
add di,4
dec si
jnz @xloop
pop dx
pop cx
sub cx,yadd
add dx,xadd
dec y
jnz @yloop
pop ds
end;
end;
function rrandom:word;assembler;
asm
mov ax,seed
mov dx,$976a
mul dx
inc ax
add ax,dx
add seed,ax
and ax,1023
sub ax,512
end;
procedure plot(x,y:word;c:byte);assembler;
asm
les di,p
mov di,word ptr y
shl di,8
add di,word ptr x
mov al,byte ptr c
stosb
end;
procedure mplot(x,y:word;c:byte);assembler;
asm
les di,mp
mov di,word ptr y
shl di,8
add di,word ptr x
mov al,byte ptr c
stosb
end;
function getpixel(x,y:word):byte;assembler;
asm
les di,p
mov di,word ptr y
shl di,8
add di,word ptr x
mov al,es:[di]
end;
procedure average(x1,y1,x2,y2,x,y:word);
var
avr,dif,r : integer;
begin
if getpixel(x,y)>0 then exit;
dif:=x2-x1+y2-y1;
r:=rrandom*dif;
r:=r div 1024;
avr:=(getpixel(x1,y1)+getpixel(x2,y2)) shr 1+r;
if avr>63 then avr:=63;
if avr<1 then avr:=1;
plot(x,y,avr);
end;
procedure subdiv(x1,y1,x2,y2:word);
var
x,y : word;
begin
x:=(x1+x2) shr 1;
y:=(y1+y2) shr 1;
if (x2-x1<2) and (y2-y1<2)then exit;
average(x1,y1,x2,y1,x,y1);
average(x2,y1,x2,y2,x2,y);
average(x2,y2,x1,y2,x,y2);
average(x1,y2,x1,y1,x1,y);
if getpixel(x,y)=0 then
plot(x,y,
(getpixel(x1,y1)+getpixel(x2,y1)+getpixel(x2,y2)+getpixel(x1,y2))
shr 2);
subdiv(x1,y1,x,y);
subdiv(x,y1,x2,y);
subdiv(x,y,x2,y2);
subdiv(x1,y,x,y2);
end;
procedure waitr;assembler;
asm;
mov dx,$3da
@wr:
in al,dx
test al,8
jnz @wr
@re:
in al,dx
test al,8
jz @re
end;
begin
getmem(P,65535);
getmem(mP,65535);
asm;
mov ax,13h
int 10h
end;
addr:=seg(p^);
asm
mov cx,63
mov al,1
mov dx,$3c8
out dx,al
inc dx
@loop1:
mov al,63
out dx,al
mov al,cl
out dx,al
out dx,al
loop @loop1
mov cx,63
mov al,65
mov dx,$3c8
out dx,al
inc dx
@loop2:
mov al,cl
out dx,al
out dx,al
mov al,63
out dx,al
loop @loop2
end;
d:=64;
for yp:=1 to 99 do
begin
z:=130*d div yp-d;
for xp:=-159 to 159 do
begin
x:=xp*z shr 6+xp;
precalc[xp+159+yp*320]:=(x) div 9 + (z div 4) shl 8;
end;
end;
asm
mov cx,65536/4
les di,p
db 66h; xor ax,ax
db 66h; rep stosw
end;
plot(0,0,62);
plot(255,0,30);
plot(0,255,30);
plot(255,255,62);
subdiv(0,0,256,256);
mkerroin:=260000;
for y:=-128 to 127 do
for x:=-128 to 127 do
mplot(x+127,y+127,mandel(x*mkerroin,y*mkerroin) shl 2);
sini:=0;
for x:=0 to 400 do
begin
sini:=sini+x;
rotate(mp,400-x,800-x shl 1);
end;
asm;
cli;
end;
qx:=0;
qy:=0;
q1:=0;
q2:=0;
time:=0;
repeat
waitr;
inc(qy);
if qx=90 then q1:=1;
if qx=1 then q1:=0;
if q1=0 then inc(qx);
if q1=1 then dec(qx);
pos:=qx+256*qy;
for y:=10 to 99 do
asm;
mov sta,ss
mov ax,$a000
mov es,ax
mov bx,y
shl bx,8
mov di,bx
shr di,2
add di,bx
mov si,di
add di,32000
mov cx,79
lea bx,precalc
shl si,1
add bx,si
mov ss,addr
mov dx,pos
@lo:
mov si,[bx]
add si,dx
mov al,ss:[si]
add bx,2
mov si,[bx]
add si,dx
mov ah,ss:[si]
add bx,2
db 66h; rol ax,16
mov si,[bx]
add si,dx
mov al,ss:[si]
add bx,2
mov si,[bx]
add si,dx
mov ah,ss:[si]
add bx,2
db 66h; ror ax,16
db 66h; mov es:[di],ax
add di,4
dec cx
jnz @lo
mov ss,sta
end;
for y:=1 to 99 do
asm;
mov sta,ss
mov ax,$a000
mov es,ax
mov bx,y
shl bx,8
mov di,bx
shr di,2
add di,bx
mov si,di
mov bx,100
sub bx,y
shl bx,8
mov di,bx
shr di,2
add di,bx
mov cx,79
lea bx,precalc
shl si,1
add bx,si
mov ss,addr
mov dx,pos
@lo:
mov si,[bx]
add si,dx
mov al,ss:[si]
add al,64
add bx,2
mov si,[bx]
add si,dx
mov ah,ss:[si]
add ah,64
add bx,2
db 66h; rol ax,16
mov si,[bx]
add si,dx
mov al,ss:[si]
add al,64
add bx,2
mov si,[bx]
add si,dx
mov ah,ss:[si]
add ah,64
add bx,2
db 66h; ror ax,16
db 66h; mov es:[di],ax
add di,4
dec cx
jnz @lo
mov ss,sta
end;
time:=time+1;
until (port[$60]=1) or (time>=700);
asm;
sti;
mov ax,3
int 10h
end;
end.
