cl-glut pre-study <page 9>
歩いてはいないが、グラウンド上を円形に滑るように動くプログラムは意外と簡単にできる。
しかし、マウスボタンの真ん中を押すと止まるだけなはずなのに、右ボタンと同様に少しずつ動くのはなんなのさ？
どこまちがえてんだろ？
BoxMan sliding！
;; ;; BoxMan sliding ;; ----------------------------------------------------------------------------------------------- (defvar *p* 1.0) ; lookat (defvar *flag* nil) ; rotation flag (defvar *toggle* t) ; toggle switch (defvar *angle* 0) ; angle on the ground (defun draw-figure (x y z 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 (* x (aref v 0)) (* y (aref v 1)) (* z (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))) (defun myBox (x y z) (let ((vertex #(#(-0.5 -1 -0.5) #( 0.5 -1 -0.5) #( 0.5 0.0 -0.5) #(-0.5 0.0 -0.5) #(-0.5 -1 0.5) #( 0.5 -1 0.5) #( 0.5 0.0 0.5) #(-0.5 0.0 0.5))) (face '((#(0 1 2 3) #(0.0 0.0 -1.0)) (#(1 5 6 2) #(1.0 0.0 0.0)) (#(5 4 7 6) #(0.0 0.0 1.0)) (#(4 0 3 7) #(-1.0 0.0 0.0)) (#(4 5 1 0) #(0.0 -1.0 0.0)) (#(3 2 6 7) #(0.0 1.0 0.0)))) (red '(0.8 0.2 0.2 1.0))) (gl:material :front :diffuse red) ; red (draw-figure x y z vertex face))) (defun armleg (girth length r1 r2) (gl:rotate r1 1.0 0.0 0.0) (myBox girth length girth) (gl:translate 0.0 (- -0.05 length) 0.0) (gl:rotate r2 1.0 0.0 0.0) (myBox girth length girth)) (defun myGround (height) (let ((ground #((0.6 0.6 0.6 1.0) (0.3 0.3 0.3 1.0))) (toggle 0) (j -5) (i -5)) (labels ((switch () (cond ((= toggle 0) (setf toggle 1)) ((= toggle 1) (setf toggle 0))))) (gl:begin :quads) (gl:normal 0.0 1.0 0.0) (dotimes (m 10) (dotimes (n 10) (gl:material :front :diffuse (aref ground toggle)) (gl:vertex i height j) (gl:vertex i height (+ j 1)) (gl:vertex (+ i 1) height (+ j 1)) (gl:vertex (+ i 1) height j) (switch) ; change toggle (incf i) (when (= i 5) (setf i -5) (switch))) ; change toggle (incf j)) (gl:end)))) ;; 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 :rgba) :title "BoxMan")) ;; Init (defmethod glut:display-window :before ((window Window)) (gl:clear-color 1.0 1.0 1.0 1.0) ; set white (gl:enable :depth-test) ; enable depth testing (gl:cull-face :front) ; cullface (gl:enable :lighting :light0) ; 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) ; make the whole window to viewport (gl:matrix-mode :projection) ; specifying the perspective transformation matrix (gl:load-identity) ; initialization of perspective transformation matrix (glu:perspective 30.0 (/ width height) 1.0 100.0) (gl:matrix-mode :modelview)) ; specification of the model view transformation matrix ;; idle (defmethod glut:idle ((window Window)) ;; user idling process (when (eql *flag* t) (sleep (/ 1.0 60.0)) (glut:post-redisplay))) ;; mouse (defmethod glut:mouse ((window Window) button state x y) (declare (ignore x y)) (case button (:LEFT-BUTTON (if (eql state :DOWN) (progn (setf *flag* t) (glut:enable-event window :idle)))) (:MIDDLE-BUTTON (if (eql state :DOWN) (progn (setf *flag* nil) (glut:disable-event window :idle)))) (:RIGHT-BUTTON (if (eql state :DOWN) (glut:post-redisplay))))) ;; 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 (#\ESC ; ESC --> exit (glut:destroy-current-window)) (#\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)) (let* ((lightpos '(3.0 4.0 5.0 1.0)) ; BoxMan parameter (ll1 0.0) ; left leg crotch angle (ll2 0.0) ; left leg knee angle (rl1 0.0) ; right leg crotch angle (rl2 0.0) ; right leg knee angle (la1 0.0) ; left arm shoulder angle (la2 0.0) ; left arm elbow angle (ra1 0.0) ; right arm shoulder angle (ra2 0.0) ; right arm elbow angle (px 0.0) ; position x (pz 0.0) ; position z (r 0.0) ; direction (h 0.0)) ; height from ground ; BoxMan direction (setf r (- (* (/ *angle* pi) 180))) ; BoxMan position (setf px (* (cos *angle*) 4)) (setf pz (* (sin *angle*) 4)) (incf *angle* 0.01) (if (>= *angle* (* pi 2)) (setf *angle* 0)) (gl:clear :color-buffer-bit :depth-buffer-bit) ; clear buffer (gl:load-identity) (gl:light :light0 :position lightpos) (glu:look-at 0.0 0.0 *p* 0.0 0.0 0.0 0.0 1.0 0.0) (gl:translate 0.0 0.0 -10.0) ; ground (myGround -1.8) ; position and direction (gl:translate px h pz) (gl:rotate r 0.0 1.0 0.0) ; BoxMan's direction ; head (myBox 0.20 0.25 0.22) ; body (gl:translate 0.0 -0.3 0.0) (myBox 0.4 0.6 0.3) ; left leg (gl:push-matrix) (gl:translate 0.1 -0.65 0.0) (armleg 0.2 0.4 ll1 ll2) (gl:pop-matrix) ; right leg (gl:push-matrix) (gl:translate -0.1 -0.65 0.0) (armleg 0.2 0.4 rl1 rl2) (gl:pop-matrix) ; left arm (gl:push-matrix) (gl:translate 0.28 0.0 0.0) (armleg 0.16 0.4 la1 la2) (gl:pop-matrix) ; right arm (gl:push-matrix) (gl:translate -0.28 0.0 0.0) (armleg 0.16 0.4 ra1 ra2) (gl:pop-matrix) (glut:swap-buffers))) ;; Main (defun BoxMan () (glut:display-window (make-instance 'Window))) ; create window (BoxMan)
