Classic Computer Magazine Archive PROGRAM LISTING: 85-06/DRAW3D.ACT


; DRAW3D (LISTING 4)

MODULE:BYTE vflag=[0],gflag=[7]
INT sx,sy,mag=[3],cx=[80],cy=[90]
  ,rx=[0],ry=[0],rz=[0],ri=[30]
CARD sa1,dl1,dl2,lin16,lin17,lin18
  ,lin19,lin20,lin21,lin22,lin23,lin15
INT ARRAY P(809),eye,foc,R(9),E(9),M(9)
  ,Q=[21:10 5 5:100:0 0 0:0:
  50 0 0:18:0 0 0:2:0 50 0:2:
  0 0 0:18:0 0 40:2:10 0 0:17:
  10 50 0:1:20 50 0:17:20 0 0:1:
  30 0 0:17:30 50 0:1:40 50 0:17:
  40 0 0:1:0 10 0:19:50 10 0:3:
  50 20 0:19:0 20 0:3:0 30 0:19:
  50 30 0:3:50 40 0:19:0 40 0:3]

PROC FixP(INT ARRAY Q):INT i,j
Zero(P,1618):j=4*Q(0)+8
FOR i=0 TO j DO P(i)=Q(i) OD
eye=P+2:foc=P+10:RETURN

PROC Rot(INT ARRAY v):INT x,y,z,s,c
y=v(1)
v(1)=y*cos(rx)/128:v(2)=y*sin(rx)/128
x=v(0):z=v(2):s=sin(ry):c=cos(ry)
v(0)=(x*c-z*s)/128:v(2)=(x*s+z*c)/128
x=v(0):y=v(1):s=sin(rz):c=cos(rz)
v(0)=x*c-y*s:v(1)=x*s+y*c:v(0)==/128
v(1)==/128:Normize(v):RETURN
 
PROC FixR():INT ARRAY v(3),w(3),u(3)
v(0)=128:v(1)=0:v(2)=0:Rot(v)
w(0)=0:w(1)=128:w(2)=0:Rot(w)
Vprod(v,w,u):Normize(u)
R(0)=v(0):R(1)=v(1):R(2)=v(2)
R(3)=w(0):R(4)=w(1):R(5)=w(2)
R(6)=u(0):R(7)=u(1):R(8)=u(2):RETURN
   
PROC FixE():INT s
E(6)=eye(0):E(7)=eye(1):E(8)=eye(2)
Normize(E+12)
IF E(8)=0 THEN E(3)=0:E(4)=0:E(5)=128
ELSEIF E(6)=0 AND E(7)=0 THEN
  E(3)=0:E(4)=128:E(5)=0
ELSE E(3)=-E(6):E(4)=-E(7)
  E(5)=E(6)*E(6):E(5)==+E(7)*E(7)
  E(5)==/E(8):Normize(E+6)
  IF E(8)<0 THEN E(3)=-E(3):E(4)=-E(4)
    E(5)=-E(5)
  FI
FI Vprod(E+6,E+12,E):Normize(E):RETURN

PROC FixM()
M(0)=Vdot(R,E):M(3)=Vdot(R,E+6)
M(1)=Vdot(R+6,E):M(4)=Vdot(R+6,E+6)
M(2)=Vdot(R+12,E):M(5)=Vdot(R+12,E+6)
Normize(M):Normize(M+6)
Vprod(M,M+6,M+12):Normize(M+12):RETURN

PROC Maksxsy(INT ARRAY v):BYTE i
INT px,py,pz,t,d:INT ARRAY w(3)
FOR i=0 TO 2 DO w(i)=v(i)-foc(i) OD
IF vflag=1 THEN px=Vdot(w,M)/128
  py=Vdot(w,M+6)/128
  sx=cx+mag*px/2:sy=cy-mag*py/2
ELSE d=eye(3):t=mag*d/8
  px=Vdot(w,M)/128:py=Vdot(w,M+6)/128
  pz=Vdot(w,M+12)/128
  d==-pz:IF d<4 THEN d=4 FI:d==/4
  sx=t*px/d:sy=t*py/d:sx==+cx:sy=cy-sy
FI RETURN

PROC CLR():Zero(sa1,7680):RETURN

PROC Draw(INT ARRAY P):BYTE i
INT ARRAY pt
pt=P+10
FOR i=1 TO P(0) DO pt==+8 Maksxsy(pt)
  Kolor(pt(3) & 15)
  IF pt(3)<16 THEN LineTo(sx,sy)
  ELSE Dot(sx,sy):xnow=sx:ynow=sy FI
OD RETURN


Back to previous page