Strict


Import klepto.minib3d
Import klepto.minisound3d

'Import BRL.TGALoader
Import BRL.StandardIO
EnableOpenALAudio()


Local Drivers:String[] = AudioDrivers()

For Local S:String = EachIn Drivers
   Print S
Next

'Local x = 0 ' hier Treiber nach liste setzen

SetAudioDriver(Drivers[0])


Graphics3D 800 , 600 , 32 , 2
AntiAlias(0)

Global Cam:TCamera = CreateCamera()


'createSampleHeightMap("temp_hmap.png" , 256 , 256 , 1000 , 32 , False)

Local Tex:TPixmap[3]
Tex[0] = LoadPixmap("media/sand3.png")
Tex[1] = LoadPixmap("media/grass2.png")
Tex[2] = LoadPixmap("media/rock.png")

GreytoColor(LoadPixmap("temp_hmap.png"),Tex)

Local Terrain:TTerrain = LoadTerrain("temp_hmap.png",32)
ScaleTerrain(Terrain , 300 , 7000 , 300)
TextureTerrain(Terrain , "color.png" , 0)
PositionTerrain(Terrain , 0 , 0 , 0)

Local Texd:TTexture = LoadTexture("media/detail1.jpg")
ScaleTexture(Texd,2,2)
Terrain.TextureDetail(Texd , 2)

PositionEntity Cam, 0, 1000.0, 0


Local Light:TLight = CreateLight()
PositionEntity Light , 45000 , 1000 , 45000


Local mxs#=0
Local mys#=0
Local move# = 15
Local Wire:Byte = False
MouseXSpeed() ;' flush
MouseYSpeed() ; ' flush


CameraRange(cam , 1 , 25000)
'CameraClsColor(Cam , 50 , 50 , 255)
CameraFogColor Cam , 100 , 100 , 255
CameraFogMode Cam , True
CameraFogRange Cam , 1, 30000
PositionEntity(Cam , 40000 , 0 , 48000)


Local mesh_skybox:TMesh = MakeSkyBox("media/sky")
ScaleEntity mesh_Skybox , 6 , 6 , 6
EntityOrder mesh_skybox,99999


Local frames:Int = 0
Local AA:Int = 0


While Not KeyHit(KEY_ESCAPE)
   
         
   If KeyDown(KEY_SPACE)=False
   
      mxs#=mxs#+(MouseXSpeed()/5.0)
      mys#=mys#+(MouseYSpeed()/5.0)
   
      RotateEntity cam,mys#,-mxs#,0
   
      MoveMouse 400,300
   
   EndIf
   
      
   

   If KeyHit(KEY_W) Then
      Wire = Not Wire
      Wireframe(Wire)
   EndIf
   
   MouseXSpeed() ;' flush
   MouseYSpeed() ;' flush
   
   'E.SetPosition(TVector.Create(-LightX1,LightY1,20-LightZ1))
    If KeyDown(KEY_UP)=True Then MoveEntity cam,0,0,move# ;' move camera forward
   If KeyDown(KEY_DOWN)=True Then MoveEntity cam,0,0,-move# ;' move camera back

   If KeyDown(KEY_LEFT)=True Then MoveEntity cam,-move#,0,0 ;' move camera left
   If KeyDown(KEY_RIGHT)=True Then MoveEntity cam,move#,0,0 ;' move camera right
      

   Local Y:Float = TerrainY(Terrain , EntityX(Cam) , EntityY(Cam) , EntityZ(Cam) )

   PositionEntity Cam , EntityX(Cam) , Y + 50 , EntityZ(Cam)
   PositionEntity mesh_Skybox,EntityX(Cam) , 0 , EntityZ(Cam)

   Terrain.Update(Cam)
   

   UpdateWorld()
   RenderWorld()
   
   If KeyHit(KEY_F2) Then
      AA:+ 1
      AntiAlias(AA Mod 16)
   EndIf
   
   If KeyHit(KEY_F3) Then
      AA:- 1
      AntiAlias(AA Mod 16)
   EndIf
      
   
   If KeyHit(KEY_F1) Then
      Local Pix:TPixmap = GrabPixmap(0 , 0 , 800 , 600)
      SavePixmapPNG(Pix , "Frame" + frames + ".png")
   EndIf
   
   SetBlend AlphaBlend
   
   
   Text  20,20,"FPS : " + TGlobal.GetFPS()
   Text 20 , 40 , "Camera Position :" + EntityX(Cam , True) + ":" + EntityY(Cam , True) + ":" + EntityZ(Cam , True)
   Text 20,60,"Rendered Tris : " + TGlobal.TrisRendered()
   Text 20,80,"Total Chunks    : " + Terrain.GetTotal()
   Text 20,100,"Rendered Chunks : " + Terrain.GetRendered()    
   Flip 0
   frames:+1
Wend

End

Function MakeSkyBox:TMesh( file$ )

   

   Local m:TMesh = CreateMesh()
   Local b:TBrush
   Local s:TSurface
   'front face
   b=LoadBrush( file$+"_FR.bmp",49 )
   s=CreateSurface( m )
   AddVertex s,-1,+1,-1,0,0;AddVertex s,+1,+1,-1,1,0
   AddVertex s,+1,-1,-1,1,1;AddVertex s,-1,-1,-1,0,1
   AddTriangle s,0,1,2;AddTriangle s,0,2,3
   PaintSurface s,b
   'FreeBrush b
   'Right face
   b=LoadBrush( file$+"_LF.bmp",49 )
   s=CreateSurface( m )
   AddVertex s,+1,+1,-1,0,0;AddVertex s,+1,+1,+1,1,0
   AddVertex s,+1,-1,+1,1,1;AddVertex s,+1,-1,-1,0,1
   AddTriangle s,0,1,2;AddTriangle s,0,2,3
   PaintSurface s,b
   'FreeBrush b
   'back face
   b=LoadBrush( file$+"_BK.bmp",49 )
   s=CreateSurface( m )
   AddVertex s,+1,+1,+1,0,0;AddVertex s,-1,+1,+1,1,0
   AddVertex s,-1,-1,+1,1,1;AddVertex s,+1,-1,+1,0,1
   AddTriangle s,0,1,2;AddTriangle s,0,2,3
   PaintSurface s,b
   'FreeBrush b
   'Left face
   b=LoadBrush( file$+"_RT.bmp",49 )
   s=CreateSurface( m )
   AddVertex s,-1,+1,+1,0,0;AddVertex s,-1,+1,-1,1,0
   AddVertex s,-1,-1,-1,1,1;AddVertex s,-1,-1,+1,0,1
   AddTriangle s,0,1,2;AddTriangle s,0,2,3
   PaintSurface s,b
   'FreeBrush b
   'top face
   b=LoadBrush( file$+"_UP.bmp",49 )
   s=CreateSurface( m )
   AddVertex s,-1,+1,+1,0,1;AddVertex s,+1,+1,+1,0,0
   AddVertex s,+1,+1,-1,1,0;AddVertex s,-1,+1,-1,1,1
   AddTriangle s,0,1,2;AddTriangle s,0,2,3
   PaintSurface s,b
   'FreeBrush b

   ScaleMesh m,1700,1700,1700
   FlipMesh m
   EntityFX m , 1
   
   DeactivateClippingPlane(0)
   Return m
   
End Function


Function GreytoColor:TPixmap(In:TPixmap,Textures:TPixmap[])
   'DebugStop()
   Local Width:Int = PixmapWidth(In)
   Local Height:Int = PixmapHeight(In)
   
   Local Out:TPixmap = CreatePixmap(Width , Height,PF_RGBA8888)
   
   Local Border:Int[] = [20 , 145,205]
   Local Color:Int[] = [0,0,0]
   
   Local Variance:Float = 30
   
   For Local X:Int = 0 To Width - 1
      For Local Y:Int = 0 To Height - 1
         Local C:Byte = ReadPixel(In , X , Y)
         
         'Calculating Red amount
         If C <= Border[0] Then
            Local Diff:Float = Border[0] - C
            Diff:/ Border[0]
            'Print "C :" +C + ":"+ Diff
            Color[0] = 255.0 * (1.0 * Diff)
            Color[1] = 255-Color[0]
         EndIf
         
         'Calculating Green
         If C <= Border[1] And C => Border[0]
            Local Diff:Float = Border[1] - C
            Diff:/ Border[1]
            'Print "C :" +C + ":"+ Diff
            Color[1] = 255.0 * (1.0 * Diff)
            Color[2] = 255-Color[1]

         EndIf
         'Calc Blue
         If C <= Border[2] And C => Border[1]
            Local Diff:Float = Border[2] - C
            Diff:/ Border[2]
            'Print "C :" +C + ":"+ Diff
            Color[2] = 255.0 * (1.0 * Diff)
            Color[1] = 255-Color[1]
         
         EndIf
         
         If c > Border[2] Then
            Color[2] = 255
         EndIf
         
         WritePixel Out , x , y , RGBToInt(Color[0] , Color[1] , Color[2])
         
         Color[0] = 0
         Color[1] = 0
         Color[2] = 0
      Next
   Next
   
   Out = ResizePixmap(Out,2048,2048)
   
   For Local I:Int = 0 To 2
      Textures[I] = ResizePixmap(Textures[I], 128 , 128)
   Next
   
   Local TexSize1:Int = PixmapWidth(Textures[0])
   Local TexSize2:Int = PixmapWidth(Textures[1])
   Local TexSize3:Int = PixmapWidth(Textures[2])

   For Local X:Int = 0 To PixmapWidth(Out) - 1
      For Local Y:Int = 0 To PixmapHeight(Out) - 1
         Local C:Int = ReadPixel(Out , X , Y)
         Local TX1:Int = X Mod TexSize1
         Local TY1:Int = Y Mod TexSize1
         
         Local TX2:Int = X Mod TexSize2
         Local TY2:Int = Y Mod TexSize2

         Local TX3:Int = X Mod TexSize3
         Local TY3:Int = Y Mod TexSize3

         Local R:Int
         Local G:Int
         Local B:Int
         
         RGBfromInt(C,R,G,B)
         
         Local RF:Float =  R / 255.0
         Local GF:Float =  G / 255.0
         Local BF:Float =  B / 255.0
         'Print "------------------"
         'Print RF + ":" + GF + ":" + BF
         

         
         Local C1:Int = ReadPixel(Textures[0],TX1 , TY1)
         Local C2:Int = ReadPixel(Textures[1],TX2 , TY2)
         Local C3:Int = ReadPixel(Textures[2] ,TX3 , TY3)
         
         'Print Hex(C1) + ":" + Hex(c2) + ":" + Hex(c3)
         
         WritePixel Out,X,Y,MultiplyColor(c1,RF)+MultiplyColor(c2,GF)+MultiplyColor(c2,BF)


      Next
   Next
   
   
   SavePixmapPNG(Out , "Color.png")
   
   Return Out
End Function

Function RGBToInt:Int  (red:Int, green:Int, blue:Int )
      Return ((255 Shl 24) | (red Shl 16) |(green Shl 8)|blue)
End Function

Function RGBFromInt (argb:Int, red:Int Var, green:Int Var, blue:Int Var)
      red = (argb Shr 16) & $FF
      green = (argb Shr 8) & $FF
      blue = argb & $FF
End Function

Function MultiplyColor:Int(Color:Int , Faktor:Float)
   Local R:Int
   Local G:Int
   Local B:Int
   RGBFromInt(Color , R , G , B)
   
   R:* Faktor
   G:* Faktor
   B:* Faktor
   
   Return RGBToInt(R , G , B)
End Function