Programming by Example

 

A BB4W Compendium

freeman69@gmx.com

IDIC BBC_Owl2 M&P

First Person Flight

This program combines all previously described 3D techniques into a single demonstration, with a few additions.

 

         Use the cursor keys to roll and pitch

         Space Bar moves you forward

 

This program includes:

 

         First person roll & pitch plus forward motion

         Adjustment of light source relative to current orientation

         Object 'in view' test

         Object under cross-hairs test

 

Note that the cross-hairs are centred on the 2D origin (0,0), which simplifies the point-within-triangle test executed when drawing each object.

 

The 'in view' test determines whether the radius of each object overlaps the limits of the 3D display. (Normally these limits are equal to the size of the window, but a smaller rectangle has been used for demonstration purposes.)

Arrow black large Arrow black large InView

  10 MODE 9:OFF

  20 ORIGIN 640,512

  30 VDU 23,23,3;0;0;0;:REM Line width

  40 *REFRESH OFF

  50

  60 DIM nd{(14) xt,yt,zt,xr,yr,zr,x2,y2}:REM Nodes

  70 DIM link{(16) type,n1,n2,n3}:REM Links (colours & triangles)

  80 DIM td{(1) np,lp,nc,lc,mr}:REM Net pointers

  90 FOR a=0 TO 14

 100   READ nd{(a)}.xt,nd{(a)}.yt,nd{(a)}.zt

 110 NEXT

 120 FOR a=0 TO 16

 130   READ link{(a)}.type,link{(a)}.n1,link{(a)}.n2,link{(a)}.n3

 140 NEXT

 150 FOR a=0 TO 1

 160   READ td{(a)}.np,td{(a)}.lp,td{(a)}.nc,td{(a)}.lc,td{(a)}.mr

 170 NEXT

 180

 190 MAXobj=300:REM Linked list

 200 DIM obj{(MAXobj) net,x,y,z,za,xa,ya,dist,life,vx,vy,vz,rvz,rvx,rvy,rlx,rly,rlz,prv,nxt}

 210 DIM stack(MAXobj):PROCresetobjstack

 220 obj{(0)}.prv=-1:REM Linked list anchor

 230

 240 vX=0:vY=0:vZ=200:vRol=0:vPit=0:vYaw=0:REM View point

 250 SF=1280:ZCUT=-1:REM Cut-off plane is Z=ZCUT

 260 DSPw=800:DSPh=800:REM Display limits (usually dimensions of window)

 270

 280 REM Create diamonds for display

 290 FOR a=1 TO 100

 300   r=FNinslot(0)

 310   IF r<>-1 THEN

 320     z=RND(400)-200:x=RND(400)-200:y=RND(400)-200:z*=-1:ya=RND(360)

 330     PROCinitobj(r,1,x,y,z,0,0,ya,RND(500)+250,0,0,0,0,0,RND(5)-3)

 340   ENDIF

 350 NEXT

 360

 370 angle=1

 380 REPEAT

 390   TIME=0:CLS

 400   REM Steering

 410   IF INKEY(-42) PROCflybywire("X",angle,"A",vRol,vPit,vYaw)

 420   IF INKEY(-58) PROCflybywire("X",angle,"C",vRol,vPit,vYaw)

 430   IF INKEY(-26) PROCflybywire("Z",angle,"A",vRol,vPit,vYaw)

 440   IF INKEY(-122) PROCflybywire("Z",angle,"C",vRol,vPit,vYaw)

 450   IF INKEY(-99) THEN

 460     REM Use first alignment vector to calculate direction of forward motion

 470     PROCrotzxy(0,0,0,0,vRol,vPit,vYaw)

 480     vX-=nd{(0)}.xr

 490     vY-=nd{(0)}.yr

 500     vZ-=nd{(0)}.zr

 510   ENDIF

 520  

 530   REM Calculate vector to light source, relative to viewer's orientation

 540   lightx=100:lighty=100:lightz=10

 550   lm=SQR(lightx^2+lighty^2+lightz^2)

 560   lightx/=lm:lighty/=lm:lightz/=lm

 570   PROCrotyxz(lightx,lighty,lightz,-vRol,-vPit,-vYaw)

 580  

 590   PROCsortlist

 600  

 610   REM Process contents of linked list in order

 620   a=obj{(0)}.nxt:visible=0:tgt=-1

 630   WHILE a>-1

 640     REM Update position & orientation

 650     obj{(a)}.x+=obj{(a)}.vx:REM Velocity

 660     obj{(a)}.y+=obj{(a)}.vy

 670     obj{(a)}.z+=obj{(a)}.vz

 680     obj{(a)}.za+=obj{(a)}.rvz:REM Spin

 690     obj{(a)}.xa+=obj{(a)}.rvx

 700     obj{(a)}.ya+=obj{(a)}.rvy

 710    

 720     x=obj{(a)}.x

 730     y=obj{(a)}.y

 740     z=obj{(a)}.z

 750     za=obj{(a)}.za

 760     xa=obj{(a)}.xa

 770     ya=obj{(a)}.ya

 780    

 790     obj{(a)}.life-=1

 800     IF obj{(a)}.life<=0 THEN

 810       REM Diamonds explode at end of life before relocating

 820       IF obj{(a)}.net=1 THEN

 830         REM Create tetrahedrons

 840         FOR b=1 TO 10

 850           r=FNinslot(a):REM Insert after this object

 860           IF r<>-1 THEN

 870             vx=RND(5)-3:vy=RND(5)-3:vz=RND(5)-3:REM Random velocity

 880             rvz=RND(40)-20:rvx=RND(40)-20:REM Random spin

 890             PROCinitobj(r,0,x,y,z,0,0,0,RND(80)+20,vx,vy,vz,rvz,rvx,0)

 900           ENDIF

 910         NEXT

 920         REM Relocate diamond

 930         z=RND(400)-200:x=RND(400)-200:y=RND(400)-200:z*=-1:ya=RND(360)

 940         PROCinitobj(a,1,x,y,z,0,0,ya,RND(500)+250,0,0,0,0,0,RND(5)-3)

 950       ELSE

 960         PROCrmvslot(a):REM Remove tetrahedron from list at end of life

 970       ENDIF

 980     ENDIF

 990    

1000     REM Find object position relative to viewer

1010     x-=vX:y-=vY:z-=vZ

1020     obj{(a)}.rlx=x:obj{(a)}.rly=y:obj{(a)}.rlz=z

1030     PROCrotyxz(obj{(a)}.rlx,obj{(a)}.rly,obj{(a)}.rlz,-vRol,-vPit,-vYaw)

1040     REM If object radius (sphere) overlaps tunnel-of-view (DSPw,DSPh) then draw it

1050     IF FNinview(obj{(a)}.rlx,obj{(a)}.rly,obj{(a)}.rlz,td{(obj{(a)}.net)}.mr) THEN

1060       IF FNdraw(obj{(a)}.net,x,y,z,za,xa,ya) tgt=a

1070       visible+=1

1080     ENDIF

1090    

1100     a=obj{(a)}.nxt

1110   ENDWHILE

1120  

1130   IF tgt<>-1 GCOL 0,1:PROChairs(1) ELSE GCOL 0,7:PROChairs(0)

1140  

1150   GCOL 0,7:RECTANGLE -DSPw/2,-DSPh/2,DSPw,DSPh

1160   PRINTTAB(0,0);"Visible objects: ";visible;" out of ";stkptr-1

1170   *REFRESH

1180   *FX21

1190   WHILE TIME<4:ENDWHILE

1200 UNTIL 0

1210 END

1220

1230 DEF PROChairs(type)

1240 LOCAL a,angle,sa,ca

1250 FOR a=0 TO 3

1260   angle=RAD(a*90+type*45):sa=SIN(angle):ca=COS(angle)

1270   LINE sa*10,ca*10,sa*(50-type*10),ca*(50-type*10)

1280 NEXT

1290 ENDPROC

1300

1310 DEF PROCinitobj(slot,net,x,y,z,za,xa,ya,life,vx,vy,vz,rvz,rvx,rvy)

1320 obj{(slot)}.net=net

1330 obj{(slot)}.x=x

1340 obj{(slot)}.y=y

1350 obj{(slot)}.z=z

1360 obj{(slot)}.za=za

1370 obj{(slot)}.xa=xa

1380 obj{(slot)}.ya=ya

1390 obj{(slot)}.life=life

1400 obj{(slot)}.vx=vx

1410 obj{(slot)}.vy=vy

1420 obj{(slot)}.vz=vz

1430 obj{(slot)}.rvz=rvz

1440 obj{(slot)}.rvx=rvx

1450 obj{(slot)}.rvy=rvy

1460 ENDPROC

1470

1480 REM *******************************************************

1490 REM Linked list maintenance

1500 REM *******************************************************

1510

1520 DEF PROCresetobjstack

1530 LOCAL a

1540 FOR a=0 TO MAXobj:stack(a)=a:NEXT

1550 stkptr=1:obj{(0)}.nxt=-1:REM Reserve anchor slot

1560 ENDPROC

1570

1580 REM Insert a slot into the list, before (-ve) or after (+ve) a slot

1590 REM A returned value of -1 indicates no room in list

1600 DEF FNinslot(insert)

1610 LOCAL b,a,slot,i

1620 IF stkptr>MAXobj THEN =-1

1630 i=ABS(insert)

1640 slot=stack(stkptr):stkptr+=1:REM retrieve free slot from stack

1650 IF insert<0 THEN

1660   b=obj{(i)}.prv:a=i

1670 ELSE

1680   b=i:a=obj{(i)}.nxt

1690 ENDIF

1700 obj{(slot)}.prv=b

1710 obj{(slot)}.nxt=a

1720 obj{(b)}.nxt=slot

1730 IF a<>-1 obj{(a)}.prv=slot

1740 =slot

1750

1760 REM Remove a freed slot from the list, returning it to the stack

1770 DEF PROCrmvslot(slot)

1780 LOCAL b,a

1790 stkptr-=1:stack(stkptr)=slot:REM return slot to stack

1800 b=obj{(slot)}.prv:REM Knit broken list together

1810 a=obj{(slot)}.nxt

1820 obj{(b)}.nxt=a

1830 IF a<>-1 obj{(a)}.prv=b

1840 ENDPROC

1850

1860 REM Partial sort (1 pass per frame) of linked list

1870 REM by object distance from viewer

1880 DEF PROCsortlist

1890 LOCAL b,a,j,i,sorting,xd,yd,zd

1900 a=obj{(0)}.nxt

1910 IF a=-1 ENDPROC

1920 IF obj{(a)}.nxt=-1 ENDPROC

1930 sorting=TRUE

1940 xd=obj{(a)}.x-vX

1950 yd=obj{(a)}.y-vY

1960 zd=obj{(a)}.z-vZ

1970 obj{(a)}.dist=SQR(xd*xd+yd*yd+zd*zd)

1980 WHILE sorting

1990   b=obj{(a)}.nxt

2000   IF b=-1 THEN

2010     sorting=FALSE

2020   ELSE

2030     xd=obj{(b)}.x-vX

2040     yd=obj{(b)}.y-vY

2050     zd=obj{(b)}.z-vZ

2060     obj{(b)}.dist=SQR(xd*xd+yd*yd+zd*zd)

2070     IF obj{(a)}.dist<obj{(b)}.dist THEN

2080       REM Swap links from i><a><b><j to form i><b><a><j

2090       i=obj{(a)}.prv

2100       j=obj{(b)}.nxt

2110       obj{(b)}.prv=i

2120       obj{(b)}.nxt=a

2130       obj{(a)}.prv=b

2140       obj{(a)}.nxt=j

2150       obj{(i)}.nxt=b

2160       IF j<>-1 obj{(j)}.prv=a

2170     ELSE

2180       a=b

2190     ENDIF

2200   ENDIF

2210 ENDWHILE

2220 ENDPROC

2230

2240 REM *******************************************************

2250 REM 3D

2260 REM *******************************************************

2270

2280 DEF FNinview(x,y,z,r)

2290 LOCAL k,t

2300 IF z>ZCUT THEN =FALSE

2310 x=ABS(x):y=ABS(y):z=ABS(z)

2320 t=ATN((DSPw/2)/SF):x-=r*COS(t):k=z+r*SIN(t)

2330 IF x/k>(DSPw/2)/SF THEN =FALSE

2340 t=ATN((DSPh/2)/SF):y-=r*COS(t):k=z+r*SIN(t)

2350 IF y/k>(DSPh/2)/SF THEN =FALSE

2360 =TRUE

2370

2380 DEF PROCflybywire(ax$,angle,dir$,RETURN za,RETURN xa,RETURN ya)

2390 LOCAL f,a,ca,sa,x,y,z

2400 f=(SQR(2)-(TAN(RAD(45-angle))*SQR(2)))/(SQR(2)*2)

2410 FOR a=0 TO 4:PROCrotzxy(a,0,0,0,za,xa,ya):NEXT

2420 CASE ax$ OF

2430   WHEN "Z"

2440     IF dir$="C" THEN

2450       nd{(1)}.xr+=f*(nd{(3)}.xr-nd{(1)}.xr)

2460       nd{(1)}.yr+=f*(nd{(3)}.yr-nd{(1)}.yr)

2470       nd{(1)}.zr+=f*(nd{(3)}.zr-nd{(1)}.zr)

2480     ELSE

2490       nd{(1)}.xr+=f*(nd{(4)}.xr-nd{(1)}.xr)

2500       nd{(1)}.yr+=f*(nd{(4)}.yr-nd{(1)}.yr)

2510       nd{(1)}.zr+=f*(nd{(4)}.zr-nd{(1)}.zr)

2520     ENDIF

2530   WHEN "X"

2540     IF dir$="C" THEN

2550       nd{(0)}.xr+=f*(nd{(1)}.xr-nd{(0)}.xr)

2560       nd{(0)}.yr+=f*(nd{(1)}.yr-nd{(0)}.yr)

2570       nd{(0)}.zr+=f*(nd{(1)}.zr-nd{(0)}.zr)

2580     ELSE

2590       nd{(0)}.xr+=f*(nd{(2)}.xr-nd{(0)}.xr)

2600       nd{(0)}.yr+=f*(nd{(2)}.yr-nd{(0)}.yr)

2610       nd{(0)}.zr+=f*(nd{(2)}.zr-nd{(0)}.zr)

2620     ENDIF

2630   WHEN "Y"

2640     IF dir$="C" THEN

2650       nd{(0)}.xr+=f*(nd{(4)}.xr-nd{(0)}.xr)

2660       nd{(0)}.yr+=f*(nd{(4)}.yr-nd{(0)}.yr)

2670       nd{(0)}.zr+=f*(nd{(4)}.zr-nd{(0)}.zr)

2680     ELSE

2690       nd{(0)}.xr+=f*(nd{(3)}.xr-nd{(0)}.xr)

2700       nd{(0)}.yr+=f*(nd{(3)}.yr-nd{(0)}.yr)

2710       nd{(0)}.zr+=f*(nd{(3)}.zr-nd{(0)}.zr)

2720     ENDIF

2730 ENDCASE

2740 ya=FNgetbearing(nd{(0)}.xr,nd{(0)}.zr)

2750 REM Unwind 2 main alignment vectors about y-axis

2760 ca=COS(RAD(ya)):sa=SIN(RAD(ya))

2770 z=nd{(0)}.zr*ca+nd{(0)}.xr*sa

2780 x=nd{(0)}.xr*ca-nd{(0)}.zr*sa

2790 nd{(0)}.zr=z

2800 nd{(0)}.xr=x

2810 z=nd{(1)}.zr*ca+nd{(1)}.xr*sa

2820 x=nd{(1)}.xr*ca-nd{(1)}.zr*sa

2830 nd{(1)}.zr=z

2840 nd{(1)}.xr=x

2850 xa=FNgetbearing(nd{(0)}.yr,nd{(0)}.zr)

2860 REM Unwind vertical alignment vectors about x-axis

2870 ca=COS(RAD(360-xa)):sa=SIN(RAD(360-xa))

2880 y=nd{(1)}.yr*ca+nd{(1)}.zr*sa

2890 z=nd{(1)}.zr*ca-nd{(1)}.yr*sa

2900 nd{(1)}.yr=y

2910 nd{(1)}.zr=z

2920 za=FNgetbearing(nd{(1)}.xr,nd{(1)}.yr)

2930 IF ya<>0 ya=360-ya

2940 ENDPROC

2950

2960 DEF FNgetbearing(x,y)

2970 LOCAL a,h

2980 a=0:h=SQR(x*x+y*y)

2990 IF h>0 THEN

3000   IF ABS(x)<ABS(y) THEN

3010     a=DEG(ACS(y/h))

3020   ELSE

3030     a=90-DEG(ACS(ABS(x)/h)):IF y<0 AND a<>180 a=180-a

3040   ENDIF

3050   IF x<0 AND a<>0 a=360-a

3060 ENDIF

3070 =a

3080

3090 DEF FNdraw(net,x,y,z,za,xa,ya)

3100 LOCAL abort,col,a,n1,n2,n3,v1x,v1y,v1z,v2x,v2y,v2z,nx,ny,nz,nm,v,hit

3110 abort=FALSE:col=7:GCOL 0,15:hit=FALSE

3120 FOR a=td{(net)}.np TO td{(net)}.np+td{(net)}.nc-1

3130   PROCrotzxy(a,x,y,z,za,xa,ya):REM Rotate node & add offset

3140   PROCrotyxz(nd{(a)}.xr,nd{(a)}.yr,nd{(a)}.zr,-vRol,-vPit,-vYaw)

3150   IF nd{(a)}.zr>ZCUT THEN

3160     abort=TRUE:REM Node behind viewer

3170   ELSE

3180     nd{(a)}.x2=SF*nd{(a)}.xr/-nd{(a)}.zr:REM 3D to 2D

3190     nd{(a)}.y2=SF*nd{(a)}.yr/-nd{(a)}.zr

3200   ENDIF

3210 NEXT

3220 IF abort THEN =FALSE

3230 FOR a=td{(net)}.lp TO td{(net)}.lp+td{(net)}.lc-1

3240   CASE link{(a)}.type OF

3250     WHEN 1 : col=link{(a)}.n1

3260     WHEN 7

3270       n1=link{(a)}.n1+td{(net)}.np

3280       n2=link{(a)}.n2+td{(net)}.np

3290       n3=link{(a)}.n3+td{(net)}.np

3300       REM Calc two vectors from 3 co-ords (triangle): b-a and c-a

3310       v1x=nd{(n2)}.xr-nd{(n1)}.xr

3320       v1y=nd{(n2)}.yr-nd{(n1)}.yr

3330       v1z=nd{(n2)}.zr-nd{(n1)}.zr

3340       v2x=nd{(n3)}.xr-nd{(n1)}.xr

3350       v2y=nd{(n3)}.yr-nd{(n1)}.yr

3360       v2z=nd{(n3)}.zr-nd{(n1)}.zr

3370       REM Find the 'normal' of a triangle, (cross product of two vectors)

3380       nx=v1y*v2z-v1z*v2y

3390       ny=v1z*v2x-v1x*v2z

3400       nz=v1x*v2y-v1y*v2x

3410       REM Vector towards viewer

3420       v1x=0-nd{(n1)}.xr

3430       v1y=0-nd{(n1)}.yr

3440       v1z=0-nd{(n1)}.zr

3450       REM Triangle faces viewer (normal points towards viewer)?

3460       IF (nx*v1x+ny*v1y+nz*v1z)>0 THEN

3470         nm=SQR(nx^2+ny^2+nz^2)

3480         REM Calc triangle shade from: A.B / |A||B|

3490         v=(nx*lightx+ny*lighty+nz*lightz)/nm

3500         IF v<-1 v=0 ELSE IF v>1 v=255 ELSE v=255-ACS(v)/PI*255

3510         COLOUR 15,v*(col AND 1),v*((col AND 2)/2),v*((col AND 4)/4)

3520         MOVE nd{(n1)}.x2,nd{(n1)}.y2

3530         MOVE nd{(n2)}.x2,nd{(n2)}.y2

3540         PLOT 85,nd{(n3)}.x2,nd{(n3)}.y2

3550         REM Co-ordinate 0,0 (crosshairs) within triangle?

3560         IF nd{(n1)}.x2*nd{(n2)}.y2-nd{(n1)}.y2*nd{(n2)}.x2>0 THEN

3570           IF nd{(n2)}.x2*nd{(n3)}.y2-nd{(n2)}.y2*nd{(n3)}.x2>0 THEN

3580             IF nd{(n3)}.x2*nd{(n1)}.y2-nd{(n3)}.y2*nd{(n1)}.x2>0 hit=TRUE

3590           ENDIF

3600         ENDIF

3610       ENDIF

3620   ENDCASE

3630 NEXT

3640 =hit

3650

3660 REM Rotate a node about 3 axes (Z,X,Y) and add any offset

3670 DEF PROCrotzxy(n,x,y,z,za,xa,ya)

3680 LOCAL ca,sa,x1,y1,z1,x2,y2,z2,x3,y3,z3,x4,y4,z4

3690 x1=nd{(n)}.xt:y1=nd{(n)}.yt:z1=nd{(n)}.zt

3700 z2=z1:ca=COS(RAD(za)):sa=SIN(RAD(za)):x2=x1*ca+y1*sa:y2=y1*ca-x1*sa

3710 x3=x2:ca=COS(RAD(xa)):sa=SIN(RAD(xa)):y3=y2*ca+z2*sa:z3=z2*ca-y2*sa

3720 y4=y3:ca=COS(RAD(ya)):sa=SIN(RAD(ya)):z4=z3*ca+x3*sa:x4=x3*ca-z3*sa

3730 nd{(n)}.xr=x4+x:nd{(n)}.yr=y4+y:nd{(n)}.zr=z4+z

3740 ENDPROC

3750

3760 REM Rotate a node about 3 axes (Y,X,Z)

3770 DEF PROCrotyxz(RETURN x1,RETURN y1,RETURN z1,za,xa,ya)

3780 LOCAL ca,sa,x2,y2,z2,x3,y3,z3,x4,y4,z4

3790 y2=y1:ca=COS(RAD(ya)):sa=SIN(RAD(ya)):z2=z1*ca+x1*sa:x2=x1*ca-z1*sa

3800 x3=x2:ca=COS(RAD(xa)):sa=SIN(RAD(xa)):y3=y2*ca+z2*sa:z3=z2*ca-y2*sa

3810 z4=z3:ca=COS(RAD(za)):sa=SIN(RAD(za)):x4=x3*ca+y3*sa:y4=y3*ca-x3*sa

3820 x1=x4:y1=y4:z1=z4

3830 ENDPROC

3840

3850 REM Nodes (x,y,z)

3860 REM Alignment vectors

3870 DATA 0,0,1,0,1,0,0,-1,0,1,0,0,-1,0,0

3880 REM Tetrahedron (4 nodes, 5 links)

3890 DATA 0,-1.15,2.31,2,-1.15,-1.15,-2,-1.15,-1.15,0,2.67,0

3900 REM Diamond (6 nodes, 12 links)

3910 DATA 0,8,0,0,-8,0,4,0,-4,-4,0,-4,-4,0,4,4,0,4

3920 REM Links (type,n1,n2,n3: type 1=colour, 7=triangle)

3930 REM Tetrahedron

3940 DATA 1,7,0,0,7,1,2,3,7,1,0,2,7,0,1,3,7,2,0,3

3950 REM Diamond

3960 DATA 1,6,0,0,7,0,4,5,7,0,3,4,1,6,0,0,7,2,3,0,7,0,5,2

3970 DATA 1,4,0,0,7,5,4,1,7,1,4,3,1,4,0,0,7,5,1,2,7,2,1,3

3980 REM Net pointers

3990 DATA 5,0,4,5,2.67

4000 DATA 9,5,6,12,8

FirstPersonFlight