Copy Link
Add to Bookmark
Report
VGA Trainer Program: part 9
Õ-------------------------------¸
| W E L C O M E |
| To the VGA Trainer Program | |
| By | |
| DENTHOR of ASPHYXIA | | |
Ô-------------------------------¾ | |
--------------------------------Ù |
--------------------------------Ù
--==[ PART 9 ]==--Introduction
Hi there! ASPHYXIA is BACK with our first MegaDemo, Psycho Neurosis! A paltry 1.3MB download is all it takes to see the group from Durbs first major production! We are quite proud of it, and think you should see it ;)
Secondly, I released a small little trainer (a trainerette ;-)) on RsaPROG and Connexctix BBS mail, also on the ASPHYXIA BBS as COPPERS.ZIP It is a small Pascal program demonstrating how to display copper bars in text mode. Also includes a check for horizontal retrace (A lot of people wanted it, that is why I wrote the program) (ASPHYXIA ... first with the trainer goodies ;-) aargh, sorry, had to be done ))
Thirdly, sorry about the problems with Tut 8! If you had all the checking on, the tutorial would probably die on the first points. The reason is this : in the first loop, we have DrawPoints then RotatePoints. The variables used in DrawPoints are set in RotatePoints, so if you put RotatePoints before DrawPoints, the program should work fine. Alternatively, turn off error checking 8-)
Fourthly, I have had a surprisingly large number of people saying that "I get this, like, strange '286 instructions not enabled' message! What's wrong with your code, dude?" To all of you, get into Pascal, hit Alt-O (for options), hit enter and a 2 (for Enable 286 instructions). Hard hey? Doesn't anyone EVER set up their version of Pascal?
Now, on to todays tutorial! 3D solids. That is what the people wanted, that is what the people get! This tutorial is mainly on how to draw the polygon on screen. For details on how the 3D stuff works, check out tut 8.
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 or Goth on Connectix.
- Write to : Grant Smith P.O.Box 270 Kloof 3640 Natal
- Call me (Grant Smith) at (031) 73 2129 (leave a message if you call during varsity)
- Write to mcphail@beastie.cs.und.ac.za on InterNet, and mention the word Denthor near the top of the letter.
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!
How to draw a polygon
Sounds easy enough, right? WRONG! There are many, many different ways to go about this, and today I'll only be showing you one. Please don't take what is written here as anything approaching the best method, it is just here to get you on your way...
The procedure I will be using here is based on something most of us learned in standard eight ... I think. I seem to recall doing something like this in Mrs. Reids maths class all those years ago ;)
Take two points, x1,y1 and x2,y2. Draw them :
+ (x1,y1)
\
\ <-- Point a somewhere along the line
\
+ (x2,y2)Right, so what we have to do is this : if we know the y-coord of a, what is it's x-coord? To prove the method we will give the points random values.
+ (2,10)
\
\ <-- a.y = 12
\
+ (15,30)Right. Simple enough problem. This is how we do it :
- (a.y-y1) = (12 - 10) {to get a.y as though y1 was zero}
- *(x2-x1) = *(15 - 2) {the total x-length of the line}
- /(y2-y1) = /(30 - 10) {the total y-length of the line}
- +x1 = +2 { to get the equation back to real coords}
So our equation is :
(a.y-y1)*(x2-x1)/(y2-y1)+x4 or (12-10)*(15-2)/(30-10)+2
which gives you :
2*13/20+2 = 26/20+2 = 3.3
That means that along the line with y=12, x is equal to 3.3. Since we are not concerned with the decimal place, we replace the / with a div, which in Pascal gives us an integer result, and is faster too. All well and good, I hear you cry, but what does this have to do with life and how it relates to polygons in general. The answer is simple. For each of the four sides of the polygon we do the above test for each y line. We store the smallest and the largest x values into separate variables for each line, and draw a horizontal line between them. Ta-Dah! We have a cool polygon!
For example : Two lines going down :
+ +
/ <-x1 x2->| <--For this y line
/ |
+ +Find x1 and x2 for that y, then draw a line between them. Repeat for all y values.
Of course, it's not as simple as that. We have to make sure we only check those y lines that contain the polygon (a simple min y, max y test for all the points). We also have to check that the line we are calculating actually extends as far as where our current y is (check that the point is between both y's). We have to compare each x to see weather it is smaller then the minimum x value so far, or bigger then the maximum (the original x min is set as a high number, and the x max is set as a small number). We must also check that we only draw to the place that we can see ( 0-319 on the x ; 0-199 on the y (the size of the MCGA screen))
To see how this looks in practice, have a look at the sample code provided. (Mrs. Reid would probably kill me for the above explanation, so when you learn it in school, split it up into thousands of smaller equations to get the same answer ;))
Okay, that's it! What's that? How do you draw a vertical line? Thats simple ...
Drawing a vertical line
Right, this is a lot easier than drawing a normal line (Tut 5 .. I think), because you stay on the same y value. So, what you do is you set ES to the screen you want to write to, and get DI to the start of the y-line (see earlier trainers for a description of how SEGMENT:OFFSET works.
IN : x1 , x2, y, color, where
asm
mov ax,where
mov es,ax
mov di,y
mov ax,y
shl di,8 { di:=di*256 }
shl ax,6 { ax:=ax*64 }
add di,ax { di := (y*256)+(y*64) := y*320 Faster then a
straight multiplication }Right, now you add the first x value to get your startoff.
add di,x1Move the color to store into ah and al
mov al,color
mov ah,al { ah:=al:=color }then get CX equal to how many pixels across you want to go
mov cx,x2
sub cx,x1 { cx:=x2-x1 }Okay, as we all know, moving a word is a lot faster then moving a byte, so we halve CX
shr cx,1 { cx:=cx/2 }but what happens if CX was an odd number. After a shift, the value of the last number is placed in the carry flag, so what we do is jump over a single byte move if the carry flag is zero, or execute it if it is one.
jnc @Start { If there is no carry, jump to label Start }
stosb { ES:[DI]:=al ; increment DI }
@Start : { Label Start }
rep stosw { ES:[DI]:=ax ; DI:=DI+2; repeat CX times }Right, the finished product looks like this :
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;Done!
In closing
This 3D system is still not perfect. It needs to be faster, and now I have also dumped the problem of face-sorting on you! Nyahahahaha!
[ My sister and I were driving along the other day when she asked me, what would I like for my computer.
I thought long and hard about it, and came up with the following hypothesis. When a girl gets a Barbie doll, she then wants the extra ballgown for the doll, then the hairbrush, and the car, and the house, and the friends etc.
When a guy gets a computer, he wants the extra memory, the bigger hard drive, the maths co-pro, the better motherboard, the latest software, and the bigger monitor etc.
I told my sister all of this, and finished up with : "So as you can see, computers are Barbie dolls for MEN!"
She called me a chauvinist. And hit me. Hard.]- Grant Smith
19:24
26/2/94
See you next time!
- Denthor
These fine BBS's carry the ASPHYXIA DEMO TRAINER SERIES : (alphabetical)
É--------------------------Ë----------------Ë-----Ë---Ë----Ë----»
|BBS Name |Telephone No. |Open |Msg|File|Past|
Ì--------------------------Î----------------Î-----Î---Î----Î----¹
|ASPHYXIA BBS #1 |(031) 765-5312 |ALL | * | * | * |
|ASPHYXIA BBS #2 |(031) 765-6293 |ALL | * | * | * |
|Connectix BBS |(031) 266-9992 |ALL | | * | * |
È--------------------------Ê----------------Ê-----Ê---Ê----Ê----¼Open = Open at all times or only A/H
Msg = Available in message base
File = Available in file base
Past = Previous Parts available
Does no other BBS's ANYWHERE carry the trainer? Am I writing this for three people who get it from one of these BBS's each week? Should I go on? (Hehehehe ... I was pleased to note that Tut 8 was THE most downloaded file from ASPHYXIA BBS last month ... )
TUTPROG9.PAS
{$X+}
USES Crt;
CONST VGA = $A000;
maxpolys = 5;
A : Array [1..maxpolys,1..4,1..3] of integer =
(
((-10,10,0),(-2,-10,0),(0,-10,0),(-5,10,0)),
((10,10,0),(2,-10,0),(0,-10,0),(5,10,0)),
((-2,-10,0),(2,-10,0),(2,-5,0),(-2,-5,0)),
((-6,0,0),(6,0,0),(7,5,0),(-7,5,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
S : Array [1..maxpolys,1..4,1..3] of integer =
(
((-10,-10,0),(10,-10,0),(10,-7,0),(-10,-7,0)),
((-10,10,0),(10,10,0),(10,7,0),(-10,7,0)),
((-10,1,0),(10,1,0),(10,-2,0),(-10,-2,0)),
((-10,-8,0),(-7,-8,0),(-7,0,0),(-10,0,0)),
((10,8,0),(7,8,0),(7,0,0),(10,0,0))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
P : Array [1..maxpolys,1..4,1..3] of integer =
(
((-10,-10,0),(-7,-10,0),(-7,10,0),(-10,10,0)),
((10,-10,0),(7,-10,0),(7,0,0),(10,0,0)),
((-9,-10,0),(9,-10,0),(9,-7,0),(-9,-7,0)),
((-9,-1,0),(9,-1,0),(9,2,0),(-9,2,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
H : Array [1..maxpolys,1..4,1..3] of integer =
(
((-10,-10,0),(-7,-10,0),(-7,10,0),(-10,10,0)),
((10,-10,0),(7,-10,0),(7,10,0),(10,10,0)),
((-9,-1,0),(9,-1,0),(9,2,0),(-9,2,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
Y : Array [1..maxpolys,1..4,1..3] of integer =
(
((-7,-10,0),(0,-3,0),(0,0,0),(-10,-7,0)),
((7,-10,0),(0,-3,0),(0,0,0),(10,-7,0)),
((-2,-3,0),(2,-3,0),(2,10,0),(-2,10,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
X : Array [1..maxpolys,1..4,1..3] of integer =
(
((-7,-10,0),(10,7,0),(7,10,0),(-10,-7,0)),
((7,-10,0),(-10,7,0),(-7,10,0),(10,-7,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0))
); { The 3-D coordinates of our object ... stored as (X1,Y1,Z1), }
{ (X2,Y2,Z2) ... for the 4 points of a poly }
I : Array [1..maxpolys,1..4,1..3] of integer =
(
((-10,-10,0),(10,-10,0),(10,-7,0),(-10,-7,0)),
((-10,10,0),(10,10,0),(10,7,0),(-10,7,0)),
((-2,-9,0),(2,-9,0),(2,9,0),(-2,9,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0)),
((0,0,0),(0,0,0),(0,0,0),(0,0,0))
); { 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:real; { The data on every point we rotate}
END;
Virtual = Array [1..64000] of byte; { The size of our Virtual Screen }
VirtPtr = ^Virtual; { Pointer to the virtual screen }
VAR Lines : Array [1..maxpolys,1..4] of Point; { The base object rotated }
Translated : Array [1..maxpolys,1..4] of Point; { The rotated object }
Xoff,Yoff,Zoff:Integer; { Used for movement of the object }
lookup : Array [0..360,1..2] of real; { Our sin and cos lookup table }
Virscr : VirtPtr; { Our first Virtual screen }
Vaddr : word; { The segment of our virtual screen}
{--------------------------------------------------------------------------}
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);
{ This clears the screen to the specified color }
BEGIN
asm
push es
mov cx, 32000;
mov es,[where]
xor di,di
mov al,[col]
mov ah,al
rep stosw
pop es
End;
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);
{ This copies the entire screen at "source" to destination }
begin
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;
end;
{--------------------------------------------------------------------------}
Procedure Pal(Col,R,G,B : Byte);
{ This sets the Red, Green and Blue values of a certain color }
Begin
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;
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 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 SetUpPoints;
{ This creates the lookup table }
VAR loop1,loop2:integer;
BEGIN
For loop1:=0 to 360 do BEGIN
lookup [loop1,1]:=sin (rad (loop1));
lookup [loop1,2]:=cos (rad (loop1));
END;
END;
{--------------------------------------------------------------------------}
Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
{ This puts a pixel on the screen by writing directly to memory. }
BEGIN
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;
END;
{--------------------------------------------------------------------------}
Procedure RotatePoints (X,Y,Z:Integer);
{ This rotates object lines by X,Y and Z; then places the result in
TRANSLATED }
VAR loop1,loop2:integer;
temp:point;
BEGIN
For loop1:=1 to maxpolys do BEGIN
For loop2:=1 to 4 do BEGIN
temp.x:=lines[loop1,loop2].x;
temp.y:=lookup[x,2]*lines[loop1,loop2].y - lookup[x,1]*lines[loop1,loop2].z;
temp.z:=lookup[x,1]*lines[loop1,loop2].y + lookup[x,2]*lines[loop1,loop2].z;
translated[loop1,loop2]:=temp;
If y>0 then BEGIN
temp.x:=lookup[y,2]*translated[loop1,loop2].x - lookup[y,1]*translated[loop1,loop2].y;
temp.y:=lookup[y,1]*translated[loop1,loop2].x + lookup[y,2]*translated[loop1,loop2].y;
temp.z:=translated[loop1,loop2].z;
translated[loop1,loop2]:=temp;
END;
If z>0 then BEGIN
temp.x:=lookup[z,2]*translated[loop1,loop2].x + lookup[z,1]*translated[loop1,loop2].z;
temp.y:=translated[loop1,loop2].y;
temp.z:=-lookup[z,1]*translated[loop1,loop2].x + lookup[z,2]*translated[loop1,loop2].z;
translated[loop1,loop2]:=temp;
END;
END;
END;
END;
{--------------------------------------------------------------------------}
Procedure DrawPoints;
{ This draws the translated object to the virtual screen }
VAR loop1:Integer;
nx,ny,nx2,ny2,nx3,ny3,nx4,ny4:integer;
temp: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 :=round (256*translated[loop1,1].X) div temp+xoff;
ny :=round (256*translated[loop1,1].Y) div temp+yoff;
temp:=round (translated[loop1,2].z+zoff);
nx2:=round (256*translated[loop1,2].X) div temp+xoff;
ny2:=round (256*translated[loop1,2].Y) div temp+yoff;
temp:=round (translated[loop1,3].z+zoff);
nx3:=round (256*translated[loop1,3].X) div temp+xoff;
ny3:=round (256*translated[loop1,3].Y) div temp+yoff;
temp:=round (translated[loop1,4].z+zoff);
nx4:=round (256*translated[loop1,4].X) div temp+xoff;
ny4:=round (256*translated[loop1,4].Y) div temp+yoff;
drawpoly (nx,ny,nx2,ny2,nx3,ny3,nx4,ny4,13,vaddr);
END;
END;
END;
{--------------------------------------------------------------------------}
Procedure MoveAround;
{ This is the main display procedure. Firstly it brings the object towards
the viewer by increasing the Zoff, then passes control to the user }
VAR deg,loop1,loop2:integer;
ch:char;
Procedure Whizz (sub:boolean);
VAR loop1:integer;
BEGIN
For loop1:=-64 to -5 do BEGIN
zoff:=loop1*8;
if sub then xoff:=xoff-7 else xoff:=xoff+7;
RotatePoints (deg,deg,deg);
DrawPoints;
flip (vaddr,vga);
Cls (vaddr,0);
deg:=(deg+5) mod 360;
END;
END;
BEGIN
deg:=0;
ch:=#0;
Yoff:=100;
Xoff:=350;
Cls (vaddr,0);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=a [loop1,loop2,1];
Lines [loop1,loop2].y:=a [loop1,loop2,2];
Lines [loop1,loop2].z:=a [loop1,loop2,3];
END;
Whizz (TRUE);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=s [loop1,loop2,1];
Lines [loop1,loop2].y:=s [loop1,loop2,2];
Lines [loop1,loop2].z:=s [loop1,loop2,3];
END;
Whizz (FALSE);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=p [loop1,loop2,1];
Lines [loop1,loop2].y:=p [loop1,loop2,2];
Lines [loop1,loop2].z:=p [loop1,loop2,3];
END;
Whizz (TRUE);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=h [loop1,loop2,1];
Lines [loop1,loop2].y:=h [loop1,loop2,2];
Lines [loop1,loop2].z:=h [loop1,loop2,3];
END;
Whizz (FALSE);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=y [loop1,loop2,1];
Lines [loop1,loop2].y:=y [loop1,loop2,2];
Lines [loop1,loop2].z:=y [loop1,loop2,3];
END;
Whizz (TRUE);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=x [loop1,loop2,1];
Lines [loop1,loop2].y:=x [loop1,loop2,2];
Lines [loop1,loop2].z:=x [loop1,loop2,3];
END;
Whizz (FALSE);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=i [loop1,loop2,1];
Lines [loop1,loop2].y:=i [loop1,loop2,2];
Lines [loop1,loop2].z:=i [loop1,loop2,3];
END;
Whizz (TRUE);
For loop1:=1 to maxpolys do
For loop2:=1 to 4 do BEGIN
Lines [loop1,loop2].x:=a [loop1,loop2,1];
Lines [loop1,loop2].y:=a [loop1,loop2,2];
Lines [loop1,loop2].z:=a [loop1,loop2,3];
END;
Whizz (FALSE);
cls (vaddr,0);
cls (vga,0);
Xoff := 160;
Repeat
if keypressed then BEGIN
ch:=upcase (Readkey);
Case ch of 'A' : zoff:=zoff+5;
'Z' : zoff:=zoff-5;
',' : xoff:=xoff-5;
'.' : xoff:=xoff+5;
'S' : yoff:=yoff-5;
'X' : yoff:=yoff+5;
END;
END;
DrawPoints;
flip (vaddr,vga);
cls (vaddr,0);
RotatePoints (deg,deg,deg);
deg:=(deg+5) mod 360;
Until ch=#27;
END;
BEGIN
SetUpVirtual;
clrscr;
Writeln ('Hello there! Varsity has begun once again, so it is once again');
Writeln ('back to the grindstone ;-) ... anyway, this tutorial is, by');
Writeln ('popular demand, on poly-filling, in relation to 3-D solids.');
Writeln;
Writeln ('In this program, the letters of ASPHYXIA will fly past you. As you');
Writeln ('will see, they are solid, not wireframe. After the last letter has');
Writeln ('flown by, a large A will be left in the middle of the screen.');
Writeln;
Writeln ('You will be able to move it around the screen, and you will notice');
Writeln ('that it may have bits only half on the screen, i.e. clipping is');
Writeln ('perfomed. To control it use the following : "A" and "Z" control the Z');
Writeln ('movement, "," and "." control the X movement, and "S" and "X"');
Writeln ('control the Y movement. I have not included rotation control, but');
Writeln ('it should be easy enough to put in yourself ... if you have any');
Writeln ('hassles, leave me mail.');
Writeln;
Writeln ('I hope this is what you wanted...leave me mail for new ideas.');
writeln;
writeln;
Write (' Hit any key to contine ...');
Readkey;
SetMCGA;
SetUpPoints;
MoveAround;
SetText;
ShutDown;
Writeln ('All done. This concludes the ninth 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.');
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 ('I hope to hear from you soon!');
Writeln; Writeln;
Write ('Hit any key to exit ...');
Readkey;
END.COPPER.PAS
{$X+}
Program Copper;
Uses Crt;
Type
ColType = Record
R,
G,
B : Byte;
End;
PalType = Array[0..255] of ColType;
BarType = Record
Col : Array[1..20] of ColType;
Pos : Array[1..20] of Byte;
UP : Array[1..20] of Boolean;
End;
Var
Pal1 : PalType;
Bars : Array[1..40] Of BarType;
NumBars, NumLines : Byte;
Procedure Pal(Col, R, G, B : Byte);
Begin
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;
End;
Procedure GetPal(Col : Byte; Var R, G, B : Byte);
Var
Rt,Gt,Bt : Byte;
Begin
Asm
mov dx, 3c7h
mov al, [Col]
out dx, al
inc dx
inc dx
in al, dx
mov [Rt],al
in al, dx
mov [Gt],al
in al, dx
mov [Bt],al
End;
R := Rt;
G := Gt;
B := Bt;
End;
Procedure WaitRetrace; Assembler;
Asm
mov dx,3DAh
@@1:
in al,dx
and al,08h
jnz @@1
@@2:
in al,dx
and al,08h
jz @@2
End;
Procedure SetPal(Var Palet : PalType); Assembler;
Asm
call WaitRetrace
push ds
lds si, Palet
mov dx, 3c8h
mov al, 0
out dx, al
inc dx
mov cx, 768
rep outsb
pop ds
End;
Procedure FadeOut(NoBars, BarSize : Byte);
Var
F, L : Integer;
PalFade : PalType;
Begin
For F := 1 to NoBars do
For L := 1 to BarSize do
Begin
If Bars[F].Col[L].R > 0 Then Dec(Bars[F].Col[L].R);
If Bars[F].Col[L].G > 0 Then Dec(Bars[F].Col[L].G);
If Bars[F].Col[L].B > 0 Then Dec(Bars[F].Col[L].B);
End;
End;
Procedure SetMcga;
Begin
Asm
mov ax, 0013h
int 10h
End;
End;
Procedure SetText;
Begin
Asm
mov ax, 0003h
int 10h
End;
End;
Procedure DrawCopper(NoLines, StartCol, YStart : Byte);
Var
Loop : Word;
Begin
For Loop := YStart to YStart + NoLines do
Begin
FillChar(Mem[$a000:Loop*320],320,StartCol+Loop-YStart);
End;
End;
Procedure SetCopperPal(NoBars, BarSize, YStart, ColStart, Space : Byte);
Var
Loop : Byte;
Loop2 : Word;
IncR : Byte;
RGB : Byte;
HalfBar : Byte;
Begin
FillChar(Bars, SizeOf (Bars),0);
HalfBar := BarSize Div 2;
IncR := 63 Div HalfBar;
RGB := 0;
For Loop := 1 to NoBars do
Begin
For Loop2 := 1 to HalfBar do
Begin
If RGB = 0 Then
Bars[Loop].Col[Loop2].R := Loop2 * IncR;
If RGB = 1 Then
Bars[Loop].Col[Loop2].G := Loop2 * IncR;
If RGB = 2 Then
Bars[Loop].Col[Loop2].B := Loop2 * IncR;
Bars[Loop].Pos[Loop2] := YStart + (Loop-1) * (BarSize+Space) + Loop2 -1 + ColStart;
Bars[Loop].UP[Loop2] := True
End;
For Loop2 := HalfBar + 1 to BarSize do
Begin
If RGB = 0 Then
Bars[Loop].Col[Loop2].R := (BarSize - Loop2) * IncR;
If RGB = 1 Then
Bars[Loop].Col[Loop2].G := (BarSize - Loop2) * IncR;
If RGB = 2 Then
Bars[Loop].Col[Loop2].B := (BarSize - Loop2) * IncR;
Bars[Loop].Pos[Loop2] := YStart + (Loop-1) * (BarSize+Space) + Loop2 -1 + ColStart;
Bars[Loop].UP[Loop2] := True
End;
RGB := (RGB + 1) Mod 3;
End;
End;
Procedure RotatePal(NoBars, BarSize, YStart, StartCol, NumLines : Byte;
Up : Boolean);
Var
TPal : PalType;
TCol : ColType;
Loop,
Loop2 : Byte;
Begin
FillChar(TPal, 768, 0);
For Loop := 1 to NoBars do
Begin
For Loop2 := 1 to BarSize do
Begin
TPal[Bars[Loop].Pos[Loop2]] := Bars[Loop].Col[Loop2];
If Up Then
Begin
If Bars[Loop].Pos[Loop2] = StartCol Then
Bars[Loop].UP[Loop2] := False;
If Bars[Loop].Pos[Loop2] = NumLines Then
Bars[Loop].UP[Loop2] := True;
If Bars[Loop].UP[Loop2] Then
Dec(Bars[Loop].Pos[Loop2])
Else
Inc(Bars[Loop].Pos[Loop2]);
End;
End;
End;
SetPal(TPal);
End;
Procedure SetUP(NumLines, NumBars, BarSize, YStart, ColStart, Space : Byte);
Begin
SetMcga;
DrawCopper(NumLines,ColStart,YStart);
SetCopperPal(NumBars, BarSize, YStart, ColStart, Space);
End;
Procedure DoItAll;
Var
NumLines,
NumBars,
BarSize,
YStart,
ColStart,
Space : Byte;
Loop : Byte;
Begin
NumLines := 200;
NumBars := 10;
BarSize := 10;
YStart := 0;
ColStart := 1;
Space := 5;
SetUP(NumLines, NumBars, BarSize, YStart, ColStart, Space);
Repeat
RotatePal(NumBars, BarSize,YStart, ColStart, NumLines, True);
If KeyPressed Then
Begin
For Loop := 0 to 63 do
Begin
RotatePal(NumBars, BarSize,YStart, ColStart, NumLines, True);
FadeOut(NumBars, BarSize);
End;
Exit;
End;
Until False;
End;
Procedure Creds;
Var
R, G, B : Byte;
R1, G1, B1 : Byte;
Loop : Byte;
Begin
SetText;
While KeyPressed do ReadKey;
Asm
mov ah, 1
mov ch, 1
mov cl, 0
int 10h
End;
GetPal(7,R,G,B);
Pal(7,0,0,0);
WriteLn('Copper Bars Trainer...');
WriteLn;
WriteLn('By EzE of Asphyxia.');
WriteLn;
WriteLn('Contact Us on ...');
WriteLn;
WriteLn;
WriteLn('the Asphyxia BBS (031) - 7655312');
WriteLn;
WriteLn('Email : eze@');
WriteLn(' asphyxia@');
WriteLn(' edwards@');
WriteLn(' bailey@');
WriteLn(' mcphail@');
WriteLn(' beastie.cs.und.ac.za');
WriteLn;
WriteLn('or peter.edwards@datavert.co.za');
WriteLn;
WriteLn('Write me snail-mail at...');
WriteLn('P.O. Box 2313');
WriteLn('Hillcrest');
WriteLn('Natal');
WriteLn('3650');
R1 := 0;
G1 := 0;
B1 := 0;
For Loop := 0 to 63 do
Begin
WaitRetrace;
WaitRetrace;
Pal(7, R1, G1, B1);
If R1 < R Then Inc(R1);
If G1 < G Then Inc(G1);
If B1 < B Then Inc(B1);
End;
Asm
mov ah, 1
mov ch, 1
mov cl, 0
int 10h
End;
End;
Procedure Fadecurs;
Var
Loop : Byte;
R, G, B : Byte;
Begin
GetPal(7, R, G, B);
For Loop := 0 to 63 do
Begin
WaitRetrace;
WaitRetrace;
Pal(7, R, G, B);
If R > 0 Then Dec(R);
If G > 0 Then Dec(G);
If B > 0 Then Dec(B);
End;
End;
Begin
TextAttr := $07;
While KeyPressed do ReadKey;
FadeCurs;
DoItAll;
Creds;
End.COPPERS.PAS
Program Copper;
Uses Crt;
Const MaxRasters = 895; { (64+64) * 7 = 896 }
WaitHoriz = FALSE; { Wait for horizontal retace? }
DisableInterrupts = TRUE; { Disable interupts ? }
Var Rastercolors : Array[0..MaxRasters,1..3] Of Byte;
Position,temp,deg: Integer; { Position = What is the first color? }
{ Temp = What color for indiv. lines }
{ Deg = degree for movement }
ret,r,g,b:byte; { Ret = verticle retrace??? }
{--------------------------------------------------------------------------}
Procedure RampColors (r,g,b:boolean);
{ Create a ramp of colors in the RasterColors array, from black to bright
to black again. The R,G,B variables are booleans that determine what mix
of colors make up the ramp. }
VAR Loop1:Integer;
BEGIN
For loop1:=0 To 63 Do Begin
if r then RasterColors[Temp,1]:=loop1 else RasterColors[Temp,1]:=0;
if g then RasterColors[Temp,2]:=loop1 else RasterColors[Temp,2]:=0;
if b then RasterColors[Temp,3]:=loop1 else RasterColors[Temp,3]:=0;
Temp:=Temp+1;
End;
For loop1:=63 DownTo 0 Do Begin
if r then RasterColors[Temp,1]:=loop1 else RasterColors[Temp,1]:=0;
if g then RasterColors[Temp,2]:=loop1 else RasterColors[Temp,2]:=0;
if b then RasterColors[Temp,3]:=loop1 else RasterColors[Temp,3]:=0;
Temp:=Temp+1;
End;
END;
{--------------------------------------------------------------------------}
Function rad (theta : real) : real;
{ This calculates the degrees of an angle }
BEGIN
rad := theta * pi / 180
END;
{--------------------------------------------------------------------------}
Procedure Init;
{ Initialise all variables }
BEGIN
Temp :=0;
Deg :=0;
Position:=0;
RampColors (TRUE,FALSE,FALSE); { Red Ramp }
RampColors (FALSE,TRUE,FALSE); { Green Ramp }
RampColors (FALSE,FALSE,TRUE); { Blue Ramp }
RampColors (TRUE,TRUE,FALSE); { Yellow Ramp }
RampColors (TRUE,FALSE,TRUE); { Purple Ramp }
RampColors (FALSE,TRUE,TRUE); { Light Blue Ramp }
RampColors (TRUE,TRUE,TRUE); { White Ramp }
if DisableInterrupts then
Port[$21]:=1; { Disable interupts. Makes scrolling
much smoother, but MUST BE RESTORED
AT PROGRAM END! }
END;
{--------------------------------------------------------------------------}
PROCEDURE Play;
{ Make the copper bars }
BEGIN
Repeat
Temp:=Position;
Repeat
r:=RasterColors[Temp,1];
g:=RasterColors[Temp,2];
b:=RasterColors[Temp,3];
asm
mov dx,3c8h
mov al,0
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al { Change color 0's pallette }
end; { Calling a separate pal procedure is too slow ... }
if waithoriz then
asm
mov dx,03dah
@WaitHRTEnd:
in al,dx
test al,01h
jz @WaitHRTEnd { Wait until horiz. retrace finished }
end;
Inc(temp); { Increase colorcount }
If temp>MaxRasters Then temp:=0; { Limit }
asm
mov dx,03dah
in al,dx
test al,8
jz @Zero { If not in Vert. Retrace, change color }
mov ret,1
jmp @Fin
@Zero :
mov ret,0
@Fin :
end;
Until ret=1;
{ During vert. retrace ... }
deg:=deg+1;
position:=position+round (sin (rad (deg))*15); { For scrolling }
If position>MaxRasters Then position:=0; { Limits }
If position<0 Then position:=MaxRasters;
Until Port[$60]<$80; { has a key been pressed? }
{ Until keypressed takes too long ... }
asm
mov dx,3c8h
mov al,0
out dx,al
inc dx
mov al,0
out dx,al
mov al,0
out dx,al
mov al,0
out dx,al
end; { Restore pallette zero to black }
if DisableInterrupts then
Port[$21]:=0; { Enable interrupts }
END;
BEGIN
ClrScr;
Writeln ('Hi there! This is a small litttle program to demonstrate how to do');
Writeln ('copper bars in textmode through SIMPLE pallette manipulation. It was');
Writeln ('mainly coded in order to display how to check for horizontal retrace.');
Writeln;
Writeln ('To achive this effect, we continally alter the pallette of color 0,');
Writeln ('according to a color gradient we have precalculated. If we alter this');
Writeln ('color once every horizontal retrace, we get a cool spectrum, which you');
Writeln ('can see behind this text. To obtain movement, we change wich color to');
Writeln ('start with every verticle retrace. The code is easy do understand and');
Writeln ('well documented, so you shouldn''t have any problems.');
Writeln;
Writeln ('The verticle retrace and many other things are discussed in the ASPHYXIA');
Writeln ('VGA Trainer Series, available on ASPHYXIA BBS (031) 765 5312');
Writeln;
Writeln ('Do you like it? If you want to get in contact with me (Denthor) or');
Writeln ('any of the other ASPHYXIA members (Goth, EzE, Fubar, Nobody), leave');
Writeln ('mail to those names on Connectix BBS (031) 2669992, or write to');
Writeln ('me (Grant Smith/DENTHOR) on the ASPHYXIA BBS or the For Your Eyes');
Writeln ('Only BBS.');
Writeln;
Writeln ('You may also get me on (031) 732129, or write to P.O.Box 270 Kloof 3640');
Writeln;
Writeln ('Bye,');
Writeln (' - Denthor');
Init;
Play;
END.
