cl-glut pre-study <page 7>
さて、ここも一気にいってみよう。
レッスン２１．光を当ててみる
;; ;; lesson21 <shading> ;; ----------------------------------------------------------------------------------------------- (defparameter *vertex* #(#(0.0 0.0 0.0) #(1.0 0.0 0.0) #(1.0 1.0 0.0) #(0.0 1.0 0.0) #(0.0 0.0 1.0) #(1.0 0.0 1.0) #(1.0 1.0 1.0) #(0.0 1.0 1.0))) (defparameter *face* '((#(0 1 2 3) #(0 0 -1)) (#(1 5 6 2) #(1 0 0)) (#(5 4 7 6) #(0 0 1)) (#(4 0 3 7) #(-1 0 0)) (#(4 5 1 0) #(0 -1 0)) (#(3 2 6 7) #(0 1 0)))) (defun draw-figure (vertex face) (labels ((set-normal (n) (gl:normal (aref n 0) (aref n 1) (aref n 2))) (set-vertex (index) (let ((v (aref vertex index))) (gl:vertex (aref v 0) (aref v 1) (aref v 2)))) (draw-face (vertex-indices normal) (gl:begin :quads) (set-normal normal) (map nil #'set-vertex vertex-indices) (gl:end))) (map nil #'(lambda (x) (draw-face (first x) (second x))) face))) (defvar *r* 0) ; angle (defvar *p* 5.0) ; lookat (defvar *flag* t) ; rotation flag (defvar *toggle* t) ;toggle switch ;; Set window class (defclass Window (glut:window) ((fullscreen :initarg :fullscreen :reader fullscreen-p)) (:default-initargs :pos-x 100 :pos-y 100 :width 500 :height 500 :fullscreen nil :mode '(:double :rgb) :title "cube-test")) ;; Init (defmethod glut:display-window :before ((window Window)) (gl:clear-color 1 1 1 1) ; set white (gl:enable :depth-test) ; enable depth testing (gl:cull-face :front) ; cullface (gl:enable :lighting :light0) ; (when (fullscreen-p window) ; check to see if fullscreen needed (glut:full-screen))) ; if so, then tell GLUT ;; View port (defmethod glut:reshape ((window Window) width height) (gl:viewport 0 0 width height) (gl:matrix-mode :projection) (gl:load-identity) (glu:perspective 30.0 (/ width height) 1.0 100.0) (gl:matrix-mode :modelview)) ; idle (defmethod glut:idle ((window Window)) ;; user idling process (sleep (/ 1.0 60.0)) (glut:post-redisplay)) ;; mouse (defmethod glut:mouse ((window Window) button state x y) (declare (ignore x y)) (case button (:RIGHT-BUTTON (if (eql state :DOWN) (progn (setf *flag* t) (glut:enable-event window :idle)) (glut:disable-event window :idle))) (:MIDDLE-BUTTON (if (eql state :DOWN) (glut:post-redisplay))) (:LEFT-BUTTON (if (eql state :DOWN) (progn (setf *flag* nil) (glut:enable-event window :idle)) (glut:disable-event window :idle))))) ;; mouse-wheel (defmethod glut:mouse-wheel ((window Window) wheel direction x y) (declare (ignore x y)) (case direction (:wheel-down (progn (incf *p* 0.2) (when (>= *p* 9.8) (setf *p* 9.8)) (glut:post-redisplay))) (otherwise (progn (decf *p* 0.2) (when (<= *p* 0.2) (setf *p* 0.2)) (glut:post-redisplay))))) ;; Keyboard (defmethod glut:keyboard ((window Window) key x y) (declare (ignore x y)) (case key ((#\q #\Q) ; q, Q --> exit (glut:destroy-current-window)) ((#\f #\F) ; f, F --> full or windowed (if (eql *toggle* t) (progn (setf *toggle* nil) (glut:full-screen)) (progn (setf *toggle* t) (glut:position-window 100 100) ; initial position (glut:reshape-window 500 500)))))) ; initial width height ;; Display (defmethod glut:display ((window Window)) (gl:clear :color-buffer-bit :depth-buffer-bit) ; clear buffer and set depth buffer (gl:load-identity) (glu:look-at 3.0 4.0 *p* 0.0 0.0 0.0 0.0 1.0 0.0) (gl:rotate *r* 0.0 1.0 0.0) ;; cube (gl:scale 1 1 1) ; x,y,z same scale (draw-figure *vertex* *face*) (glut:swap-buffers) (if (eql *flag* t) (incf *r*) ; right rotation (decf *r*)) ; left rotation (cond ((>= *r* 360) (setf *r* 0)) ((<= *r* 0) (setf *r* 360)))) ;; Main (defun lesson21 () (glut:display-window (make-instance 'Window))) ; create window (lesson21)
レッスン２２．光源を設定する
;; ;; lesson22 <set the light> ;; ----------------------------------------------------------------------------------------------- (defparameter *vertex* #(#(0.0 0.0 0.0) #(1.0 0.0 0.0) #(1.0 1.0 0.0) #(0.0 1.0 0.0) #(0.0 0.0 1.0) #(1.0 0.0 1.0) #(1.0 1.0 1.0) #(0.0 1.0 1.0))) (defparameter *face* '((#(0 1 2 3) #(0 0 -1)) (#(1 5 6 2) #(1 0 0)) (#(5 4 7 6) #(0 0 1)) (#(4 0 3 7) #(-1 0 0)) (#(4 5 1 0) #(0 -1 0)) (#(3 2 6 7) #(0 1 0)))) (defun draw-figure (vertex face) (labels ((set-normal (n) (gl:normal (aref n 0) (aref n 1) (aref n 2))) (set-vertex (index) (let ((v (aref vertex index))) (gl:vertex (aref v 0) (aref v 1) (aref v 2)))) (draw-face (vertex-indices normal) (gl:begin :quads) (set-normal normal) (map nil #'set-vertex vertex-indices) (gl:end))) (map nil #'(lambda (x) (draw-face (first x) (second x))) face))) (defvar *r* 0) ; angle (defvar *p* 5.0) ; lookat (defvar *flag* t) ; rotation flag (defvar *toggle* t) ;toggle switch (defvar *pos0* '(0.0 3.0 5.0 1.0)) ; light0pos (defvar *pos1* '(5.0 3.0 0.0 1.0)) ; light1pos (defvar *green* '(0.0 1.0 0.0 1.0)) ; green ;; Set window class (defclass Window (glut:window) ((fullscreen :initarg :fullscreen :reader fullscreen-p)) (:default-initargs :pos-x 100 :pos-y 100 :width 500 :height 500 :fullscreen nil :mode '(:double :rgb) :title "cube-test")) ;; Init (defmethod glut:display-window :before ((window Window)) (gl:clear-color 1 1 1 1) ; set white (gl:enable :depth-test) ; enable depth testing (gl:cull-face :front) ; cullface (gl:enable :lighting :light0) ; light0 (gl:enable :lighting :light1) ; light1 (when (fullscreen-p window) ; check to see if fullscreen needed (glut:full-screen))) ; if so, then tell GLUT ;; View port (defmethod glut:reshape ((window Window) width height) (gl:viewport 0 0 width height) (gl:matrix-mode :projection) (gl:load-identity) (glu:perspective 30.0 (/ width height) 1.0 100.0) (gl:matrix-mode :modelview)) ; idle (defmethod glut:idle ((window Window)) ;; user idling process (sleep (/ 1.0 60.0)) (glut:post-redisplay)) ;; mouse (defmethod glut:mouse ((window Window) button state x y) (declare (ignore x y)) (case button (:RIGHT-BUTTON (if (eql state :DOWN) (progn (setf *flag* t) (glut:enable-event window :idle)) (glut:disable-event window :idle))) (:MIDDLE-BUTTON (if (eql state :DOWN) (glut:post-redisplay))) (:LEFT-BUTTON (if (eql state :DOWN) (progn (setf *flag* nil) (glut:enable-event window :idle)) (glut:disable-event window :idle))))) ;; mouse-wheel (defmethod glut:mouse-wheel ((window Window) wheel direction x y) (declare (ignore x y)) (case direction (:wheel-down (progn (incf *p* 0.2) (when (>= *p* 9.8) (setf *p* 9.8)) (glut:post-redisplay))) (otherwise (progn (decf *p* 0.2) (when (<= *p* 0.2) (setf *p* 0.2)) (glut:post-redisplay))))) ;; Keyboard (defmethod glut:keyboard ((window Window) key x y) (declare (ignore x y)) (case key ((#\q #\Q) ; q, Q --> exit (glut:destroy-current-window)) ((#\f #\F) ; f, F --> full or windowed (if (eql *toggle* t) (progn (setf *toggle* nil) (glut:full-screen)) (progn (setf *toggle* t) (glut:position-window 100 100) ; initial position (glut:reshape-window 500 500)))))) ; initial width height ;; Display (defmethod glut:display ((window Window)) (gl:clear :color-buffer-bit :depth-buffer-bit) ; clear buffer and set depth buffer (gl:load-identity) (glu:look-at 3.0 4.0 *p* 0.0 0.0 0.0 0.0 1.0 0.0) (gl:light :light0 :position *pos0*) (gl:light :light1 :position *pos1*) (gl:light :light1 :diffuse *green*) (gl:light :light1 :specular *green*) (gl:rotate *r* 0.0 1.0 0.0) ;; cube (gl:scale 1 1 1) ; x,y,z same scale (draw-figure *vertex* *face*) (glut:swap-buffers) (if (eql *flag* t) (incf *r*) ; right rotation (decf *r*)) ; left rotation (cond ((>= *r* 360) (setf *r* 0)) ((<= *r* 0) (setf *r* 360)))) ;; Main (defun lesson22 () (glut:display-window (make-instance 'Window))) ; create window (lesson22)
レッスン２３．材質を設定する
;; ;; lesson23 <set the material> ;; ----------------------------------------------------------------------------------------------- (defparameter *vertex* #(#(0.0 0.0 0.0) #(1.0 0.0 0.0) #(1.0 1.0 0.0) #(0.0 1.0 0.0) #(0.0 0.0 1.0) #(1.0 0.0 1.0) #(1.0 1.0 1.0) #(0.0 1.0 1.0))) (defparameter *face* '((#(0 1 2 3) #(0 0 -1)) (#(1 5 6 2) #(1 0 0)) (#(5 4 7 6) #(0 0 1)) (#(4 0 3 7) #(-1 0 0)) (#(4 5 1 0) #(0 -1 0)) (#(3 2 6 7) #(0 1 0)))) (defun draw-figure (vertex face) (labels ((set-normal (n) (gl:normal (aref n 0) (aref n 1) (aref n 2))) (set-vertex (index) (let ((v (aref vertex index))) (gl:vertex (aref v 0) (aref v 1) (aref v 2)))) (draw-face (vertex-indices normal) (gl:begin :quads) (set-normal normal) (map nil #'set-vertex vertex-indices) (gl:end))) (map nil #'(lambda (x) (draw-face (first x) (second x))) face))) (defvar *r* 0) ; angle (defvar *p* 5.0) ; lookat (defvar *flag* t) ; rotation flag (defvar *toggle* t) ;toggle switch (defvar *pos0* '(0.0 3.0 5.0 1.0)) ; light0pos (defvar *pos1* '(5.0 3.0 0.0 1.0)) ; light1pos (defvar *green* '(0.0 1.0 0.0 1.0)) ; green (defvar *red* '(0.8 0.2 0.2 1.0)) ; red ;; Set window class (defclass Window (glut:window) ((fullscreen :initarg :fullscreen :reader fullscreen-p)) (:default-initargs :pos-x 100 :pos-y 100 :width 500 :height 500 :fullscreen nil :mode '(:double :rgb) :title "cube-test")) ;; Init (defmethod glut:display-window :before ((window Window)) (gl:clear-color 1 1 1 1) ; set white (gl:enable :depth-test) ; enable depth testing (gl:cull-face :front) ; cullface (gl:enable :lighting :light0) ; light0 (gl:enable :lighting :light1) ; light1 (when (fullscreen-p window) ; check to see if fullscreen needed (glut:full-screen))) ; if so, then tell GLUT ;; View port (defmethod glut:reshape ((window Window) width height) (gl:viewport 0 0 width height) (gl:matrix-mode :projection) (gl:load-identity) (glu:perspective 30.0 (/ width height) 1.0 100.0) (gl:matrix-mode :modelview)) ; idle (defmethod glut:idle ((window Window)) ;; user idling process (sleep (/ 1.0 60.0)) (glut:post-redisplay)) ;; mouse (defmethod glut:mouse ((window Window) button state x y) (declare (ignore x y)) (case button (:RIGHT-BUTTON (if (eql state :DOWN) (progn (setf *flag* t) (glut:enable-event window :idle)) (glut:disable-event window :idle))) (:MIDDLE-BUTTON (if (eql state :DOWN) (glut:post-redisplay))) (:LEFT-BUTTON (if (eql state :DOWN) (progn (setf *flag* nil) (glut:enable-event window :idle)) (glut:disable-event window :idle))))) ;; mouse-wheel (defmethod glut:mouse-wheel ((window Window) wheel direction x y) (declare (ignore x y)) (case direction (:wheel-down (progn (incf *p* 0.2) (when (>= *p* 9.8) (setf *p* 9.8)) (glut:post-redisplay))) (otherwise (progn (decf *p* 0.2) (when (<= *p* 0.2) (setf *p* 0.2)) (glut:post-redisplay))))) ;; Keyboard (defmethod glut:keyboard ((window Window) key x y) (declare (ignore x y)) (case key ((#\q #\Q) ; q, Q --> exit (glut:destroy-current-window)) ((#\f #\F) ; f, F --> full or windowed (if (eql *toggle* t) (progn (setf *toggle* nil) (glut:full-screen)) (progn (setf *toggle* t) (glut:position-window 100 100) ; initial position (glut:reshape-window 500 500)))))) ; initial width height (defun cube () (gl:scale 1 1 1) ; x,y,z same scale (draw-figure *vertex* *face*)) ;; Display (defmethod glut:display ((window Window)) (gl:clear :color-buffer-bit :depth-buffer-bit) ; clear buffer and set depth buffer (gl:load-identity) (glu:look-at 3.0 4.0 *p* 0.0 0.0 0.0 0.0 1.0 0.0) (gl:light :light0 :position *pos0*) (gl:light :light1 :position *pos1*) (gl:light :light1 :diffuse *green*) (gl:light :light1 :specular *green*) (gl:push-matrix) ; store matrix (gl:rotate *r* 0.0 1.0 0.0) (gl:material :front-and-back :ambient-and-diffuse *red*) (cube) ; set cube (gl:pop-matrix) (glut:swap-buffers) (if (eql *flag* t) (incf *r*) ; right rotation (decf *r*)) ; left rotation (cond ((>= *r* 360) (setf *r* 0)) ((<= *r* 0) (setf *r* 360)))) ;; Main (defun lesson23 () (glut:display-window (make-instance 'Window))) ; create window (lesson23)
レッスン２４．階層構造
;; ;; lesson24 <hierarchical structure> ;; ----------------------------------------------------------------------------------------------- (defparameter *vertex* #(#(0.0 0.0 0.0) #(1.0 0.0 0.0) #(1.0 1.0 0.0) #(0.0 1.0 0.0) #(0.0 0.0 1.0) #(1.0 0.0 1.0) #(1.0 1.0 1.0) #(0.0 1.0 1.0))) (defparameter *face* '((#(0 1 2 3) #(0 0 -1)) (#(1 5 6 2) #(1 0 0)) (#(5 4 7 6) #(0 0 1)) (#(4 0 3 7) #(-1 0 0)) (#(4 5 1 0) #(0 -1 0)) (#(3 2 6 7) #(0 1 0)))) (defun draw-figure (vertex face) (labels ((set-normal (n) (gl:normal (aref n 0) (aref n 1) (aref n 2))) (set-vertex (index) (let ((v (aref vertex index))) (gl:vertex (aref v 0) (aref v 1) (aref v 2)))) (draw-face (vertex-indices normal) (gl:begin :quads) (set-normal normal) (map nil #'set-vertex vertex-indices) (gl:end))) (map nil #'(lambda (x) (draw-face (first x) (second x))) face))) (defvar *r* 0) ; angle (defvar *p* 5.0) ; lookat (defvar *flag* t) ; rotation flag (defvar *toggle* t) ;toggle switch (defvar *pos0* '(0.0 3.0 5.0 1.0)) ; light0pos (defvar *pos1* '(5.0 3.0 0.0 1.0)) ; light1pos (defvar *green* '(0.0 1.0 0.0 1.0)) ; green (defvar *red* '(0.8 0.2 0.2 1.0)) ; red (defvar *blue* '(0.2 0.2 0.8 1.0)) ; blue ;; Set window class (defclass Window (glut:window) ((fullscreen :initarg :fullscreen :reader fullscreen-p)) (:default-initargs :pos-x 100 :pos-y 100 :width 500 :height 500 :fullscreen nil :mode '(:double :rgb) :title "cube-test")) ;; Init (defmethod glut:display-window :before ((window Window)) (gl:clear-color 1 1 1 1) ; set white (gl:enable :depth-test) ; enable depth testing (gl:cull-face :front) ; cullface (gl:enable :lighting :light0) ; light0 (gl:enable :lighting :light1) ; light1 (when (fullscreen-p window) ; check to see if fullscreen needed (glut:full-screen))) ; if so, then tell GLUT ;; View port (defmethod glut:reshape ((window Window) width height) (gl:viewport 0 0 width height) (gl:matrix-mode :projection) (gl:load-identity) (glu:perspective 30.0 (/ width height) 1.0 100.0) (gl:matrix-mode :modelview)) ; idle (defmethod glut:idle ((window Window)) ;; user idling process (sleep (/ 1.0 60.0)) (glut:post-redisplay)) ;; mouse (defmethod glut:mouse ((window Window) button state x y) (declare (ignore x y)) (case button (:RIGHT-BUTTON (if (eql state :DOWN) (progn (setf *flag* t) (glut:enable-event window :idle)) (glut:disable-event window :idle))) (:MIDDLE-BUTTON (if (eql state :DOWN) (glut:post-redisplay))) (:LEFT-BUTTON (if (eql state :DOWN) (progn (setf *flag* nil) (glut:enable-event window :idle)) (glut:disable-event window :idle))))) ;; mouse-wheel (defmethod glut:mouse-wheel ((window Window) wheel direction x y) (declare (ignore x y)) (case direction (:wheel-down (progn (incf *p* 0.2) (when (>= *p* 9.8) (setf *p* 9.8)) (glut:post-redisplay))) (otherwise (progn (decf *p* 0.2) (when (<= *p* 0.2) (setf *p* 0.2)) (glut:post-redisplay))))) ;; Keyboard (defmethod glut:keyboard ((window Window) key x y) (declare (ignore x y)) (case key ((#\q #\Q) ; q, Q --> exit (glut:destroy-current-window)) ((#\f #\F) ; f, F --> full or windowed (if (eql *toggle* t) (progn (setf *toggle* nil) (glut:full-screen)) (progn (setf *toggle* t) (glut:position-window 100 100) ; initial position (glut:reshape-window 500 500)))))) ; initial width height (defun cube () ;(gl:with-pushed-matrix (gl:scale 1 1 1) ; x,y,z same scale (draw-figure *vertex* *face*)) ;; Display (defmethod glut:display ((window Window)) (gl:clear :color-buffer-bit :depth-buffer-bit) ; clear buffer and set depth buffer (gl:load-identity) (glu:look-at 3.0 4.0 *p* 0.0 0.0 0.0 0.0 1.0 0.0) (gl:light :light0 :position *pos0*) (gl:light :light1 :position *pos1*) (gl:light :light1 :diffuse *green*) (gl:light :light1 :specular *green*) (gl:push-matrix) ; store matrix (gl:rotate *r* 0.0 1.0 0.0) (gl:material :front-and-back :ambient-and-diffuse *red*) (cube) ; set first cube (gl:push-matrix) (gl:translate 1.0 1.0 1.0) (gl:rotate (* 2 *r*) 0.0 1.0 0.0) ; double speed (gl:material :front-and-back :ambient-and-diffuse *blue*) (cube) ; set second cube (gl:pop-matrix) (gl:pop-matrix) (glut:swap-buffers) (if (eql *flag* t) (incf *r*) ; right rotation (decf *r*)) ; left rotation (cond ((>= *r* 360) (setf *r* 0)) ((<= *r* 0) (setf *r* 360)))) ;; Main (defun lesson24 () (glut:display-window (make-instance 'Window))) ; create window (lesson24)
プレスタディーとしてはこんなもんかな。
