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