Antic Magazine 1985 June/Antic_Magazine_1985_06_Antic_Side_A.atr/draw3d.act

Text File | 2023-02-26 | 2KB | 1 lines

; 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¢¢