home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
PHANTCYB.ZIP
/
VGA256.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1994-07-15
|
19KB
|
644 lines
unit VGA256;
interface
uses Dos,crt;
const SCREEN=$A000;
var p1,p2,p3,p4,p5,p6,p7: pointer;
bank1,bank2,bank3,bank4,bank5,sys,font: word;
r,g,b: array[0..255] of byte;
procedure Bar(segm,x1,y1,x2,y2: word; c: byte);
procedure Polygon(segm,x1,y1,x2,y2,x3,y3,x4,y4: word; c: byte);
procedure Checkers(segm: word);
procedure ShowBank(segm: word);
procedure LoadBank(s: string; segm: word);
procedure SaveBank(s: string; segm: word);
procedure DefaultPalette;
procedure InitBanks;
procedure LoadScreen(s: string; p: pointer);
procedure InitScreen;
procedure CloseScreen;
procedure Palette (n,r,g,b: byte);
procedure NCls(c: byte);
procedure Hline (x1,y1,l,c: integer);
procedure Vline (x1,y1,l,c: integer);
procedure WaitVbl;
procedure Mode(n: byte);
procedure Plasma(segm: word);
procedure Plasma256(segm: word);
procedure C_Plasma(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
procedure C_Plasma256(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
implementation
procedure Bar(segm,x1,y1,x2,y2: word; c: byte); Assembler;
{Optimized ofcourse... Draws a bar using words in selected segment}
var linec,width: word;
label lines,drawwords,pixels,exit;
asm
mov DI,[y1] {Calculate screenaddress}
mov BX,DI
shl BX,6
shl DI,8
add DI,BX
add DI,[x1]
mov CX,[y2] {Calculate number of lines}
sub CX,[y1]
mov [linec],CX
mov CX,[x2] {Calculate width of square}
sub CX,[x1]
mov [width],CX
mov ES,[segm] {Output segment}
mov AL,[c] {Pixel color}
mov AH,AL
lines:
mov CX,[width] {Load pixelcounter}
mov SI,DI {Load addresscounter}
add DI,320 {Increase linestartaddress}
mov BX,SI
and BX,1 {odd?}
jz drawwords
mov ES:[SI],AL {then draw one pixel}
inc SI
dec CX
jz exit {No more pixels}
drawwords:
mov BX,CX
shr CX,1 {Words=bytes/2}
jz exit
pixels:
mov ES:[SI],AX
add SI,2
loop pixels
and BX,1 {Last odd pixel?}
jz exit
mov ES:[SI],AL
exit:
dec [linec]
jnz lines
end;
procedure Polygon(segm,x1,y1,x2,y2,x3,y3,x4,y4: word; c: byte);
{Draws a polygon with four edges with color c in a bank or on screen}
label pixels1,pixels2,pixels3,pixels4,clear,lines,drawit,nodraw
,skip1a,skip1b,skip2a,skip2b,skip3a,skip3b,skip4a,skip4b
,drawword,startfast,lastodd;
var x,y: array[1..5] of word;
xs: word;
dy: integer;
dx: word;
i,l: word;
a,b: word;
h1,v1: word;
loopc: word;
begin
x[1]:=x1; y[1]:=y1;
x[2]:=x2; y[2]:=y2;
x[3]:=x3; y[3]:=y3;
x[4]:=x4; y[4]:=y4;
x[5]:=x1; y[5]:=y1;
{Clear the start-end-of-horizontal-line table}
asm
mov AX,[sys]
mov ES,AX
mov DI,0
mov CX,200
clear:
mov word ptr ES:[DI],320 {min value at current line}
mov word ptr ES:[DI+2],0 {max value at current line}
add DI,4
loop clear
end;
{Draw lines}
for i:=1 to 4 do begin
b:=0;
if abs(y[i]-y[i+1])>0 then begin
if y[i]<y[i+1] then begin
if x[i]<x[i+1] then begin
h1:=x[i];
v1:=y[i];
dx:=x[i+1]-h1;
dy:=y[i+1]-v1;
xs:=(dx shl 7) div dy;
asm
mov AX,[sys] {write min&max values in bank6}
mov ES,AX
mov DI,[v1] {first line to fill}
shl DI,2 {4 bytes per line}
mov BX,[h1] {get start-x for line}
shl BX,7 { *127 }
mov DX,[xs] {x-displacement per line}
mov CX,[dy]
pixels1:
mov SI,BX {get x}
shr SI,7 {divide by 127}
cmp SI,ES:[DI] {smaller than min at this line?}
jae skip1a
mov ES:[DI],SI {replace min}
skip1a:
cmp SI,ES:[DI+2] {greater than max at this line?}
jbe skip1b
mov ES:[DI+2],SI {replace max}
skip1b:
add DI,4 {next line}
add BX,DX {update x-coord}
loop pixels1 {next pixel}
end;
end else begin
h1:=x[i+1];
v1:=y[i+1];
dx:=x[i]-h1;
dy:=v1-y[i];
xs:=(dx shl 7) div dy;
asm
mov AX,[sys] {write min&max values in bank6}
mov ES,AX
mov DI,[v1] {first line to fill}
shl DI,2 {4 bytes per line}
mov BX,[h1] {get start-x for line}
shl BX,7 { *127 }
mov DX,[xs] {x-displacement per line}
mov CX,[dy]
pixels2:
mov SI,BX {get x}
shr SI,7 {divide by 127}
cmp SI,ES:[DI] {smaller than min at this line?}
jae skip2a
mov ES:[DI],SI {replace min}
skip2a:
cmp SI,ES:[DI+2] {greater than max at this line?}
jbe skip2b
mov ES:[DI+2],SI {replace max}
skip2b:
sub DI,4 {next line}
add BX,DX {update x-coord}
loop pixels2 {next pixel}
end;
end
end else begin
if x[i]>x[i+1] then begin
h1:=x[i+1];
v1:=y[i+1];
dx:=x[i]-h1;
dy:=y[i]-v1;
xs:=(dx shl 7) div dy;
asm
mov AX,[sys] {write min&max values in bank6}
mov ES,AX
mov DI,[v1] {first line to fill}
shl DI,2 {4 bytes per line}
mov BX,[h1] {get start-x for line}
shl BX,7 { *127 }
mov DX,[xs] {x-displacement per line}
mov CX,[dy]
pixels3:
mov SI,BX {get x}
shr SI,7 {divide by 127}
cmp SI,ES:[DI] {smaller than min at this line?}
jae skip3a
mov ES:[DI],SI {replace min}
skip3a:
cmp SI,ES:[DI+2] {greater than max at this line?}
jbe skip3b
mov ES:[DI+2],SI {replace max}
skip3b:
add DI,4 {next line}
add BX,DX {update x-coord}
loop pixels3 {next pixel}
end;
end else begin
h1:=x[i];
v1:=y[i];
dx:=x[i+1]-h1;
dy:=v1-y[i+1];
xs:=(dx shl 7) div dy;
asm
mov AX,[sys] {write min&max values in bank6}
mov ES,AX
mov DI,[v1] {first line to fill}
shl DI,2 {4 bytes per line}
mov BX,[h1] {get start-x for line}
shl BX,7 { *127 }
mov DX,[xs] {x-displacement per line}
mov CX,[dy]
pixels4:
mov SI,BX {get x}
shr SI,7 {divide by 127}
cmp SI,ES:[DI] {smaller than min at this line?}
jae skip4a
mov ES:[DI],SI {replace min}
skip4a:
cmp SI,ES:[DI+2] {greater than max at this line?}
jbe skip4b
mov ES:[DI+2],SI {replace max}
skip4b:
sub DI,4 {next line}
add BX,DX {update x-coord}
loop pixels4 {next pixel}
end;
end;
end;
end;
end;
{determine highest and lowest y-coord}
i:=0; {highest}
l:=200; {lowest}
for a:=1 to 4 do begin
if y[a]<l then l:=y[a];
if y[a]>i then i:=y[a];
end;
{Now draw the horizontal lines really fast using words}
asm
mov CX,[i] {last line to draw}
mov DI,[l] {first line to draw}
sub CX,DI {number of lines to draw}
mov [loopc],CX
mov AX,DI
mov SI,DI {min-max table pointer}
shl SI,2
shl AX,6
shl DI,8
add DI,AX {DI=startline *320}
mov ES,[segm]
mov AL,[c]
mov AH,AL
push DS
mov DS,[sys] {min-max table segment}
lines:
mov BX,DS:[SI] {startpos of current line}
mov CX,DS:[SI+2] {endpos of current line}
inc CX
sub CX,BX {length of current line}
drawit:
mov DX,BX {odd?}
and DX,1
jz startfast {no: start drawing words}
mov ES:[DI+BX],AL {yes: draw the odd pixel}
inc BX {now it's even}
dec CX {was this the last pixel?}
jz nodraw {then quit}
startfast:
mov DX,CX
shr CX,1 {how many words?}
jz lastodd {none}
drawword:
mov ES:[DI+BX],AX
add BX,2
loop drawword
lastodd:
and DX,1
jz nodraw
mov ES:[DI+BX],AL
nodraw:
add SI,4 {next min-max line}
add DI,320 {next screen-line}
dec [loopc]
jnz lines
pop DS
end;
end;
procedure Checkers(segm: word);
{Draws a nice checkers-pattern in a memory bank (256x256)}
var x,y,h,v,a: word;
begin
for y:=0 to 15 do for x:=0 to 15 do if odd(x+y) then begin
a:=x*16+y*16*256;
for h:=0 to 15 do for v:=0 to 15 do mem[segm:a+h+v shl 8]:=255;
end;
end;
procedure ShowBank(segm: word);
{Copy the contents of a bank to the screen (only first 64000 bytes,
320x200 format, current palette) }
var i: word;
begin
for i:=0 to 13999 do meml[$a000:i shl 2]:=meml[segm:i shl 2];
end;
procedure LoadBank(s: string; segm: word);
{Load a bank from disk}
var f: file;
begin
assign(f,s);
reset(f,1);
if segm=bank1 then BlockRead(f,p1^,65535);
if segm=bank2 then BlockRead(f,p2^,65535);
if segm=bank3 then BlockRead(f,p3^,65535);
if segm=bank4 then BlockRead(f,p4^,65535);
if segm=bank5 then BlockRead(f,p5^,65535);
close(f);
end;
procedure SaveBank(s: string; segm: word);
{Save a bank to disk}
var f: file;
begin
assign(f,s);
rewrite(f,1);
if segm=bank1 then BlockWrite(f,p1^,65535);
if segm=bank2 then BlockWrite(f,p2^,65535);
if segm=bank3 then BlockWrite(f,p3^,65535);
if segm=bank4 then BlockWrite(f,p4^,65535);
if segm=bank5 then BlockWrite(f,p5^,65535);
close(f);
end;
procedure ClearBank(segm: word); Assembler;
{Clear the contents of a memory bank}
label clear;
asm
mov ES,[segm]
mov DI,0
mov CX,32767
clear:
mov word ptr ES:[DI],0
add DI,2
loop clear
end;
procedure InitBanks;
{Initialize the memory banks}
begin
GetMem(p1,65535);
GetMem(p2,65535);
GetMem(p3,65535);
GetMem(p4,65535);
GetMem(p5,65535);
GetMem(p6,32767);
GetMem(p7,32767);
bank1:=Seg(p1^);
bank2:=Seg(p2^);
bank3:=Seg(p3^);
bank4:=Seg(p4^);
bank5:=Seg(p5^);
sys:=Seg(p6^);
font:=Seg(p7^);
ClearBank(bank1);
ClearBank(bank2);
ClearBank(bank3);
ClearBank(bank4);
ClearBank(bank5);
ClearBank(sys);
ClearBank(font);
end;
procedure DefaultPalette;
{Create a simple greyscale-palette}
var i: byte;
begin
for i:=0 to 255 do palette(i,i div 4,i div 4,i div 4);
end;
procedure LoadScreen(s: string; p: pointer);
{Load a screen from disk, including the palette}
var f: file;
i: integer;
s1,o1: word;
begin
s1:=Seg(p^);
o1:=Ofs(p^);
assign(f,s);
Reset(f,1);
BlockRead(f,p^,9);
BlockRead(f,p^,64000);
BlockRead(f,p^,256*3);
for i:=0 to 255 do begin
r[i]:=mem[s1:o1+i*3];
g[i]:=mem[s1:o1+i*3+1];
b[i]:=mem[s1:o1+i*3+2];
palette(i,r[i],g[i],b[i]);
end;
reset(f,1);
BlockRead(f,p^,9);
BlockRead(f,p^,64000);
end;
procedure InitScreen;
{Initialize 320x200x256 MCGA mode}
var i: word;
begin
Inline($B8/$13/0/$CD/$10);
NCls(0);
for i:=0 to 255 do palette(i,i div 4,i div 4,i div 4);
end;
procedure CloseScreen;
{Return to textmode}
begin
Textmode(Lastmode);
end;
Procedure Palette (n,r,g,b: byte);
{Change the palette}
Begin Port[$3C8] := n;
Port[$3C9] := r;
Port[$3C9] := g;
Port[$3C9] := b;
End;
procedure NCls(c: byte);
{Clear the screen}
var i: word;
cc: longint;
begin
cc:=c+c*256+c*65536+c*65536*256;
for i:=0 to $3e7f do meml[$a000:4*i]:=cc
end;
procedure Line(x1,y1,x2,y2,c: integer);
{Draw a line}
var dx,dy,l: real; i,z: integer;
begin
l:=sqrt(abs((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)));
dx:=(x2-x1)/l;
dy:=(y2-y1)/l;
z:=x1+y1*320;
for i:=1 to round(l) do mem[$a000:z+round(i*dx)+320*round(i*dy)]:=c
end;
procedure Hline(x1,y1,l,c: integer);
{Draw a horizontal line}
var i,z: word;
q: word;
begin
z:=x1+y1*320;
q:=c+256*c;
while l>1 do begin
l:=l-2;
memw[$a000:z]:=q;
z:=z+2
end;
for i:=1 to l do mem[$a000:z+i-1]:=c
end;
procedure Vline(x1,y1,l,c: integer);
{Draw a vertical line}
var i,z: integer;
begin
z:=x1+y1*320;
for i:=0 to l-1 do mem[$a000:z+i*320]:=c
end;
procedure WaitVbl; assembler;
{Wait for sync}
label
l1, l2;
asm
cli
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
sti
end;
procedure Mode (n: byte);
{Initialize mode n}
begin
asm
mov AH,00
mov AL,n
Int 10h
end;
end;
procedure Plasma(segm: word);
{Draw a default plasma (320x200) }
begin
C_Plasma(segm,2,0,0,319,199,1,255);
end;
procedure Plasma256(segm: word);
{Draw a default plasma (256x256) }
begin
C_Plasma256(segm,2,0,0,255,255,1,255);
end;
procedure C_Plasma(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
{Draw a customized plasma}
var i: longint;
x,y: word;
procedure subDivide(x1,y1,x2,y2: integer);
var
x,y: word; {OPTIMIZED BY THE PHANTOM}
v: integer; {SPEED GAIN APPROX. 400% }
begin
if x2-x1>=2 then begin
x:=(x1+x2) shr 1;
y:=(y1+y2) shr 1;
if mem[segm:x+y1*320]=0 then begin
v:=round(((mem[segm:x1+y1*320]+mem[segm:x2+y1*320]) shr 1)+
(random-0.5)*(x2-x1)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x+y1*320]:=v;
end;
if mem[segm:x2+y*320]=0 then begin
v:=round(((mem[segm:x2+y1*320]+mem[segm:x2+y2*320]) shr 1)+
(random-0.5)*(y2-y1)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x2+y*320]:=v
end;
if mem[segm:x+y2*320]=0 then begin
v:=round(((mem[segm:x1+y2*320]+mem[segm:x2+y2*320]) shr 1)+
(random-0.5)*(x1-x2)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x+y2*320]:=v
end;
if mem[segm:x1+y*320]=0 then begin
v:=round(((mem[segm:x1+y1*320]+mem[segm:x1+y2*320]) shr 1)+
(random-0.5)*(y2-y1)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x1+y*320]:=v
end;
if mem[segm:x+y*320]=0 then
mem[segm:x+y*320]:=(mem[segm:x1+y1*320]+mem[segm:x2+y1*320]
+mem[segm:x2+y2*320]+mem[segm:x1+y2*320]) shr 2;
subDivide(x1,y1,x,y);
subDivide(x,y1,x2,y);
subDivide(x,y,x2,y2);
subDivide(x1,y,x,y2)
end
end;
begin
Randomize;
for x:=h1 to h2 do for y:=v1 to v2 do mem[segm:x+y*320]:=0;
mem[segm:h1+v1*320]:=Random(maxv-minv)+minv;
mem[segm:h2+v1*320]:=Random(maxv-minv)+minv;
mem[segm:h2+v2*320]:=Random(maxv-minv)+minv;
mem[segm:h1+v2*320]:=Random(maxv-minv)+minv;
subDivide(h1,v1,h2,v2);
end;
procedure C_Plasma256(segm: word; F: byte; h1,v1,h2,v2,minv,maxv: integer);
{Draw a customized plasma}
var i: longint;
x,y: word;
procedure subDivide(x1,y1,x2,y2: integer);
var
x,y: word; {OPTIMIZED BY THE PHANTOM}
v: integer; {SPEED GAIN APPROX. 400% }
begin
if x2-x1>=2 then begin
x:=(x1+x2) shr 1;
y:=(y1+y2) shr 1;
if mem[segm:x+y1 shl 8]=0 then begin
v:=round(((mem[segm:x1+y1 shl 8]+mem[segm:x2+y1 shl 8]) shr 1)+
(random-0.5)*(x2-x1)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x+y1 shl 8]:=v;
end;
if mem[segm:x2+y shl 8]=0 then begin
v:=round(((mem[segm:x2+y1 shl 8]+mem[segm:x2+y2 shl 8]) shr 1)+
(random-0.5)*(y2-y1)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x2+y shl 8]:=v
end;
if mem[segm:x+y2 shl 8]=0 then begin
v:=round(((mem[segm:x1+y2 shl 8]+mem[segm:x2+y2 shl 8]) shr 1)+
(random-0.5)*(x1-x2)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x+y2 shl 8]:=v
end;
if mem[segm:x1+y shl 8]=0 then begin
v:=round(((mem[segm:x1+y1 shl 8]+mem[segm:x1+y2 shl 8]) shr 1)+
(random-0.5)*(y2-y1)*F);
if v<minv then v:=minv;
if v>maxv then v:=maxv;
mem[segm:x1+y shl 8]:=v
end;
if mem[segm:x+y shl 8]=0 then
mem[segm:x+y shl 8]:=(mem[segm:x1+y1 shl 8]+mem[segm:x2+y1 shl 8]
+mem[segm:x2+y2 shl 8]+mem[segm:x1+y2 shl 8]) shr 2;
subDivide(x1,y1,x,y);
subDivide(x,y1,x2,y);
subDivide(x,y,x2,y2);
subDivide(x1,y,x,y2)
end
end;
begin
Randomize;
for x:=h1 to h2 do for y:=v1 to v2 do mem[segm:x+y shl 8]:=0;
mem[segm:h1+v1 shl 8]:=Random(maxv-minv)+minv;
mem[segm:h2+v1 shl 8]:=Random(maxv-minv)+minv;
mem[segm:h2+v2 shl 8]:=Random(maxv-minv)+minv;
mem[segm:h1+v2 shl 8]:=Random(maxv-minv)+minv;
subDivide(h1,v1,h2,v2);
end;
end.