VGA Trainer Program: part 13
Õ-------------------------------¸
| W E L C O M E |
| To the VGA Trainer Program | |
| By | |
| DENTHOR of ASPHYXIA | | |
Ô-------------------------------¾ | |
--------------------------------Ù |
--------------------------------Ù
--==[ PART 13 ]==--Introduction
Hello again! Here I am, cooped up at home, recovering from my illness with nothing to do, so of course it is the perfect time to write another trainer! After the long delay between parts 11 and 12, two trainers in two days doesn't sound like a bad idea.
This trainer is on starfields, which is by request of more then one person. This is quite an easy effect, and you should have no trouble grasping the concept behind it. I will be doing a 3d starfield, a horizontal starfield is very easy with you merely incrementing a x-value for each star for each frame. I am not even going to bother doing code for that one (unless requested).
So I am off to go grab my antibiotics pills and I will be right back with the tutorial! ;-)
If you would like to contact me, or the team, there are many ways you can do it :
- Write a message to Grant Smith/Denthor/Asphyxia in private mail on the ASPHYXIA BBS.
- Write to Denthor, EzE, Goth, Fubar or Nobody on Connectix.
- Write to : Grant Smith P.O.Box 270 Kloof 3640 Natal South Africa
- Call me (Grant Smith) at (031) 73 2129 (leave a message if you call during varsity). Call +27-31-73-2129 if you call from outside South Africa. (It's YOUR phone bill ;-))
- Write to smith9@batis.bis.und.ac.za in E-Mail.
- Write to asphyxia@beastie.cs.und.ac.za
NB : If you are a representative of a company or BBS, and want ASPHYXIA to do you a demo, leave mail to me; we can discuss it.
NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling quite lonely and want to meet/help out/exchange code with other demo groups. What do you have to lose? Leave a message here and we can work out how to transfer it. We really want to hear from you!
What is a 3d starfield?
I am not even sure if I should do this bit. Go watch any episode of Star Trek, the movies, Star Wars, or just about any sci-fi movie. Somewhere there will be a scene where you can see stars whizzing past the viewscreen, with the ones that are further away moving slower then the ones that are passed quite close to.
This is a 3d starfield. If you look closely, you will see that all the stars seem to originate from a point, the point you are travelling towards. This is an illusion which thankfully happens automatically, you don't have to code for it ;)
Starfields look very nice, and can make a big difference to an otherwise black background. It also makes a great screen saver ;-)
How do they work?
This is actually quite simple. Imagine if you will, each star in the heavens having an x,y and z coordinate, with you being at 0,0,0. Easy? Right. Now, if you were to say move forward, ie. increase your z value, to you you will still be at 0,0,0 , but all the stars z values would have appeared to decrease by the exact same amount.
In easier language, we decrease the z value of all the the stars so that they come closer to you, and eventually whizz past.
This solves all our problems. Stars that are close to us on the x and y scales will pass us by faster then those that are very far from us on the x and y scales. The only thing we must watch out for is that no star is at 0,0 , ie. exactly in front of us, otherwise there will be a collision which will not look good.
How do we code this?
The first thing to be done is to generate our starfield. This is quite easy, with us choosing x values between -160 and 160, and y values between -100 and 100 randomly. Each z is sequentially greater for each star so that we don't get large areas with no stars. We must remember to check that there are no stars at 0,0!
Okay, now we start the actual viewing section. Here are the steps :
- Convert our 3-d coords into their 2-d versions. Have a look at tut 8 to see how this is done, but basically we divide by z.
- Clear away all old stars that may be on the screen.
- Draw all our stars according to our 2-d values we have calculated in 1)
- Move all the stars either closer to us or further away from us by decreasing or increasing their z values respectively.
- If a star's z value has passed into the negative, place it at the very back of our "queue" so that it will come around again
- Jump back to 1) ad-infinitum.
That is, as they say, it. In our sample program the steps have been neatly placed into individual procedures for easy reading.
What next?
Okay, so now we have a cool looking starfield. What next? How about adding left and right motion? A menu or a scrolly in the foreground? How about figuring out how a star tunnel works? A cool 3d routine going in front of the stars?
A starfield can make just about any routine look just that much more professional, and can itself be improved to be a great effect all on it's own.
In closing
So, this was yet another effect in the series. Do you still want more effects, or what? Leave me mail with further ideas for trainers. I may not do it if you don't ask for it!
Oh, well, the medicine has been taken, it is time for me to go. Hello to all those people who have sent me mail, and those great guys on #coders in IRC (you know who you are). Wow. That is the first greets I have ever done in a trainer. Hmm. Maybe I'm just ill ;-)
Happy coding people!
- Denthor
19:28
24-7-94
The following are official ASPHYXIA distribution sites :
É--------------------------Ë----------------Ë-----»
|BBS Name |Telephone No. |Open |
Ì--------------------------Î----------------Î-----¹
|ASPHYXIA BBS #1 |+27-31-765-5312 |ALL |
|ASPHYXIA BBS #2 |+27-31-765-6293 |ALL |
|C-Spam BBS |410-531-5886 |ALL |
|Connectix BBS |+27-31-266-9992 |ALL |
|POP! |+27-12-661-1257 |ALL |
|Soul Asylum |+358-0-5055041 |ALL |
|Wasted Image |407-838-4525 |ALL |
È--------------------------Ê----------------Ê-----¼Leave me mail if you want to become an official Asphyxia BBS distribution site.
TUTPRO13.PAS
{$X+}
USES GFX2,crt;
CONST Num = 400; { Number of stars }
TYPE Star = Record
x,y,z:integer;
End; { Information on each star }
Pos = Record
x,y:integer;
End; { Information on each point to be plotted }
VAR Stars : Array [1..num] of star;
Clear : Array [1..2,1..num] of pos;
{--------------------------------------------------------------------------}
Procedure Init;
VAR loop1,loop2:integer;
logo:array [1..50,1..320] of byte;
BEGIN
for loop1:=1 to num do
Repeat
stars[loop1].x:=random (320)-160;
stars[loop1].y:=random (200)-100;
stars[loop1].z:=loop1;
Until (stars[loop1].x<>0) and (stars[loop1].y<>0);
{ Make sure no stars are heading directly towards the viewer }
pal (32,00,00,30);
pal (33,10,10,40);
pal (34,20,20,50);
pal (35,30,30,60); { Pallette for the stars coming towards you }
pal (247,20,20,20);
pal (136,30,0 ,0 );
pal (101,40,0 ,0 );
pal (19 ,60,0 ,0 ); { Pallette for the logo at the top of the screen }
loadcel ('logo.cel',addr(logo));
for loop1:=0 to 319 do
for loop2:=1 to 50 do
putpixel (loop1,loop2-1,logo[loop2,loop1+1],vga);
{ Placing the logo at the top of the screen }
END;
{--------------------------------------------------------------------------}
Procedure Calcstars;
{ This ccalculates the 2-d coordinates of our stars and saves these values
into the variable clear }
VAR loop1,x,y:integer;
BEGIN
For loop1:=1 to num do BEGIN
x:=((stars[loop1].x shl 7) div stars[loop1].z)+160;
y:=((stars[loop1].y shl 7) div stars[loop1].z)+100;
clear[1,loop1].x:=x;
clear[1,loop1].y:=y;
END;
END;
{--------------------------------------------------------------------------}
Procedure Drawstars;
{ This draws the 2-d values stored in clear to the vga screen, with various
colors according to how far away it is. }
VAR loop1,x,y:integer;
BEGIN
For loop1:=1 to num do BEGIN
x:=clear[1,loop1].x;
y:=clear[1,loop1].y;
if (x>0) and (x<320) and (y>50) and (y<200) then
If stars[loop1].z>400 then putpixel(x,y,32,vga)
else
If stars[loop1].z>300 then putpixel(x,y,33,vga)
else
If stars[loop1].z>200 then putpixel(x,y,34,vga)
else
If stars[loop1].z>100 then putpixel(x,y,34,vga)
else
putpixel(x,y,35,vga)
END;
END;
{--------------------------------------------------------------------------}
Procedure Clearstars;
{ This clears the 2-d values from the vga screen, which is faster then a
cls (vga,0) }
VAR loop1,x,y:integer;
BEGIN
For loop1:=1 to num do BEGIN
x:=clear[2,loop1].x;
y:=clear[2,loop1].y;
if (x>0) and (x<320) and (y>50) and (y<200) then
putpixel (x,y,0,vga);
END;
END;
{--------------------------------------------------------------------------}
Procedure MoveStars (Towards:boolean);
{ If towards is True, then the z-value of each star is decreased to come
towards the viewer, otherwise the z-value is increased to go away from
the viewer }
VAR loop1:integer;
BEGIN
If towards then
for loop1:=1 to num do BEGIN
stars[loop1].z:=stars[loop1].z-2;
if stars[loop1].z<1 then stars[loop1].z:=stars[loop1].z+num;
END
else
for loop1:=1 to num do BEGIN
stars[loop1].z:=stars[loop1].z+2;
if stars[loop1].z>num then stars[loop1].z:=stars[loop1].z-num;
END;
END;
{--------------------------------------------------------------------------}
Procedure Play;
{ This is our main procedure }
VAR ch:char;
BEGIN
Calcstars;
Drawstars; { This draws our stars for the first time }
ch:=#0;
Repeat
if keypressed then ch:=readkey;
clear[2]:=clear[1];
Calcstars; { Calculate new star positions }
waitretrace;
Clearstars; { Erase old stars }
Drawstars; { Draw new stars }
if ch=' ' then Movestars(False) else Movestars(True);
{ Move stars towards or away from the viewer }
Until ch=#27;
{ Until the escape key is pressed }
END;
BEGIN
clrscr;
writeln ('Hello! Another effect for you, this one is on starfields, again by');
writeln ('request. In this sample program, a starfield will be coming towards');
writeln ('you. Hit the space bar to have it move away from you, any other key');
writeln ('to have it come towards you again. Hit [ESC] to end.');
writeln;
Writeln ('The logo at the top of the screen was drawn by me in Autodesk Animator.');
Writeln ('It only took a few seconds, so please don''t laugh too much at my attempt.');
writeln;
writeln ('The code is very easy to follow, and the documentation is as usual in the');
writeln ('main text. Leave me mail with further ideas for future trainers.');
writeln;
writeln;
write ('Hit any key to continue ...');
readkey;
randomize;
setmcga;
init;
Play;
settext;
Writeln ('All done. This concludes the thirteenth sample program in the ASPHYXIA');
Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
Writeln (' smith9@batis.bis.und.ac.za');
Writeln ('The numbers are available in the main text. You may also write to me at:');
Writeln (' Grant Smith');
Writeln (' P.O. Box 270');
Writeln (' Kloof');
Writeln (' 3640');
Writeln (' Natal');
Writeln (' South Africa');
Writeln ('I hope to hear from you soon!');
Writeln; Writeln;
Write ('Hit any key to exit ...');
readkey;
END.GFX2.PAS
Unit GFX2;
INTERFACE
USES crt;
CONST VGA = $A000;
TYPE Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }
VirtPtr = ^Virtual; { Pointer to the virtual screen }
VAR Virscr : VirtPtr; { Our first Virtual screen }
Vaddr : word; { The segment of our virtual screen}
Procedure SetMCGA;
{ This procedure gets you into 320x200x256 mode. }
Procedure SetText;
{ This procedure returns you to text mode. }
Procedure Cls (Where:word;Col : Byte);
{ This clears the screen to the specified color }
Procedure SetUpVirtual;
{ This sets up the memory needed for the virtual screen }
Procedure ShutDown;
{ This frees the memory used by the virtual screen }
procedure flip(source,dest:Word);
{ This copies the entire screen at "source" to destination }
Procedure Pal(Col,R,G,B : Byte);
{ This sets the Red, Green and Blue values of a certain color }
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
{ This gets the Red, Green and Blue values of a certain color }
procedure WaitRetrace;
{ This waits for a vertical retrace to reduce snow on the screen }
Procedure Hline (x1,x2,y:word;col:byte;where:word);
{ This draws a horizontal line from x1 to x2 on line y in color col }
Procedure Line(a,b,c,d:integer;col:byte;where:word);
{ This draws a solid line from a,b to c,d in colour col }
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
{ This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
in color col }
Function rad (theta : real) : real;
{ This calculates the degrees of an angle }
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
{ This puts a pixel on the screen by writing directly to memory. }
Function Getpixel (X,Y : Integer; where:word) :Byte;
{ This gets the pixel on the screen by reading directly to memory. }
Procedure LoadCEL (FileName : string; ScrPtr : pointer);
{ This loads the cel 'filename' into the pointer scrptr }
IMPLEMENTATION
{--------------------------------------------------------------------------}
Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. }
BEGIN
asm
mov ax,0013h
int 10h
end;
END;
{--------------------------------------------------------------------------}
Procedure SetText; { This procedure returns you to text mode. }
BEGIN
asm
mov ax,0003h
int 10h
end;
END;
{--------------------------------------------------------------------------}
Procedure Cls (Where:word;Col : Byte); assembler;
{ This clears the screen to the specified color }
asm
push es
mov cx, 32000;
mov es,[where]
xor di,di
mov al,[col]
mov ah,al
rep stosw
pop es
End;
{--------------------------------------------------------------------------}
Procedure SetUpVirtual;
{ This sets up the memory needed for the virtual screen }
BEGIN
GetMem (VirScr,64000);
vaddr := seg (virscr^);
END;
{--------------------------------------------------------------------------}
Procedure ShutDown;
{ This frees the memory used by the virtual screen }
BEGIN
FreeMem (VirScr,64000);
END;
{--------------------------------------------------------------------------}
procedure flip(source,dest:Word); assembler;
{ This copies the entire screen at "source" to destination }
asm
push ds
mov ax, [Dest]
mov es, ax
mov ax, [Source]
mov ds, ax
xor si, si
xor di, di
mov cx, 32000
rep movsw
pop ds
end;
{--------------------------------------------------------------------------}
Procedure Pal(Col,R,G,B : Byte); assembler;
{ This sets the Red, Green and Blue values of a certain color }
asm
mov dx,3c8h
mov al,[col]
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 GetPal(Col : Byte; Var R,G,B : Byte);
{ This gets the Red, Green and Blue values of a certain color }
Var
rr,gg,bb : Byte;
Begin
asm
mov dx,3c7h
mov al,col
out dx,al
add dx,2
in al,dx
mov [rr],al
in al,dx
mov [gg],al
in al,dx
mov [bb],al
end;
r := rr;
g := gg;
b := bb;
end;
{--------------------------------------------------------------------------}
procedure WaitRetrace; assembler;
{ This waits for a vertical retrace to reduce snow on the screen }
label
l1, l2;
asm
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
end;
{--------------------------------------------------------------------------}
Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
{ This draws a horizontal line from x1 to x2 on line y in color col }
asm
mov ax,where
mov es,ax
mov ax,y
mov di,ax
shl ax,8
shl di,6
add di,ax
add di,x1
mov al,col
mov ah,al
mov cx,x2
sub cx,x1
shr cx,1
jnc @start
stosb
@Start :
rep stosw
end;
{--------------------------------------------------------------------------}
Procedure Line(a,b,c,d:integer;col:byte;where:word);
{ This draws a solid line from a,b to c,d in colour col }
function sgn(a:real):integer;
begin
if a>0 then sgn:=+1;
if a<0 then sgn:=-1;
if a=0 then sgn:=0;
end;
var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
begin
u:= c - a;
v:= d - b;
d1x:= SGN(u);
d1y:= SGN(v);
d2x:= SGN(u);
d2y:= 0;
m:= ABS(u);
n := ABS(v);
IF NOT (M>N) then
BEGIN
d2x := 0 ;
d2y := SGN(v);
m := ABS(v);
n := ABS(u);
END;
s := m shr 1;
FOR i := 0 TO m DO
BEGIN
putpixel(a,b,col,where);
s := s + n;
IF not (s<m) THEN
BEGIN
s := s - m;
a:= a + d1x;
b := b + d1y;
END
ELSE
BEGIN
a := a + d2x;
b := b + d2y;
END;
end;
END;
{--------------------------------------------------------------------------}
Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
{ This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
in color col }
var
x:integer;
mny,mxy:integer;
mnx,mxx,yc:integer;
mul1,div1,
mul2,div2,
mul3,div3,
mul4,div4:integer;
begin
mny:=y1; mxy:=y1;
if y2<mny then mny:=y2;
if y2>mxy then mxy:=y2;
if y3<mny then mny:=y3;
if y3>mxy then mxy:=y3; { Choose the min y mny and max y mxy }
if y4<mny then mny:=y4;
if y4>mxy then mxy:=y4;
if mny<0 then mny:=0;
if mxy>199 then mxy:=199;
if mny>199 then exit;
if mxy<0 then exit; { Verticle range checking }
mul1:=x1-x4; div1:=y1-y4;
mul2:=x2-x1; div2:=y2-y1;
mul3:=x3-x2; div3:=y3-y2;
mul4:=x4-x3; div4:=y4-y3; { Constansts needed for intersection calc }
for yc:=mny to mxy do
begin
mnx:=320;
mxx:=-1;
if (y4>=yc) or (y1>=yc) then
if (y4<=yc) or (y1<=yc) then { Check that yc is between y1 and y4 }
if not(y4=y1) then
begin
x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
if x<mnx then
mnx:=x;
if x>mxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if (y1>=yc) or (y2>=yc) then
if (y1<=yc) or (y2<=yc) then { Check that yc is between y1 and y2 }
if not(y1=y2) then
begin
x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
if x<mnx then
mnx:=x;
if x>mxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if (y2>=yc) or (y3>=yc) then
if (y2<=yc) or (y3<=yc) then { Check that yc is between y2 and y3 }
if not(y2=y3) then
begin
x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
if x<mnx then
mnx:=x;
if x>mxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if (y3>=yc) or (y4>=yc) then
if (y3<=yc) or (y4<=yc) then { Check that yc is between y3 and y4 }
if not(y3=y4) then
begin
x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
if x<mnx then
mnx:=x;
if x>mxx then
mxx:=x; { Set point as start or end of horiz line }
end;
if mnx<0 then
mnx:=0;
if mxx>319 then
mxx:=319; { Range checking on horizontal line }
if mnx<=mxx then
hline (mnx,mxx,yc,color,where); { Draw the horizontal line }
end;
end;
{--------------------------------------------------------------------------}
Function rad (theta : real) : real;
{ This calculates the degrees of an angle }
BEGIN
rad := theta * pi / 180
END;
{--------------------------------------------------------------------------}
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
{ This puts a pixel on the screen by writing directly to memory. }
Asm
mov ax,[where]
mov es,ax
mov bx,[X]
mov dx,[Y]
mov di,bx
mov bx, dx {; bx = dx}
shl dx, 8
shl bx, 6
add dx, bx {; dx = dx + bx (ie y*320)}
add di, dx {; finalise location}
mov al, [Col]
stosb
End;
{--------------------------------------------------------------------------}
Function Getpixel (X,Y : Integer; where:word):byte; assembler;
{ This puts a pixel on the screen by writing directly to memory. }
Asm
mov ax,[where]
mov es,ax
mov bx,[X]
mov dx,[Y]
mov di,bx
mov bx, dx {; bx = dx}
shl dx, 8
shl bx, 6
add dx, bx {; dx = dx + bx (ie y*320)}
add di, dx {; finalise location}
mov al, es:[di]
End;
{--------------------------------------------------------------------------}
Procedure LoadCEL (FileName : string; ScrPtr : pointer);
{ This loads the cel 'filename' into the pointer scrptr }
var
Fil : file;
Buf : array [1..1024] of byte;
BlocksRead, Count : word;
begin
assign (Fil, FileName);
reset (Fil, 1);
BlockRead (Fil, Buf, 800); { Read and ignore the 800 byte header }
Count := 0; BlocksRead := $FFFF;
while (not eof (Fil)) and (BlocksRead <> 0) do begin
BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
Count := Count + 1024;
end;
close (Fil);
end;
BEGIN
END.
