[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{
=================================================================
PROGRAM NAME : NEWLENS.PAS
AUTHOR : Bas Van Gaalen (originally for GFXFX2)
Scott Tunstall (for KOJAKVGA 3.3) in August 1997.
NOTES :
This is Bas Van Gaalen's LENS.PAS "transparent sphere" routine
converted to KOJAKVGA 3.3. Only the data tables and
initialisation code remain from the GFXFX2 version.
The rest of the graphics code has been changed to suit my unit.
Why did I convert it? 'Cos I like the sphere!
The lens draw routine is now converted to 90% assembler; I HATE
slow Pascal routines!
What you do is specify your 320 x 200 x 256 colour PCX file name
as the command line parameter and watch the sphere bounce around.
Hope you enjoy it...
Scott.
P.S.
You can get my KOJAKVGA 3.3 unit from June 97's GRAPHICS
section.
DISCLAIMER:
There's no way this should damage your PC -unless you have a
286 processor or an EGA graphics card. However, use this at your
own risk!
-----------------------------------------------------------------
}
program Newlens;
{ Lens effect (Wierd? Yeah!) By Bas van Gaalen,
Update by Scott Tunstall.
If you have a fast computer, try using a transparent sprite... }
uses KOJAKVGA,crt;
const
radius=30; { sphere radius }
maxpoints=3000; { maximum number of points }
xs=60;
ys=60; { size is two times sphere-radius }
ptab:array[0..255] of byte=( { parabole table for bounce }
123,121,119,117,115,114,112,110,108,106,104,103,101,99,97,96,94,92,91,
89,87,86,84,82,81,79,78,76,75,73,72,70,69,67,66,64,63,62,60,59,58,56,
55,54,52,51,50,49,48,46,45,44,43,42,41,39,38,37,36,35,34,33,32,31,30,
29,28,27,26,26,25,24,23,22,21,21,20,19,18,17,17,16,15,15,14,13,13,12,
12,11,10,10,9,9,8,8,7,7,6,6,5,5,5,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,5,5,6,6,
7,7,7,8,8,9,9,10,11,11,12,12,13,14,14,15,16,16,17,18,19,19,20,21,22,
23,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,
46,47,48,49,51,52,53,54,56,57,58,60,61,62,64,65,67,68,69,71,72,74,75,
77,78,80,82,83,85,86,88,90,91,93,95,96,98,100,102,103,105,107,109,111,
113,114,116,118,120,122,124,126);
type
parastruc=array[0..xs-1,0..ys-1] of shortint;
var
para:parastruc;
pal:paletteType;
virscr,bckscr:pointer;
const
paraptr:pointer=@para;
procedure initialize;
const
step=0.035; { working step-size for a radius of 30 }
var
alpha,beta:real;
r,x,y,z:integer;
begin
writeln('Calculating hemi-sphere data. Can take a few secs...');
fillchar(para,sizeof(para),0);
alpha:=pi;
while alpha>0 do begin
beta:=pi;
while beta>0 do begin
x:=radius+round(radius*cos(alpha)*sin(beta));
y:=radius+round(0.833*radius*cos(beta));
z:=round(radius*sin(alpha)*sin(beta));
para[x,y]:=(radius-z) shr 1;
beta:=beta-step;
end;
alpha:=alpha-step;
end;
end;
{ Bas said: Anyone brainy enough could rewrite this to assembler,
that would speed up things considerably.
So (ahem) seeing as I'm sad enough to do things like that..
I did. ;)
Sickening isn't it: all that assembler!
}
{ Bas's original code: }
{procedure displaypara(x,y:word);
var p:parastruc; i,j:word;
begin
for i:=x to x+xs-1 do for j:=y to y+ys-1 do
mem[seg(virscr^):j*320+i]:=
mem[seg(virscr^):(j-para[i-x,j-y])*320+i+para[i-x,j-y]];
end;}
{ And the (mostly) assembler equivalent : }
procedure displaypara(x,y:word);
var p:parastruc;
short: shortint;
i,j:word;
begin
for i:=x to x+xs-1 do
for j:=y to y+ys-1 do
begin
short:=para[i-x,j-y];
asm
les di,virscr
mov dx,es { Save ES in DX }
mov ax,j
mov cx,ax
shl ax,8 { J * 256 }
shl cx,6 { J * 64 }
add ax,cx { = J * 320 }
add ax,i { + I }
mov di,ax { DI = AX }
push es { Got to save es and di onto the stack }
push di { as they will be corrupted }
mov ax,j { AX = J }
xor bh,bh
mov bl,short
sub ax,bx { J - Para[i-x,j-y] }
mov cx,ax { J * 320, see above please }
shl ax,8
shl cx,6
add ax,cx
add ax,i { Add I too }
add ax,bx { Mind take into account Para[i-x,j-y] ! }
xchg ax,bx { I want BX to be the offset }
mov es,dx { Restore ES }
mov al,[es:bx] { Read byte from screen }
pop di { And now restore the screen pointer }
pop es
mov [es:di],al { Store new byte. }
end
end;
end;
var di:shortint; i:integer; idx:byte;
begin
initialize;
initVGAMode;
bckscr:=New64KBitmap;
UseBitmap(bckscr);
Cls;
LoadPCX(paramstr(1),pal);
UsePalette(pal);
ShowAllBitmap(bckscr);
VirScr:=New64KBitmap;
UseBitmap(VirScr);
Cls;
i:=30;
idx:=128;
di:=2;
repeat
CopyBitmap(bckscr,virscr);
UseBitmap(virscr);
displaypara(i,15+ptab[idx]); inc(idx,3);
inc(i,di);
if (i<25) or (i+xs>295) then
di:=-di;
{ Removing the VWAIT could cause faster computers (P200s)
to spout flames <grin> as the sphere will be drawn VERY quickly!
}
Vwait(1);
CopyBitmap(virscr,ptr($a000,0));
until keypressed;
freebitmap(virscr);
freebitmap(bckscr);
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]