r2t - Sourcecode.

Author: Tim Fisher
License: Indiepath License for non warranted software
Summary: This software is free to use, you may distribute within a pre-compiled executable file only.

If you have a license question then ask, don't assume! If you don't have a copy of the license then get one.

Strict

Rem
bbdoc: Render 2 Texture Module
End Rem
Module Indiepath.Render2Texture

ModuleInfo "Version: 1.0"
ModuleInfo "Author: Tim Fisher"
ModuleInfo "License: Indiepath License for non warranted software"
ModuleInfo "Summary: This software is free to use, you may distribute within a pre-compiled executable file only."
ModuleInfo "Contact: If you have a license question then ask, don't assume! If you don't have a copy of the license then get one."
ModuleInfo "Modserver:Indiepath"
'EndRem


?win32
Import BRL.D3D7Max2D
?
Import BRL.GLMax2D
Import BRL.PNGLoader
Import BRL.Retro


Const DDERR_INVALIDSURFACETYPE 	= $88760250
Const DDERR_INVALIDPARAMS		= $80070057
Const DDERR_INVALIDOBJECT 		= $88760082
Const DDERR_NOTFOUND 			= $887600ff
Const DDERR_SURFACELOST 		= $887601c2

Global tRenderERROR:String

Function tError:String(err:Int)

	Select err
		Case DDERR_INVALIDSURFACETYPE
			Return "DDERR_INVALIDSURFACETYPE"
			
		Case DDERR_INVALIDPARAMS
			Return "DDERR_INVALIDPARAMS"
			
		Case DDERR_INVALIDOBJECT 
			Return "DDERR_INVALIDOBJECT"
			
		Case DDERR_NOTFOUND
			Return "DDERR_NOTFOUND"
			
		Case DDERR_SURFACELOST
			Return "DDERR_SURFACELOST"
			
	End Select
End Function

Type tRender
	
	?Win32
	Global DXFrame:TD3D7ImageFrame
	?
	Global GLFrame:TGLImageFrame
	Global DX:Int 
	Global Image:TImage = CreateImage(1,1)
	Global Width:Int
	Global Height:Int
	Global o_r,o_g,o_b
Rem
bbdoc: Initialise the Module
about: 
The module must be initialised before use. This ensures usage of the correct render pipeline. If the render device is changed then you must 
re initialise the module.
End Rem		
	Function Initialise()
	?Win32
		If _max2dDriver.ToString() = "DirectX7"
			DX = True
		'	ViewPort = New D3DVIEWPORT7
		Else
	?
			DX = False
		'	GlEnable(GL_TEXTURE_2D)
	?Win32
		EndIf
	?
		Print "tRender : Initialise OK"
		Return True
	End Function
	
'#################################################################################

Rem
bbdoc: Create Image with Render Characteristics
returns: TImage Handle to Object
about: 
 <table>
		<tr><td><b>Width:Int</td><td>Width in Pixels of Image, try to follow the normal rules of textures</td></tr>
		<tr><td><b>Height:Int</td><td>Height in Pixels of Image</td></tr>
		<tr><td><b>Flags:Int</td><td>Normal Image Flags</td></tr>
	</table>
End Rem	
	Function Create:TImage(Width:Int,Height:Int,Flags:Int=FILTEREDIMAGE)

		Local t:TImage=New TImage
		t.width=width
		t.height=height
		t.flags=flags
		t.mask_r= 0
		t.mask_g= 0
		t.mask_b= 0
		t.pixmaps=New TPixmap[1]
		t.frames=New TImageFrame[1]
		t.seqs=New Int[1]
		t.pixmaps[0]= t.Lock(0,True,False)
		t.seqs[0]=GraphicsSeq
		
	'	MaskPixmap( t.pixmaps[0],mask_r,mask_g,mask_b )
	?Win32	
		If DX
			t.frames[0] = CreateFrame(TD3D7Max2DDriver(_max2dDriver),t.Width,t.Height,t.flags)
		Else
	?
			t.frames[0] = TGLImageFrame.CreateFromPixmap:TGLImageFrame( t.pixmaps[0],t.flags )
	?Win32
		EndIf
	?
		
		Print "tRender : Create OK"
		
		
		Return t

	End Function

'#################################################################################
?Win32			
	Function CreateFrame:TD3D7ImageFrame( driver:TD3D7Max2DDriver,width,height,flags )				
		Function Pow2Size( n )
			Local t=1
			While t<n
				t:*2
			Wend
			Return t
		End Function

		Local	swidth=Pow2Size(width)
		Local	sheight=Pow2Size(height)
		Local	desc:DDSURFACEDESC2=New DDSURFACEDESC2
		Local	res
						
		desc.dwSize=SizeOf(desc)
		desc.dwFlags=DDSD_WIDTH|DDSD_HEIGHT|DDSD_CAPS|DDSD_PIXELFORMAT
		desc.dwWidth=swidth
		desc.dwHeight=sheight	
		desc.ddsCaps=DDSCAPS_TEXTURE|DDSCAPS_3DDEVICE|DDSCAPS_VIDEOMEMORY|DDSCAPS_LOCALVIDMEM  ' **************************************************
		desc.ddsCaps2=DDSCAPS2_HINTDYNAMIC'|DDSCAPS2_TEXTUREMANAGE
		desc.ddpf_dwSize=SizeOf(DDPIXELFORMAT)
		desc.ddpf_dwFlags=DDPF_RGB|DDPF_ALPHAPIXELS
		desc.ddpf_BitCount=32
		desc.ddpf_BitMask_0=$ff0000
		desc.ddpf_BitMask_1=$00ff00
		desc.ddpf_BitMask_2=$0000ff
		desc.ddpf_BitMask_3=$ff000000

		
		Local surf:IDirectDrawSurface7
		If flags & MIPMAPPEDIMAGE desc.ddsCaps:|DDSCAPS_MIPMAP|DDSCAPS_COMPLEX
		res=PrimaryDevice.DDraw.CreateSurface( desc,Varptr surf,Null )
		If res<>DD_OK 
			tRenderERROR = tError(res)
			Print "tRender : CreateFrame ERROR : "+tRenderERROR
			Return Null
		EndIf
		'RuntimeError "Create DX7 surface Failed"	
							
		Local frame:TD3D7ImageFrame=New TD3D7ImageFrame
		frame.driver=driver
		frame.surface=surf
		frame.sinfo=New DDSurfaceDesc2
		frame.sinfo.dwSize=SizeOf(frame.sinfo)
		frame.xyzuv=New Float[24]
		frame.width=width
		frame.height=height
		frame.flags=flags
		frame.SetUV 0.0,0.0,Float(width)/swidth,Float(height)/sheight
	
			
		'frame.BuildMipMaps()
		Print "tRender : CreateFrame OK"
		Return frame
	End Function
?
	
'#################################################################################
Rem
bbdoc: Set Screen Viewport
about: 
 <table>
	<tr><td><b>X:Int</td><td>Set the X Position of the Viewport</td></tr>
	<tr><td><b>Y:Int</td><td>Set the Y Position of the Viewport</td></tr>
	<tr><td><b>Width:Int</td><td>Set the Viewport Width in Pixels</td></tr>
	<tr><td><b>Height:Int</td><td>Set the Viewport Height in Pixels</td></tr>
	<tr><td><b>FlipY:Byte</td><td>Flip the Viewport on the Y Axis, OpenGL only. Automatically done by the Texture Renderer.</td></tr>
 </table>
End Rem	
	Function ViewportSet(X:Int=0,Y:Int=0,Width:Int=640,Height:Int=480,FlipY:Byte=False)
	?Win32
		If DX
			TD3D7Max2DDriver(_max2dDriver).viewport.dwX=x
			TD3D7Max2DDriver(_max2dDriver).viewport.dwY=y
			TD3D7Max2DDriver(_max2dDriver).viewport.dwWidth=width
			TD3D7Max2DDriver(_max2dDriver).viewport.dwHeight=height
			PrimaryDevice.device.SetViewport(TD3D7Max2DDriver(_max2dDriver).viewport)
		Else
	?
			If FlipY
				glViewport(X, Y, Width, Height)
				glMatrixMode(GL_PROJECTION)
				glPushMatrix()
				glLoadIdentity()
				gluOrtho2D(X, GraphicsWidth(), GraphicsHeight(),Y)
				glScalef(1, -1, 1)
				glTranslatef(0, -GraphicsHeight(), 0)
				glMatrixMode(GL_MODELVIEW)
			Else
				glViewport(X, Y, Width, Height)
				glMatrixMode(GL_PROJECTION)
				glLoadIdentity()
				glOrtho(X, GraphicsWidth(), GraphicsHeight(), Y, -1, 1)
				glMatrixMode(GL_MODELVIEW)
				glLoadIdentity()
			EndIf
	?Win32
		EndIf
	?
	'	Print "tRender : ViewportSet OK"
		Return True
	EndFunction
	
'#################################################################################
Rem
bbdoc: Begin the Texture Render Process
about: 
 <table>
	<tr><td><b>Image:TImage</td><td>The Image to Render to, as created with "Create" command.</td></tr>
	<tr><td><b>Viewport:Byte</td><td>True (default) to Automatically resize the viewport to the image size</td></tr>
 </table>
End Rem
	Function TextureRender_Begin(Image1:TImage,Viewport:Byte=True)
		Image = Image1
		If Viewport Then 
			Width = image1.width
			Height = image1.height
			If DX
				ViewportSet(0,0,Width,Height)
			Else
				ViewportSet(0,0,Width,Height,True)
			EndIf
		Else
			Width = GraphicsWidth()
			Height = GraphicsHeight()
		EndIf
		
	?Win32	
		If DX
			Local DXFrame:TD3D7ImageFrame = TD3D7ImageFrame (image1.frame(0))
			PrimaryDevice.Device.SetRenderTarget( DXFrame.Surface,0)
			PrimaryDevice.Device.BeginScene()
		Else
	?
			GLFrame:TGLImageFrame = TGLImageFrame(Image1.frame(0))
		'	ViewportSet(0,0,Width,Height,True)
	?Win32
		EndIf		
	?
	'	Print "tRender : TextureRender_Begin OK"
		Return True
	End Function
	
'#################################################################################
Rem
bbdoc: Clear the Current Viewport with color
about: 
 <table>
	<tr><td><b>col:Int</td><td>The Color to clear the Viewport with includes Alpha AARRGGBB format.</td></tr>
 </table>
End Rem
	Function Cls(col:Int=$FF000000)
	?Win32	
		If dx
			PrimaryDevice.device.Clear 1,Null,D3DCLEAR_TARGET,col,0,0
		Else
	?
				Local Red# 	= (col Shr 16) & $FF
				Local Green# 	= (col Shr 8) & $FF
				Local Blue# 	= col & $FF
				Local Alpha# 	= (col Shr 24) & $FF
			'	DebugLog Alpha
				glClearColor red/255.0,green/255.0,blue/255.0,alpha/255.0
				glClear GL_COLOR_BUFFER_BIT
	?Win32	
		EndIf
	?
	End Function
	
'#################################################################################
Rem
bbdoc: Setup GreyScale Rendering
about: 
 <table>
	<tr><td><b>state:Byte</td><td>True = Turn GreyScale on, False = Turn it Off</td></tr>
	<tr><td><b>dwFactor:Int</td><td>Texture Coloring Factor</td></tr>
	<tr><td><b>SourceCol:Int</td><td>Color Source to be used to calculate GreyScale</td></tr>
 </table>
End Rem
?win32
	Function SetMono(state:Byte=True,dwFactor:Int = $0036B612,SourceCol:Int=$FF0000)
		If State
			GetColor (o_r,o_g,o_b)
			SetColor((SourceCol Shr 16) & $FF,(SourceCol Shr 8) & $FF,SourceCol & $FF)
			PrimaryDevice.device.SetRenderState(D3DRS_TEXTUREFACTOR, dwFactor)
  		'	PrimaryDevice.device.SetTextureStageState(0, D3DTSS_COLOROP,D3DTOP_DOTPRODUCT3)
  		'	PrimaryDevice.device.SetTextureStageState(0, D3DTSS_COLORARG1, D3DTA_TEXTURE) 
  		'	PrimaryDevice.device.SetTextureStageState(0, D3DTSS_COLORARG2, D3DTA_TFACTOR) 

			PrimaryDevice.device.SetTextureStageState(1, D3DTSS_COLOROP,D3DTOP_DOTPRODUCT3)
  			PrimaryDevice.device.SetTextureStageState(1, D3DTSS_COLORARG1, D3DTA_TEXTURE) 
  			PrimaryDevice.device.SetTextureStageState(1, D3DTSS_COLORARG2, D3DTA_TFACTOR) 
		Else
			PrimaryDevice.device.SetRenderState(D3DRS_TEXTUREFACTOR, $FFFFFFFF ) 
  		'	PrimaryDevice.device.SetTextureStageState(0,D3DTSS_COLOROP,D3DTOP_MODULATE)  
		'	PrimaryDevice.device.SetTextureStageState(0,D3DTSS_COLORARG1,D3DTA_TEXTURE)
		'	PrimaryDevice.device.SetTextureStageState(0,D3DTSS_COLORARG2,D3DTA_DIFFUSE)
			
			PrimaryDevice.device.SetTextureStageState(1,D3DTSS_COLOROP,D3DTOP_MODULATE)  
			PrimaryDevice.device.SetTextureStageState(1,D3DTSS_COLORARG1,D3DTA_TEXTURE)
			PrimaryDevice.device.SetTextureStageState(1,D3DTSS_COLORARG2,D3DTA_DIFFUSE)
			SetColor o_r,o_g,o_b
		EndIf
End Function
?win32
'#################################################################################
?win32	
	Function SetMipMap(Image:TImage,Level:Int)
	
		Local DXFrame:TD3D7ImageFrame = TD3D7ImageFrame (image.frame(0))
		
		'DXFrame.BuildMipMaps()
		
		Local	src:IDirectDrawSurface7
		Local	dest:IDirectDrawSurface7
		Local	caps2:DDSCAPS2
		caps2=New DDSCAPS2
		caps2.dwCaps=DDSCAPS_TEXTURE|DDSCAPS_MIPMAP'|DDSCAPS_3DDEVICE
		caps2.dwCaps2= DDSCAPS2_MIPMAPSUBLEVEL
	
		src = DXFrame.Surface
				
		Local res = src.GetAttachedSurface(caps2,Varptr dest)
		
		If res<>DD_OK 
			tRenderERROR = tError(res)
			Return False
		EndIf
		
		DXFrame.Surface =  dest
		dest.Release_
		
		Print "MipMap Selected OK"
		Return True
	
	End Function
?	
'#################################################################################
Rem
bbdoc: End the Texture Render Process
about: 
This Must be called when you have finished rendering to the Texture
End Rem	
	Function TextureRender_End()
	?Win32
		If dx
			PrimaryDevice.Device.EndScene()
		Else
	?
			glBindTexture GL_TEXTURE_2D,GLFrame.name
			glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 0, Width, Height, 0)
			glBindTexture GL_TEXTURE_2D,0
	?Win32
		EndIf
	?
		ViewportSet(0,0,GraphicsWidth(),GraphicsHeight())
		DrawImageRect Image,-2000,-2000,1,1
	'	Print "tRender : TextureRender_End OK"
		Return True
	End Function
	
'#################################################################################
Rem
bbdoc: Begin the Normal BackBuffer Rendering Process
End Rem
	Function BackBufferRender_Begin()
	?Win32
		If DX Then 
			PrimaryDevice.Device.SetRenderTarget PrimaryDevice.backbuffer,0
		Else
	?		
		'	If GLFrame <> Null Then glBindTexture GL_TEXTURE_2D,GLFrame.name
	?Win32
		EndIf
	?
		ViewportSet(0,0,GraphicsWidth(),GraphicsHeight())
	'	Print "tRender : BackBufferRender_Begin OK"
		Return True
	End Function
	
'#################################################################################
Rem
bbdoc: End the Normal BackBuffer Rendering process
about: 
This Must be called when you have finished rendering to the BackBuffer and Before the Flip Command.
End Rem	
	Function BackBufferRender_End()
	?Win32
		If DX
			PrimaryDevice.Device.EndScene()
		Else
	?
			glBindTexture GL_TEXTURE_2D,0
	?Win32
		EndIf
	?
	'	Print "tRender : BackBufferRender_End OK"
		Return True
	End Function
	
'#################################################################################
		

End Type

Well, first question about the license.. where is it?

I have it (from precompiled 1.18 version) ... its the "default" non-waranty license should should be able to find on license page.

ie: the code is licensed to you but still owned by Tim, no waranty in case of damage etc ... Most likely the same as any application either has as license or as some explicit EULA paragraphs.

Thanks for the code Tim. Much appreciated as always.

Hi Tim,
This doesn't look right...

Strict

Import Indiepath.Render2Texture

HideMouse()
'SetGraphicsDriver GLMax2DDriver()
Graphics 512,512

tRender.Initialise()

Local myImage:TImage = tRender.Create(256,256)
Local image:TImage=LoadImage("max.png")
Delay (500)
' Do Normal Render to Backbuffer

Local ms=MilliSecs()

tRender.BackBufferRender_Begin()
	Cls
	DrawImage image , 0 , 0
	SetColor 255,0,0
	DrawRect 100 , 100 , 100 , 100
	SetColor 255,255,255
tRender.BackBufferRender_End()	

Flip 0

Print MilliSecs()-ms

WaitKey()
Cls

' Do Render To Texture Then draw Textured image on screen

ms=MilliSecs()

tRender.TextureRender_Begin(myImage)
	Cls
	DrawImage image , 0 , 0
	SetColor 255,0,0
	DrawRect 100 , 100 , 100 , 100
	SetColor 255,255,255
tRender.TextureRender_End()

SetColor 255,255,255

tRender.BackBufferRender_Begin()
	Cls
  	DrawImage myImage,20,0
tRender.BackBufferRender_End()

Flip 0

Print MilliSecs()-ms

WaitKey()

The render-to-texture image size is reduced.

Thats great news. now i have the source to all modules i use :)

TextureRender_Begin has a viewport flag. As a default the viewport is always resized to the size of the render texture. This is a true viewport and as such will re-scale all the GFX to fit within the image bounds.

OK, tried it and it works. Thanks

Hi, anyone know how to fix it?
I can't clean the texture before draw in it (in real size).

edit: solved, using rects instead whole buffer (null).

Strict

Import Indiepath.Render2Texture

SetGraphicsDriver D3D7Max2DDriver()
Graphics 640,480,0
SetBlend(ALPHABLEND)
tRender.Initialise()

Local image:TImage=LoadImage("bmax160_2.png")
MidHandleImage(image)

Local myImage1:TImage = tRender.Create(256,256)
Local myImage2:TImage = tRender.Create(256,256)

Local rot:Int,x:Int,y:Int

Repeat
rot:+1
If rot>10 Then rot=0; x=Rand(100,400); y=Rand(100,400)


tRender.TextureRender_Begin(myImage1,0) 'fit to the screen size
	tRender.Cls($90FF0000)
	DrawImage image,x,y
tRender.TextureRender_End()

tRender.TextureRender_Begin(myImage2,1) 'fit to the image size
	tRender.Cls($900000FF)
	DrawImage image,x,y
tRender.TextureRender_End()


tRender.BackBufferRender_Begin()
	tRender.Cls($FF000000)
	SetScale 10,10
	DrawText "********",0,0
	DrawText "********",0,130
	SetScale 1,1
  	DrawImage myImage1,0,0
  	DrawImage myImage2,320,0
tRender.BackBufferRender_End()

Flip

Until KeyHit(KEY_ESCAPE)

K, I've got problems on when I try to use this on a canvas. I get an unhandled memory exception error when I try to switch to a different graphics canvas in my windowed program. So I SetGraphics CanvasGraphics(), then tRender.Initialise, then do my drawing to an image, and when I'm done, display it on one canvas, then switch canvas to update another image (which isn't using the render2texture capabilities) and right when it tries to SetGraphics again ... error. Please help! Thanks.

That does not work.
The initialisation is special, the image are no BM images and can not be transfered. They are lost if the context is shut down.

You would need to copy the render texture content to a regular image if you want to use it on a different canvas.

Ok, thanks for the info! I may have a better way of doing it, but only time (and my lack of skill) will tell :D Thank again.