Rem Never Ending Matrix Example By TDK_Man Oct 2005 Gosub Setup Do Gosub InputControls Gosub ScrollMatrix Sync Center Text 512,0,"Flight Sim-Style Mouse Control: [LMB] Increase Speed [RMB] Decrease Speed Options: [W]ireframe [Textured]" S=Scancode() If S=17 Set Matrix Wireframe On 1 Repeat Until Scancode()<>17 Endif If S=20 Set Matrix Wireframe Off 1 Repeat Until Scancode()<>20 Endif Loop InputControls: CX=Camera Angle X(): CY=Camera Angle Y(): CZ=Camera Angle Z() CY=Wrapvalue(CY+mousemovex()) CX=Wrapvalue(CX-mousemovey()) Rotate Camera CX,CY,CZ If MouseClick()=1 Then Inc Speed#,5 If MouseClick()=2 Then Dec Speed#,5: If Speed# < 0.0 Then Speed#=0.0 If Camera Angle X()>300 and Camera Angle X()<=359 Rem Up ClimbRate = 359-Camera Angle X() Inc CamPosY,ClimbRate*Speed# Endif If Camera Angle X()>=1 and Camera Angle X()<90 Rem Down ClimbRate = Camera Angle X() Dec CamPosY,ClimbRate*Speed# Endif Floor = Get Ground Height(1,MatCentreX-MatrixXPosition,MatCentreZ-MatrixZPosition)+300 If CamPosY < Floor Then CamPosY = Floor Position Camera MatCentreX,CamPosY,MatCentreZ Return ScrollMatrix: Inc MatrixXPosition,Int(DirX#(CY)*Speed#) Inc MatrixZPosition,0-(Int(DirZ#(CY))*Speed#) If MatrixZPosition <= 0-TileHeight MatrixZPosition = 0 Shift Matrix Down 1 for f=0 to TilesX set matrix height 1,f,TilesZ,get matrix height(1,f,0) next f Endif If MatrixZPosition >= TileHeight MatrixZPosition = 0 Shift Matrix Up 1 for f=0 to TilesX set matrix height 1,f,0,get matrix height(1,f,TilesZ) next f Endif If MatrixXPosition <= 0-TileWidth MatrixXPosition = 0 Shift Matrix Left 1 for f=0 to TilesZ : set matrix height 1,TilesX,f,get matrix height(1,0,f) : next f Endif If MatrixXPosition >= TileWidth MatrixXPosition = 0 Shift Matrix Right 1 for f=0 to TilesZ : set matrix height 1,0,f,get matrix height(1,TilesX,f) : next f Endif Position Matrix 1, MatrixXPosition,0,MatrixZPosition Return Setup: Randomize Timer() Dim DirX#(359) Dim DirZ#(359) Gosub CalcDirection: Rem Direction Percentage For All Camera Angles Sync On: Sync Rate 60 CLS 0 Set Display Mode 1024,768,16 Hide Mouse Rem Initial Variables MatPixelWidth = 30000000: MatPixelHeight = 30000000 TilesX = 70: TilesZ = 70 MatCentreX = MatPixelWidth/2 MatCentreZ = MatPixelHeight/2 TileWidth = MatPixelWidth/TilesX TileHeight = MatPixelHeight/TilesZ MatrixXPosition = 0 MatrixZPosition = 0 Hills = 100 Speed# = 0 Set Camera view 0,0,1,1: CLS 0 Text 0,0,"Please Wait - Initialising Terrain...": Sync: Sync Make Matrix 1,MatPixelWidth,MatPixelHeight,TilesX,TilesZ Position Matrix 1, MatrixXPosition,0,MatrixZPosition Color Backdrop 0 Fog On Fog Color 0 Fog Distance MatCentreX/2 For N = 1 To Hills X = Rnd(TilesX-2)+1: Z = Rnd(TilesZ-2)+1 Set Matrix Height 1,x,z,(Rnd(3000)+2000)*1000 Set Matrix Height 1,x-1,z-1,(Rnd(2000)+1500)*1000 Set Matrix Height 1,x+1,z-1,(Rnd(2000)+1500)*1000 Set Matrix Height 1,x-1,z+1,(Rnd(2000)+1500)*1000 Set Matrix Height 1,x+1,z+1,(Rnd(2000)+1500)*1000 Next N Rem Now Smooth The Hills For N = 1 To 5 Gosub Smooth Next N Gosub TextureMatrix Update Matrix 1 Set Matrix Wireframe On 1 CamPosY = Get Ground Height(1,MatCentrex,MatCentrez)+300 Position Camera MatCentreX,CamPosY,MatCentreZ Set Camera Range 30.0,MatPixelWidth*2 Set Camera view 0,0,1024,768 Return Smooth: Rem Averages matrix heights to remove jagged edges For Z=0 to TilesZ For X=0 to TilesX P0#=Get Matrix Height(1,X,Z): Rem Current point height Rem Get 4 adjoining points heights (if they exist) If Z-1 > 0 P1#=Get Matrix Height(1,X,Z-1) Else P1#=Get Matrix Height(1,X,TilesZ) Endif If X+1 < TilesX P2#=Get Matrix Height(1,X+1,Z) Else P2#=Get Matrix Height(1,0,Z) Endif If Z+1 < TilesZ P3#=Get Matrix Height(1,X,Z+1) Else P3#=Get Matrix Height(1,X,0) Endif If X-1 > 0 P4#=Get Matrix Height(1,X-1,Z) Else P4#=Get Matrix Height(1,TilesX,Z) Endif Average#=(P0#+P1#+P2#+P3#+P4#)/5: Rem Av height of other points Set Matrix Height 1,x,z,Average# Next x Next z Return CalcDirection: For Angle = 0 To 359 If Angle = 0 Rem Up DirX#(Angle) = 0.0 DirZ#(Angle) = 90.0 Endif If ANGLE > 0 and ANGLE < 90 Rem up left 1 to 89 DirX#(Angle) = 0-ANGLE DirZ#(Angle) = 90.0 - ANGLE Endif If ANGLE = 90 Rem left 90 DirX#(Angle) = 0-90.0 DirZ#(Angle) = 0.0 Endif If ANGLE > 90 and ANGLE < 180 Rem Down left - 91 to 179 DirX#(Angle) = 0 - (180.0 - ANGLE) DirZ#(Angle) = 0 - (ANGLE - 90.0) Endif If ANGLE = 180 Rem Down DirX#(Angle) = 0.0 DirZ#(Angle) = 0 - (ANGLE-90.0) Endif If ANGLE > 180 and ANGLE < 270 Rem Down Right 181 - 269 DirX#(Angle) = ANGLE - 180.0 DirZ#(Angle) = 0 - (270.0-ANGLE) Endif If ANGLE = 270 Rem Right 270 DirX#(Angle) = 360.0-ANGLE: Rem Was 181- DirZ#(Angle) = 0.0 Endif If ANGLE > 270 and ANGLE < 360 Rem Up Right 271 to 359 DirX#(Angle) = 360.0 - ANGLE DirZ#(Angle) = 90.0-(360.0 - ANGLE) Endif Next Angle Return TextureMatrix: Create Bitmap 1,600,600 TextureImageSize = 512 CLS RGB(35,40,0) RatioX = MatPixelWidth/TextureImageSize RatioZ = MatPixelHeight/TextureImageSize Hi = 0: Lo = 500000 For Nz = 0 To TextureImageSize For Nx = 0 To TextureImageSize MatHeight = Get Ground Height(1,Nx*RatioX,Nz*RatioZ) If MatHeight > Hi Then Hi = MatHeight If MatHeight < Lo Then Lo = MatHeight Next Nx Next Nz RatioY = (Hi-Lo)/255 For Nz = 0 To TextureImageSize For Nx = 0 To TextureImageSize MatHeight = Get Ground Height(1,Nx*RatioX,(TextureImageSize-Nz)*RatioZ) Band = (MatHeight/RatioY) Rem Muddy If Band < 4 R = Band+Rnd(64)+32 G = Band+Rnd(64)+48 B = 0 Endif Rem Grassy If Band >= 4 and Band < 32 R = Band G = Band+Rnd(64)+48 B = 0 Endif Rem Grass To Rocky If Band >= 32 and Band < 64 R = Band-Rnd(32) G = Band+Rnd(32)+32 B = R Endif Rem Mountain Base If Band >= 64 and Band < 100 R = Band-Rnd(32) G = Band+Rnd(32) B = Band-Rnd(32)-32 Endif Rem Rocky If Band >= 100 and Band < 128 R = Band-Rnd(64) G = R B = R Endif Rem Rocky Snow If Band >= 128 and Band < 164 R = Band+Rnd(64) G = R B = R Endif Rem Snowy If Band >= 164 R = 255 G = 255 B = 255 Endif If Band < 100 If Rnd(10)<>0 Then Ink RGB(R,G,B),0: Dot Nx,Nz Else Ink RGB(R,G,B),0: Dot Nx,Nz Endif Next Nx Next Nz Blur Bitmap 1,7 sync Get Image 1,0,0,TextureImageSize-1,TextureImageSize-1 Sleep 2 Set Current Bitmap 0 Delete Bitmap 1 CLS Prepare Matrix Texture 1,1,TilesX,TilesZ t=1 For z = TilesZ-1 to 0 Step -1 For x = 0 to TilesX-1 Set Matrix Tile 1,x,z,t Inc t Next x Next z Ink RGB(255,255,255),0 Return