S_WIEZORKE@iravcl.ira.uka.de (Hans B. Wiezorke) (06/03/91)
I just wrote a library for 3D (red/blue) turtle graphics for PCs.
It's written in Turbo Pascal (should run with TP 4.0-6.0) and requires
VGA and a color monitor.
I've included a short demo program at the end of this posting.
The colors are best fit for my pair of R/B glasses, you may have to
change them.
If you write any other good things with these routines, just let me know.
Most of all, share & enjoy,
opus
------- cut here ------- TURTLE3D.PAS ---------- cut here ------
unit turtle3d;
{ 3D turtle graphics, written 1991 by Hans B. Wiezorke }
{ distribute freely }
interface
uses dos, crt;
type vector = record x, y, z : real; end;
procedure init3d; { initializes & clears screen and sets clors }
procedure close3d; { resets former text mode }
procedure line3 ( v1, v2 : vector ); { draws 3d line }
procedure penup; { causes turtle not to draw while moving }
procedure pendown; { opposite of penup }
procedure home; { sets turtle into middle of screen }
procedure fd (n : real); { moves turtle forward n steps }
procedure bk (n : real);
procedure lt (n : real); { turns turtle left n degrees }
procedure rt (n : real); { turns turtle right n degrees }
procedure up (n : real); { turns turtle up }
procedure dn (n : real); { turns turtle down }
procedure rl (n : real); { rolls left }
procedure rr (n : real); { rolls right }
implementation
const xmax = 640; { screen width }
ymax = 480; { screen height }
red = 50; { color for red line }
green = 30; { color for green/blue line }
blue = 60; { color for green/blue line }
vpos = ymax div 2; { vertical position of eyes }
rhpos = (xmax * 4) div 10; { horizontal position of left(red) eye }
ghpos = (xmax * 6) div 10; { hor. pos. of right(green/blue) eye }
distance = xmax * 2; { distance of eyes from screen in pixels }
var r : registers;
color : byte;
draw : boolean;
degree : real;
temp, t, tnew, tfront, ttop, tright : vector;
procedure init3d;
begin
degree := pi/180;
r.ah := 0; {set mode}
r.al := $12; {640x480x16} {if $12 doesn't work, try $25}
intr($10, r);
r.ah := $10;
r.al := $10; {setcolor} { color for left eye (red) }
r.bx := 1; {colornum 1}
r.dh := red; {red}
r.ch := 0; {green}
r.cl := 0; {blue}
intr ($10, r);
r.ah := $10;
r.al := $10; {setcolor} { color for right eye (green) }
r.bx := 2; {colornum 2}
r.dh := 0; {red}
r.ch := green; {green}
r.cl := blue; {blue}
intr ($10, r);
r.ah := $10;
r.al := $10; {setcolor} { both colors }
r.bx := 3; {colornum 3}
r.dh := red; {red}
r.ch := green; {green}
r.cl := blue; {blue}
intr ($10, r);
r.ah := $10;
r.al := $10; {setcolor} { black (you know what murphy says about }
r.bx := 0; {colornum 0} { colors that didn't get initialized) }
r.dh := 0; {red}
r.ch := 0; {green}
r.cl := 0; {blue}
intr ($10, r);
home
end;
procedure close3d;
begin
textmode(lastmode)
end;
procedure orplot(x, y : integer); { draws a pixel }
begin { the current color is or-ed with }
r.ah := $d; { the pixel's previos content }
r.bh := 0;
r.cx := x;
r.dx := y;
intr($10, r);
r.ah := $c;
r.al := r.al or color;
r.cx := x;
r.dx := y;
intr($10, r)
end;
procedure line (x, y, x2, y2 : integer);
{ draws a 2D line in the current color }
var dx,dy,xs,ys,dir:integer;
begin
xs:=1;
ys:=1;
if x>x2 then xs:=-1;
if y>y2 then ys:=-1;
dx:=abs(x-x2);
dy:=abs(y-y2);
if dx=0 then dir:=-1
else dir:=0;
while ((x<>x2) or (y<>y2)) do begin
orplot(x,y);
if dir<0 then
begin
y:=y+ys;
dir:=dir+dx
end
else
begin
x:=x+xs;
dir:=dir-dy
end
end
end;
{rx, gx, vx are routines for projection of coordinates (redx, greenx, vert)}
function rx (x, z : real) : integer;
var ratio : real;
begin
ratio := (distance + z)/distance;
rx := trunc((x - rhpos)/ratio + rhpos);
end;
function gx (x, z : real) : integer;
var ratio : real;
begin
ratio := (distance + z)/distance;
gx := trunc((x - ghpos)/ratio + ghpos);
end;
function vy (y, z : real) : integer;
var ratio : real;
begin
ratio := (distance + z)/distance;
vy := trunc((y - vpos)/ratio + vpos);
end;
procedure line3;
begin
color := 1;
line(rx(v1.x, v1.z), vy(v1.y, v1.z), rx(v2.x, v2.z), vy(v2.y, v2.z));
color := 2;
line(gx(v1.x, v1.z), vy(v1.y, v1.z), gx(v2.x, v2.z), vy(v2.y, v2.z));
end;
procedure penup;
begin
draw := false
end;
procedure pendown;
begin
draw := true
end;
procedure home;
begin
t.x := xmax div 2;
t.y := ymax div 2;
t.z := 0;
tfront.x := 0;
tfront.y := -1;
tfront.z := 0;
ttop.x := 0;
ttop.y := 0;
ttop.z := 1;
tright.x := 1;
tright.y := 0;
tright.z := 0;
end;
procedure fd; { moves turtle the distace equivalent of n pixels }
begin
tnew.x := t.x + n*tfront.x;
tnew.y := t.y + n*tfront.y;
tnew.z := t.z + n*tfront.z;
if draw then line3 (t, tnew);
t := tnew
end;
procedure bk;
begin
fd(-n)
end;
procedure rt;
var c, s : real;
begin
c := cos(n*degree);
s := sin(n*degree);
temp.x := tfront.x*c + tright.x*s;
temp.y := tfront.y*c + tright.y*s;
temp.z := tfront.z*c + tright.z*s;
tright.x := (-tfront.x*s) + tright.x*c;
tright.y := (-tfront.y*s) + tright.y*c;
tright.z := (-tfront.z*s) + tright.z*c;
tfront := temp
end;
procedure lt;
begin
rt (-n)
end;
procedure dn;
var c, s : real;
begin
c := cos(n*degree);
s := sin(n*degree);
temp.x := tfront.x*c + ttop.x*s;
temp.y := tfront.y*c + ttop.y*s;
temp.z := tfront.z*c + ttop.z*s;
ttop.x := (-tfront.x*s) + ttop.x*c;
ttop.y := (-tfront.y*s) + ttop.y*c;
ttop.z := (-tfront.z*s) + ttop.z*c;
tfront := temp
end;
procedure up;
begin
dn (-n)
end;
procedure rl;
var c, s : real;
begin
c := cos(n*degree);
s := sin(n*degree);
temp.x := ttop.x*c + tright.x*s;
temp.y := ttop.y*c + tright.y*s;
temp.z := ttop.z*c + tright.z*s;
tright.x := (-ttop.x*s) + tright.x*c;
tright.y := (-ttop.y*s) + tright.y*c;
tright.z := (-ttop.z*s) + tright.z*c;
ttop := temp
end;
procedure rr;
begin
rl (-n)
end;
begin
end.
------------- end of TURTLE3D.PAS ------- cut here ----------
----- cut here ------ DEMO.PAS --------cut here -------------
uses turtle3d;
var i, j : integer;
begin
init3d;
pendown;
rl(20);
dn(20);
for j := 1 to 18 do begin
for i := 1 to 36 do begin
fd (20); rt(10);
end;
rr(20);
end;
dn(90);
for j := 1 to 18 do begin
for i := 1 to 36 do begin
fd (20); rt(10);
end;
rr(20);
end;
readln;
close3d
end.
-------- cut here ------- sig ahead ------- cut here ------------
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
I __ I Hans Bernhard Wiezorke (at Uni. of Karlsruhe) I
I /opus\ _____(@ \ I E-Mail : S_WIEZORKE@iravcl.ira.uka.de I
I \sndo/ /. ! I or UK9K@DKAUNI2.bitnet (better not) I
I ------) ! I- - - - - - - - - - - - - - - - - - - - - - - - - -I
I X~~~~! I Always remember : WHEREVER YOU BE -- I
I I THERE YOU ARE I
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -