Игростроение - Создание игр

texsize=256 ;cubemap texture size, multiple of 2
cubecam=CreateCamera()
CameraViewport cubecam,0,0,texsize,texsize ;viewport same as texture
CameraClsMode cubecam,False,True ;color-buffer, z-buffer
CameraProjMode cubecam,0 ;disable cubemap camera

meshsize=24 : quadsize=1
water=CreateFlatMesh(180,180,4,0,0,0)
wsurf=GetSurface(water,1) ;mesh surface
EntityAlpha water,0.8 ;transparency
watertex=CreateTexture(texsize,texsize,1+48+128+256) ;cubemap
EntityTexture water,watertex,0,0
PositionEntity water,0,-100,300
meshsize=24 : quadsize=1

wh#=0.15 ;wave height, "calm" range 0.05..0.2
   ws#=ws#+3 : If ws#>=360 Then ws#=0 ;wave speed, wrap to avoid error
   wd#=wd#+0.1 : If wd#>=360 Then wd#=0 ;wave direction
   xd#=Sin(wd#)*45 : If Abs(xd#)<0.01 Then xd#=xd#*10 ;min to avoid error
   zd#=Cos(wd#)*-45 : If Abs(zd#)<0.01 Then zd#=zd#*10

   For i=0 To CountVertices(wsurf)-1
    ;vy=wheight*sin(wspeed+(vx*sin(wdir)*45)+(vxz*cos(wdir)*-45))
    vy#=wh#*Sin(ws#+(VertexX(wsurf,i)*xd#)+(VertexZ(wsurf,i)*zd#))
    VertexCo ords wsurf,i,VertexX(wsurf,i),vy#,VertexZ(wsurf,i)
   Next
   UpdateNormals water ;set normals, to distort cubemap texture

   ;move the box around the water
   btic#=btic#+0.2
   bx#=10*Sin(btic#)
   bz#=10*Cos(btic#)

;--------------------------------------------------------------------

Function UpdateCubemap(Cubetex,Cubecam, camera)
   ;Render a cubemap with a given texture and camera

   Local xpos#,ypos#,zpos#,texsize

   CameraProjMode  camera,0 ;disable view camera
   CameraProjMode Cubecam,1 ;enable cubemap camera

   xpos#=EntityX( camera,True) ;cubemap camera positions, global
   ypos#=-EntityY( camera,True)
   zpos#=EntityZ( camera,True)
   PositionEntity Cubecam,xpos#,ypos#,zpos# ;set position of render

   texsize=TextureWidth(Cubetex) ;assume width/height are the same

   RotateEntity Cubecam,0,90,0
   RenderWorld
   SetCubeFace Cubetex,0 ;left view, -x axis
   CopyRect 0,0,texsize,texsize,0,0,BackBuffer(),TextureBuffer(Cubetex)
   RotateEntity Cubecam,0,0,0
   RenderWorld
   SetCubeFace Cubetex,1 ;forward view, +z axis
   CopyRect 0,0,texsize,texsize,0,0,BackBuffer(),TextureBuffer(Cubetex)
   RotateEntity Cubecam,0,-90,0
   RenderWorld
   SetCubeFace Cubetex,2 ;right view, +x axis
   CopyRect 0,0,texsize,texsize,0,0,BackBuffer(),TextureBuffer(Cubetex)
   RotateEntity Cubecam,0,180,0
   RenderWorld
   SetCubeFace Cubetex,3 ;back view, -z axis
   CopyRect 0,0,texsize,texsize,0,0,BackBuffer(),TextureBuffer(Cubetex)
   If EntityY( camera,True)>0 ;optimize cubemapping
    RotateEntity Cubecam,-90,0,0
    RenderWorld
    SetCubeFace Cubetex,4 ;up view, +y axis
    CopyRect 0,0,texsize,texsize,0,0,BackBuffer(),TextureBuffer(Cubetex)
   Else
    RotateEntity Cubecam,90,0,0
    RenderWorld
    SetCubeFace Cubetex,5 ;down view, -y axis
    CopyRect 0,0,texsize,texsize,0,0,BackBuffer(),TextureBuffer(Cubetex)
   EndIf

   CameraProjMode Cubecam,0 ;disable cubemap camera
   CameraProjMode  camera,1 ;enable view camera
     
End Function

Function CreateFlatMesh(Xlen#,Zlen#,Size#,Xpos#,Ypos#,Zpos#)
   ;Create a flat mesh grid of given dimensions and position
   ;Xlen#/Zlen#=mesh dimensions, Size#=quad size
   ;Xpos#/Ypos#/Zpos#=x/y/z center

   Local hmesh,hsurf,xnum,znum,ix,iz,ptx#,ptz#,iv

   hmesh=CreateMesh()
   hsurf=CreateSurface(hmesh)

   xnum=Xlen#/Size# ;number of vertices on axis
   znum=Zlen#/Size#

   ;create grid vertices, centered and offset
   For iz=0 To znum
    For ix=0 To xnum
     ptx#=(ix*Size#)-(xnum*Size#*0.5) ;ipos-midpos
     ptz#=(iz*Size#)-(znum*Size#*0.5)
     AddVertex(hsurf,ptx#+Xpos#,Ypos#,ptz#+Zpos#) ;pos+offset
    Next
   Next

   ;fill in quad triangles, created in "reverse z" order
   For iz=0 To znum-1
    For ix=0 To xnum-1
     iv=ix+(iz*(xnum+1)) ;iv=x+(z*x1)
     AddTriangle(hsurf,iv,iv+xnum+1,iv+xnum+2) ;0,x1,x2
     AddTriangle(hsurf,iv+xnum+2,iv+1,iv) ;x2,1,0
    Next
   Next

   UpdateNormals hmesh ;set normals, for cubemaps and lighting

   Return hmesh ;mesh handle

End Function

Function CreateBasinCube(Xlen#,Zlen#,Xmid#,Ymid#,Zmid#,Xpos#,Ypos#,Zpos#)
   ;Create a basin cube of given dimensions and position
   ;Xlen#/Zlen#=mesh dimensions, Xmid#/Ymid#/Zmid#=basin dimensions
   ;Xpos#/Ypos#/Zpos#=x/y/z center

   Local hmesh,hsurf,xnum,znum,i,ptx#,pty#,ptz#,ix,iz

   hmesh=CreateMesh()
   hsurf=CreateSurface(hmesh)

   ;create grid vertices, centered and offset
   For i=0 To 19
    If i=0 Or i=4 Or i=8 Or i=12 Then ptx#=(Xlen#/2)-Xlen# ;x
    If i=1 Or i=5 Or i=9 Or i=13 Or i=16 Or i=18 Then ptx#=(Xmid#/2)-Xmid#
    If i=2 Or i=6 Or i=10 Or i=14 Or i=17 Or i=19 Then ptx#=Xmid#-(Xmid#/2)
    If i=3 Or i=7 Or i=11 Or i=15 Then ptx#=Xlen#-(Xlen#/2)
    pty#=0 : If i>15 Then pty#=-Ymid# ;y
    If i=0 Or i=1 Or i=2 Or i=3 Then ptz#=(Zlen#/2)-Zlen# ;z
    If i=4 Or i=5 Or i=6 Or i=7 Or i=16 Or i=17 Then ptz#=(Zmid#/2)-Zmid#
    If i=8 Or i=9 Or i=10 Or i=11 Or i=18 Or i=19 Then ptz#=Zmid#-(Zmid#/2)
    If i=12 Or i=13 Or i=14 Or i=15 Then ptz#=Zlen#-(Zlen#/2)
    AddVertex(hsurf,ptx#+Xpos#,pty#+Ypos#,ptz#+Zpos#) ;pos+offset
   Next

   ;fill in quad triangles, created in "reverse z" order
   For iz=0 To 2
    For ix=0 To 2
     i=ix+(iz*4) ;i=x+(z*x1)
     If ix=1 And iz=1 ;basin quads
      AddTriangle(hsurf,16,18,19)
      AddTriangle(hsurf,19,17,16) ;top view
      AddTriangle(hsurf,5,16,17)  ;_|_|_
      AddTriangle(hsurf,17,6,5)   ; | |   
      AddTriangle(hsurf,9,10,18)  ;Ї|Ї|Ї
      AddTriangle(hsurf,19,18,10) ;side view
      AddTriangle(hsurf,5,9,18)   ;_   _
      AddTriangle(hsurf,16,5,18)  ; |_|
      AddTriangle(hsurf,17,19,10)
      AddTriangle(hsurf,10,6,17)
     Else ;surrounding quads
      AddTriangle(hsurf,i,i+4,i+5) ;0,x1,x2
      AddTriangle(hsurf,i+5,i+1,i) ;x2,1,0
     EndIf
    Next
   Next

   ;add uv coordinates for texture, planar-mapped
   For i=0 To 19
    ptx#=(VertexX(hsurf,i)/Xlen#)*((Xlen#-Xmid#)/2)
    ptz#=(VertexZ(hsurf,i)/Zlen#)*((Zlen#-Zmid#)/2)
    VertexTexCoords hsurf,i,ptx#,ptz#,0,0
   Next

   Return hmesh ;mesh handle

End Function

Function CreateConcreteTexture(Xsize,Ysize)
   ;Create a concrete slab texture of given dimensions

   Local hmap,hpal,htex,ix,iy,ip

   hpal=CreatePalette(256,180,180,180,80,80,80) ;grey gradient
   hmap=CreateHeightMap(hpal,Xsize,Ysize,1,1,1,2,8,5,84,4,4)
   htex=CreateTexture(Xsize,Ysize)

   ;set all heightmap points
   LockBuffer(TextureBuffer(htex))
   For iy=0 To Ysize-1
    For ix=0 To Xsize-1
     ip=PeekByte(hmap,ix+(iy*Xsize)) ;index=x+(y*width)
     WritePixelFast ix,iy,PeekInt(hpal,ip*4),TextureBuffer(htex)
    Next
   Next
   UnlockBuffer(TextureBuffer(htex))

   FreeBank hmap
   FreeBank hpal

   Return htex ;texture handle

End Function

Function CreatePalette(ncol,rmin,gmin,bmin,rmax,gmax,bmax)
   ;Create a palette for a heightmap of given size and color range

   Local hpal,ic,red,green,blue

   hpal=CreateBank(ncol*4)
   For ic=0 To ncol-1
    red=(ic*(rmax-rmin)/ncol)+rmin
    green=(ic*(gmax-gmin)/ncol)+gmin
    blue=(ic*(bmax-bmin)/ncol)+bmin
    PokeInt hpal,ic*4,(red Shl 16)+(green Shl 8)+blue
   Next

   Return hpal ;palette bank handle

End Function

Function CreateHeightMap(hpal,Xdm,Ydm,Xps,Yps,Bps,Blr,Wpr,Mcv,Bcv,Bxs,Bys)
   ;From "lands.bas" by Per Larsson (www.programmersheaven.com)
   ;Xps/Yps/Bps=X/Y/Blur pixel step, Blr=blur (smoothing) amount,
   ;Wpr=water probability (not 0), Mcv=minimum color value,
   ;Bcv=border color value (0 for none), Bxs/Bys=border X/Y size

   Local hmap,hnewmap,ix,iy,ystep,xstep,val,ptx,pty,ib,lf,rt,up,dn

   SeedRnd MilliSecs() ;randomize seed
   hmap=CreateBank(Xdm*Ydm)
   hnewmap=CreateBank(Xdm*Ydm)

   ;make random 2-colors map
   For iy=0 To Ydm-1
    If ystep=0 ;instead of using Step, for variable steps
     For ix=0 To Xdm-1
      If xstep=0
       val=Rand(0,Wpr) ;water probability
       If val=1 : val=BankSize(hpal)-1 : Else : val=1 : EndIf ;set 2-colors
       If Bcv>0 ;draw border around map
        If ix<Bys Or ix>=Xdm-Bys Then val=Bcv
        If iy<Bxs Or iy>=Ydm-Bxs Then val=Bcv
       EndIf
       ;set heightmap points, and boxfill in-between points
       For ptx=0 To Xps-1
        For pty=0 To Yps-1
         PokeByte hmap,(ix+ptx)+((iy+pty)*Xdm),val ;calculate x,y offset
        Next
       Next
      EndIf
      xstep=xstep+1 : If xstep>=Xps Then xstep=0
     Next   
    EndIf
    ystep=ystep+1 : If ystep>=Yps Then ystep=0
   Next

   If Blr=0 Then CopyBank hmap,0,hnewmap,0,Xdm*Ydm ;copy 2-colors map

    ;blur smooth map by pixel steps, average out 2-colors map
    For ib=1 To Blr
     For iy=0 To Ydm-1
      If ystep=0
       For ix=0 To Xdm-1
        If xstep=0
         ;get surrounding points, and wrap overlapping points
         lf=ix-Bps : If lf<0 Then lf=Xdm-Bps
         rt=ix+Bps : If rt>Xdm-Bps Then rt=0
         up=iy-Bps : If up<0 Then up=Ydm-Bps
         dn=iy+Bps : If dn>Ydm-Bps Then dn=0
         ;calculate average of current point, blur
         ;color=(up+lf+rt+down+(pt*2)+lfup+rtup+lfdown+rtdown)/10
         val=PeekByte(hmap,ix+(up*Xdm))+PeekByte(hmap,lf+(iy*Xdm))
         val=val+PeekByte(hmap,rt+(iy*Xdm))+PeekByte(hmap,ix+(dn*Xdm))  
         val=val+(PeekByte(hmap,ix+(iy*Xdm))*2)
         val=val+PeekByte(hmap,lf+(up*Xdm))+PeekByte(hmap,rt+(up*Xdm))
         val=val+Pee kByte(hmap,lf+(dn*Xdm))+PeekByte(hmap,rt+(dn*Xdm))
         val=val/10
         If val<Mcv Then val=Mcv ;set minimum color
         If ib>1 Then PokeByte hmap,ix+(iy*Xdm),val ;set smoothed average
         ;Set actual heightmap points, in pixel steps
         For ptx=0 To Bps-1
          For pty=0 To Bps-1
           PokeByte hnewmap,(ix+ptx)+((iy+pty)*Xdm),val
          Next
         Next
        EndIf
        xstep=xstep+1 : If xstep>=Bps Then xstep=0
       Next
      EndIf
      ystep=ystep+1 : If ystep>=Bps Then ystep=0
     Next
    Next

   FreeBank hmap

   Return hnewmap ;heightmap bank handle

End Function