HIMEM=PAGE +1E8 INSTALL @lib$+"D3DLIBA" MODE 21 xres%=800 yres%=600 s%=128 :REM must be a power of 2. Size of the map in squares (each way) vscale=yres%/s% hscale=xres%/s% DIM l%(s%,s%) :REM This will hold the height data REPEAT REM Set up a map and see if we like it! minh%=1000 maxh%=0 PROCfillland(0,0,s%) :REM Recursive fractal generation of the landscape PROCMeasureLand :REM Look for the highest and lowest points wlevel%=minh%+(maxh%-minh%)/2 :REM everything below this level will be sea l%()-=wlevel% maxh%-=wlevel% snowlevel%=maxh%*3/4 :REM Snowy mountains above this level REM Fill in the sea FOR y%=0 TO s%-1 FOR x%=0 TO s%-1 IF l%(x%,y%)<0 THEN l%(x%,y%)=0 NEXT x% NEXT y% PROCPlot :REM Quick and dirty view of the generated world, before we make the big vertex buffer PRINT "Fly this world (y/n/q)?" q$=GET$ CLS IF q$="q" OR q$="Q" THEN QUIT UNTIL q$="y" OR q$="Y" PRINT "Creating the world: please wait a moment." REM OK, We've made our world, let's set up D3D and fly round it mapscaleh=5 :REM This determines how big the x,y squares are, relative to the vertical coordinates DIM l2%(1), b%(1), n%(1), f%(1), s%(1), m%(1), t%(1), y(1), p(1), r(1), X(1), Y(1), Z(1), e(2), a(2) ON CLOSE PROCcleanup:QUIT ON ERROR PROCcleanup:PRINT REPORT$:END PROCSetUpLights d% = FN_initd3d(@hwnd%, 1, 1) IF d% = 0 ERROR 100, "Can't initialise Direct3D" b%(0) = FN_MakeVBuf(d%, n%(0), f%(0), s%(0)) IF b%(0) = 0 ERROR 100, "Failed to make buffer" PROCSetStartPos REPEAT REM Use arrow keys to bank left or right, or raise or lower nose REM Use keys A and Z to accelerate forward or backward, respectively. IF INKEY(-66) THEN v+=0.01 IF INKEY(-98) THEN v-=0.01 IF INKEY(-26) THEN ra+=0.01 IF INKEY(-122) THEN ra-=0.01 IF INKEY(-58) THEN va-=0.01 IF INKEY(-42) THEN va+=0.01 ha+=SIN(ra)/100 px+=v*COS(ha)*COS(va) py+=v*SIN(ha)*COS(va) pz+=v*SIN(va) e() = px,pz,py a()=px+COS(ha),pz+SIN(va),py+SIN(ha) PROC_render(d%, &FF8080FF, 2, l2%(), 1, m%(), t%(), b%(), n%(), f%(), s%(), y(), p(), r(), X(), Y(), Z(), e(), a(), PI/4, 5/4, 1, 5000,ra) q$=INKEY$(1) IF q$="r" OR q$="R" THEN PROCSetStartPos:REM Reset position and speed UNTIL q$="q" OR q$="Q" QUIT : DEFPROCfillland(l%,b%,side%) LOCAL mx%,my%,r%,t%,hs%,localscale localscale=2*(RND(1)) hs%=side% DIV 2 mx%=l%+hs% my%=b%+hs% r%=l%+side% t%=b%+side% l%(r%,my%)=(l%(r%,b%)+l%(r%,t%))/2+(RND(side%)-hs%)*localscale l%(mx%,t%)=(l%(l%,t%)+l%(r%,t%))/2+(RND(side%)-hs%)*localscale l%(mx%,my%)=(l%(l%,my%)+l%(r%,my%)+l%(mx%,b%)+l%(mx%,t%))/4+(RND(side%)-hs%)*localscale IF side%>1 THEN PROCfillland(l%,b%,hs%) PROCfillland(l%,my%,hs%) PROCfillland(mx%,b%,hs%) PROCfillland(mx%,my%,hs%) ENDIF ENDPROC : DEFPROCMeasureLand LOCAL x%,y% FOR y%=0 TO s%-1 FOR x%=0 TO s%-1 IF l%(x%,y%)>maxh% THEN maxh%=l%(x%,y%) IF l%(x%,y%)<minh% THEN minh%=l%(x%,y%) NEXT x% NEXT y% ENDPROC : DEFPROCPlot LOCAL x%,y% FOR y%=0 TO s%-1 MOVE xres%-hscale*y%,vscale*y%+l%(0,y%)*vscale FOR x%=0 TO s%-1 IF l%(x%,y%)<=0 THEN GCOL 4 ELSE GCOL 2 IF l%(x%,y%)>snowlevel% THEN GCOL 7 DRAW xres%-hscale*y%+hscale*x%,vscale*y%+vscale*x%+l%(x%,y%)*vscale NEXT x% NEXT y% ENDPROC : DEFFN_MakeVBuf(D%,RETURN N%,RETURN V%,RETURN L%) LOCAL B%,P%,R% N%=s%*s%*6 :REM Number of vertices V%=&52 :REM Format for each vertex L%=28 :REM Size of each vertex SYS!(!D%+92),D%,N%*L%,0,V%,0,^B% TO R%:REM CreateVertexBuffer IF R% THEN=0 SYS!(!B%+44),B%,0,N%*L%,^P%,0:REM Lock FOR x%=0 TO s%-1 FOR y%=0 TO s%-1 PROCDoVBpoint(P%,x%,y%,n()) PROCDoVBpoint(P%,(x%+1),y%,n()) PROCDoVBpoint(P%,(x%+1),(y%+1),n()) PROCDoVBpoint(P%,x%,y%,n()) PROCDoVBpoint(P%,(x%+1),(y%+1),n()) PROCDoVBpoint(P%,(x%),(y%+1),n()) NEXT y% NEXT x% SYS!(!B%+48),B%:REM Unlock =B% : DEF PROC4(A%):BPUT#F%,A%:BPUT#F%,A%>>8:BPUT#F%,A%>>16:BPUT#F%,A%>>24:ENDPROC : DEFPROCDoVBpoint(RETURN p%,x%,y%,n()) LOCAL c%,n(),u(),v() DIM n(2),u(2),v(2) REM XYZ data !p%=FN_f4(mapscaleh*x%) p%!4=FN_f4(l%(x%,y%)) p%!8=FN_f4(mapscaleh*y%) p%+=12 REM Sort out the surface normal, looking at points either side of this one IF x%=0 OR x%=s% OR y%=0 OR y%=s% THEN n()=0,0,1 ELSE u(0)=2:u(1)=0:u(2)=l%(x%+1,y%)-l%(x%-1,y%) v(0)=0:v(1)=2:v(2)=l%(x%,y%+1)-l%(x%,y%-1) n(0)=u(1)*v(2)-u(2)*v(1) n(1)=u(2)*v(0)-u(0)*v(2) n(2)=u(0)*v(1)-u(1)*v(0) ENDIF REM Add surface normals !p%=FN_f4(n(0)) p%!4=FN_f4(n(2)) p%!8=FN_f4(n(1)) p%+=12 REM Now work out colour CASE TRUE OF WHEN l%(x%,y%)=0: c%=&FF0000F0 :REM water WHEN l%(x%,y%)<3:c%=&FFF0F000 :REM Sand WHEN l%(x%,y%)<snowlevel%*3/4:c%=&FF00F000 :REM Grass WHEN l%(x%,y%)<snowlevel%:c%=&FFF08050 :REM dirt OTHERWISE:c%=&FFF0F0F0 :REM Snow ENDCASE !p%=c% :REM Colour data p%+=4 ENDPROC : DEF PROCcleanup REM Stolen unchanged from one of Richard's demos: probably needs beefing up t%(1) += 0:IF t%(1) PROC_release(t%(1)) b%(0) += 0:IF b%(0) PROC_release(b%(0)) b%(1) += 0:IF b%(1) PROC_release(b%(1)) d% += 0 :IF d% PROC_release(d%) ENDPROC : DEFPROCSetUpLights REM Set up a couple of light sources: the first is "like the sun", REM while the second gives a bit of backlighting from directly above DIM D3Dlight8{Type%, Diffuse{r%,g%,b%,a%}, Specular{r%,g%,b%,a%}, \ \ Ambient{r%,g%,b%,a%}, Position{x%,y%,z%}, Direction{x%,y%,z%}, \ \ Range%, Falloff%, Attenuation0%, Attenuation1%, Attenuation2%, \ \ Theta%, Phi% } D3Dlight8.Type% = 3 : REM directional source D3Dlight8.Diffuse.r% = FN_f4(0.2) D3Dlight8.Diffuse.g% = FN_f4(0.2) D3Dlight8.Diffuse.b% = FN_f4(0.2) D3Dlight8.Direction.x% = FN_f4(1) D3Dlight8.Direction.y% = FN_f4(-1) D3Dlight8.Direction.z% = FN_f4(1) l2%(0) = D3Dlight8{} DIM D3Dlight2{}=D3Dlight8{} D3Dlight2.Type% = 3 : REM directional source D3Dlight2.Diffuse.r% = FN_f4(0.1) D3Dlight2.Diffuse.g% = FN_f4(0.1) D3Dlight2.Diffuse.b% = FN_f4(0.1) D3Dlight2.Direction.x% = FN_f4(0) D3Dlight2.Direction.y% = FN_f4(-1) D3Dlight2.Direction.z% = FN_f4(0) l2%(1) = D3Dlight2{} ENDPROC : DEFPROCSetStartPos px=0 py=0 pz=maxh%*2 v=0 va=-PI/8 ha=PI/4 ra=0 e()= px,pz,py a()=0,0,0 ENDPROC
|
|