(*****************************************************************************)
(* *)
(* TUT8.PAS - VGA Trainer Program 8 (in Pascal) *)
(* *)
(* "The VGA Trainer Program" is written by Denthor of Asphyxia. However it *)
(* was limited to Pascal only in its first run. All I have done is taken *)
(* his original release, translated it to C++, and touched up a few things. *)
(* I take absolutely no credit for the concepts presented in this code, and *)
(* am NOT the person to ask for help if you are having trouble. -Snowman *)
(* *)
(* Program Notes : This program presents the basis of 3D. *)
(* *)
(* Author : Grant Smith (Denthor) - [email protected] *)
(* *)
(*****************************************************************************)
{$X+}
USES Crt;
CONST VGA = $A000;
MaxLines = 12;
Obj : Array [1..MaxLines,1..2,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 two ends of a line }
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..MaxLines,1..2] of Point; { The base object rotated }
Translated : Array [1..MaxLines,1..2] 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;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Function rad (theta : real) : real;
{ This calculates the degrees of an angle }
BEGIN
rad := theta * pi / 180
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure SetUpPoints;
{ This sets the basic offsets of the object, creates the lookup table and
moves the object from a constant to a variable }
VAR loop1:integer;
BEGIN
Xoff:=160;
Yoff:=100;
Zoff:=-256;
For loop1:=0 to 360 do BEGIN
lookup [loop1,1]:=sin (rad (loop1));
lookup [loop1,2]:=cos (rad (loop1));
END;
For loop1:=1 to MaxLines do BEGIN
Lines [loop1,1].x:=Obj [loop1,1,1];
Lines [loop1,1].y:=Obj [loop1,1,2];
Lines [loop1,1].z:=Obj [loop1,1,3];
Lines [loop1,2].x:=Obj [loop1,2,1];
Lines [loop1,2].y:=Obj [loop1,2,2];
Lines [loop1,2].z:=Obj [loop1,2,3];
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 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 DrawLogo;
{ This draws 'ASPHYXIA' at the top of the screen in little balls }
CONST ball : Array [1..5,1..5] of byte =
((0,1,1,1,0),
(1,4,3,2,1),
(1,3,3,2,1),
(1,2,2,2,1),
(0,1,1,1,0));
VAR Logo : Array [1..5] of String;
loop1,loop2,loop3,loop4:integer;
BEGIN
pal (13,0,63,0);
pal (1,0,0,40);
pal (2,0,0,45);
pal (3,0,0,50);
pal (4,0,0,60);
Logo[1]:=' O OOO OOO O O O O O O OOO O ';
Logo[2]:='O O O O O O O O O O O O O O';
Logo[3]:='OOO OOO OOO OOO O O O OOO';
Logo[4]:='O O O O O O O O O O O O';
Logo[5]:='O O OOO O O O O O O OOO O O';
For loop1:=1 to 5 do
For loop2:=1 to 31 do
if logo[loop1][loop2]='O' then
For loop3:=1 to 5 do
For loop4:=1 to 5 do
putpixel (loop2*10+loop3,loop1*4+loop4,ball[loop3,loop4],vaddr);
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure RotatePoints (X,Y,Z:Integer);
{ This rotates object lines by X,Y and Z; then places the result in
TRANSLATED }
VAR loop1:integer;
temp:point;
BEGIN
For loop1:=1 to maxlines do BEGIN
temp.x:=lines[loop1,1].x;
temp.y:=lookup[x,2]*lines[loop1,1].y - lookup[x,1]*lines[loop1,1].z;
temp.z:=lookup[x,1]*lines[loop1,1].y + lookup[x,2]*lines[loop1,1].z;
translated[loop1,1]:=temp;
If y>0 then BEGIN
temp.x:=lookup[y,2]*translated[loop1,1].x - lookup[y,1]*translated[loop1,1].y;
temp.y:=lookup[y,1]*translated[loop1,1].x + lookup[y,2]*translated[loop1,1].y;
temp.z:=translated[loop1,1].z;
translated[loop1,1]:=temp;
END;
If z>0 then BEGIN
temp.x:=lookup[z,2]*translated[loop1,1].x + lookup[z,1]*translated[loop1,1].z;
temp.y:=translated[loop1,1].y;
temp.z:=-lookup[z,1]*translated[loop1,1].x + lookup[z,2]*translated[loop1,1].z;
translated[loop1,1]:=temp;
END;
temp.x:=lines[loop1,2].x;
temp.y:=cos (rad(X))*lines[loop1,2].y - sin (rad(X))*lines[loop1,2].z;
temp.z:=sin (rad(X))*lines[loop1,2].y + cos (rad(X))*lines[loop1,2].z;
translated[loop1,2]:=temp;
If y>0 then BEGIN
temp.x:=cos (rad(Y))*translated[loop1,2].x - sin (rad(Y))*translated[loop1,2].y;
temp.y:=sin (rad(Y))*translated[loop1,2].x + cos (rad(Y))*translated[loop1,2].y;
temp.z:=translated[loop1,2].z;
translated[loop1,2]:=temp;
END;
If z>0 then BEGIN
temp.x:=cos (rad(Z))*translated[loop1,2].x + sin (rad(Z))*translated[loop1,2].z;
temp.y:=translated[loop1,2].y;
temp.z:=-sin (rad(Z))*translated[loop1,2].x + cos (rad(Z))*translated[loop1,2].z;
translated[loop1,2]:=temp;
END;
END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure DrawPoints;
{ This draws the translated object to the virtual screen }
VAR loop1:Integer;
nx,ny,nx2,ny2:integer;
temp:integer;
BEGIN
For loop1:=1 to MaxLines do BEGIN
If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].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;
If (NX > 0) and (NX < 320) and (NY > 25) and (NY < 200) and
(NX2> 0) and (NX2< 320) and (NY2> 25) and (NY2< 200) then
line (nx,ny,nx2,ny2,13,vaddr);
END;
END;
END;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ClearPoints;
{ This clears the translated object from the virtual screen ... believe it
or not, this is faster then a straight "cls (vaddr,0)" }
VAR loop1:Integer;
nx,ny,nx2,ny2:Integer;
temp:integer;
BEGIN
For loop1:=1 to MaxLines do BEGIN
If (translated[loop1,1].z+zoff<0) and (translated[loop1,2].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;
If (NX > 0) and (NX < 320) and (NY > 25) and (NY < 200) and
(NX2> 0) and (NX2< 320) and (NY2> 25) and (NY2< 200) then
line (nx,ny,nx2,ny2,0,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:integer;
ch:char;
BEGIN
deg:=0;
ch:=#0;
Cls (vaddr,0);
DrawLogo;
For loop1:=-256 to -40 do BEGIN
zoff:=loop1*2;
RotatePoints (deg,deg,deg);
DrawPoints;
flip (vaddr,vga);
ClearPoints;
deg:=(deg+5) mod 360;
END;
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);
ClearPoints;
RotatePoints (deg,deg,deg);
deg:=(deg+5) mod 360;
Until ch=#27;
END;
BEGIN
SetUpVirtual;
Writeln ('Greetings and salutations! Hope you had a great Christmas and New');
Writeln ('year! ;-) ... Anyway, this tutorial is on 3-D, so this is what is');
Writeln ('going to happen ... a wireframe square will come towards you.');
Writeln ('When it gets close, you get control. "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 ('Read the main text file for ideas on improving this code ... and');
Writeln ('welcome to the world of 3-D!');
writeln;
writeln;
Write (' Hit any key to contine ...');
Readkey;
SetMCGA;
SetUpPoints;
MoveAround;
SetText;
ShutDown;
Writeln ('All done. This concludes the eigth 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 ('For discussion purposes, I am also the moderator of the Programming');
Writeln ('newsgroup on the For Your Eyes Only BBS.');
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.