' ------------------------------------------------------------
'   n3xt-D exemples
'
'   Sample  023   as   Procedural texture Test.
'   Historique   as 
'     29/03/09  19 as 16    TMyke
'
' ------------------------------------------------------------

' Includes libraries
#include "N3xtD.bi"

declare Sub Procedural(texture as NTexture)

' Dimes
Dim app As any Ptr
Dim Quit As Integer


'----------------------------------------------------------
' open n3xt-D screen
app = _CreateGraphics3D(800,600)
If app=NULL Then
  End
End If

 

'-----------------------------------------
' set ambient light
 _AmbientLight(&hffaaaaaa)


'-----------------------------------------
' Create a cube And set position
Dim cubemesh as Mesh = _CreateCubeMesh(1.0)
 ' first Method To texturing
 
Dim cube as EntityNode = _CreateEntityNode(cubemesh)
 _PositionNode(cube, 0,0,0) 

Dim material as NMaterial = _NodeMaterial(cube)
' Load texture
Dim tex as NTexture = _LoadTexture( "media/glass.bmp") 
' set texture in material 
  _TextureMaterial(material,  0, tex) 



'-----------------------------------------
' Create first  camera
dim cam as CameraNode = _CreateCameraFree( )
_PositionNode(cam, 0,1,-3)


' simple text inside the scene area 
_LoadFont("media/courriernew.png")
Dim font as IGUIFont = _GetFont()



'; ---------------------------------------
';           Main loop
'; ---------------------------------------
While Quit=0
 

' If Escape Key, Exit	
  If _GetKeyDown(KEY_ESCAPE) then
    Quit=1
  EndIf
   
  
  _TurnNode(cube, 0,1,0)
  
  ' move camera with dir key and mouse (left click)
  If _GetKeyDown(KEY_ARROW_UP) Then _MoveNode(cam, 0,0,1.0)
  If _GetKeyDown(KEY_ARROW_DOWN) Then _MoveNode(cam, 0,0,-1.0)
  If _GetMouseEvent(MOUSE_BUTTON_LEFT) Then _TurnNode(cam, _GetDeltaMouseY()/2.0 , _GetDeltaMouseX()/2.0 ,0)


  If _GetKeyUp(KEY_KEY_P) Then
    ' call procedural Function
     procedural(tex)
  EndIf


  	' ---------------
  	'      Render
  	' ---------------
  _BeginScene()
    _DrawScene()
    _DrawText(font, "Press P key for generate procedural texture",  10,10,0,0, &hffffff00)
  _EndScene()

Wend 
' end
_FreeEngine()


Sub Procedural(texture as NTexture)
  Dim wwidth as Integer,  height as Integer
  Dim Tex as Byte Ptr,	col as Integer
  
  ' lock texture And get the memory pointer of image buffer
  Tex = _LockTexture(texture)
  _TextureSize(texture, Varptr( wwidth), Varptr (height)) 

	' And go....
	Dim R as Single 
	If wwidth<height then
	    R=wwidth/2.0
     Else
      R=height/2.0
     EndIf

	For w as Integer = 0 To height-1

	  For h As Integer = 0 To  wwidth-1

         Dim c As Single = 0.0
				
		Dim dx as Single = h-R
		Dim dy as Single = w-R

		Dim rr as Single = Sqr( dx*dx + dy*dy )/R
				
		c = rr
		If rr>1.0 Then  c = 0.0

		dim c2 As Integer = c*255.0

		col =  &hff000000 or (c2 Shl 16) or (c2 Shl 8) Or 255
		poke integer, Tex,col
		Tex = Tex + 4

      Next
     Next

  ' Unloack texture
	_UnLockTexture(texture)
  ' regenerate mipmapping
  _MipMapLevelTexture(texture) 
End Sub
