VGA Trainer Program: part 17
Õ-------------------------------¸
| W E L C O M E |
| To the VGA Trainer Program | |
| By | |
| DENTHOR of ASPHYXIA | | |
Ô-------------------------------¾ | |
--------------------------------Ù |
--------------------------------Ù
--==[ PART 17 ]==--Introduction
Hi there everybody. It's a new year, but the parties are over and it's time to get coding again!
My mailserver died. Various sysadmins decided it was time to upgrade the OS, and wound up nuking the hard drive :-( ... this means that request-list is not working at the moment, and I have probably lost lots of mail.
denthor@beastie.cs.und.ac.za is still the account to write to, and hopefully the mailserver will be back up in the near future.
There are various C/C++ conversions of my trainer, best of which seem to be those by Snowman ... he runs through the text files with C++ updates (and seems to point out my previous mistakes with glee ;-), as well is giving a fully documented C++ conversion of the source ... very nice stuff.
Also, my trainers are being put on a World Wide Web site ... it is still under construction, but go to http://www.cit.gu.edu.au/~rwong my site is at http://goth.vironix.co.za/~denthor ... it is currently pretty awful, anyone want to write a nice one for me? ;)
I have just about finished Asphyxia's new game, I will let you all know when it is completed.
Tut 16 dies with large bitmaps ... the way to sort this out is to decrease the accuracy of the fixed point from 256 to 128 ... then you can have bitmaps up to 512 pixels wide. I will be putting an updated scale routine in the gfx4.pas unit.
This tutor is on a few demo effects (pixel morphs and static) ... after this one, I will go on to more theory ... perhaps some more 3d stuff, such as gourad shading etc. Comments?
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 : 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 denthor@beastie.cs.und.ac.za in E-Mail.
- Write to asphyxia@beastie.cs.und.ac.za to get to all of us at once.
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!
Pixel Morphing
Have you ever lain down on your back in the grass and looked up at the cloudy sky? If you have, you have probably seen the clouds move together and create wonderful shapes ... that cloud plus that cloud together make a whale ... a ship ... a face etc.
We can't quite outdo mother nature, but we can sure give it a shot. The effect I am going to show you is where various pixels at different starting points move together and create an overall picture.
The theory behind it is simple : Each pixel has bits of data associated with it, most important of which is as follows :
- This is my color
- This is where I am
- This is where I want to be.
The pixel, keeping it's color, goes from where it is to where it wants to be. Our main problem is _how_ it moves from where it is to where it wants to be. A obvious approach would be to say "If it's destination is above it, decrement it's y value, if the destination is to the left, decrement it's x value and so on."
This would be bad. The pixel would only ever move at set angles, as you can see below :
Dest O-----------------\
\ <--- Path
\
\
O SourceDoesn't look very nice, does it? The pixels would also take different times to get to their destination, whereas we want them to reach their points at the same time, ie :
Dest 1 O-------------------------------O Source 1
Dest 2 O-----------------O Source 2Pixels 1 and 2 must get to their destinations at the same time for the best effect. The way this is done by defining the number of frames or "hops" needed to get from source to destination. For example, we could tell pixel one it is allowed 64 hops to get to it's destination, and the same for point 2, and they would both arrive at the same time, even though pixel 2 is closer.
The next question, it how do we move the pixels in a straight line? This is easier then you think...
Let us assume that for each pixel, x1,y1 is where it is, and x2,y2 is where it wants to be.
- (x2-x1) = The distance on the X axis between the two points
- (y2-y1) = The distance on the Y axis between the two points
If we do the following :
dx := (x2-x1)/64;we come out with a value in dx which is very useful. If we added dx to x1 64 times, the result would be x2! Let us check...
dx = (x2-x1)/64
dx*64 = x2-x1 { Multiply both sides by 64 }
dx*64+x1 = x2 { Add x1 to both sides }This is high school math stuff, and is pretty self explanitory. So what we have is the x movement for every frame that the pixel has to undergo. We find the y movement in the same manner.
dy := (y2-y1)/64;So our program is as follows :
Set x1,y1 and x2,y2 values
dx:= (x2-x1)/64;
dy:= (y2-y1)/64;
for loop1:=1 to 64 do BEGIN
putpixel (x1,y1)
wait;
clear pixel (x1,y1);
x1:=x1+dx;
y1:=y1+dy;
END;If there was a compiler that could use the above pseudocode, it would move the pixel from x1,y1 to x2,y2 in 64 steps.
So, what we do is set up an array of many pixels with this information, and move them all at once ... viola, we have pixel morphing! It is usually best to use a bitmap which defines the color and destination of the pixels, then randomly scatter them around the screen.
Why not use pixel morphing on a base object in 3d? It would be the work of a moment to add in a Z axis to the above.
The sample program uses fixed point math in order to achieve high speeds, but it is basically the above algorithm.
Static
A static screen was one of the first effects Asphyxia ever did. We never actually released it because we couldn't find anywhere it would fit. Maybe you can.
The easiest way to get a screen of static is to tune your TV into an unused station ... you even get the cool noise effect too. Those people who build TV's really know how to code ;-)
For us on a PC however, it is not as easy to generate a screen full of static (unless you desperately need a new monitor)
What we do is this :
- Set colors 1-16 to various shades of grey.
- Fill the screen up with random pixels between colors 1 and 16
- Rotate the pallette of colors 1 to 16.
That's it! You have a screenfull of static! To get two images in one static screen, all you need to do is fade up/down the specific colors you are using for static in one of the images.
A nice thing about a static screen is that it is just pallette rotations ... you can do lots of things in the foreground at the same time (such as a scroller).
In closing
Well, that is about it ... as I say, I will be doing more theory stuff in future, as individual demo effects can be thought up if you know the base stuff.
Note the putpixel in this GFX3.PAS unit ... it is _very_ fast .. but remember, just calling a procedure eats clock ticks... so imbed putpixels in your code if you need them. Most of the time a putpixel is not needed though.
PCGPE ][ will be out on the 10th of Feburary. All the new tutors will be on it (if you aren't reading this from it right now! ;-) ... grab a copy of it, it is a very useful ting to have handy.
I have found out that these tutors have been distributed inside paper magazines ... please remember that Denthor and Asphyxia retain full copyright to the series (as mentioned earlier in the series), and if you want to use a version in a magazine, CONTACT ME FIRST ... I will probably also modify it/cut out various unneccesary things ... other then that, you must not alter the files without my permission, or at least leave a copy of the original with the update. Maybe I could even start up a nice column for some magazine or other :)
Sorry 'bout that, but it had to be said ...
I am writing a column for the Demuan list, a Florida-based electronic magazine ... pick it up off ftp.eng.ufl.edu ... I have written various articles, all bordering on quote-like design.
There are more BBS's to be added to the list at the end, but I don't have them here... this tut has taken long enough ;-)
Byeeeee....
- Denthor
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 |
|POP! |+27-12-661-1257 |ALL |
|Soul Asylum |+358-0-5055041 |ALL |
|Wasted Image |407-838-4525 |ALL |
|Reckless Life |351-01-716 67 58|ALL |
|Mach 5 BBS |+1 319-355-7336 |ALL |
È--------------------------Ê----------------Ê-----¼Leave me mail if you want to become an official Asphyxia BBS distribution site.
TUTPRO17.PAS
{$X+}
USES crt,gfx3;
Const jump = 64; { Number of pixels active at once }
sjump = 6; { 1 shl 6 = 64 }
TYPE
FontDat = Array [' '..'Z',1..16,1..16] of byte; {Our main font }
target = record
herex,herey : integer;
targx,targy : integer;
dy,dx : integer;
active : boolean;
col : byte;
num:integer;
END;
PixelDat = Array [1..4095] of target; { This is the maximum number
of points we canb fit in a
segment... }
VAR Font : ^FontDat; { Our nice font }
nextrow : ^PixelDat;
scr : array [' '..'Z',1..8,1..8] of byte; { The basic bios font }
Vir2 : VirtPtr;
Vaddr2 : Word; { Spare virtual screen }
counter:integer;
PosLoop:integer;
dir : boolean;
pathx,pathy:array [1..314] of integer; { Path of origination }
arbpal : array [1..8,1..3] of byte; { Used to remember certain
colors }
{--------------------------------------------------------------------------}
Procedure Bigmsg (x,y:integer;msg:string);
{ This draws string msg to screen in the bios font, but bigger }
VAR loop1,loop2,loop3,loop4,loop5:integer;
BEGIN
for loop1:=1 to length (msg) do
for loop2:=1 to 8 do
for loop3:=1 to 8 do
if (scr[msg[loop1],loop3,loop2]<>0) then BEGIN
for loop4:=1 to 4 do
for loop5:=1 to 8 do
putpixel (x+(loop1*32)+(loop2*4)+loop4,y+(loop3*8)+loop5,
getpixel (x+(loop1*32)+(loop2*4)+loop4,y+(loop3*8)+loop5,vaddr2)+51,vaddr);
END;
END;
{--------------------------------------------------------------------------}
Procedure Static;
{ This moves the static and tunes in to our background logo }
VAR loop1,loop2,count,count2,count3:integer;
BEGIN
flip (vaddr2,vaddr);
Bigmsg (0,60,'ASPHYXIA');
flip (vaddr,vga);
count:=0;
count2:=0;
for loop2:=1 to 100 do BEGIN
waitretrace;
for loop1:=99 to 150 do BEGIN
count:=random (64);
pal (loop1,count,count,count);
END;
for loop1:=150 to 201 do BEGIN
count:=random (64);
pal (loop1,count,count,count);
END;
END; { Do the static for a while }
repeat
inc (count);
if count>10 then BEGIN
count:=0;
inc (count2);
END;
waitretrace;
for loop1:=99 to 150 do BEGIN
count3:=random (64-count2);
if count3<0 then count3:=0;
pal (loop1,count3,count3,count3);
END;
for loop1:=150 to 201 do BEGIN
count3:=random (64);
count3:=count3+count2;
if count3>63 then count3:=63;
pal (loop1,count3,count3,count3);
END;
until count2>63; { Static fade in Asphyxia logo }
delay (500);
for loop1:=30 to 62 do BEGIN
line (0,loop1*2,319,loop1*2,0,vga);
delay (5);
END;
for loop1:=62 downto 30 do BEGIN
line (0,loop1*2+1,319,loop1*2+1,0,vga);
delay (5);
END; { Erase logo with lines }
delay (1000);
while keypressed do readkey;
END;
{--------------------------------------------------------------------------}
Procedure Fadeup;
{ This fades up the pallette to white }
VAR loop1,loop2:integer;
Tmp : Array [1..3] of byte;
BEGIN
For loop1:=1 to 64 do BEGIN
WaitRetrace;
For loop2:=0 to 255 do BEGIN
Getpal (loop2,Tmp[1],Tmp[2],Tmp[3]);
If Tmp[1]<63 then inc (Tmp[1]);
If Tmp[2]<63 then inc (Tmp[2]);
If Tmp[3]<63 then inc (Tmp[3]);
Pal (loop2,Tmp[1],Tmp[2],Tmp[3]);
END;
END;
END;
{--------------------------------------------------------------------------}
Procedure FadeTo (name:string);
{ This procedure fades the screen to name ... if you use this for yourself,
you will need to cut out the extra stuff I do in here specific to this
program }
VAR loop1,loop2:integer;
tmp,pall2:array[0..255,1..3] of byte;
f:file;
BEGIN
assign (f,name);
reset (f,1);
blockread (f,pall2,768);
close (f);
for loop1:=100 to 150 do BEGIN
pall2[loop1,1]:=loop1-100;
pall2[loop1,2]:=loop1-100;
pall2[loop1,3]:=loop1-100;
END; { Set the background colors }
waitretrace;
for loop1:=0 to 255 do
getpal (loop1,tmp[loop1,1],tmp[loop1,2],tmp[loop1,3]);
For loop1:=1 to 64 do BEGIN
For loop2:=0 to 255 do BEGIN
If Tmp[loop2,1]<Pall2[loop2,1] then inc (Tmp[loop2,1]);
If Tmp[loop2,2]<Pall2[loop2,2] then inc (Tmp[loop2,2]);
If Tmp[loop2,3]<Pall2[loop2,3] then inc (Tmp[loop2,3]);
If Tmp[loop2,1]>Pall2[loop2,1] then dec (Tmp[loop2,1]);
If Tmp[loop2,2]>Pall2[loop2,2] then dec (Tmp[loop2,2]);
If Tmp[loop2,3]>Pall2[loop2,3] then dec (Tmp[loop2,3]);
END;
WaitRetrace;
for loop2:=0 to 255 do
pal (loop2,tmp[loop2,1],tmp[loop2,2],tmp[loop2,3]);
END;
END;
{--------------------------------------------------------------------------}
Procedure Show (x,y:integer;ch:string);
{ This dumps string ch to screen at x,y in our main font }
VAR loop1,loop2,loop3:integer;
BEGIN
for loop3:=1 to length (ch) do
For loop1:=1 to 16 do
for loop2:=1 to 16 do
if Font^[ch[loop3],loop2,loop1]<>0 then
putpixel (x+loop1+(loop3*17),y+loop2,getpixel (x+loop1+(loop3*17),y+loop2,vaddr2)+51,VGA);
END;
{--------------------------------------------------------------------------}
Procedure Eye_Popper;
{ This fades up the colors used in our main font }
VAR Loop1,loop2:integer;
tmp : array [1..3] of byte;
BEGIN
if keypressed then exit;
for loop1:=1 to 63 do
for loop2:=1 to 8 do BEGIN
Waitretrace;
Getpal (loop2,tmp[1],tmp[2],tmp[3]);
if tmp[1]<63 then inc (tmp[1]);
if tmp[2]<63 then inc (tmp[2]);
if tmp[3]<63 then inc (tmp[3]);
pal (loop2,tmp[1],tmp[2],tmp[3]);
END;
for loop1:=151 to 200 do
pal (loop1,63,63,63);
END;
{--------------------------------------------------------------------------}
Procedure FadeOutText;
{ This fades out the colors of our main font to the colors of the background
static }
VAR Loop1,loop2:integer;
tmp : array [1..3] of byte;
BEGIN
if keypressed then exit;
for loop1:=1 to 63 do BEGIN
Waitretrace;
for loop2:=151 to 200 do BEGIN
Getpal (loop2,tmp[1],tmp[2],tmp[3]);
if tmp[1]>loop2-151 then dec (tmp[1]);
if tmp[2]>loop2-151 then dec (tmp[2]);
if tmp[3]>loop2-151 then dec (tmp[3]);
pal (loop2,tmp[1],tmp[2],tmp[3]);
END;
END;
delay (100);
END;
{--------------------------------------------------------------------------}
Procedure Move_Em_Out (num:integer;del:byte);
{ This procedure runs through each pixel that is active and moves it closer
to its destination }
VAR loop2:integer;
BEGIN
if del<>0 then delay (del);
for loop2:=1 to num do
if nextrow^[loop2].active then with nextrow^[loop2] do BEGIN
putpixel (herex shr sjump,herey shr sjump,
getpixel (herex shr sjump,herey shr sjump,vaddr),vga);
{ Restore old bacground }
herex:=herex-dx;
herey:=herey-dy; { Move pixel one step closer }
putpixel (herex shr sjump,herey shr sjump,col,vga); { Put down pixel }
dec (num);
if num=0 then BEGIN
active:=false;
putpixel (herex shr sjump,herey shr sjump,col,vaddr);
END; { If destination reached, deactivate }
END;
END;
{--------------------------------------------------------------------------}
Procedure Doletter (msg : char; dx,dy : integer);
{ This procedure activates the pixels necessary to draw a letter }
VAR loop1,loop2:integer;
x,y : Integer;
BEGIN
if keypressed then exit;
for loop2:=1 to 16 do BEGIN
for loop1:=1 to 16 do { Our font is 16x16 }
if Font^[msg,loop1,loop2]<>0 then BEGIN { Don't do black pixels }
if dir then PosLoop:=PosLoop+1
else PosLoop:=PosLoop-1;
if PosLoop=315 then PosLoop:=1;
if PosLoop=0 then PosLoop:=314;
X:=pathx[PosLoop]+160;
y:=pathy[PosLoop]+100; { Find point of origination }
nextrow^ [counter].herex:=x shl sjump;
nextrow^ [counter].herey:=y shl sjump;
{ This is where I am }
nextrow^ [counter].targx:=(dx+loop2) shl sjump;
nextrow^ [counter].targy:=(dy+loop1) shl sjump;
{ This is where I want to be }
nextrow^ [counter].dx:=(nextrow^[counter].herex-nextrow^[counter].targx) div jump;
nextrow^ [counter].dy:=(nextrow^[counter].herey-nextrow^[counter].targy) div jump;
{ This is how I get there }
nextrow^ [counter].col:=Font^[msg,loop1,loop2];
nextrow^ [counter].active:=TRUE;
nextrow^ [counter].num:=jump;
move_em_out(jump,6);
inc (counter);
if counter=jump+1 then counter:=1;
END;
END;
END;
{--------------------------------------------------------------------------}
Procedure DoPic;
{ This procedure morphs in the tank }
VAR f:file;
ch:byte;
count,loop1,loop2:integer;
ourpal : array [0..255,1..3] of byte;
BEGIN
cls (vaddr,0);
getmem (nextrow,sizeof(nextrow^));
GetMem(Vir2,64000);
Vaddr2 := Seg(Vir2^);
for loop2:=1 to 4095 do
nextrow^[loop2].active:=false;
assign (f,'tut17.cel');
reset (f,1);
seek (f,32);
blockread (f,ourpal,768);
for loop1:=0 to 255 do
pal (loop1,ourpal[loop1,1],ourpal[loop1,2],ourpal[loop1,3]);
count:=1;
for loop2:=1 to 60 do
for loop1:=1 to 160 do BEGIN
blockread (f,ch,1); { Go through the pic, and activate non-black
pixels }
if ch<>0 then BEGIN
nextrow^ [count].herex:=random (320) shl sjump;
nextrow^ [count].herey:=random (200) shl sjump;
{ This is where I am }
nextrow^ [count].targx:=(loop1+80) shl sjump;
nextrow^ [count].targy:=(loop2+70) shl sjump;
{ This is where I want to be }
nextrow^ [count].dx:=(nextrow^[count].herex-nextrow^[count].targx) div jump;
nextrow^ [count].dy:=(nextrow^[count].herey-nextrow^[count].targy) div jump;
{ This is how I get there }
nextrow^ [count].col:=ch;
nextrow^ [count].active:=TRUE;
nextrow^ [count].num:=jump;
inc (count);
END;
END;
close (f);
for loop1:=0 to 64 do
move_em_out (count,0); { Move pixels to targets }
delay (2000);
fadeup;
END;
{--------------------------------------------------------------------------}
Procedure Init;
VAR f:file;
loop1,loop2:integer;
loopie:real;
BEGIN
getmem (Font,sizeof(Font^));
for loop2:=1 to jump do
nextrow^[loop2].active:=false;
Assign(f,'gods.Fnt');
Reset(f,1);
Blockread(F,Font^,SizeOf(Font^));
Close(f);
assign (f,'biostext.dat');
reset (f,1);
Blockread (f,scr,sizeof (scr));
close (f);
counter:=1;
PosLoop:=1;
dir:=true;
loopie:=0;
for loop1:=1 to 314 do BEGIN
loopie:=loopie+0.02;
pathX[loop1]:=round(150*cos (loopie));
pathy[loop1]:=round(90*sin (loopie));
END; { Generate our path of origination }
cls (vga,0);
cls (vaddr,0);
cls (vaddr2,0);
for loop1:=0 to 319 do
for loop2:=0 to 199 do
putpixel (loop1,loop2,random (50)+100,vaddr2); { Fill the screen with static }
flip (vaddr2,vaddr);
flip (vaddr,vga);
fadeto ('game01.col');
for loop1:=1 to 8 do
getpal (loop1,arbpal[loop1,1],arbpal[loop1,2],arbpal[loop1,3]);
END;
{--------------------------------------------------------------------------}
Procedure Play;
VAR loop1,loop2:integer;
message : Array [1..10] of string;
BEGIN
DoPic;
init;
while keypressed do readkey;
{[ ]}
message[1]:='';
message[2]:='';
message[3]:=' PIXEL TEXT ';
message[4]:='';
message[5]:=' A ROUTINE';
message[6]:='';
message[7]:=' BY...';
message[9]:='';
message[10]:='';
for loop2:=1 to 7 do BEGIN
For loop1:=1 to length (message[loop2]) do BEGIN
doletter (message[loop2][loop1],loop1*17,loop2*17);
dir:=not(dir);
END;
for loop1:=1 to jump do move_em_out(jump,6);
END;
eye_popper;
For loop1:=1 to 7 do
show (0,loop1*17,message[loop1]);
fadeouttext;
flip (vaddr2,vaddr);
flip (vaddr,vga);
for loop1:=1 to 8 do
pal (loop1,arbpal[loop1,1],arbpal[loop1,2],arbpal[loop1,3]);
message[1]:=' TUNING...';
For loop1:=1 to length (message[1]) do BEGIN
if message[1][loop1]='.' then for loop2:=1 to 20 do
move_em_out(jump,6);
doletter (message[1][loop1],loop1*17,100);
dir:=not(dir);
END;
for loop1:=1 to jump do move_em_out(jump,6);
eye_popper;
show (0,100,message[1]);
fadeouttext;
static;
freemem (vir2,sizeof (vir2^));
END;
BEGIN
clrscr;
writeln ('Hi there ... welcome to the seventeenth Asphyxia VGA Trainer ... and');
writeln ('the last one on demo effects for a while ... I am going to be doing');
writeln ('more work on the theory aspect in future trainers.');
writeln;
writeln ('This is an effect I first saw in an Extreme demo, and features ''Pixel');
writeln ('Text'', with various dots forming letters. Also included are some crossfades');
writeln ('and a static routine.');
writeln;
writeln ('Check out the GFX3 unit for a faster putpixel...');
writeln;
writeln ('The tank was drawn by Fubar a while ago when he was starting to learn');
writeln ('3D Studio. The font I found somewhere on my hard drive.');
writeln;
writeln;
writeln ('Hit any key to continue ...');
readkey;
setmcga;
setupvirtual;
play;
settext;
shutdown;
Writeln ('All done. This concludes the seventeenth 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 also occasinally read');
Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. E-mail me at :');
Writeln (' denthor@beastie.cs.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.GFX3.PAS
Unit GFX3;
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}
Scr_Ofs : Array[0..199] of Word;
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 }
Procedure LoadPal (FileName : string);
{ This loads in an Autodesk Animator V1 pallette file }
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,[y]
shl bx,1
mov di,word ptr [Scr_Ofs + bx]
add di,[x]
mov al,[col]
mov es:[di],al
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,[y]
shl bx,1
mov di,word ptr [Scr_Ofs + bx]
add di,[x]
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;
procedure LoadPal (FileName : string);
var
F:file;
loop1:integer;
pall:array[0..255,1..3] of byte;
begin
assign (F, FileName);
reset (F,1);
blockread (F, pall,768);
close (F);
for loop1 := 0 to 255 do
Pal(loop1,pall[loop1,1],pall[loop1,2],pall[loop1,3]);
end;
VAR Loop1:integer;
BEGIN
For Loop1 := 0 to 199 do
Scr_Ofs[Loop1] := Loop1 * 320;
END.
