; Basic example of the use of the Cg runtime in a simple OpenGL program.
;
; This demo originated from examples/runtime_ogl_vertex_fragment/ in the Cg
; distribution. It was ported to Gauche by Issac Trotts in 2005.
;
; The port involved some changes.
; The function cgSetErrorCallback is
; not explicitly called, since the Gauche Cg binding automatically
; sets things up to generate an informative exception whenever a Cg
; error occurs.
; The vertex program and fragment program are
; kept in this file as strings rather than in separate files.
; Scheme's nice handling of multiline literal strings makes this a
; reasonable thing to do, though it does seem to play havoc on
; syntax highlighting in emacs and Vim.
; The computation of the checkerboard was made more efficient to avoid a long
; wait at startup.
; A display list was added to minimize the amount of traffic on the bus, in the hope
; that the occasional slow-downs would go away. This didn't really work as well
; as I had hoped. The C version doesn't seem to have this problem, at least not
; as bad, so I guess it has something to do with garbage collection turning on from
; time to time.
;
; -ijt
; Here is the original copyright notice:
;
; Copyright NVIDIA Corporation 2002
; TO THE MAXIMUM EXTENT PERMITTED BY APPLICABLE LAW THIS SOFTWARE IS PROVIDED
; *AS IS* AND NVIDIA AND ITS SUPPLIERS DISCLAIM ALL WARRANTIES EITHER EXPRESS
; OR IMPLIED INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
; AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL NVIDIA OR ITS SUPPLIERS
; BE LIABLE FOR ANY SPECIAL INCIDENTAL INDIRECT OR CONSEQUENTIAL DAMAGES
; WHATSOEVER (INCLUDING WITHOUT LIMITATION DAMAGES FOR LOSS OF BUSINESS PROFITS
; BUSINESS INTERRUPTION LOSS OF BUSINESS INFORMATION OR ANY OTHER PECUNIARY LOSS)
; ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE EVEN IF NVIDIA HAS
; BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
(use gl)
(use gl.glut)
(use gl.math3d)
(use gl.cg)
(use gauche.sequence)
(use gauche.uvector)
(use gauche.array)
(define *context* #f)
;; Choose the vertex and fragment profiles to use. Try to use
;; CG_PROFILE_ARBVFP1 and CG_PROFILE_ARBFP1 depending on hardware support.
;; If those aren't available fall back to CG_PROFILE_VP30 and
;; CG_PROFILE_FP30 respectively.
(define *vertex-profile* #f)
(define *fragment-profile* #f)
(define *vertex-program-string*
"
void main(float4 Pobject : POSITION,
float3 Nobject : NORMAL,
float2 TexUV : TEXCOORD0,
float3 diffuse : TEXCOORD1,
float3 specular : TEXCOORD2,
uniform float4x4 ModelViewProj,
uniform float4x4 ModelView,
uniform float4x4 ModelViewIT,
out float4 HPosition : POSITION,
out float3 Peye : TEXCOORD0,
out float3 Neye : TEXCOORD1,
out float2 uv : TEXCOORD2,
out float3 Kd : COLOR0,
out float3 Ks : COLOR1)
{
// compute homogeneous position of vertex for rasterizer
HPosition = mul(ModelViewProj, Pobject);
// transform position and normal from model-space to view-space
Peye = mul(ModelView, Pobject).xyz;
Neye = mul(ModelViewIT, float4(Nobject, 0)).xyz;
// pass uv, Kd, and Ks through unchanged; if they are varying
// per-vertex, however, they'll be interpolated before being
// passed to the fragment program.
uv = TexUV;
Kd = diffuse;
Ks = specular;
}
")
(define *fragment-program-string*
"
// Utility functions that return the appropriate components from the vector
// of lighting coefficients returned by the standard library lighting
// funciton, lit().
half diffuse(half4 l) { return l.y; }
half specular(half4 l) { return l.z; }
// Main shader.
half4 main(float3 Peye : TEXCOORD0,
half3 Neye : TEXCOORD1,
half2 uv : TEXCOORD2,
half3 Kd : COLOR0,
half3 Ks : COLOR1,
uniform sampler2D diffuseMap,
uniform float3 Plight,
uniform half3 lightColor,
uniform half3 shininess) : COLOR
{
// Normalize surface normal, vector to light source, and vector
// to the viewer
half3 N = normalize(Neye);
half3 L = normalize(Plight - Peye);
half3 V = normalize(-Peye);
// Compute half-angle vector for specular lighting
half3 H = normalize(L + V);
// Compute lighting values. lit() returns the diffuse coefficient
// in y (or zero, if NdotL < 0), and the specular coefficient in z
// (or zero, also if NdotL < 0).
half NdotL = dot(N, L), NdotH = dot(N, H);
half4 lighting = lit(NdotL, NdotH, shininess);
// Compute overall color for the fragment. Scale sum of diffuse
// and specular contributions together and by the light color.
half tmp = (half)tex2D(diffuseMap, uv).x;
half3 tmp3 = half3(tmp,tmp,tmp);
// half eps = 0.005;
// half tmp = 0.5*(1.0+sin(16*3.1415927*uv.x)*sin(16*3.1415927*uv.y));
// tmp = tmp < (0.5-eps) ? 0.1 : (tmp > 0.5+eps) ? 0.7 : 0.5;
// half3 tmp3 = half3(tmp,tmp,tmp);
half3 C = lightColor *
(diffuse(lighting) * Kd * tmp3 +
specular(lighting) * Ks);
// Here is a way to do ad-hoc antialiasing by turning on alpha-blending
// wherever the normal is roughly perpendicular to the viewing vector.
// -ijt
// half epsz = 0.2;
// return half4(C, abs(N.z)<=epsz?0.2:1.0);
return half4(C, 1); // Set the alpha value to 1.
}
")
(define *vertex-program* #f)
(define *fragment-program* #f)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Main program; do basic GLUT and Cg setup but leave most of the work
;; to the on-display() function.
(define (main args)
(glut-init args)
(glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGB GLUT_DEPTH GLUT_ALPHA))
(glut-init-window-size 512 512)
(glut-create-window "Cg checkered sphere demo")
(glut-keyboard-func keyboard)
(glut-display-func on-display)
(glut-main-loop)
0)
;; display callback function
(define on-display
(let ((have-initialized #f)
(cur-time 0))
(lambda ()
(if (not have-initialized)
(begin
;; Do one-time setup only once; setup Cg programs and textures
;; and set up Open-gL state.
(load-gpu-programs)
(load-textures)
(gl-enable GL_DEPTH_TEST)
(gl-enable GL_BLEND)
(gl-blend-func GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA)
(set! have-initialized #t)
))
;; The usual Open-gL stuff to clear the screen and set up viewing.
(gl-clear-color .25 .25 .25 1.)
(gl-clear (logior GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
(gl-matrix-mode GL_PROJECTION)
(gl-load-identity)
(glu-perspective 30. 1.0 .1 100)
(gl-matrix-mode GL_MODELVIEW)
(gl-load-identity)
(glu-look-at 4 4 -4 0 0 0 0 1 0)
;; Make the object rotate a bit each time the display function
;; is called
(gl-rotate (modulo cur-time 360) 0 1 0)
;; Now make sure that the vertex and fragment programs loaded
;; in Load-cg-programs) are bound.
(cg-gl-bind-program *vertex-program*)
(cg-gl-bind-program *fragment-program*)
;; Bind uniform parameters to vertex shader
(cg-gl-set-state-matrix-parameter
(cg-get-named-parameter *vertex-program* "ModelViewProj")
CG_GL_MODELVIEW_PROJECTION_MATRIX
CG_GL_MATRIX_IDENTITY)
(cg-gl-set-state-matrix-parameter
(cg-get-named-parameter *vertex-program* "ModelView")
CG_GL_MODELVIEW_MATRIX
CG_GL_MATRIX_IDENTITY)
(cg-gl-set-state-matrix-parameter
(cg-get-named-parameter *vertex-program* "ModelViewIT")
CG_GL_MODELVIEW_MATRIX
CG_GL_MATRIX_INVERSE_TRANSPOSE)
;; We can also go ahead and bind varying parameters to vertex shader
;; that we just want to have the same value for all vertices. The
;; vertex shader could be modified so that these were uniform for
;; better efficiency but this gives us flexibility for the future.
(cg-gl-set-parameter
(cg-get-named-parameter *vertex-program* "diffuse")
'#f32(.7 .2 .2))
(cg-gl-set-parameter
(cg-get-named-parameter *vertex-program* "specular")
'#f32(.9 .9 .9))
;; Now bind uniform parameters to fragment shader
(cg-gl-set-parameter
(cg-get-named-parameter *fragment-program* "Plight")
#,(vector4f 3 2 -3 1))
(cg-gl-set-parameter
(cg-get-named-parameter *fragment-program* "lightColor")
'#f32(1 1 1))
(cg-gl-set-parameter (cg-get-named-parameter *fragment-program* "shininess")
40)
;; And finally enable the approprate texture for fragment shader; the
;; texture was originally set up in load-textures).
(cg-gl-enable-texture-parameter
(cg-get-named-parameter *fragment-program* "diffuseMap"))
;; And go ahead and draw the scene geometry
(draw-geometry)
;; Disable the texture now that we're done with it.
(cg-gl-disable-texture-parameter
(cg-get-named-parameter *fragment-program* "diffuseMap"))
(glut-swap-buffers)
(inc! cur-time)
;; Force another display so that the object keeps moving
(glut-post-redisplay)
)))
(define GL_GENERATE_MIPMAP #x8191)
(define (load-textures)
;; There is only one texture needed here--we'll set up a basic
;; checkerboard--which is used to modulate the diffuse channel in the
;; fragment shader.
(let ((handle (ref (gl-gen-textures 1) 0)))
;; Basic Open-gL texture state setup
(gl-bind-texture GL_TEXTURE_2D handle)
(auto-generate-mipmaps! #t)
(gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR_MIPMAP_LINEAR)
(gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)
(gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP_TO_EDGE)
(gl-tex-parameter GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP_TO_EDGE)
;; Fill in the texture map.
(let* ((res 256)
(data (make-f32array (shape 0 res 0 res) 0.0))
(bleh (/ res 16)))
(dotimes (i res)
(dotimes (j res)
(if (= 0 (modulo (+ (floor (/ i bleh)) (floor (/ j bleh))) 2))
(array-set! data i j 0.1)
(array-set! data i j 0.7)
)))
(gl-tex-image-2d GL_TEXTURE_2D 0 GL_LUMINANCE res res 0 GL_LUMINANCE GL_FLOAT
(array->f32vector data))
;; Tell Cg which texture handle should be associated with the sampler2D
;; parameter to the fragment shader.
(cg-gl-set-texture-parameter
(cg-get-named-parameter *fragment-program* "diffuseMap")
handle)
)))
;; This seems inefficient. Is there a way to get a pointer to the start of the
;; array's memory so we can just hand it off to OpenGL or Cg? -ijt
(define (array->f32vector a)
(vector->f32vector (array->vector a)))
(define pi (imag-part (log -1.0)))
(define nu 60)
(define nv 60)
(define us (tabulate-array (shape 0 nu) (lambda (iu) (/ iu (- nu 1)))))
(define vs (tabulate-array (shape 0 nv) (lambda (iv) (/ iv (- nv 1)))))
(define uvs
(let ((uvs (make-f32array (shape 0 nu 0 nv 0 2) 0.0)))
(dotimes (iu nu)
(dotimes (iv nv)
(array-set! uvs iu iv 0 (array-ref us iu))
(array-set! uvs iu iv 1 (array-ref vs iv))
))
(array->f32vector uvs)))
(define thetas (array-map (cut * pi <>) us))
(define phis (array-map (cut * 2.0 pi <>) vs))
(define P ; points
(let ((xyz (make-f32array (shape 0 nu 0 nv 0 3) 0.0)))
(dotimes (iu nu)
(dotimes (iv nv)
(let* ((theta (array-ref thetas iu))
(phi (array-ref phis iv)))
(array-set! xyz iu iv 0 (* (sin theta) (sin phi)))
(array-set! xyz iu iv 1 (* (sin theta) (cos phi)))
(array-set! xyz iu iv 2 (* (cos theta))))))
(array->f32vector xyz)))
(define N P) ; normals
(define ntris (* 2 (- nu 1) (- nv 1)))
(define indices-per-tri 3)
(define indices
(let* ((indices (make-u32vector (* ntris indices-per-tri)))
(vert-index (lambda (iu iv) (+ iu (* iv nu))))
(k -1)
(set-next! (lambda (a b)
(u32vector-set! indices (inc! k) (vert-index a b)))))
(dotimes (iu (- nu 1))
(dotimes (iv (- nv 1))
(set-next! iu iv)
(set-next! (+ iu 1) iv)
(set-next! (+ iu 1) (+ iv 1))
(set-next! iu iv)
(set-next! (+ iu 1) (+ iv 1))
(set-next! iu (+ iv 1))
))
indices))
;; Geometry creation and drawing function; we'll just draw a sphere.
(define draw-geometry
(let ((first-time #t)
(display-list #f))
(lambda ()
;; Tell Cg which of these data pointers are associated with which
;; parameters to the vertex shader so that when we call
;; cg-gLEnable-client-state) and then gl-draw-elements) the shader
;; gets the right input information.
(if first-time
(begin
(cg-gl-set-parameter-pointer
(cg-get-named-parameter *vertex-program* "Pobject")
3 GL_FLOAT 0 P)
(cg-gl-set-parameter-pointer
(cg-get-named-parameter *vertex-program* "Nobject")
3 GL_FLOAT 0 N)
(cg-gl-set-parameter-pointer
(cg-get-named-parameter *vertex-program* "TexUV")
2 GL_FLOAT 0 uvs)
;; In an earlier version of the ported demo, I was passing
;; in (array->f32vector uvs) since uvs was an array.
;; This produced undesired results because the temporary f32vector
;; was then garbage collected after a few seconds.
(set! first-time #f)))
(let ((names (list "Pobject" "Nobject" "TexUV")))
;; Enable the bindings to the parameters
(for-each
(lambda (name)
(cg-gl-enable-client-state
(cg-get-named-parameter *vertex-program* name)))
names)
;; Enable the texture parameter as well.
(cg-gl-enable-texture-parameter
(cg-get-named-parameter *fragment-program* "diffuseMap"))
;; And now draw the geometry.
(cond
(display-list (gl-call-list display-list))
(else
(set! display-list (gl-gen-lists 1))
(gl-new-list display-list GL_COMPILE_AND_EXECUTE)
(gl-draw-elements GL_TRIANGLES indices)
(gl-end-list)
))
;; Be a good citizen and disable the various bindings we set up above.
(for-each
(lambda (name)
(cg-gl-disable-client-state
(cg-get-named-parameter *vertex-program* name)))
names)
(cg-gl-disable-texture-parameter
(cg-get-named-parameter *fragment-program* "diffuseMap"))
))))
(define (keyboard key x y)
(let ((ikey (if (char? key)
(char->integer key)
key)))
(case key
(('q' 'Q' #\escape)
(cg-destroy-context *context*)
(exit 0)))))
(define (load-gpu-programs)
(set! *context* (cg-create-context))
(set! *vertex-profile*
(cond
((cg-gl-is-profile-supported CG_PROFILE_ARBVP1) CG_PROFILE_ARBVP1)
((cg-gl-is-profile-supported CG_PROFILE_VP30) CG_PROFILE_VP30)
(else
(error "Neither arbvp1 or vp30 vertex profiles supported on this system."))))
(set! *fragment-profile*
(cond
((cg-gl-is-profile-supported CG_PROFILE_ARBFP1) CG_PROFILE_ARBFP1)
((cg-gl-is-profile-supported CG_PROFILE_FP30) CG_PROFILE_FP30)
(else
(error "Neither arbfp1 nor fp30 fragment profiles supported"))))
(set! *vertex-program* (cg-create-program *context*
CG_SOURCE *vertex-program-string*
*vertex-profile* "main" '() ))
(set! *fragment-program* (cg-create-program *context* CG_SOURCE
*fragment-program-string*
*fragment-profile* "main" '() ))
(cg-compile-program *vertex-program*)
(cg-compile-program *fragment-program*)
(cg-gl-enable-profile *vertex-profile*)
(cg-gl-enable-profile *fragment-profile*)
(cg-gl-load-program *vertex-program*)
(cg-gl-load-program *fragment-program*)
)
