読者です 読者をやめる 読者になる 読者になる

`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

cl-glut pre-study <page 9>

cl-glut pre-study

歩いてはいないが、グラウンド上を円形に滑るように動くプログラムは意外と簡単にできる。
しかし、マウスボタンの真ん中を押すと止まるだけなはずなのに、右ボタンと同様に少しずつ動くのはなんなのさ?
どこまちがえてんだろ?
f:id:tomekame0126:20151123203748p:plain
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)