Update of /project/cells/cvsroot/cell-cultures/cellodemo In directory common-lisp.net:/tmp/cvs-serv12927/cellodemo Modified Files: cellodemo.lpr demo-window.lisp hedron-decoration.lisp hedron-render.lisp Log Message: Delete copy of celtic mainly Date: Tue Oct 19 05:47:33 2004 Author: ktilton Index: cell-cultures/cellodemo/cellodemo.lpr diff -u cell-cultures/cellodemo/cellodemo.lpr:1.3 cell-cultures/cellodemo/cellodemo.lpr:1.4 --- cell-cultures/cellodemo/cellodemo.lpr:1.3 Wed Sep 29 04:50:11 2004 +++ cell-cultures/cellodemo/cellodemo.lpr Tue Oct 19 05:47:33 2004 @@ -11,8 +11,8 @@ (make-instance 'module :name "tutor-geometry.lisp") (make-instance 'module :name "light-panel.lisp") (make-instance 'module :name "hedron-render.lisp") - (make-instance 'module :name - "hedron-decoration.lisp")) + (make-instance 'module :name "hedron-decoration.lisp") + (make-instance 'module :name "virtual-human.lisp")) :projects (list (make-instance 'project-module :name "..\\cello\\cello")) :libraries nil Index: cell-cultures/cellodemo/demo-window.lisp diff -u cell-cultures/cellodemo/demo-window.lisp:1.4 cell-cultures/cellodemo/demo-window.lisp:1.5 --- cell-cultures/cellodemo/demo-window.lisp:1.4 Fri Oct 15 05:37:30 2004 +++ cell-cultures/cellodemo/demo-window.lisp Tue Oct 19 05:47:33 2004 @@ -33,7 +33,7 @@ :focus (c-in nil) :display-continuous (c-in t) :clear-rgba (list 0 0 0 1) - :lb (c-in (downs 650))))) + :lb (c-in (downs 1000))))) (defun demo-scroller () (mk-part :demo-scroller (ix-zero-tl) @@ -118,8 +118,8 @@ (:close . "close-window")) :idler nil :ll 0 :lt 0 - :lr (c-in (scr2log 900)) - :lb (c-in (scr2log -900)) + :lr (c-in (scr2log 1000)) + :lb (c-in (scr2log -1500)) :fixed-lighting (list (make-instance 'light :id gl_light6 :enabled t Index: cell-cultures/cellodemo/hedron-decoration.lisp diff -u cell-cultures/cellodemo/hedron-decoration.lisp:1.3 cell-cultures/cellodemo/hedron-decoration.lisp:1.4 --- cell-cultures/cellodemo/hedron-decoration.lisp:1.3 Fri Oct 15 05:37:30 2004 +++ cell-cultures/cellodemo/hedron-decoration.lisp Tue Oct 19 05:47:33 2004 @@ -32,7 +32,7 @@ (mk-part :spinning (ct-check-text) :title$ "spinning") (mk-part :wireframe (ct-check-text) - :md-value (c-in nil) + :md-value (c-in t) :title$ "wireframe" :clipped nil :enabled t)) @@ -86,7 +86,7 @@ (a-row () (hedron-shapes) (test-image-group :shape-backer "Backdrops" "hedron-bkgs") - (test-image-group :shape-skin "Skin" "shapers" #+not "mandelbrot")) + (test-image-group :shape-skin "Skin" "shapers" "cloudy")) (hedron-texxing))))) (defun hedron-shapes () Index: cell-cultures/cellodemo/hedron-render.lisp diff -u cell-cultures/cellodemo/hedron-render.lisp:1.3 cell-cultures/cellodemo/hedron-render.lisp:1.4 --- cell-cultures/cellodemo/hedron-render.lisp:1.3 Fri Oct 15 05:37:30 2004 +++ cell-cultures/cellodemo/hedron-render.lisp Tue Oct 19 05:47:33 2004 @@ -58,43 +58,23 @@ (draw-test-nurb nurb)) (defparameter *hill* (make-ff-array :float 0 0 0 0 1 1 1 1)) -(defparameter *hill-controls* (make-ff-array :float -3.0 -3.0 -9 -3.0 -1.0 -9 -3.0 1.0 - -9 -3.0 3.0 -9 -1.0 -3.0 -9 -1.0 -1.0 9 -1.0 1.0 9 -1.0 - 3.0 -9 1.0 -3.0 -9 1.0 -1.0 9 1.0 1.0 9 1.0 3.0 -9 3.0 - -3.0 -9 3.0 -1.0 -9 3.0 1.0 -9 3.0 3.0 -9) - #+not (loop with fv = (fgn-alloc 'glfloat 48 :testnurb) - for u below 4 do - (loop for v below 4 - for base = (+ (* u 12) (* v 3)) - do (setf (eltf fv (+ base 0)) (* 2 (- u 1.5))) - (setf (eltf fv (+ base 1)) (* 2 (- v 1.5))) - (setf (eltf fv (+ base 2)) - (* 3 (if (and (or (eql u 1)(eql u 2)) - (or (eql v 1)(eql v 2))) - 3 -3)))) - finally (return fv))) - -(defparameter *dump-matrix* (fgn-alloc 'glfloat 16 :dump-matrix)) -(defun dump-matrix (matrix-id msg) - (gl-get-floatv matrix-id *dump-matrix*) - (format t "~&~a > ~a matrix> ~{~a ~}" msg - (cond ((eql matrix-id gl_modelview_matrix) 'modelview) - ((eql matrix-id GL_PROJECTION_MATRIX) 'projection)) - (loop for n below 16 collecting (eltf *dump-matrix* n)))) - -(defun dump-viewport ( msg) - (gl-get-floatv GL_VIEWPORT *dump-matrix*) - (format t "~&~a > viewport> ~{~a ~}" msg - (loop for n below 4 collecting (eltf *dump-matrix* n)))) - -;;;glGetFloatv(GL_MODELVIEW_MATRIX,modelview); -;;; glGetFloatv(GL_PROJECTION_MATRIX,projection); -;;; glGetIntegerv(GL_VIEWPORT,viewport); -;;; gluLoadSamplingMatrices (Nurb, modelview, projection, viewport); - +(defparameter *hill-controls* + (let ((m 3) (d 2)) + (loop with fv = (fgn-alloc 'glfloat 48 :testnurb) + for u below 4 do + (loop for v below 4 + for base = (+ (* u 12) (* v 3)) + do (setf (eltf fv (+ base 0)) (- (* m u) d)) + (setf (eltf fv (+ base 1)) (- (* m v) d)) + (setf (eltf fv (+ base 2)) + (* 3 (if (and (or (eql u 1)(eql u 2)) + (or (eql v 1)(eql v 2))) + d (- d))))) + finally (return fv)))) + (defun draw-test-nurb (nurb) - (glu-nurbs-property nurb glu_sampling_tolerance 5) - (glu-nurbs-property nurb glu_auto_load_matrix gl_false) + (glu-nurbs-property nurb glu_sampling_tolerance 1) + ;(glu-nurbs-property nurb glu_auto_load_matrix gl_false) (gl-enable gl_lighting) (gl-enable gl_light0) @@ -102,11 +82,23 @@ (gl-enable gl_auto_normal) (gl-enable gl_normalize) - (gl-rotatef 330 1 0 0) + ;(gl-rotatef 330 1 0 0) (gl-scalef .25 .25 .25) (glu-begin-surface nurb) (glu-nurbs-surface nurb 8 *hill* 8 *hill* 12 3 *hill-controls* 4 4 gl_map2_vertex_3) - (glu-end-surface nurb)) + (glu-end-surface nurb) + + (gl-point-size 5) + (gl-disable gl_lighting) + (gl-color3f 1 1 0) + (gl-begin gl_points) + (loop for u below 4 do + (loop for v below 4 + for base = (+ (* u 12) (* v 3)) + do (gl-vertex3f (eltf *hill-controls* (+ base 0)) + (eltf *hill-controls* (+ base 1)) + (eltf *hill-controls* (+ base 2))))) + (gl-end)) (defparameter *sponge-offset* (loop with fv = (fgn-alloc 'gldouble 3 :sponge) for n below 3 @@ -232,6 +224,6 @@ (gl-disable gl_texture_gen_r) (gl-disable gl_texture_gen_q) - (gl-matrix-mode gl_projection)) + #+hunh (gl-matrix-mode gl_projection)) (gl-matrix-mode gl_modelview))