'Terrain texture generation based on the tute by Tobias Franke at Flipcode.com
'Final Blended terrain is on the Lower-right corner

'Relsoft 2004
'Rel.Betterwebber.com

DEFINT A - Z

const PI = 3.141593
const SCR_WIDTH = 800
const SCR_HEIGHT = 600
const BPP = 32

Const MAX_TEXT  = 4


option explicit

'$include: "\sdl\sdl.bi"

DECLARE SUB Init_SDL(SDLscreen as SDL_Surface ptr)
Declare Sub SDL_GetEvents(EscapeVal as Integer)
DECLARE Sub Draw_Sprite(Byval Layer as SDL_Surface Ptr, byval x as integer, byval y  as integer, byval image as SDL_Surface Ptr )
DECLARE sub Load_Images(Hmap as SDL_Surface Ptr, ImageFinal as SDL_Surface Ptr,_
                        Images() as SDL_Surface Ptr)
DECLARE function Limit_255(byval a as single) as single
DECLARE sub bitmap_getcolor(Byval Image as SDL_Surface Ptr,_
                            Byval  x as integer, Byval y as integer,_
                            byref r as ubyte, byref g as ubyte, byref b as ubyte)
DECLARE sub bitmap_setcolor(Byval Image as SDL_Surface Ptr,_
                            Byval  x as integer, y as integer,_
                            Byval  r as ubyte, Byval g as ubyte, Byval b as ubyte)
DECLARE sub  Blend(Byval Hmap as SDL_Surface Ptr,Byval ImageFinal as SDL_Surface Ptr,_
                   Images() as SDL_Surface Ptr)



	dim vpage as SDL_Surface ptr
	dim images(MAX_TEXT - 1) as SDL_Surface ptr
	dim image_final as SDL_Surface ptr
	dim hMap as SDL_Surface ptr


    dim Finished as integer

    dim shared path as string
    path = "C:\compiler\freebasic\images\"
    path= ""

    Init_SDL vpage

    Load_Images hMap, image_final, images()
    Finished = 0
    dim keys as ubyte ptr

    Draw_Sprite vpage, 0, 0, Images(0)
    Draw_Sprite vpage, 256, 0, Images(1)
    Draw_Sprite vpage, 512, 0, Images(2)
    Draw_Sprite vpage, 0, 256, Images(3)
    Draw_Sprite vpage, 256, 256, hMap


    Blend hMap, image_final, images()
    Draw_Sprite vpage, 512, 256, Image_final
	do
	    'SDL_GetEvents(Finished)
   		keys = SDL_GetKeyState(0)
		if keys[SDLK_UP] then Finished = -1
        SDL_Flip vpage
        SDL_GetEvents(Finished)
		SDL_PumpEvents
	loop until Finished

	'Unrem this if you want to save the new BMP

	'SDL_SaveBMP Image_Final, Path+"Terrain2.Bmp"





	SDL_Quit

    end


SUB Init_SDL(SDLscreen as SDL_Surface ptr)
    dim Result as unsigned integer
	dim SDL_flags as integer

    SDL_flags = SDL_HWSURFACE or SDL_DOUBLEBUF
	result = SDL_Init(SDL_INIT_EVERYTHING)
	if result <> 0 then
  		end 1
	end if

	SDLscreen = SDL_SetVideoMode(SCR_WIDTH, SCR_HEIGHT, BPP, SDL_flags)
	if SDLscreen = 0 then
		SDL_Quit
		end 1
	end if

	SDL_WM_SetCaption "Sdl Terrain Blender", ""

END SUB

Sub SDL_GetEvents(EscapeVal as Integer)
  dim event as SDL_Event
		while( SDL_PollEvent ( @event ) )
			select case event.type
				case SDL_KEYDOWN:
				    EscapeVal = -1
				case SDL_MOUSEBUTTONDOWN:
			end select
		wend
End Sub


sub Load_Images(Hmap as SDL_Surface Ptr, ImageFinal as SDL_Surface Ptr,_
                Images() as SDL_Surface Ptr)

    dim i as integer

    for i = 0 to Ubound(Images)
        images(i) = SDL_LoadBMP(Path+"Tex"+ Trim$(Str$(i+1)) + ".BMP")
           if images(i) = 0  then
    	       SDL_FreeSurface images(i)
    	       SDL_Quit
	           screen 13
	           print "error"
	           sleep
	           end -1
            end if
    next i

 ImageFinal = SDL_LoadBMP(Path+"Tex1.bmp")
    if ImageFinal = 0  then
	   SDL_FreeSurface ImageFinal
	   SDL_Quit
	   screen 13
	   print "error"
	   sleep
	   end -1
	end if


 HMap = SDL_LoadBMP(Path+"hmap24.bmp")
    if hMap = 0  then
	   SDL_FreeSurface hMap
	   SDL_Quit
	   screen 13
	   print "error"
	   sleep
	   end -1
	end if


End sub

Sub Draw_Sprite(Byval Layer as SDL_Surface Ptr, Byval x as integer, byval y  as integer, byval image as SDL_Surface Ptr )

  dim dest as SDL_Rect
  dest.x = x
  dest.y = y
  SDL_BlitSurface image, NULL, Layer, @dest

End sub



function Limit_255(byval a as single) as single

    Limit_255 = a

	if a < 0.0 then
		Limit_255 =  0.0
	elseif a > 255.0  then
		Limit_255 = 255.0
	else
        Limit_255 = a
	end if

end function

function texture_factor(byval h1 as integer, byval h2 as single, byval f as single) as single

	dim t as single
	t = (f - abs(h1 - h2)) / f

	if t < 0.0 then
        t = 0.0
	elseif t > 1.0 then
         t = 1.0
    end if

	texture_factor =  t

end function


sub  Blend(Byval Hmap as SDL_Surface Ptr,Byval ImageFinal as SDL_Surface Ptr,_
           Images() as SDL_Surface Ptr)

    dim Max_Textures  as integer

	dim h1 as single 	'h1 is heigtmap value at position x/z, f0 and f1 are percentage of color resulting due to the heightmap value stored in h1
	dim f(Max_Textures) as single

    dim r(Max_Textures) as ubyte    'Store color at pixel x/z of both images (i1 and i2), store the new calculated values
    dim g(Max_Textures) as ubyte
    dim b(Max_Textures) as ubyte

    dim new_r as ubyte
    dim new_g as ubyte
    dim new_b as ubyte

    dim i_r as uinteger
    dim i_g as uinteger
    dim i_b as uinteger

    dim x as integer
    dim y as integer

    Max_Textures  = Ubound(Images)
    dim imgptr as ubyte ptr
    imgptr = hMap->pixels
                                   
    dim i as integer
	for y = 0 to hMap->h - 1
	   for x = 0 to hMap->w - 1

  			h1 = Limit_255(*(imgptr + (x + (y * hMap->w)) * 3 + 2))    'Get height value
			f(1) = texture_factor(256,	h1,	64)		   'Get percentage of color of pixel x/y
			f(3) = texture_factor(192,	h1, 64)        'from bitmap1, if height is zero (black) then bitmap1 receives 100%
			f(0) = texture_factor(128,	h1, 64)        '(black) then final BMP receives 100%
			f(2) = texture_factor(0,	h1, 64)

            i_r = 0
            i_g = 0
            i_b = 0
            for i = 0 to Max_Textures
    			bitmap_getcolor(Images(i), x, y, r(i), g(i), b(i))	   'Get color of pixel x/y from textures
    			i_r = i_r + ( r(i) * f(i) )
                i_g = i_g + ( g(i) * f(i) )
                i_b = i_b + ( b(i) * f(i) )
    		next i

    		    new_r = Limit_255(i_r)
                new_g = Limit_255(i_g)
                new_b = Limit_255(i_b)

    			bitmap_setcolor(ImageFinal, x, y, new_r, new_g, new_b)      'Set new pixel color in final

		next x
	next y
End sub


sub bitmap_getcolor(Byval Image as SDL_Surface Ptr,_
                    Byval  x as integer, Byval y as integer,_
                    byref r as ubyte, byref g as ubyte, byref b as ubyte)

    dim imgptr as ubyte ptr
    imgptr = Image->pixels

	if (x < (Image->W)) and (y < (Image->H)) then
	    r = *(imgptr + (x + (y * Image->w)) * 3 + 0)
	    g = *(imgptr + (x + (y * Image->w)) * 3 + 1)
	    b = *(imgptr + (x + (y * Image->w)) * 3 + 2)
	end if

end sub


sub bitmap_setcolor(Byval Image as SDL_Surface Ptr,_
                    Byval  x as integer, y as integer,_
                    Byval  r as ubyte, Byval g as ubyte, Byval b as ubyte)

    dim imgptr as ubyte ptr
    imgptr = Image->pixels

	if (x < (Image->W)) and (y < (Image->H)) then
	    *(imgptr + (x + (y * Image->w)) * 3 + 0) = r
	    *(imgptr + (x + (y * Image->w)) * 3 + 1) = g
	    *(imgptr + (x + (y * Image->w)) * 3 + 2) = b
	end if

end sub



