VGA Trainer Program: part 14
Õ-------------------------------¸
| W E L C O M E |
| To the VGA Trainer Program | |
| By | |
| DENTHOR of ASPHYXIA | | |
Ô-------------------------------¾ | |
--------------------------------Ù |
--------------------------------Ù
--==[ PART 14 ]==--Introduction
Hello there. Exams are just around the corner (again :( ), so I thought I better get round to doing the next trainer. As usual, there seems to have been a big delay between this one and the last one... sorry about that ;-)
Well, this trainer is mainly on four things : Glenzing, faster polys, fixed point and assembler. The sample program is basically tut 9 rewritten to include the above.
I'll go through them in order, and hopefully you won't have any hassles grasping the concepts. By the way, do any of you read the text files? I find myself answering questions via E-Mail etc. that were discussed in the text sections of the trainers ... oh well, I'll just ramble along anyway ;-)
Please don't send any mail to smith9@batis.bis.und.ac.za anymore ... I don't know for how much longer the account will be valid (How can a non-BIS person get onto the BIS UNIX machine in the BIS2 directory? If his name is Denthor I suppose ;-) Oh well, I got about 8 months use out of it. The account expires on Christmas day anyway...) So anyway, please leave all messages to denthor@beastie.cs.und.ac.za
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!
What is glenzing?
This is an easy one. Imagine, in a 3D object, that all the sides are made out of colored glass. That means that every time you look through that side, everything behind it is tinged in a certain color.
In ascii ...
+---------+
| <--|---Light blue
| |
+--------+ |
| | <-|-----|---Dark blue
| +---|-----+
| <--|---------Light blue
+--------+So where the two sides overlap, the color values of the two sides are added. Easy huh? It is also easy to code. This is how you do it :
Set up your pallette to be a nice run of colors.
Draw your first poly.
While drawing poly 1, instead of plonking down a set pixel color, grab the background pixel, add 1 to it, then put the result down.
Draw your second poly.
While drawing poly 2, instead of plonking down a set pixel color, grab the background pixel, add 2 to it, then put the result down.
and so forth.
So if the color behind poly 1 was 5, you would place pixel 6 down instead.
If you do this for every single pixel of every single side of your 3d object, you then have glenzing going. This is obviously slightly slower then just drawing an item straight, but in the sample program it goes quite quickly ... this is because of the following sections...
Faster Polygons
In Tut 9, you probably noticed that we were using a multiply for every single line of the poly that we drew. This is not good. Let's find out how to speed it up, shall we...
With the multiply method, we went through every line, to find out the minimum x and maximum x value for that line.
+
------/---\------- Find min x and max x, draw a line
/ \ between them.
+ +
\ /
\ /
+How about if we found out all the min and max x's for every line first, then just went through an array drawing them. We could do it by "scanning" each side in turn. Here is how we do it :
+ 1
/
/
2 +We go from point one to point two. For every single y we go down, we move a constant x value. This value is found like this :
xchange := (x1-x2)/(y1-y2)Remember gradients? This is how you calculated the slope of a line waaay back in school. You never thought it would be any use, didn't you ;-)
Anyway, with this value, we can do the following :
For loop1:=y1 to y2 do BEGIN
[ Put clever stuff here ]
x:=x+xchange;
END;and we will go through all the x-values we need for that line. Clever, huh?
Now for the clever bit. You have an array, from 0 to 199 (which is all the possible y-values your onscreen poly can have). Inside this is two values, which will be your min x and your max x. You start off with the min x being a huge number, and the max x being a low number. Then you scan a side. For each y, check to see if one of the following has happened :
- If the x value is smaller then the xmin value in your array, make the xmin value equal to the x value
- If the x value is larger then the xmax value in your array, make the xmax value equal to the x value
The loop now looks like this :
For loop1:=y1 to y2 do BEGIN
if x>poly[loop1,1] then poly[loop1,1]:=x;
if x<poly[loop1,1] then poly[loop1,1]:=x;
x:=x+xchange;
END;Easy? Do this for all four sides (you can change this for polys with different numbers of sides), and then you have all the x min and x max values you need to draw your polygon.
In the sample program, if you replaced the Hline procedure with one that draws solid lines, you could use the given drawpoly for solids.
Even this procedure is sped up by the next section, on fixed point.
What is fixed point?
Have you ever noticed how slow reals are? I mean slooooow. You can get a massive speed increase in most programs by replacing your reals with integers, words etc. But, I hear you cry, what happens to the much needed fraction bit after the decimal point? The answer? You keep it.
Here's how.
Let us say you have a word, which is 16 bits. If you want to use it as a fixed point value, you can separate it into 2 sections, one of which holds the whole value, and one which holds the fraction.
00000000 00000000 <-Bits
Whole FractionThe number 6.5 would therefore be shown as follows :
Top byte : 6
Bottom byte : 128128 is half (or .5) of 256, and in the case of the fraction section, 256 would equal one whole number.
So let us say we had 6.5 * 2. Using reals this would be a slow mul, but with fixed point ...
Top Byte : 6
Bottom Byte : 128
Value : 1664 <-This is the true value of the word
ie. (top byte*256)+bottom byte).
this is how the computer sees the
word.
1664 shl 1 = 3328 <-shl 1 is the same as *2, just faster.
Top byte : 13
Bottom byte : 0As you can see, we got the correct result! And in a fraction of the time that a multiplication of a real would have taken us. You can add and subtract fixed point values with no hassles, and multiply and divide them by normal values too. When you need the whole value section, you can just read the high byte, or do the following
whole = word shr 8
eg 1664 shr 8 = 6As you can see, the fraction is truncated. Obviously, the more bits you set aside for the fraction section, the more accurate your calculation is, but the lesser the maximum whole number you can have. For example, in the above numbers, the maximum value of your whole number was 256, a far cry from the 65535 a normal (non fixed point) word's maximum.
There are a lot of hassles using fixed point (go on, try shift a negative value), most of which have to do with the fact that you have severely decreased the maximum number you may have, but trust me, the speed increase is worth it (With longintegers, and/or extended 386 registers, you can even have 16x16 fixed point, which means high accuracy and high maximum values)
Try write a program using fixed point. It is not difficult and you will get it perfect easily. Trust me, I'm a democoder ;-)
Assembler
In the sample program I used one or two assembler commands that I haven't discussed with you ... here they are ...
-
imul valueThis is the same as mul, but for integer values. It multiplies ax by the value. If the value is a word, it returns the result in DX:AX -
sal register,valueThis is the same as shl, but it is arithmetic, in other words it works on integers. If you had to shl a negative value, the result would mean nothing to you. -
rcl register,valueThis is the same as shl, but after you have shifted, the value in the carry flag is placed in the now-vacated rightmost bit. The carry flag is set when you do an operation where the result is greater then the upmost possible value of the variable (usually 65535 or 32767)eg mov ax,64000 shl ax,1 {<- Carry flag now = 1}
For more info on shifting etc, re-read tut 7, it goes into the concept in detail.
The sample program is basically Tut 9 rewritten. To see how the assembler stuff is working, do the following ... Go into 50 line mode (-Much- easier to debug), then hit [Alt - D] then R. A little box with all your registers, segments etc and their values will pop up. Move it down to where you want it, then go back to the program screen (Hit Alt and it's number together), and resize it so that you have both it and the register box onscreen at once (Alt - 5 to resize) ... then use F4, F7 and F8 to trace though the program (you know how). The current value of the registers will always be in that box.
In closing
Well, that is about it. The sample program may start as being a little intimidating to some when they first look at it, just remember to read it with tut 9, very little is different, it's just with fixed point and a bit of assembler.
Before I forget, with Tut 13, the program crashes if you have error checking on. This is how you sort it out :
- Turn off error checking or
- Make logo a pointer, and get and free the memory or
- Read the logo directly to screen or
- Use the {$M ......} command with various values at the top of the program till it works.
I prefer options 3 or 2, but hey ... the problem was that the logo was rather large (16k), and Pascal likes complaining ;-)
I am in doubt as to weather to continue doing quotes ... here is a conversation I had with Pipsy, after the group conversation got around to weather we were normal or not ...
Me : I'm normal.
Pipsy : No your not.
Me : Prove it.
Pipsy : Just look at your quotes in your trainers.
Me : What? You think those are weird?
Pipsy : Too weird.
Me : You mean that there is a weirdness line, and I crossed it?
Pipsy : Yes.
Bit of a conversation killer that, so we stopped there.
Anyway, this trainer won't have a quote in it ... how about a disclaimer instead? Feel free to use it in your messages ...
----------
The views expressed above are mine and not Novells. In fact, I've never worked for them in my life!
Byeeee....
- Denthor
18:57
9-9-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 |
|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.
TUTPRO14.PAS
{$X+}
USES Crt,GFX2;
CONST VGA = $A000;
maxpolys = 6;
A : Array [1..maxpolys,1..4,1..3] of integer =
(
((-10,-10,10),(-10,10,10),(10,10,10),(10,-10,10)),
((-10,-10,-10),(-10,10,-10),(10,10,-10),(10,-10,-10)),
((-10,-10,-10),(-10,10,-10),(-10,10,10),(-10,-10,10)),
((10,-10,-10),(10,10,-10),(10,10,10),(10,-10,10)),
((10,-10,10),(10,-10,-10),(-10,-10,-10),(-10,-10,10)),
((10,10,10),(10,10,-10),(-10,10,-10),(-10,10,10))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
Type Point = Record
x,y,z:integer; { The data on every point we rotate}
END;
VAR Lines : Array [1..maxpolys,1..4] of Point; { The base object to be rotated }
Translated : Array [1..maxpolys,1..4] of Point; { The rotated object }
lookup : Array [0..360,1..2] of integer; { Our sin and cos lookup table }
poly : array [0..199,1..2] of integer;
ytopclip,ybotclip:integer; {where to clip our polys to}
xoff,yoff,zoff:integer;
{--------------------------------------------------------------------------}
Procedure SetMCGA; { This procedure gets you into 320x200x256 mode. }
BEGIN
asm
mov ax,0013h
int 10h
end;
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 cx,x2
sub cx,x1
cmp cx,0
jle @End
@Loop1 :
mov al,es:[di]
add al,col
{ inc al}
stosb
loop @loop1
@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 miny,maxy:integer;
loop1:integer;
Procedure doside (x1,y1,x2,y2:integer);
{ This scans the side of a polygon and updates the poly variable }
VAR temp:integer;
x,xinc:integer;
loop1:integer;
BEGIN
if y1=y2 then exit;
if y2<y1 then BEGIN
temp:=y2;
y2:=y1;
y1:=temp;
temp:=x2;
x2:=x1;
x1:=temp;
END;
xinc:=((x2-x1) shl 7) div (y2-y1);
x:=x1 shl 7;
for loop1:=y1 to y2 do BEGIN
if (loop1>ytopclip-1) and (loop1<ybotclip+1) then BEGIN
if (x shr 7<poly[loop1,1]) then poly[loop1,1]:=x shr 7;
if (x shr 7>poly[loop1,2]) then poly[loop1,2]:=x shr 7;
END;
x:=x+xinc;
END;
END;
begin
asm
mov si,offset poly
mov cx,200
@Loop1:
mov ax,32766
mov ds:[si],ax
inc si
inc si
mov ax,-32767
mov ds:[si],ax
inc si
inc si
loop @loop1
end; { Setting the minx and maxx values to extremes }
miny:=y1;
maxy:=y1;
if y2<miny then miny:=y2;
if y3<miny then miny:=y3;
if y4<miny then miny:=y4;
if y2>maxy then maxy:=y2;
if y3>maxy then maxy:=y3;
if y4>maxy then maxy:=y4;
if miny<ytopclip then miny:=ytopclip;
if maxy>ybotclip then maxy:=ybotclip;
if (miny>199) or (maxy<0) then exit;
Doside (x1,y1,x2,y2);
Doside (x2,y2,x3,y3);
Doside (x3,y3,x4,y4);
Doside (x4,y4,x1,y1);
for loop1:= miny to maxy do
hline (poly[loop1,1],poly[loop1,2],loop1,color,where);
end;
{--------------------------------------------------------------------------}
Procedure SetUpPoints;
{ This creates the lookup table }
VAR loop1,loop2:integer;
BEGIN
For loop1:=0 to 360 do BEGIN
lookup [loop1,1]:=round(sin (rad (loop1))*16384);
lookup [loop1,2]:=round(cos (rad (loop1))*16384);
END;
END;
{--------------------------------------------------------------------------}
Procedure RotatePoints (x,Y,z:Integer);
{ This rotates the objecct in lines to translated }
VAR loop1,loop2:integer;
a,b,c:integer;
BEGIN
For loop1:=1 to maxpolys do BEGIN
for loop2:=1 to 4 do BEGIN
b:=lookup[y,2];
c:=lines[loop1,loop2].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[y,1];
c:=lines[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].x:=a;
translated[loop1,loop2].y:=lines[loop1,loop2].y;
b:=-lookup[y,1];
c:=lines[loop1,loop2].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[y,2];
c:=lines[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].z:=a;
if x<>0 then BEGIN
b:=lookup[x,2];
c:=translated[loop1,loop2].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[x,1];
c:=translated[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[x,1];
c:=translated[loop1,loop2].y;
translated[loop1,loop2].y:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[x,2];
c:=translated[loop1,loop2].z;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].z:=a;
END;
if z<>0 then BEGIN
b:=lookup[z,2];
c:=translated[loop1,loop2].x;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[z,1];
c:=translated[loop1,loop2].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
sub a,dx
end;
b:=lookup[z,1];
c:=translated[loop1,loop2].x;
translated[loop1,loop2].x:=a;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
mov a,dx
end;
b:=lookup[z,2];
c:=translated[loop1,loop2].y;
asm
mov ax,b
imul c
sal ax,1
rcl dx,1
sal ax,1
rcl dx,1
add a,dx
end;
translated[loop1,loop2].y:=a;
END;
END;
END;
END;
{--------------------------------------------------------------------------}
Procedure DrawPoints;
{ This draws the translated object to the virtual screen }
VAR loop1:Integer;
temp:integer;
nx:integer;
tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4:integer;
BEGIN
For loop1:=1 to maxpolys do BEGIN
If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].z+zoff<0)
and (translated[loop1,3].z+zoff<0) and (translated[loop1,4].z+zoff<0)
then BEGIN
temp:=round (translated[loop1,1].z)+zoff;
nx:=translated[loop1,1].X;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,160
mov nx,ax
end;
tx1:=nx;
nx:=translated[loop1,1].Y;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,100
mov nx,ax
end;
ty1:=nx;
temp:=round (translated[loop1,2].z)+zoff;
nx:=translated[loop1,2].X;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,160
mov nx,ax
end;
tx2:=nx;
nx:=translated[loop1,2].Y;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,100
mov nx,ax
end;
ty2:=nx;
temp:=round (translated[loop1,3].z)+zoff;
nx:=translated[loop1,3].X;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,160
mov nx,ax
end;
tx3:=nx;
nx:=translated[loop1,3].Y;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,100
mov nx,ax
end;
ty3:=nx;
temp:=round (translated[loop1,4].z)+zoff;
nx:=translated[loop1,4].X;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,160
mov nx,ax
end;
tx4:=nx;
nx:=translated[loop1,4].Y;
asm
mov ax,nx
mov dx,ax
sal ax,8
sar dx,8
idiv temp
add ax,100
mov nx,ax
end;
ty4:=nx;
drawpoly (tx1,ty1,tx2,ty2,tx3,ty3,tx4,ty4,loop1,vaddr);
END;
END;
END;
{--------------------------------------------------------------------------}
Procedure MoveAround;
{ This is the main display procedure. }
VAR deg,loop1,loop2:integer;
ch:char;
BEGIN
for loop1:=1 to 15 do
pal (loop1,0,loop1*4+3,63-(loop1*4+3));
pal (100,50,50,50);
deg:=0;
ch:=#0;
Cls (vaddr,0);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=a [loop1,loop2,1]*8;
Lines [loop1,loop2].y:=a [loop1,loop2,2]*8;
Lines [loop1,loop2].z:=a [loop1,loop2,3]*8;
END;
cls (vaddr,0);
cls (vga,0);
Xoff := 160;
Yoff:=100;
zoff:=-500;
ytopclip:=101;
ybotclip:=100;
line (0,100,319,100,100,vga);
delay (2000);
for loop1:=1 to 25 do BEGIN
RotatePoints (deg,deg,deg);
DrawPoints;
line (0,ytopclip,319,ytopclip,100,vaddr);
line (0,ybotclip,319,ybotclip,100,vaddr);
flip (vaddr,vga);
cls (vaddr,0);
deg:=(deg+5) mod 360;
ytopclip:=ytopclip-4;
ybotclip:=ybotclip+4;
END;
Repeat
if keypressed then ch:=upcase (Readkey);
RotatePoints (deg,deg,deg);
DrawPoints;
line (0,0,319,0,100,vaddr);
line (0,199,319,199,100,vaddr);
flip (vaddr,vga);
cls (vaddr,0);
deg:=(deg+5) mod 360;
Until ch=#27;
for loop1:=1 to 25 do BEGIN
ytopclip:=ytopclip+4;
ybotclip:=ybotclip-4;
RotatePoints (deg,deg,deg);
DrawPoints;
line (0,ytopclip,319,ytopclip,100,vaddr);
line (0,ybotclip,319,ybotclip,100,vaddr);
flip (vaddr,vga);
cls (vaddr,0);
deg:=(deg+5) mod 360;
END;
END;
BEGIN
clrscr;
writeln ('Welcome to the fourteenth trainer! This one is on glenzing, and also');
writeln ('throws in a faster poly, fixed point math and a lot more assembler.');
writeln;
Writeln ('This isn''t very interactive ... hit any key to start, and then');
writeln ('hit the [ESC] key to exit. It is a glenzed cube spinning in the');
writeln ('middle of the screen. Read the text file for more information on');
writeln ('how the fixed point etc. works ... it will also help a lot if you');
writeln ('compare it with TUTPROG9.PAS, as this is the same 3D system, just');
writeln ('speeded up.');
writeln;
writeln;
writeln;
write ('Hit any key to continue ...');
readkey;
SetUpVirtual;
SetMCGA;
SetUpPoints;
MoveAround;
SetText;
ShutDown;
Writeln ('All done. This concludes the fourteenth 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');
Writeln ('RSAProg, comp.lang.pascal and comp.sys.ibm.pc.demos. 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.
