rem Box Simple ..... Rev 2.1 rem A J Tooth / 14th Sept 2003 rem Minor revision 6th May 2007 on error if (err=17) then quit rem Illustrates Rotation of Axes using EULER ANGLES. rem Also utilises TRUE Perspective. rem Call Utility Procedures proc_fullscreen(xscreen%,yscreen%) rem Set up Initial Axis Arrays rem Dimension Axes Array and Projection Array dim Mat(3,3) dim boxor(8,3),boxnow(8,3),bxalpbet(8,2),boxpos(8,2) dim verseq&(15) rem Place Origin and Draw Axes print : print " Choosing a SMALL cube will EXAGGERATE the PERSPECTIVE !" print : input " Choose a small cube or large one ( -s- or -l-)(l)",cub$ if (cub$="" or cub$="l") then cub$="l" else cub$="s" case cub$ of when "s": vht=3 : hdis=3 : SCL%=750 when "l": vht=350 : hdis=350 : SCL%=1250 endcase cls theta=0.0 : phi=0.0 : psi=0.0 dth=0.0 : dph=0.0 : dps=0.0 : dh=0.0 : dv=0.0 if cub$="l" then Fac%=10 else Fac%=1 rem Loads Initial Axes Vertex Vectors restore for aa&=1 to 8 for bb&=1 to 3 read nxt : boxor(aa&,bb&)=Fac%*nxt next bb& next aa& rem Loads Vertex Printing Sequence for c&=0 to 15 read verseq&(c&) next c& rem Centres Graphics and sets scale R=fn_R(vht,hdis) xmax%=xscreen% : zmax%=yscreen% scl%=int(SCL%*R) origin xmax%,zmax% : gcol 3 sw%=1 *REFRESH OFF rem Rotation Section repeat rem Increment Parameters - with Truncation Control theta+=dth : phi+=dph : psi+=dps if theta>360 then theta=theta-360 if theta<-360 then theta=theta+360 if phi>360 then phi=phi-360 if phi<-360 then phi=phi+360 if psi>360 then psi=psi-360 if psi<-360 then psi=psi+360 vht+=dv : hdis+=dh : if hdis<1 then hdis=1 : dh=0.0 vht=fn_Int(vht,100) : hdis=fn_Int(hdis,100) theta=fn_Int(theta,10) : phi=fn_Int(phi,10) : psi=fn_Int(psi,10) rem Main Subroutine proc_mainsub(theta,phi,psi,vht,hdis,sw%) sp$=inkey$(0) if sp$="t" then sw%=1-sw% sp%=asc(sp$) case sp% of when 44 : dps-=0.1 : if abs(dps)<0.1 then dps=0.0 when 46 : dps+=0.1 : if abs(dps)<0.1 then dps=0.0 when 98 : dh+=0.01 : if abs(dh)<0.01 then dh=0.0 when 102 : dh-=0.01 : if abs(dh)<0.01 then dh=0.0 when 100 : dv-=0.01 : if abs(dv)<0.01 then dv=0.0 when 117 : dv+=0.01 : if abs(dv)<0.01 then dv=0.0 when 136 : dth-=0.1 : if abs(dth)<0.1 then dth=0.0 when 137 : dth+=0.1 : if abs(dth)<0.1 then dth=0.0 when 138 : dph-=0.1 : if abs(dph)<0.1 then dph=0.0 when 139 : dph+=0.1 : if abs(dph)<0.1 then dph=0.0 when 32 : dv=0.0 : dh=0.0 otherwise endcase until (sp$="s" or sp$="r") if sp$="r" then run *REFRESH ON quit end rem End of Programme --------------------------------------- rem Initial Axis Vectors data 1,-1,-1,1,1,-1,-1,1,-1,-1,-1,-1 data 1,-1,1,1,1,1,-1,1,1,-1,-1,1 data 1,2,3,4,1,5,6,7,8,5,6,2,3,7,8,4 rem--------------------------------------------------------- rem Master Subroutine def proc_mainsub(Theta,Phi,Psi,vh,hd,Sw%) local d% proc_rotmat(Theta,Phi,Psi) proc_boxrot(boxor(),Mat()) for d&=1 to 8 proc_bxalpha(vh,hd,d&) proc_bxbeta(vh,hd,d&) next d& endif proc_boxdraw(vh,hd,Sw%) endproc rem--------------------------------------------------------- rem Rotation Matrix Update def proc_rotmat(Thet,Phii,Psii) local Th,Ph,Ps Th=rad(Thet) : Ph=rad(Phii) : Ps=rad(Psii) Mat(1,1)= cos(Ps)*cos(Ph)*cos(Th) - sin(Ps)*sin(Th) Mat(1,2)=-sin(Ps)*cos(Ph)*cos(Th) - cos(Ps)*sin(Th) Mat(1,3)=-sin(Ph)*cos(Th) Mat(2,1)= cos(Ps)*cos(Ph)*sin(Th) + sin(Ps)*cos(Th) Mat(2,2)=-sin(Ps)*cos(Ph)*sin(Th) + cos(Ps)*cos(Th) Mat(2,3)=-sin(Ph)*sin(Th) Mat(3,1)= cos(Ps)*sin(Ph) Mat(3,2)=-sin(Ps)*sin(Ph) Mat(3,3)= cos(Ph) endproc rem--------------------------------------------------- rem Rotate Box def proc_boxrot(boxor(),Mat()) local i%,j%,k%,cum for i&=1 to 8 for j&=1 to 3 cum=0 for k&=1 to 3 cum=cum + Mat(j&,k&)*boxor(i&,k&) next k& boxnow(i&,j&)=cum next j& next i& endproc rem-------------------------------------------------- rem Set up use of Full Screen def proc_fullscreen(return xscreen%, return yscreen%) sys "GetSystemMetrics", 0 to xscreen% sys "GetSystemMetrics", 1 to yscreen% sys "SetWindowLong",@hwnd%,-16,&16000000 sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0 vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode mouse off : off : rem Turns off the Mouse Pointer and the Cursor endproc rem-------------------------------------------------- rem Calculates line of sight distance for 2-D View Angle def fn_bxrdis(Vht,Hdis,Vr%) local xd,yd,zd xd=boxnow(Vr%,1) : yd=boxnow(Vr%,2)+Hdis : zd=boxnow(Vr%,3)-Vht =sqr(xd*xd+yd*yd+zd*zd) rem Calculates normalising factor for normal to position vector plane def fn_bxnpl(Vht,Hdis,Vr%) local xd,yd,zd xd=Hdis*boxnow(Vr%,1) : yd=Vht*boxnow(Vr%,1) : zd=Vht*boxnow(Vr%,2)+Hdis*boxnow(Vr%,3) =sqr(xd*xd+yd*yd+zd*zd) rem Calculates distance from Origin to Vertex def fn_rmod(Vr%) local xd,yd,zd xd=boxnow(Vr%,1) : yd=boxnow(Vr%,2) : zd=boxnow(Vr%,3) =sqr(xd*xd+yd*yd+zd*zd) rem Calculates Distance to Origin def fn_R(Vh,Hd) =sqr(Vh*Vh+Hd*Hd) rem-------------------------------------------------- rem Angle between vertical plane and plane containing position vector def proc_bxalpha(Vht,Hdis,Ver%) local npl,num npl=fn_bxnpl(Vht,Hdis,Ver%) num=Vht*boxnow(Ver%,2)+Hdis*boxnow(Ver%,3) if npl=0 then bxalpbet(Ver%,1)=pi/2 else bxalpbet(Ver%,1)=acs(num/npl) if boxnow(Ver%,1)>0 then bxalpbet(Ver%,1)=2*pi-bxalpbet(Ver%,1) endproc rem 2-D Projection View-Angle def proc_bxbeta(Vht,Hdis,Ver%) local rdis,yfact,zfact rdis=fn_bxrdis(Vht,Hdis,Ver%) rmod=fn_rmod(Ver%) : R=fn_R(Vht,Hdis) yfact=Hdis*(Hdis+boxnow(Ver%,2)) : zfact=Vht*(Vht-boxnow(Ver%,3)) bxalpbet(Ver%,2)=acs((yfact+zfact)/(rdis*R)) rem Convert from Polar to x/y Coords for Printing to Screen boxpos(Ver%,1)=(rmod/rdis)*bxalpbet(Ver%,2)*(-sin(bxalpbet(Ver%,1))) boxpos(Ver%,2)=(rmod/rdis)*bxalpbet(Ver%,2)*cos(bxalpbet(Ver%,1)) endproc rem-------------------------------------------------- rem Draw Box on Screen def proc_boxdraw(Vh,Hd,Swt%) local k%,l%,a$,Ind%,Jnd% gcol 15 for k&=0 to 15 Ind&=verseq&(k&) if k&=0 then move scl%*boxpos(Ind&,1),scl%*boxpos(Ind&,2) else plot 5,scl%*boxpos(Ind&,1),scl%*boxpos(Ind&,2) endif next k& if Swt%=1 then Lst%=Swt% colour 2 print tab(5,1);"THETA =";theta;" " print tab(5,2);"PHI = ";phi;" " print tab(5,3);"PSI = ";psi;" " print tab(5,5);"Delta Theta = ";dth;" " print tab(5,6);"Delta Phi = ";dph;" " print tab(5,7);"Delta Psi = ";dps;" " print tab(5,9);"Height = ";Vh;" " print tab(5,10);"Distance = ";Hd;" " else if Lst%=1 then cls : Lst%=0 for t%=1 to 50000 : next t% endif *REFRESH for l&=0 to 15 Jnd&=verseq&(l&) gcol 0 if l&=0 then move scl%*boxpos(Jnd&,1),scl%*boxpos(Jnd&,2) else plot 5,scl%*boxpos(Jnd&,1),scl%*boxpos(Jnd&,2) endif next l& endproc rem-------------------------------------------------- rem Truncation Function def fn_Int(Num,Acc%) =(int((Num+.001)*(Acc%)))/Acc% rem--------------------------------------------------