[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
unit gru; { GRaphic Unit. }
{$g+}
INTERFACE
type
palrec=record
r,g,b:byte;
end;
paltype=array[0..255]of palrec;
palptr=^paltype;
const
vidseg:word=$a000;
procedure plot(const x,y:word;const c:byte);
procedure plot2(const x,y,where:word;const c:byte);
procedure setmode(const mode:word);
procedure flip386(const a,b:word);
procedure clear386(const where:word;const c:byte);
procedure flip286(const a,b:word);
procedure clear286(const where:word;const c:byte);
procedure flip(const a,b:word);
procedure clear(const where:word;const c:byte);
procedure vret;
procedure hline(const x1,x2,y:word;const c:byte);
procedure hline2(const x1,x2,y,where:word;const c:byte);
procedure vline(const x,y1,y2:word;const c:byte);
procedure vline2(const x,y1,y2,where:word;const c:byte);
procedure line(const x1,y1,x2,y2:word;const c:byte);
procedure line2(const x1,y1,x2,y2,where:word;const c:byte);
function getpix(const x,y:word):byte;
function getpix2(const x,y,where:word):byte;
function rad(theta:real):real;
procedure setpal(c,r,g,b:byte);
procedure getvgapal(var pal:paltype);
procedure setvgapal(var pal:paltype);
procedure smooth(where:word);
procedure smooth1(x,y,where:word);
procedure smooth2(where,size:word);
procedure drawsprite(const x,y,where:word;const w,h,c:byte;var sprite);
procedure fadefrompaltopal(oldpal,newpal:paltype);
procedure ffblack(palin:paltype);
procedure f2black(palin:paltype);
procedure scanlines(numl:word);
procedure combine(const in1,in2,out,eline:word);
var
clipon:boolean;
cx1,cx2,cy1,cy2:word;
IMPLEMENTATION
var
scrofs:array[0..199]of word; { Holding screen offsets. }
blackp:paltype;
whitep:paltype;
tempal:paltype;
procedure plot(const x,y:word;const c:byte); assembler;
asm
cmp clipon,0
je @@sc
mov ax,[x]
cmp ax,cx1
jb @@exit
cmp ax,cx2
ja @@exit
mov ax,[y]
cmp ax,cy1
jb @@exit
cmp ax,cy2
ja @@exit
@@sc: { SkipCheck :-) }
mov es,sega000
mov bx,[y]
shl bx,1
mov di,word ptr[scrofs+bx]
add di,[x]
mov al,[c]
mov es:[di],al
@@exit:
end;
procedure plot2(const x,y,where:word;const c:byte); assembler;
asm
cmp clipon,0
je @@sc
mov ax,[x]
cmp ax,cx1
jb @@exit
cmp ax,cx2
ja @@exit
mov ax,[y]
cmp ax,cy1
jb @@exit
cmp ax,cy2
ja @@exit
@@sc: { SkipCheck :-) }
mov ax,where
mov es,ax
mov bx,[y]
shl bx,1
mov di,word ptr[scrofs+bx]
add di,[x]
mov al,[c]
mov es:[di],al
@@exit:
end;
procedure setmode(const mode:word);assembler;
asm
mov ax,mode
int 10h
end;
procedure flip386(const a,b:word); assembler;
asm
push ds
mov ds,a
mov es,b
xor si,si
xor di,di
mov cx,16000
db 66h; rep movsw
pop ds
end;
procedure clear386(const where:word;const c:byte); assembler;
asm
mov es,where
xor ax,ax
xor di,di
mov al,[c]
mov ah,al
db 66h; shr ax,16
mov al,[c]
mov ah,al
mov cx,16000
db 66h; rep stosw
end;
procedure flip286(const a,b:word); assembler;
asm
push ds
mov ds,a
mov es,b
xor si,si
xor di,di
mov cx,32000
rep movsw
pop ds
end;
procedure clear286(const where:word;const c:byte); assembler;
asm
mov es,where
xor ax,ax
xor di,di
mov al,[c]
mov ah,al
mov cx,32000
rep stosw
end;
procedure flip(const a,b:word); assembler;
asm
push ds
mov ds,a
mov es,b
xor si,si
xor di,di
mov cx,64000
rep movsb
pop ds
end;
procedure clear(const where:word;const c:byte); assembler;
asm
mov es,where
xor ax,ax
xor di,di
mov al,[c]
mov cx,64000
rep stosb
end;
procedure vret; assembler;
asm
mov dx,3dah;
@vert1: in al,dx
test al,8
jz @vert1
@vert2: in al,dx
test al,8
jnz @vert2
end;
procedure hline(const x1,x2,y:word;const c:byte); assembler;
asm
cld
mov es,sega000
mov ax,[x1]
mov cx,[x2]
sub cx,ax
mov di,[y]
mov bx,di
shl di,8
shl bx,6
add di,bx
add di,ax
mov al,[c]
mov ah,al
shr cx,1
rep stosw
adc cx,cx
rep stosb
end;
procedure hline2(const x1,x2,y,where:word;const c:byte); assembler;
asm
cld
mov ax,where
mov es,ax
mov ax,[x1]
mov cx,[x2]
sub cx,ax
mov di,[y]
mov bx,di
shl di,8
shl bx,6
add di,bx
add di,ax
mov al,[c]
mov ah,al
shr cx,1
rep stosw
adc cx,cx
rep stosb
end;
procedure vline(const x,y1,y2:word;const c:byte);assembler;
asm
mov es,sega000
mov ax,[y1]
mov bx,ax
shl ax,8
shl bx,6
add ax,bx
mov di,ax
mov ax,[y2]
mov bx,ax
shl ax,8
shl bx,6
add bx,ax
mov al,[c]
mov cx,[x]
add di,cx
add bx,cx
@@loop1:
mov es:[di],al
add di,320
cmp di,bx
jne @@loop1
end;
procedure vline2(const x,y1,y2,where:word;const c:byte);assembler;
asm
mov ax,where
mov es,ax
mov ax,[y1]
mov bx,ax
shl ax,8
shl bx,6
add ax,bx
mov di,ax
mov ax,[y2]
mov bx,ax
shl ax,8
shl bx,6
add bx,ax
mov al,[c]
mov cx,[x]
add di,cx
add bx,cx
@@loop1:
mov es:[di],al
add di,320
cmp di,bx
jne @@loop1
end;
procedure line(const x1,y1,x2,y2:word;const c:byte);assembler;
var
dex,dey,incf:Integer;
offset:word;
asm
mov ax,[x2]
sub ax,[x1]
jnc @@dont1
neg ax
@@dont1:
mov [dex],ax
mov ax,[y2]
sub ax,[y1]
jnc @@dont2
neg ax
@@dont2:
mov [dey],ax
cmp ax,[dex]
jbe @@otherline
mov ax,[y1]
cmp ax,[y2]
jbe @@dontswap1
mov bx,[y2]
mov [y1],bx
mov [y2],ax
mov ax,[x1]
mov bx,[x2]
mov [x1],bx
mov [x2],ax
@@dontswap1:
mov [incf],1
mov ax,[x1]
cmp ax,[x2]
jbe @@skipnegate1
neg [incf]
@@skipnegate1:
mov di,[y1]
mov bx,di
shl di,8
shl bx,6
add di,bx
add di,[x1]
mov bx,[dey]
mov cx,bx
mov ax,$a000
mov es,ax
mov dl,[c]
mov si,[dex]
@@drawloop1:
mov es:[di],dl
add di,320
sub bx,si
jnc @@goon1
add bx,[dey]
add di,[incf]
@@goon1:
loop @@drawloop1
jmp @@exitline
@@otherline:
mov ax,[x1]
cmp ax,[x2]
jbe @@dontswap2
mov bx,[x2]
mov [x1],bx
mov [x2],ax
mov ax,[y1]
mov bx,[y2]
mov [y1],bx
mov [y2],ax
@@dontswap2:
mov [incf],320
mov ax,[y1]
cmp ax,[y2]
jbe @@skipnegate2
neg [incf]
@@skipnegate2:
mov di,[y1]
mov bx,di
shl di,8
shl bx,6
add di,bx
add di,[x1]
mov bx,[dex]
mov cx,bx
mov ax,$a000
mov es,ax
mov dl,[c]
mov si,[dey]
@@drawloop2:
mov es:[di],dl
inc di
sub bx,si
jnc @@goon2
add bx,[dex]
add di,[incf]
@@goon2:
loop @@drawloop2
@@exitline:
end;
procedure line2(const x1,y1,x2,y2,where:word;const c:byte);assembler;
var
dex,dey,incf:Integer;
offset:word;
asm
mov ax,[x2]
sub ax,[x1]
jnc @@dont1
neg ax
@@dont1:
mov [dex],ax
mov ax,[y2]
sub ax,[y1]
jnc @@dont2
neg ax
@@dont2:
mov [dey],ax
cmp ax,[dex]
jbe @@otherline
mov ax,[y1]
cmp ax,[y2]
jbe @@DontSwap1
mov bx,[y2]
mov [y1],bx
mov [y2],ax
mov ax,[x1]
mov bx,[x2]
mov [x1],bx
mov [x2],ax
@@dontswap1:
mov [incf],1
mov ax,[x1]
cmp ax,[x2]
jbe @@skipnegate1
neg [incf]
@@skipnegate1:
mov di,[y1]
mov bx,di
shl di,8
shl bx,6
add di,bx
add di,[x1]
mov bx,[dey]
mov cx,bx
mov ax,where
mov es,ax
mov dl,[c]
mov si,[dex]
@@drawloop1:
mov es:[di],dl
add di,320
sub bx,si
jnc @@goon1
add bx,[dey]
add di,[incf]
@@goon1:
loop @@drawloop1
jmp @@exitline
@@otherline:
mov ax,[x1]
cmp ax,[x2]
jbe @@dontswap2
mov bx,[x2]
mov [x1],bx
mov [x2],ax
mov ax,[y1]
mov bx,[y2]
mov [y1],bx
mov [y2],ax
@@dontswap2:
mov [incf],320
mov ax,[y1]
cmp ax,[y2]
jbe @@skipnegate2
neg [incf]
@@skipnegate2:
mov di,[y1]
mov bx,di
shl di,8
shl bx,6
add di,bx
add di,[x1]
mov bx,[dex]
mov cx,bx
mov ax,where
mov es,ax
mov dl,[c]
mov si,[dey]
@@drawloop2:
mov es:[di],dl
inc di
sub bx,si
jnc @@goon2
add bx,[dex]
add di,[incf]
@@goon2:
loop @@drawloop2
@@exitline:
end;
function getpix(const x,y:word):byte; assembler;
asm
cmp clipon,0
je @@sc
mov ax,[x]
cmp ax,cx1
jb @@exit
cmp ax,cx2
ja @@exit
mov ax,[y]
cmp ax,cy1
jb @@exit
cmp ax,cy2
ja @@exit
@@sc: { SkipCheck :-) }
mov es,sega000
mov bx,[y]
shl bx,1
mov di,word ptr[scrofs+bx]
add di,[x]
mov al,es:[di]
@@exit:
end;
function getpix2(const x,y,where:word):byte; assembler;
asm
cmp clipon,0
je @@sc
mov ax,[x]
cmp ax,cx1
jb @@exit
cmp ax,cx2
ja @@exit
mov ax,[y]
cmp ax,cy1
jb @@exit
cmp ax,cy2
ja @@exit
@@sc: { SkipCheck :-) }
mov ax,where
mov es,ax
mov bx,[y]
shl bx,1
mov di,word ptr[scrofs+bx]
add di,[x]
mov al,es:[di]
@@exit:
end;
function rad(theta:real):real;
begin
rad:=theta*pi/180;
end;
procedure setpal(c,r,g,b:byte); assembler;
asm
mov dx,3c8h
mov al,[c]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
end;
procedure getvgapal(var pal:paltype); assembler;
asm
push ds
xor ax,ax
mov cx,0300h
les di,pal
mov dx,03c7h
out dx,al
inc dx
inc dx
cld
rep insb
pop ds
end;
procedure setvgapal(var pal:paltype); assembler;
asm
push ds
xor ax,ax
mov cx,0300h/2
lds si,pal
mov dx,03c8h
out dx,al
inc dx
mov bx,dx
cld
mov dx,03dah
@vsync0:
in al,dx
test al,8
jz @vsync0
mov dx,bx
rep outsb
mov bx,dx
mov dx,03dah
@vsync1:
in al,dx
test al,8
jz @vsync1
mov dx,bx
mov cx,0300h/2
rep outsb
pop ds
end;
procedure smooth(where:word); assembler;
asm
mov ax,where
mov es,ax
xor di,di
mov cx,64000-320
xor bh,bh
@@loop:
xor ax,ax
mov al,es:[di]
mov bl,es:[di+320] ;add ax,bx
mov bl,es:[di+1] ;add ax,bx
mov bl,es:[di+321] ;add ax,bx
shr ax,2
mov es:[di],al
inc di
loop @@loop
end;
procedure smooth1(x,y,where:word); assembler;
asm
mov ax,where
mov es,ax
mov di,[y]
mov bx,di
shl di,8
shl bx,6
add di,bx
add di,[x]
xor bh,bh
xor ax,ax
mov al,es:[di]
mov bl,es:[di+320] ;add ax,bx
mov bl,es:[di+1] ;add ax,bx
mov bl,es:[di+321] ;add ax,bx
shr ax,2
mov es:[di],al
end;
procedure smooth2(where,size:word); assembler;
asm
mov ax,where
mov es,ax
xor di,di
mov cx,size
xor bh,bh
@@loop:
xor ax,ax
mov al,es:[di]
mov bl,es:[di+320] ;add ax,bx
mov bl,es:[di+1] ;add ax,bx
mov bl,es:[di+321] ;add ax,bx
shr ax,2
mov es:[di],al
inc di
loop @@loop
end;
procedure drawsprite(const x,y,where:word;const w,h,c:byte;var sprite); assembler;
asm
push ds
lds si,[sprite]
mov ax,where
mov es,ax
cld
mov ax,[y]
shl ax,6
mov di,ax
shl ax,2
add di,ax
add di,[x]
mov bh,[h]
mov cx,320
sub cl,[w]
sbb ch,0
@l:
mov bl,[w]
@l2:
lodsb
cmp al,[c]
je @s
mov dl,[es:di]
add dl,al
mov es:[di],dl
@s:
inc di
dec bl
jnz @l2
add di,cx
dec bh
jnz @l
pop ds
end;
procedure fadefrompaltopal(oldpal,newpal:paltype);
var
dac,c:word;
begin
for c:=32 downto 0 do
begin
for dac:=0 to 255 do
begin
tempal[dac].r:=((oldpal[dac].r*c)div 32)+((newpal[dac].r*(32-c))div 32);
tempal[dac].g:=((oldpal[dac].g*c)div 32)+((newpal[dac].g*(32-c))div 32);
tempal[dac].b:=((oldpal[dac].b*c)div 32)+((newpal[dac].b*(32-c))div 32);
end;
setvgapal(tempal);
end;
end;
procedure ffblack(palin:paltype);
var dac,i:word;
begin
for i:=0 to 32 do
begin
for dac:=0 to 255 do
begin
tempal[dac].r:=(palin[dac].r*i)div 32;
tempal[dac].g:=(palin[dac].g*i)div 32;
tempal[dac].b:=(palin[dac].b*i)div 32;
end;
setvgapal(tempal);
end;
end;
procedure f2black(palin:paltype);
var
dac,i:word;
begin
for i:=32 downto 0 do
begin
for dac:=0 to 255 do
begin
tempal[dac].r:=(palin[dac].r*i)div 32;
tempal[dac].g:=(palin[dac].g*i)div 32;
tempal[dac].b:=(palin[dac].b*i)div 32;
end;
setvgapal(tempal);
end;
end;
procedure scanlines(numl:word); assembler;
asm
mov dx, 3d4h
mov al, 9
out dx, al
inc dx
in al, dx
and al, 0E0h
add ax, numl
out dx, al
end;
procedure combine(const in1,in2,out,eline:word); assembler;
asm
push ds
mov ax,out; mov es,ax; xor di,di
cld
mov cx,[eline]
mov bx,cx
shl cx,8
shl bx,6
add cx,bx
mov bx,cx
shr cx,2
mov ax,in1; mov ds,ax; xor si,si
db 66h; rep movsw; adc cx,cx; rep movsw
mov ax,in2; mov ds,ax; mov si,bx
mov cx,64000
sub cx,bx
shr cx,2
db 66h; rep movsw; adc cx,cx; rep movsw
pop ds
end;
var
count:word;
begin
clipon:=false;
cx1:=0; cx2:=319; cy1:=0; cy2:=199;
for count:=0 to 199 do scrofs[count]:=count*320; { Set up the offsets. }
for count:=0 to 255 do
begin
blackp[count].r:=0;
blackp[count].g:=0;
blackp[count].b:=0;
whitep[count].r:=63;
whitep[count].g:=63;
whitep[count].b:=63;
end;
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]