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

`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

Lisp Game Programming 2 <supplement>

Road to the Programmer

Clozure clがエラーで起動できないのはウィルス対策ソフトだと判明したのもつかの間、今度は、SBCL 1.1.12が起動できなくなったので、最新バージョンのSBCL 1.3.1を入れて、先に作った common-abogadro を起動してみるとこんなことが分かった。

f:id:tomekame0126:20160101093735p:plain

さすが、最新バージョン!
なんたって、素人lispプログラマだもんね!

ちなみに、Clozure cl最新バージョンの1.11でも同じエラー発生!

なので、遊ぶ場合は SBCL 1.1.12 onlyでね!
そのうち直します。(?)

あ!、slime も2.15にしたのでエラー表示のビジュアルが向上!へへへ!

cl-glut pre-study <page 11>

cl-glut pre-study

なんやかんやと試してみた結果、課題のレポートとして、以下のプログラムを提出させていただきます。
歩くというよりランニングしているようにも見えますが、一応完成ということで単位をくださいな。common lispですけど。
あ!、インターネット聴講生だから関係ないか!
では、冬休みをいただきますね。
f:id:tomekame0126:20151128002116p:plain
BoxMan walking or running!

;;
;; BoxMan walking
;; -----------------------------------------------------------------------------------------------
(defparameter *stepcycle* 400)  ; frame number for swing of arm
(defparameter *walkcycle* 4000) ; frame number for around the stage
(defvar *p* 1.0)                ; lookat
(defvar *flag* nil)             ; rotation flag
(defvar *toggle* t)             ; toggle switch
(defvar *frame* 0)              ; frames
(defvar *steps* 0)              ; step 
(defvar *walk* 0)               ; walk

(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
        (progn 
	  (setf *toggle* t)
        (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

    (setf *steps* (/ (mod *frame* *stepcycle*) *stepcycle*))  ; from 0 to 1 
    (setf *walk*  (/ (mod *frame* *walkcycle*) *walkcycle*))  ; from 0 to 1
 
    ; BoxMan direction
    (setf r (- (* 360 *walk*)))
    ; BoxMan position
    (setf px (* (cos (* (* 2 pi) *walk*)) 3))
    (setf pz (* (sin (* (* 2 pi) *walk*)) 3))

    ; BoxMan legs swing
    (setf ll1 (* 25 (sin (* (/ (* 360 *steps*) 360) (* 2 pi)))))
    (setf ll2 (- 25 (* 25 (cos (* (/ (* 360 *steps*) 360) (* 2 pi))))))
    (setf rl1 (* 25 (cos (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi)))))
    (setf rl2 (- 25 (* 25 (sin (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi))))))
    ; BoxMan arms swing
    (setf la1 (* 25 (cos (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi)))))
    (setf la2 (- -25 (* 25 (sin (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi))))))
    (setf ra1 (* 25 (sin (* (/ (* 360 *steps*) 360) (* 2 pi)))))
    (setf ra2 (- -25 (* 25 (cos (* (/ (* 360 *steps*) 360) (* 2 pi))))))

    ; frame count
    (incf *frame*)
    
    (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)

cl-glut pre-study <page 10>

cl-glut pre-study

歩く姿をsinとcosを使用して実験してみた。
正面だと分かりにくいので、移動を止めて斜め45度の角度から動きを確認してみる。
試してみると、腕や脚の移動範囲を25度位の角度にすると何となく歩いている感じに見えた。
角度だけでなくいろいろな数値をいじってみると、数値の意味が見えてくると思う。
もう少し微調整することで、更に歩いている感を醸し出せるのでは。
f:id:tomekame0126:20151126223357p:plain
BoxMan stepping!

;;
;; BoxMan stepping
;; -----------------------------------------------------------------------------------------------
(defparameter *stepcycle* 400)  ; frame number for swing of arm
(defvar *p* 1.0)                ; lookat
(defvar *flag* nil)             ; rotation flag
(defvar *toggle* t)             ; toggle switch
(defvar *frame* 0)              ; frames
(defvar *steps* 0)              ; step

(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 45.0)   ; direction               <------------ angle view test
	(h 0.0))   ; height from ground

    (setf *steps* (/ (mod *frame* *stepcycle*) *stepcycle*))

    ; BoxMan legs swing
    (setf ll1 (* 25 (sin (* (/ (* 360 *steps*) 360) (* 2 pi)))))                  ; left leg
    (setf ll2 (- 25 (* 25 (cos (* (/ (* 360 *steps*) 360) (* 2 pi))))))
    (setf rl1 (* 25 (cos (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi)))))           ; right leg
    (setf rl2 (- 25 (* 25 (sin (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi))))))
    ; BoxMan arms swing
    (setf la1 (* 25 (cos (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi)))))           ; left arm
    (setf la2 (- -25 (* 25 (sin (* (/ (+ (* 360 *steps*) 30) 360) (* 2 pi))))))
    (setf ra1 (* 25 (sin (* (/ (* 360 *steps*) 360) (* 2 pi)))))                  ; right arm       
    (setf ra2 (- -25 (* 25 (cos (* (/ (* 360 *steps*) 360) (* 2 pi))))))

    ; frame count
    (incf *frame*)
    
    (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)

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)

cl-glut pre-study <page 8>

cl-glut pre-study

勝手に聴講生になったので、どのグループでもないから予備の課題を選び、取り合えずは表示のみ。
やっぱりこれでしょ。何だかわかるかな?
f:id:tomekame0126:20151122123433p:plain
BoxMan standing!

;;
;; BoxMan standing
;; -----------------------------------------------------------------------------------------------
(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)
  (gl:matrix-mode :projection)
  (gl:load-identity)
  (glu:perspective 30.0 (/ width height) 1.0 100.0)
  (gl:matrix-mode :modelview))


(defvar *toggle* t)
;; Keyboard
(defmethod glut:keyboard ((window Window) key x y)
  (declare (ignore x y))
    (case key
      ((#\q #\ESC)                           ; q, ESC --> exit
        (glut:destroy-current-window))
       ((#\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
  (gl:load-identity)
  (let ((lightpos '(3.0 4.0 5.0 1.0))
	(ll1 0.0)
	(ll2 0.0)
	(rl1 0.0)
	(rl2 0.0)
	(la1 0.0)
	(la2 0.0)
	(ra1 0.0)
	(ra2 0.0)
	(px 0.0)
	(pz 0.0)
	(r 0.0)
	(h 0.0))

    (gl:light :light0 :position lightpos)
    (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)
    ; 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)

何となく、labelsの使い方が解ったような気がしてきた。 

cl-glut pre-study <page 7>

cl-glut pre-study

さて、ここも一気にいってみよう。

レッスン21.光を当ててみる
f:id:tomekame0126:20151118201124p:plain

;;
;; 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)

レッスン22.光源を設定する
f:id:tomekame0126:20151118201440p:plain

;;
;; 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)

レッスン23.材質を設定する
f:id:tomekame0126:20151118201810p:plain

;;
;; 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)

レッスン24.階層構造
f:id:tomekame0126:20151118202221p:plain

;;
;; 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)

プレスタディーとしてはこんなもんかな。

cl-glut pre-study <page 6>

cl-glut pre-study

なかなかいいサンプルがあったので、レッスン17を以下のように変えてみた
http://blog.lowsnr.net/2013/04/14/using-opengl-with-common-lisp-and-macos-x/
f:id:tomekame0126:20151117231748p:plain

;;
;; lesson17 <animation>
;; -----------------------------------------------------------------------------------------------
(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 *edge*
  '(#(0 1)
    #(1 2) 
    #(2 3)
    #(3 0)
    #(4 5)
    #(5 6)
    #(6 7)
    #(7 4)
    #(0 4)
    #(1 5)
    #(2 6)
    #(3 7)))

(defun draw-figure (vertex edge)
  (labels ((set-vertex (index)
             (let ((v (aref vertex index)))
	       (%gl:vertex-3d (aref v 0) (aref v 1) (aref v 2))))
              ;(gl:vertex (aref v 0) (aref v 1) (aref v 2))))
           (draw-face (vertex-indices)
             (gl:begin :lines)
               (map nil  #'set-vertex vertex-indices)
             (gl:end)))
    (map nil #'(lambda (x) (draw-face x)) edge)))

(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 :rgba) :title "cube-test"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1)        ; set white
  (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)                ; clear 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)
  (gl:color 0.0 0.0 0.0)

  (draw-figure *vertex* *edge*)

  (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 lesson17 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson17)

レッスン18.多面体を塗りつぶす
確かに変な表示だ
f:id:tomekame0126:20151117232310p:plain

;;
;; lesson18 <fill the polyhedron>
;; -----------------------------------------------------------------------------------------------
(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) #(1 0 0))    ; red
    (#(1 5 6 2) #(0 1 0))    ; green
    (#(5 4 7 6) #(0 0 1))    ; blue
    (#(4 0 3 7) #(1 1 0))    ; yellow
    (#(4 5 1 0) #(1 0 1))    ; magenda
    (#(3 2 6 7) #(0 1 1))))  ; cyan

(defun draw-figure (vertex face)
  (labels ((set-color (color)
	     (%gl:color-3d (aref color 0) (aref color 1) (aref color 2)))
	   (set-vertex (index)
             (let ((v (aref vertex index)))
	       (%gl:vertex-3d (aref v 0) (aref v 1) (aref v 2))))
           (draw-face (vertex-indices color)
             (gl:begin :quads)
	       (set-color color)
               (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
  (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)                ; clear 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 lesson18 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson18)

レッスン19.デプスバッファを使用する
表示がまともになった
f:id:tomekame0126:20151117232839p:plain

;;
;; lesson19 <depth buffer>
;; -----------------------------------------------------------------------------------------------
(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) #(1 0 0))    ; red
    (#(1 5 6 2) #(0 1 0))    ; green
    (#(5 4 7 6) #(0 0 1))    ; blue
    (#(4 0 3 7) #(1 1 0))    ; yellow
    (#(4 5 1 0) #(1 0 1))    ; magenda
    (#(3 2 6 7) #(0 1 1))))  ; cyan

(defun draw-figure (vertex face)
  (labels ((set-color (color)
	     (%gl:color-3d (aref color 0) (aref color 1) (aref color 2)))
	   (set-vertex (index)
             (let ((v (aref vertex index)))
	       (%gl:vertex-3d (aref v 0) (aref v 1) (aref v 2))))
           (draw-face (vertex-indices color)
             (gl:begin :quads)
	       (set-color color)
               (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
  (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 lesson19 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson19)

レッスン20.カリング
見た目は全く変わらないため、画像は割愛

;;
;; lesson20 <culling>
;; -----------------------------------------------------------------------------------------------
(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) #(1 0 0))    ; red
    (#(1 5 6 2) #(0 1 0))    ; green
    (#(5 4 7 6) #(0 0 1))    ; blue
    (#(4 0 3 7) #(1 1 0))    ; yellow
    (#(4 5 1 0) #(1 0 1))    ; magenda
    (#(3 2 6 7) #(0 1 1))))  ; cyan

(defun draw-figure (vertex face)
  (labels ((set-color (color)
	     (%gl:color-3d (aref color 0) (aref color 1) (aref color 2)))
	   (set-vertex (index)
             (let ((v (aref vertex index)))
	       (%gl:vertex-3d (aref v 0) (aref v 1) (aref v 2))))
           (draw-face (vertex-indices color)
             (gl:begin :quads)
	       (set-color color)
               (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 :back)            ; cullface
  (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 lesson20 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson20)

遅々として進まないが、なかなか面白い。

cl-glut pre-study <page 5>

cl-glut pre-study

レッスン13.2次元と3次元
y軸を中心に25°回転してみた。
f:id:tomekame0126:20151108163333p:plain

;;
;; lesson13 <2D & 3D>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   :mode '(:rgba)))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1))                  ; set white

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer 
  ;       degreee  x   y   z
  (gl:rotate 25.0 0.0 1.0 0.0)               ; y-axis rotate 25 degrees
  ; draw a square
  (gl:begin :polygon)
    ; set red color 
    (%gl:color-3d 1 0 0)
    (%gl:vertex-2d -0.9 -0.9)
    ; set green color 
    (%gl:color-3d 0 1 0)
    (%gl:vertex-2d 0.9 -0.9)
    ; set blue color 
    (%gl:color-3d 0 0 1)
    (%gl:vertex-2d 0.9 0.9)
    ; set yellow color 
    (%gl:color-3d 1 1 0)
    (%gl:vertex-2d -0.9 0.9)
  (gl:end)
  (gl:flush))                                ; show window

;; Main
(defun lesson13 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson13)

レッスン14.線画(3D)を表示する
vertex-3dの使い方がわからなかったため、wire-cubeで試してみた。
これも、そのうち考えてみることとする。
加えて、ダブルバッファも試してみた。
f:id:tomekame0126:20151108163655p:plain

;;
;; lesson14 <Line drawing>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window)
  ()
 (:default-initargs
   :pos-x 100 :pos-y 100 :width 500 :height 500
   :mode '(:double :rgb) :title "cube-test"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 0 0 0 1))                  ; set black

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (gl:ortho -2.0 2.0 -2.0 2.0 -2.0 2.0))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer 
    ;; cube
    (gl:with-pushed-matrix
      (gl:scale 1 1 1)
      (glut:wire-cube 1))
  (glut:swap-buffers))
  
;; Main
(defun lesson14 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson14)

レッスン15.透視投影する
f:id:tomekame0126:20151108163920p:plain

;;
;; lesson15 <Perspective>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window)
  ()
 (:default-initargs
   :pos-x 100 :pos-y 100 :width 500 :height 500
   :mode '(:double :rgb) :title "cube-test"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 0 0 0 1))                  ; set black

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (glu:perspective 30.0 (/ width height) 1.0 100.0)
  (gl:translate 0.0 0.0 -5.0))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer 
    ;; cube
    (gl:with-pushed-matrix
      (gl:scale 1 1 1)
      (glut:wire-cube 1))
  (glut:swap-buffers))
  
;; Main
(defun lesson15 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson15)

レッスン16.視点の位置を変更する
f:id:tomekame0126:20151108164103p:plain

;;
;; lesson16 <Look at>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window)
  ()
 (:default-initargs
   :pos-x 100 :pos-y 100 :width 500 :height 500
   :mode '(:double :rgb) :title "cube-test"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 0 0 0 1))                  ; set black

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (glu:perspective 30.0 (/ width height) 1.0 100.0)
  (glu:look-at 3.0 4.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer 
    ;; cube
    (gl:with-pushed-matrix
      (gl:scale 1 1 1)
      (glut:wire-cube 1))
  (glut:swap-buffers))
  
;; Main
(defun lesson16 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson16)

レッスン17.図形を動かす
マウスの右ボタンを押しっぱなしで右回転、左ボタンは左回転し、ホイールボタンを押すと1ステップずつ直前に回転していた方向に動く。
ついでだから、マウスのホイールを回すことで視点の位置を動かすようにしてみた。
但し、これはfreeglutの機能を利用して提供されているとの記載が以下にある。
https://github.com/3b/cl-opengl/blob/master/glut/package.lisp
#:mouse-wheel-func ; freeglut ext
また、fやFを押すとフルスクリーンになったり元に戻ったりするようにしてみた。終了はqやQを押すことでウィンドウが消滅する。
f:id:tomekame0126:20151108164418p:plain

;;
;; lesson17 <animation>
;; -----------------------------------------------------------------------------------------------
(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 0 0 0 1)        ; set black
  (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)                ; clear 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:with-pushed-matrix
      (gl:scale 1 1 1)
      (glut:wire-cube 1))
  (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 lesson17 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson17)

Cで書かれたサンプルは結構な数が見つかるけど、cl-glutのサンプルは少ないなぁ。
マウスのホイールを利用するサンプルは探しきれなかった。
暗雲だだよう、pre-study編。

cl-glut pre-study <page 4>

cl-glut pre-study

レッスン8.マウスボタンをクリックする

;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; lesson4 <Put the color lines>
;; lesson5 <Set polygon and several colors>
;; lesson6 <Reshape >
;; lesson7 <Window size and position>
;; lesson8 <mouse>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   ; 
   :width 320 :height 240 :pos-x 100 :pos-y 100
   :mode '(:rgba) :title "test-window"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1))                  ; set white

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity))
  ; cut program code

;; Mouse
(defmethod glut:mouse ((window Window) button state x y)
  (cond ((eql button :LEFT-BUTTON)
          (princ "left"))
        ((eql button :MIDDLE-BUTTON)
          (princ "middle")) 
        ((eql button :RIGHT-BUTTON)
    	  (princ "right")))

  (princ " button is ")

  (cond ((eql state :UP)
          (princ "up")) 
        ((eql state :DOWN)
    	  (princ "down")))

  (format t " at ~@{~d~^, ~}~%" x y))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; cut program code
  (gl:flush))                                ; show window

;; Main
(defun lesson8 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson8)

f:id:tomekame0126:20151103192522p:plain

レッスン9.マウスをクリックする(線を引く)

;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; lesson4 <Put the color lines>
;; lesson5 <Set polygon and several colors>
;; lesson6 <Reshape >
;; lesson7 <Window size and position>
;; lesson8 <mouse>
;; lesson9 <Draw a line with the mouse>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   ; 
   :width 320 :height 240 :pos-x 100 :pos-y 100
   :mode '(:rgba) :title "test-window"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1))                  ; set white

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (gl:ortho -0.5 (- width 0.5) (- height 0.5) -0.5 -1 1))

;; Mouse
(defvar *x0*)
(defvar *y0*)
(defmethod glut:mouse ((window Window) button state x y)
  (cond ((eql button :LEFT-BUTTON)
         (if (eql state :UP)
           (progn    
             (%gl:color-3d 0 0 0)                ; black color
             (gl:begin :lines)               ; line
               (%gl:vertex-2i *x0* *y0*)
               (%gl:vertex-2i x y)
             (gl:end)  
             (gl:flush))
           (setf *x0* x                      ; store mouse position 
                 *y0* y)))		   
	 ((eql button :MIDDLE-BUTTON)
	  ; cut program code
          )
         ((eql button :RIGHT-BUTTON)
          ; cut program code
	  )))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; draw a square
  (gl:flush))                                ; show window

;; Main
(defun lesson9 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson9)

f:id:tomekame0126:20151103193258p:plain

ここで、問題発生!
有名なサイトだけあって、いろんな人が実際に自分の環境で「やってみた」画像を掲載しているが、比較するとどうも違う。
他の人の画像では、マウスを動かした後には何本もの線が残っているのに、自分の環境では描くたびに前の線が消えてしまう。
まだ「見習い」なので、これ以上は深入りせず、この後に控えている「ラバーバンド」まで一旦スキップすることにした。
そのうち考えることにする。(?)


レッスン12.キーボードから読み込む(10・11はスキップ)

;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; lesson4 <Put the color lines>
;; lesson5 <Set polygon and several colors>
;; lesson6 <Reshape >
;; lesson7 <Window size and position>
;; lesson8 <mouse>
;; lesson9 <Draw a line with the mouse>
;; lesson10-11 -> skip
;; lesson12 <Keyboard>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   ; 
   :width 320 :height 240 :pos-x 100 :pos-y 100
   :mode '(:rgba) :title "test-window"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1))                  ; set white

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (gl:ortho -0.5 (- width 0.5) (- height 0.5) -0.5 -1 1))

;; Mouse
(defvar *x0*)
(defvar *y0*)
(defmethod glut:mouse ((window Window) button state x y)
  (cond ((eql button :LEFT-BUTTON)
         (if (eql state :UP)
           (progn    
             (%gl:color-3d 0 0 0)            ; black color
             (gl:begin :lines)               ; line
               (%gl:vertex-2i *x0* *y0*)
               (%gl:vertex-2i x y)
             (gl:end)  
             (gl:flush))
           (setf *x0* x                      ; store mouse position 
                 *y0* y)))		   
	 ((eql button :MIDDLE-BUTTON)
	  ; cut program code
          )
         ((eql button :RIGHT-BUTTON)
          ; cut program code
	  )))
;; Keyboard
(defmethod glut:keyboard ((window Window) key x y)
  (declare (ignore x y))
    (case key
      ((#\q #\Q)                              ; q or Q --> exit
        (glut:destroy-current-window))))

;; Special key
(defmethod glut:special ((window Window) key x y)
  (declare (ignore x y))
    (case key
      (:key-up                                ; upkey  --> exit
        (glut:destroy-current-window))))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; draw a square
  (gl:flush))                                ; show window

;; Main
(defun lesson12 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson12)

q、Qキーで終了。もう一つは矢印キー↑でも終了する。
以下に定義されているため、確認してくださいな。
https://github.com/3b/cl-opengl/blob/master/glut/interface.lisp
https://github.com/3b/cl-opengl/blob/master/glut/callbacks.lisp


なかなか、勝手が違ってたいへんだね。

cl-glut pre-study <page 3>

cl-glut pre-study

さて3日目。
レッスン6.座標軸とビューポート

;;
;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; lesson4 <Put the color lines>
;; lesson5 <Set polygon and several colors>
;; lesson6 <Reshape >
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   :mode '(:rgba)))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1))                  ; set white

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (gl:ortho (- (/ width 200)) (/ width 200) (- (/ height 200)) (/ height 200) -1 1))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; draw a square
  (gl:begin :polygon)
    ; set red color 
    (%gl:color-3d 1 0 0)
    (%gl:vertex-2d -0.9 -0.9)
    ; set green color 
    (%gl:color-3d 0 1 0)
    (%gl:vertex-2d 0.9 -0.9)
    ; set blue color 
    (%gl:color-3d 0 0 1)
    (%gl:vertex-2d 0.9 0.9)
    ; set yellow color 
    (%gl:color-3d 1 1 0)
    (%gl:vertex-2d -0.9 0.9)
  (gl:end)
  (gl:flush))                                ; show window

;; Main
(defun lesson6 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson6)

f:id:tomekame0126:20151101153538p:plain
レッスン5との違いは、中に表示されている色どり鮮やかなスクエアが、ウィンドウ全体を拡大したときも大きさを保つというところ。
レッスン5では、ウィンドウと連動して「でっかくなっちゃった!」になる。

レッスン7.位置とサイズを指定してウィンドウを開く(追加でタイトルも付けた)

;;
;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; lesson4 <Put the color lines>
;; lesson5 <Set polygon and several colors>
;; lesson6 <Reshape >
;; lesson7 <Window size and position>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   :width 320 :height 240 :pos-x 100 :pos-y 100
   :mode '(:rgba) :title "test-window"))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1))                  ; set white

;; View port
(defmethod glut:reshape ((window Window) width height)
  (gl:viewport 0 0 width height)
  (gl:load-identity)
  (gl:ortho (- (/ width 200)) (/ width 200) (- (/ height 200)) (/ height 200) -1 1))

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; draw a square
  (gl:begin :polygon)
    ; set red color 
    (%gl:color-3d 1 0 0)
    (%gl:vertex-2d -0.9 -0.9)
    ; set green color 
    (%gl:color-3d 0 1 0)
    (%gl:vertex-2d 0.9 -0.9)
    ; set blue color 
    (%gl:color-3d 0 0 1)
    (%gl:vertex-2d 0.9 0.9)
    ; set yellow color 
    (%gl:color-3d 1 1 0)
    (%gl:vertex-2d -0.9 0.9)
  (gl:end)
  (gl:flush))                                ; show window

;; Main
(defun lesson7 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson7)

こんな感じで、画面の左上から(100,100)の位置に(320,240)の大きさでタイトル「test-window」のウィンドウが出現する。

f:id:tomekame0126:20151101155136p:plain
まあ、ここまでは順調かな?

H27.11.3 修正

bindings-packageを使うバージョンに変更した。

cl-glut pre-study <page 2>

cl-glut pre-study

聴講2日目はここからスタート。

レッスン3.線を引く
lesson3.lisp

;;
;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   :mode '(:rgba)))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 0 0 1 1))                  ; set blue

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; draw a square
  (gl:begin :line-loop)
    (%gl:vertex-2d -0.9 -0.9)
    (%gl:vertex-2d 0.9 -0.9)
    (%gl:vertex-2d 0.9 0.9)
    (%gl:vertex-2d -0.9 0.9)
  (gl:end)
  (gl:flush))                                ; show window

;; Main
(defun lesson3 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson3)

f:id:tomekame0126:20151031214339p:plain
まぁ、想定通り。色を指定しなければ、デフォルトでは白ってことね。
画像を見てわかると思うけど、(%gl:vertex-2d X Y)のXとYは1~0の範囲で指定できる。
※1だと、ウィンドウの枠ぎりぎりに表示され、0だと表示されない。


お次は?
レッスン4.線に色をつける
lesson4.lisp

;;
;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; lesson4 <Put the color lines>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   :mode '(:rgba)))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 0 0 1 1))                  ; set blue

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; set red color 
  (%gl:color-3d 1 0 0)
  ; draw a square
  (gl:begin :line-loop)
    (%gl:vertex-2d -0.9 -0.9)
    (%gl:vertex-2d 0.9 -0.9)
    (%gl:vertex-2d 0.9 0.9)
    (%gl:vertex-2d -0.9 0.9)
  (gl:end)
  (gl:flush))                                ; show window

;; Main
(defun lesson4 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson4)

f:id:tomekame0126:20151031214845p:plain
これも想定通り。

そして、そして。
レッスン5.図形を塗りつぶす
lesson5.lisp

;;
;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; lesson3 <Draw the lines>
;; lesson4 <Put the color lines>
;; lesson5 <Set polygon and several colors>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   :mode '(:rgba)))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 1 1 1 1))                  ; set white

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  ; draw a square
  (gl:begin :polygon)
    ; set red color 
    (%gl:color-3d 1 0 0)
    (%gl:vertex-2d -0.9 -0.9)
    ; set green color 
    (%gl:color-3d 0 1 0)
    (%gl:vertex-2d 0.9 -0.9)
    ; set blue color 
    (%gl:color-3d 0 0 1)
    (%gl:vertex-2d 0.9 0.9)
    ; set yellow color 
    (%gl:color-3d 1 1 0)
    (%gl:vertex-2d -0.9 0.9)
  (gl:end)
  (gl:flush))                                ; show window

;; Main
(defun lesson5 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson5)

f:id:tomekame0126:20151031215658p:plain
これはこれは、色どり鮮やかなことで!
てなとこで、今日はここまで。

H27.11.3修正
cl-openglのbindings-packageを使用するバージョンに変更した。
(gl:xxxx) ⇒ (%gl:xxxx)

ついでに書くと、このpackageはこんな感じで定義されている。

(defpackage #:cl-opengl-bindings
(:nicknames #:%gl) <-------------------- ここね!
(:use #:common-lisp #:cffi)
 ・・・・・・・・・・・・・・・

cl-glut pre-study <page 1>

cl-glut pre-study

これまでは、HSPで作られたシューティングゲーム2本をcommon-lispでリメイクしてみた。
lispbuilder-sdlは結構便利で、若干古さは否めないものの簡単なゲームを作るには十分だと感じた。
だけど、グラフィックスと言えばopenGLは外せない。
なので、どこまで自分が理解できるか、つまみ食いをしてみる。
※先のページでsbclrcにcl-opengl、cl-glu、cl-glutを書き加えてあるのはそのため。

さて、common-lispopenGLを使うためには、まずここからdownloadする。
※ダウンロードファイル名はcl-opengl-master.zip
https://github.com/3b/cl-opengl

展開したら、以下のホルダに、展開したホルダごとファイルを追加した。
C:\Program Files (x86)\Steel Bank Common Lisp\1.1.12\site

そして、freeglutのdownload。
※ダウンロードファイル名はfreeglut-MSVC-3.0.0.2-2.mp
http://www.transmissionzero.co.uk/software/freeglut-devel/

展開したらbinホルダの中のfreeglut.dllをC:\Windows\System32に移動。
※多分32bit用
また、binホルダ内のx64ホルダにある同名のfreeglut.dllをC:\Windows\SysWOW64に移動。
※多分64bit用

こんな感じで、インストールを完了させ、後は前述のsbclrcの設定を実施。

pre-studyなので勉強の材料をさがしたところ、その筋ではかなり有名らしいサイトがあったので、勝手にインターネット聴講生にさせていただきました。(何十年ぶり?)
http://www.wakayama-u.ac.jp/~tokoi/opengl/libglut.html
しまった、Cで書いてあるじゃん。と思ったけど、プログラムなんてみんな同じで何となくわかるだろうと高をくくり、cl-glutで挑戦。

レッスン1.空のウィンドウを開く
lesson1.lisp

;;
;; lesson1 <Open the window>
;; -----------------------------------------------------------------------------------------------
;; Init window
(defclass Window (glut:window) 
  ())
;; Main
(defun lesson1 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson1)

f:id:tomekame0126:20151031175534p:plain

PC画面の左上にウィンドウ出現。
すげぇ。こんなもんでウィンドウができるんだ。
※タイトルを入れないと、処理系とそのバージョンがタイトルに出現。(どっから引っ張ってくるんだろ?)

レッスン2.ウィンドウを塗りつぶす
lesson2.lisp

;;
;; lesson1 <Open the window>
;; lesson2 <Fill in the blue>
;; -----------------------------------------------------------------------------------------------
;; Set window class
(defclass Window (glut:window) 
  ()
  (:default-initargs
   :mode '(:rgba)))

;; Init
(defmethod glut:display-window :before ((window Window))
  (gl:clear-color 0 0 1 1))                  ; set blue

;; Display
(defmethod glut:display ((window Window))
  (gl:clear :color-buffer-bit)               ; clear buffer
  (gl:flush))                                ; show window

;; Main
(defun lesson2 ()
  (glut:display-window (make-instance 'Window)))  ; create window

(lesson2)

f:id:tomekame0126:20151031180436p:plain

cl-glutでのwindow関連の定義はここを参照してくださいな。
https://github.com/3b/cl-opengl/blob/master/glut/interface.lisp
それと、ここを照らし合わせてみると、なんとなく関数がやっていることがイメージできそう。
http://quickdocs.org/cl-opengl/api#system-cl-glut

今日はこの辺で勘弁してやるか。
つづく(かな?)

Lisp Game Programming 2 <Stage 14>

Road to the Programmer

最後はお約束のasdfを使うためのパッケージ化。
package.lisp ⇒

;;;; package.lisp
(defpackage :game
 (:use :common-lisp :lispbuilder-sdl
       :sprite-sheets :map-list :enemy-map-list :audio-list :move-pattern :shot-data)
 (:nicknames :shooting)
 (:export #:Common-abogadro))

そして、asdファイルの作成。
common-abogadro.asd ⇒

;;;; common-abogadro.asd
(asdf:defsystem :common-abogadro
  :version "0.1"
  :description "A remake of abogadro made with HSP"
  :author "tomekame0126"
  :license "GPL v2"
  :depends-on (:lispbuilder-sdl
               :lispbuilder-sdl-ttf
               :lispbuilder-sdl-mixer)
  :serial t
  :components ((:file "sprite-sheets")
	       (:file "map-list")
	       (:file "enemy-map-list")
	       (:file "audio-list")
	       (:file "move-pattern")
	       (:file "shot-data")
	       (:file "package")
	       (:file "common-abogadro")))

load命令の場所をコメントアウト

;; step1 <Sprite Sheets>
;; -----------------------------------------------------------------------------------------------
;(load "C:\\work\\sprite-sheets.lisp")

;; step2 <Map>
;; -----------------------------------------------------------------------------------------------  
;(load "C:\\work\\map-list.lisp")

;; step7 <Enemy Map List>
;; -----------------------------------------------------------------------------------------------
;(load "C:\\work\\enemy-map-list.lisp")

;; step7 <Enemy Map List>
;; -----------------------------------------------------------------------------------------------
;(load "C:\\work\\move-pattern.lisp")

;; step10 <Audio>
;; -----------------------------------------------------------------------------------------------  
;(load "C:\\work\\audio-list.lisp")

;; step13 <Enemy Shot Data>
;; -----------------------------------------------------------------------------------------------  
;(load "C:\\work\\shot-data.lisp")

今回は、package.lispを作ったので、in-packageを除き該当する部分をコメントアウト

;; step1 <Define Package>
;; -----------------------------------------------------------------------------------------------
;(defpackage :game
;  (:use :common-lisp :lispbuilder-sdl :sprite-sheets :map-list :enemy-map-list :move-pattern
;   :audio-list :shot-data)
;  (:nicknames :shooting)
;  (:export #:Common-abogadro))
(in-package :game)

最後の(common-abogadro)もコメントアウト

;(common-abogadro)

ab-step13.lisp ⇒ common-abogadro.lispにリネームしてコンパイルし、

(asdf:operate 'asdf:load-op :common-abogadro)

そして、実行。

(game:common-abogadro)

せっかくだからsbclrcに追記し、Emacs+Slimeを起動し直してから、また(game:common-abogadro)を実行してみる。

(require :asdf)
 
(dolist (dir (directory "C:\\Program Files (x86)\\Steel Bank Common Lisp\\1.1.12\\site\\*\\"))
 (pushnew dir asdf:*central-registry* :test #'equal))
  
(dolist (dir (directory "C:\\work\\"))
 (pushnew dir asdf:*central-registry* :test #'equal))  

 ;; load lispbuilder-sdl
 (asdf:operate 'asdf:load-op :lispbuilder-sdl)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-binaries)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-image)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-image-binaries)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-ttf)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-ttf-binaries)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-mixer)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-mixer-binaries)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-mixer-examples)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-gfx)
 (asdf:operate 'asdf:load-op :lispbuilder-sdl-gfx-binaries)
 (asdf:operate 'asdf:load-op :cl-opengl)
 (asdf:operate 'asdf:load-op :cl-glu)
 (asdf:operate 'asdf:load-op :cl-glut)
 (asdf:operate 'asdf:load-op :cl-glut-examples)
 (asdf:operate 'asdf:load-op :nibbles)
 (asdf:operate 'asdf:load-op :usocket)
 (asdf:operate 'asdf:load-op :split-sequence)
 (asdf:operate 'asdf:load-op :bordeaux-threads)
 (asdf:operate 'asdf:load-op :common-abogadro)

;;; The following lines added by ql:add-to-init-file:
#-quicklisp
(let ((quicklisp-init (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname))))
  (when (probe-file quicklisp-init)
    (load quicklisp-init)))

うまく動けば、めでたしめでたし。
ちなみにfaslファイルはこの場所にひっそりとできていました。
C:\Users\[ユーザ名]\AppData\Local\common-lisp\cache\sbcl-1.1.12-win-x86\C\work
f:id:tomekame0126:20151026093736p:plain

ついでに、実行ファイルを作り、うまく動くかどうか試してみた。
こんなものを用意し、
main.lisp

;; Common-abogadro
;;--------------------------
(defun main ()
;; Load SDL
;;--------------------------
(cffi:define-foreign-library sdl
  (t (:default "SDL")))
(cffi:use-foreign-library sdl)
;; Run the game
;;--------------------------
(sdl:with-init ()
  (game:common-abogadro))
;; Quit
;;--------------------------
(sb-ext:exit))

こんなことをして、

(load (compile-file "c:\\work\\main.lisp"))

こんなことをすると、いつものようにでっかいファイルができあがる。
※M-x shellをしてからsbclを起動する必要あり。

(sb-ext:save-lisp-and-die "c:\\work\\common-abogadro.exe" :toplevel 'main :executable t)

f:id:tomekame0126:20151026144208p:plain
せっかくだから、Dos窓が開かないように小細工してみた。
common-abogadro.vbs ⇒

CreateObject("WScript.Shell").Run "C:\work\common-abogadro.exe",0

いい感じで起動し実行できるが、途中でフリーズ!!
だめじゃん!!
f:id:tomekame0126:20151026192907p:plain

H28.1.3 訂正

SBCL 1.3.1 にバージョンアップした際に上記プログラムにBugがあることが分かったので修正を行った結果、作成した「実行ファイル」は正常に動作した。
ごめんなさいね。

Lisp Game Programming 2 <Stage 13-3 Program>

Road to the Programmer

弾幕の作成では一気に突っ走った。
今回、目的としていたプログラムは以下のとおり。
なお、このプログラムを動かすための必要なファイルは過去のブログで作成しているため、遊んでみたい方は参照してくださいな。

ab-stage13.lisp

;;;; The Common-Abogadro
;;; step1  <Game Frame> <Sprite Sheets> <Define Package> <Macro> <Character Object> <Draw Images>
;;;        <Initialize> <Update Key State> <Fix Ship Position> <Move Ship>
;;; step2  <Map> <Scroll> 
;;; step3  <Font> <Stage Class> <Start Stage Message>
;;; step4  <Game Start Message> <Game Over Message> <Judge Game Over> <Set Screen Mode>
;;; step5  <Score Panel>
;;; step6  <Move Shot> <Set Shot> <Remove Dead Shot> <Draw Shot>
;;; step7  <Generate Enemy> <Judge Stage End> <Move Enemy> <Change Id> <Remove Enemy>
;;;        <Draw Enemy> <Reset Variables> <Rotate Map Pointer> 
;;; step8  <Move Balloon> <Generate Balloon> <Draw Balloon> <Move Item> <Remove Item>
;;;        <Hit Item> <Draw Item> 
;;; step9  <Move Enemy Shot> <Set Enemy Shot> <Remove Dead Enemy Shot>
;;; step10 <Audio> <Enemy Hit P> <Damage Counter> <Explode Enemy> <Score Up> <Change Damaged Id>
;;;        <Set Reset Id>
;;; step11 <Set Bomb Key> <Set Bomb> <Explode Bomb> <Remove Explode Bomb> <Draw Bomb> 
;;; step12 <Ship Hit P> <Explode Counter> <Revive Counter> <Draw Ship Explosion> <Set Explosion>
;;;        <Explode Large Enemy> <Remove Explode Large Enemy> <Draw Explosion Large Enemy>
;;;        <N-ship Zero P>
;;; step13 <Enemy Shot Data> <Enemy Shot Pattern> <Set Enemy Shot> <Set Enemy Center>
;;;        <Set Enemy Variables> <Set Enemy Shot Direction> <Set Repeat Flag OFF>
;;;        <Set Enemy Shot Timing> <Set Enemy Shot Angle> <Charge Enemy Shot> 
;;;      
;; step1 <Sprite Sheets>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\sprite-sheets.lisp")

;; step2 <Map>
;; -----------------------------------------------------------------------------------------------  
(load "C:\\work\\map-list.lisp")

;; step7 <Enemy Map List>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\enemy-map-list.lisp")

;; step7 <Enemy Map List>
;; -----------------------------------------------------------------------------------------------
(load "C:\\work\\move-pattern.lisp")

;; step10 <Audio>
;; -----------------------------------------------------------------------------------------------  
(load "C:\\work\\audio-list.lisp")

;; step13 <Enemy Shot Data>
;; -----------------------------------------------------------------------------------------------  
(load "C:\\work\\shot-data.lisp")

;; step1 <Define Package>
;; -----------------------------------------------------------------------------------------------
(defpackage :game
  (:use :common-lisp :lispbuilder-sdl :sprite-sheets :map-list :enemy-map-list :move-pattern
   :audio-list :shot-data)
  (:nicknames :shooting)
  (:export #:Common-abogadro))
(in-package :game)

;; step1 <Macro>
;; -----------------------------------------------------------------------------------------------
(defmacro define-class (name superclasses slots form)
  `(defclass ,name ,superclasses
    ,(mapcar (lambda (slot)
               (let ((keyword (intern (symbol-name slot) :keyword)))
               `(,slot :initarg ,keyword :initform ,form :accessor ,slot)))
              slots)))

;;step1 <Character Object>
;; -----------------------------------------------------------------------------------------------
(define-class object ()
  (id x y width height) 0)
 ; id      graphic id in imageid
 ; x       upper left corner
 ; y       upper left corner
 ; width   from upper left corner
 ; height  from upper left corner

(define-class entity (object)
  (dx dy explode-cnt state revival-cnt) 0)     ; + ship explosion revival
 ; dx          x direction speed
 ; dy          y direction speed
 ; explode-cnt explosion counter(wait) 
 ; state       ship  0:dead 1:alive 2:explosion 3:revival 
 ;             enemy 0:dead 1:alive 2:damage    3:explosion

;;step13 <Enemy Shot Pattern>
;; -----------------------------------------------------------------------------------------------
(define-class shotpattern ()
  (timing angle-store shot-counter beforetime pattern-number pattern-number-store 
   pattern-cnt pattern-cnt-store repeat-flag count-flag first-x first-y first-angle) 0)
 ; timing                shottiming
 ; angle-store           angle-store
 ; shot-counter          number of shot per battery 
 ; beforetime            interval before shot
 ; pattern-number        shotpattern0-13
 ; pattern-number-store  store pattern number
 ; pattern-cnt           number of shotpattern
 ; pattern-cnt-store     store pattern counter
 ; repeat-flag           0:once 1:repeat
 ; count-flag            repeat count
 ; first-x               x position of first shot
 ; first-y               y position of first shot
 ; first-angle           angle of first shot

(define-class foe (entity shotpattern)
  (move-cnt damage-cnt life-cnt kind) 0)
 ; move-cnt   moving counter      (distance)  
 ; damage-cnt enemy damage counter(wait)
 ; life-cnt   enemy life counter  (life time)
 ; kind       kind of enemy

(define-class enemy-manager ()
  (enemy-list enemy-shot-list) nil)
 ; enemy-list       enemy list
 ; enemy-shot-list  enemy shot list

(define-class shot-manager ()
  (shot-list) nil)
 ; shot-list      4 shot store

(define-class balloon-manager ()
  (balloon-list balloon-cnt) nil)
 ; balloon-list    list of balloon       
 ; balloon-cnt     max 2 balloon   

(define-class item-manager ()
  (item-list item-flag) nil)
 ; item-list  list of item
 ; item-flag  item get flag

(define-class score ()
  (score highscore oneup n-ship n-bomb) 0)
 ; score       score counter       
 ; highscore   hight score
 ; oneup       plus one ship
 ; n-ship      number of ship
 ; n-bomb      number of bomb

(define-class explosion-manager ()
  (bomb-list bomb-cnt bomb-number) nil)
; bomb-list    list of bomb       
; bomb-cnt     60 times waiting
; bomb-number  max 5

;; step1 <Draw Images>
;; -----------------------------------------------------------------------------------------------  
(defun Draw (obj)
  "character draw"
  (sdl:draw-surface-at-* *images* (round (x obj)) (round (y obj)) :cell (id obj)))

;; step1 <Initialize>
;; -----------------------------------------------------------------------------------------------  
(defun Initialize ()
  "graphics initialize"
  (setf (sdl:frame-rate) 60)                      ; frame rate set
  (setf *random-state* (make-random-state t))     ; random set
  (Set-imageid)                                   ; imageid set
  (sdl:show-cursor nil))                          ; cursor not show

;; step1 <Update Key State>
;; -----------------------------------------------------------------------------------------------
(define-class keystate ()
  (right left up down z lshift) nil)
 ; right  right-key
 ; left   left-key
 ; up     up-key
 ; down   down-key
 ; z      z-key
 ; lshift lshift-key

(defgeneric Update-keystate (key boolean keystate))
(defmethod Update-keystate (key boolean keystate)  
  (cond ((sdl:key= key :SDL-KEY-RIGHT)  (setf (right  keystate) boolean))
        ((sdl:key= key :SDL-KEY-LEFT)   (setf (left   keystate) boolean))
        ((sdl:key= key :SDL-KEY-UP)     (setf (up     keystate) boolean))
        ((sdl:key= key :SDL-KEY-DOWN)   (setf (down   keystate) boolean))
        ((sdl:key= key :SDL-KEY-Z)      (setf (z      keystate) boolean))
        ((sdl:key= key :SDL-KEY-LSHIFT) (setf (lshift keystate) boolean))))

;; step 1 <Move Ship>
;; -----------------------------------------------------------------------------------------------
(defgeneric Move-ship (ship keystate))
(defmethod Move-ship (ship keystate)
  (when (or (= (state ship) 1)                                 ; When ship is alive or revival
            (= (state ship) 3))
    (cond ((right keystate) (progn (incf (x ship) (dx ship))   ; set ship id 1 (right turn)
				   (setf (id ship) 1)))
          ((left  keystate) (progn (decf (x ship) (dx ship))   ; set ship id 2 (left turn)
				   (setf (id ship) 2)))
          ((up    keystate)  (decf (y ship) (dy ship)))
          ((down  keystate)  (incf (y ship) (dy ship))))))

;; step1 <Fix Ship Position>
;; -----------------------------------------------------------------------------------------------
(define-class game-field ()
  (field-x field-y width height) 0)
; field-x  game field upper left x
; field-y  game field upper left y
; width    game field width
; height   game field height

(defgeneric Fix-ship-position (ship game-field))
(defmethod Fix-ship-position (ship game-field)
  "ship always inside game-field"
  (when (< (x ship) (field-x game-field))       (setf (x ship) (field-x game-field)))
  (when (< (y ship) (field-y game-field))       (setf (y ship) (field-y game-field)))
  (when (> (x ship) (- (width game-field) 32))  (setf (x ship) (- (width game-field) 32)))
  (when (> (y ship) (- (height game-field) 32)) (setf (y ship) (- (height game-field) 32))))

;; step3 <Font>
;; -----------------------------------------------------------------------------------------------
(defparameter *path-font16* "C:\\WINDOWS\\Fonts\\msmincho.ttc")
(defparameter *font16* (make-instance 'sdl:ttf-font-definition
                                :size 16
                                :filename (sdl:create-path *path-font16*)))
(defvar *menu-font*)                                     ; menu font

(defun Set-font ()
  (setf *menu-font*  (sdl:initialise-font *font16*)))

;; Step3 <Stage Class>
;; -----------------------------------------------------------------------------------------------
(define-class stage ()
  (stage-flag stage-number title-loop ending-loop start) t)
 ; stage-flag        on-stage or not
 ; stage-number      map change
 ; title-loop        waiting for input-key
 ; ending-loop       waiting for input-key
 ; start             game start

;; Step3 <Start Stage Message>
;; -----------------------------------------------------------------------------------------------
(defvar *atlas*)                                           ; map set
(defvar *enemymap*)                                        ; enemy map set
(defvar *BGM*)
(defvar *enemy-generate-flag* nil)
(defvar *rotation* '(0 1 2 3 4 5 6 7))
(defvar *bossbgm-on-air* nil)                              ; now BossBGM playing

(defgeneric Stage-start-message (stage keystate))
(defmethod Stage-start-message (stage keystate)            ; stage start message
  "Draw stage start message and set game parameters"
  (when (eql (stage-flag stage) t)
    (setf (stage-flag stage) nil
          (z keystate) nil                                 ; z-key reset
	  (lshift keystate) nil                            ; lshift-key reset
          *rotation* '(0 1 2 3 4 5 6 7)                    ; boss stage set   
          *enemy-generate-flag* t                            
          *bossbgm-on-air* nil)
    (incf (stage-number stage) 1)
    (case (stage-number stage)
      (1 (setf *atlas* *map1*	      
               *BGM* *samplebgm1*
               *enemymap* *enemy-map1*))
      (2 (setf *atlas* *map2*
               *BGM* *samplebgm2*
               *enemymap* *enemy-map2*))
      (3 (setf *atlas* *map3*
               *BGM* *samplebgm3* 
               *enemymap* *enemy-map3*)))
    (sdl:clear-display sdl:*black*)
    (sdl:draw-string-solid-* 
         (format nil "S T A G E  ~d" (stage-number stage)) 272 208 :color sdl:*white* :font *menu-font*)
    (sdl:update-display)
    (sleep 3)
    (Play-music *BGM*)))

;; step 2 <Scroll>
;; -----------------------------------------------------------------------------------------------  
(defvar *scroll-cnt* 0)                                  ; scroll counter
(defvar *map-pointer* 64)                                ; map start line
(defvar *draw-position-y* 0)                             ; y-axis start position
(defvar *repeat* nil)                                    ; scroll repeat flag
(defvar *BGM-change-flag* nil)                           ; BGM --> Boss BGM flag

(defun Rotate-map-pointer ()
  "Move last element to front of the list"
  (let ((x *rotation*))                                  ; list rotation right
    (setf *rotation* (append (last x) (butlast x)))))    ; --> (7 0 1 2 3 4 5 6)

(defun BossBGM-set ()
  (cond ((and (= *map-pointer* 4)                        ; when *map-pointer* is 4
	      (eql *bossbgm-on-air* nil))                ; BGM stop
          (Stop-sound))
        ((and (= *map-pointer* 0)                        ; when *map-pointer* is 0
              (eql *bossbgm-on-air* nil))                ;
          (setf *BGM* *bossbgm*                          ; BossBGM play     
                *BGM-change-flag* t))))                  ; BGM changeflag on

(defun BossBGM-change ()
  (when (eql *BGM-change-flag* t)
    (setf *BGM-change-flag* nil
          *bossbgm-on-air* t)
    (Play-music *BGM*)))                                 ;;;;;Do not use midi file. Delay Happend ! ;;;;;

(defun Set-map-pointer ()
  "Set map pointer"
  (incf *scroll-cnt* 2)                                  ; 2 dot scroll
  (when (eql (mod *scroll-cnt* 64) 0)                    ; mapchip draw position
    (setf *draw-position-y* 0)
    (decf *map-pointer*)                                 ; else scroll-line -1
    (BossBGM-set)
    (BossBGM-change)    
    (when (< *map-pointer* 0)                            ; when scroll-line is 0 (end line)      
      (setf *repeat* t))))                               ; map repeat flag on

(defun Scroll-background (map)
  "draw background"  
    (setf *draw-position-y* (+ -48 (mod *scroll-cnt* 64))) ; scroll start from y(-48) to y(16)
    (cond ((eql *repeat* nil)                              ; when map repeat flag off
            (dotimes (i 8)                                 ; 8 row
              (dotimes (j 5)                               ; 5 column 
                (sdl:draw-surface-at-* *images* (+ 160 (* j 64)) (+ *draw-position-y* (* i 64))
                    :cell (aref map (+ *map-pointer* i) j)))))
          ((eql *repeat* t)                                ; when map repeat flag on
            (when (= (mod *scroll-cnt* 64) 0)              ; when 64 dot scroll
              (Rotate-map-pointer))                        ; map rotate
            (dotimes (i 8)
              (setf *map-pointer* (nth i *rotation*))      ; read element of the list
              (dotimes (j 5)
                (sdl:draw-surface-at-* *images* (+ 160 (* j 64)) (+ *draw-position-y* (* i 64))
                    :cell (aref map *map-pointer* j)))))))

(defun Scroll-mask ()
  (sdl:draw-box-*   0   0 160 480 :color sdl:*black*)    ; mask scroll left  side
  (sdl:draw-box-* 160   0 320  16 :color sdl:*black*)    ; mask scroll upper side
  (sdl:draw-box-* 160 464 320 480 :color sdl:*black*)    ; mask scroll lower side
  (sdl:draw-box-* 480   0 640 480 :color sdl:*black*))   ; mask scroll right side

;; Step4 <Game Start Message>
;; -----------------------------------------------------------------------------------------------
(defvar *screen-mode* 1)        ; screen mode toggle switch  0:fullscreen 1:windowed
(defvar *switch* nil)           ; screen flag

(defgeneric Game-start-message (pointer character stage keystate))
(defmethod Game-start-message (pointer character stage keystate)   ; game start message
  "Draw game opening message"
  (sdl:clear-display sdl:*black*)
  (Stop-sound)                                                     ; stop ending BGM if playing
 ; title
  (dotimes (i 8)                                                   ; show title
    (setf (x character) (+ 192 (* i 32))
          (id character) (+ 19 i))
    (Draw character))
 ; memu
  (sdl:draw-string-solid-* "S T A R T" 224 328 :color sdl:*white* :font *menu-font*) ; show menu
  (if (= *screen-mode* 0)
    (sdl:draw-string-solid-* "S C R E E N : F U L L" 224 360 :color sdl:*white* :font *menu-font*)
    (sdl:draw-string-solid-* "S C R E E N : W I N D O W" 224 360 :color sdl:*white* :font *menu-font*))
  (sdl:draw-string-solid-* "E X I T" 224 392 :color sdl:*white* :font *menu-font*)
 ; select menu
  (cond ((up keystate)                                            ; select menu
         (decf (y pointer) 32) 
         (setf (up keystate) nil) 
         (when (<= (y pointer) 328)                               ; y:328 is START menu position
                (setf (y pointer) 328
                      (start stage) t)))
        ((down keystate)
          (incf (y pointer) 32)
          (setf (down keystate) nil)          
          (when (>= (y pointer) 392)                              ; y:392 is EXIT menu position
            (setf (y pointer) 392
                  (start stage) nil)))
        ((lshift keystate)
          (when (= (y pointer) 360)
            (if (= *screen-mode* 1)                               ; screen-mode toggle switch                   
              (setf *screen-mode* 0)                              ; 0:fullscreen  1:windowed
              (setf *screen-mode* 1))
            (setf *switch* t))
          (setf (lshift keystate) nil)))                     
 ; show pointer
  (sdl:draw-string-solid-* ">" (x pointer) (y pointer) :color sdl:*white* :font *menu-font*)
 ; game start or exit
  (cond ((and (z keystate) (eql (start stage) t) (= (y pointer) 328))              ; input z-key on start menu
          (setf (title-loop stage) nil
                (z keystate) nil))                                                 ; z key state reset 
        ((and (z keystate) (eql (start stage) nil) (= (y pointer) 392))            ; input z-key on exit menu  
          (sdl:push-quit-event)))
  (sdl:update-display))

;; Step12 <N-ship Zero P>
;; -----------------------------------------------------------------------------------------------
(defvar *interval* 0)

(defgeneric N-ship-zero-p (score stage))
(defmethod N-ship-zero-p (score stage)
  (when (= (n-ship score) 0)
    (incf *interval*)
    (stop-sound)
    (when (= *interval* 200)
      (setf *interval* 0
	    (ending-loop stage) t))))

;; Step7 <Reset Variables>
;; -----------------------------------------------------------------------------------------------
(defvar *enemy-map-pointer* 64)
(defvar *stage-end-flag* nil)
(defvar *bossbgm-flag* nil)

(defgeneric Reset-variables (stage enemy-manager balloon-manager score ship shot-manager))
(defmethod Reset-variables (stage enemy-manager balloon-manager score ship shot-manager)
  "reset variables" 
  (setf (title-loop stage) t
        (stage-flag stage) t
	*bossbgm-flag* nil
	*stage-end-flag* nil
        *scroll-cnt* 0
        *draw-position-y* 0
        *map-pointer* 64
        *repeat* nil
        *enemy-map-pointer* 64
        (shot-list shot-manager) nil
	(enemy-list enemy-manager) nil
        (enemy-shot-list enemy-manager) nil
        (stage-number stage) 0
        (balloon-cnt balloon-manager) 0
	(balloon-list balloon-manager) nil
        (score score) 0
        (n-ship score) 3
        (n-bomb score) 3
        (x ship) 304
        (y ship) 416
        (state ship) 1))

;; Step4 <Game Over Message> + score + ship explosion
;; -----------------------------------------------------------------------------------------------
(defgeneric Game-over-message (stage enemy-manager score balloon-manager ship shot-manager keystate)) 
(defmethod Game-over-message (stage enemy-manager score balloon-manager ship shot-manager keystate)
  "Draw game ending" 
  (case (n-ship score)
    ((0)
      ; game over message
      (sdl:draw-string-solid-* "GAME OVER" 284 200  :color sdl:*white* :font *menu-font*)
      (sdl:update-display))
    (otherwise
      (sdl:clear-display sdl:*black*)
      ; congratulations message
      (sdl:draw-string-solid-* "君の活躍によりアボガドロ軍は撤退した。"
                                          178 64  :color sdl:*white* :font *menu-font*)
      ; (sdl:draw-string-solid-* "THE ABOGADRO FORCES WITHDREW BY YOUR SUCCESS"
      ;                                      150 64  :color sdl:*white* :font *menu-font*)
      (sdl:draw-string-solid-* "C O N G R A T U L A T I O N S"
                                             208 96  :color sdl:*white* :font *menu-font*)
      (sdl:draw-string-solid-* "Y O U R S C O R E"
                                             224 160 :color sdl:*white* :font *menu-font*)
      (sdl:draw-string-solid-* (format nil "~5,'0d" (score score))
                                             380 160 :color sdl:*white* :font *menu-font*)
      (sdl:draw-string-solid-* "H I G H S C O R E"      
                                             224 192 :color sdl:*white* :font *menu-font*)
      (sdl:draw-string-solid-* (format nil "~d" (highscore score))        
                                             380 192 :color sdl:*white* :font *menu-font*)
      (sdl:update-display)))

    (when (eql *bossbgm-flag* nil)
      (setf *bossbgm-flag* t 
            *BGM* *endbgm*)             ; set ending BGM
      (sleep 2)                         ; 2 seconds waiting before play ending BGM 
      (Play-music-once *BGM*))          ; BGM play once   
    (when (or (z keystate)                       ; push z key   
	      (not (sdl-mixer:music-playing-p))) ; or BGM end
      (setf (title-loop stage) t                 ; GAME TITLE flag   ON
            (ending-loop stage) nil              ; GAME OVER flag    OFF
            (z keystate) nil)
      (Reset-variables stage enemy-manager balloon-manager score ship shot-manager)))

;; Step4 <Set Screen Mode>
;; -----------------------------------------------------------------------------------------------
(defun Set-screen-mode()
  (when (eql *switch* t) 
    (if (= *screen-mode* 0)                    ; fullscreen-mode on 
      (sdl:resize-window 640 480 :sw t :fullscreen t)
      (sdl:resize-window 640 480 :sw t))       
    (setf *switch* nil)))                      ; twice executing prevent

;; step5 <Score Panel>
;; -----------------------------------------------------------------------------------------------
(defgeneric Score-panel (score score-ship score-bomb))
(defmethod Score-panel (score score-ship score-bomb)
  "draw score and ships of rest"
  (sdl:draw-string-solid-* "SCORE:"       160 16 :color sdl:*white* :font *menu-font*)
  (sdl:draw-string-solid-* "HIGH-SCORE:"  320 16 :color sdl:*white* :font *menu-font*)
  (sdl:draw-string-solid-* (format nil "~5,'0d" (score score))     208 16 :color sdl:*white* :font *menu-font*)
  (sdl:draw-string-solid-* (format nil     "~d" (highscore score)) 408 16 :color sdl:*white* :font *menu-font*)
  (dotimes (i (- (n-ship score) 1))
    (setf (x score-ship) (+ 160 (* 16 i)))
    (Draw score-ship))
  (dotimes (i (n-bomb score))
    (setf (x score-bomb) (+ 160 (* 16 i)))
    (Draw score-bomb)))

;; step6 <Move Shot>
;; -----------------------------------------------------------------------------------------------
(defgeneric Move-shot (shot-manager))
(defmethod Move-shot (shot-manager)
  "shot move"
  (dolist (shot (shot-list shot-manager))               
    (when (= (state shot) 1)                ; shot is alive
      (decf (y shot) (dy shot)))            ; shot 16 dot up 
    (when (< (y shot) -16)                  ; out of screen 
      (setf (state shot) 0))))              ; shot is dead

;; step6 <Set Shot> + Balloon Shot + shot
;; -----------------------------------------------------------------------------------------------
(defgeneric Set-shot (shot-manager ship keystate balloon-manager))
(defmethod Set-shot (shot-manager ship keystate balloon-manager)
  "set shot"
  (when (and (/= (state ship) 2)                          ; if ship is not explode
	     (eql (mod *scroll-cnt* 8) 0)                 ; 1 shot / 8 loop          
             (eql (z keystate) t)                         ; and set z key
             (eql *stage-end-flag* nil))                  ; not stage end
    (when (< (length (shot-list shot-manager)) (* 4 (+ (balloon-cnt balloon-manager) 1)))
      (Play-sample *shot*)
      (let ((shot (make-instance 'entity :id 3 :width 4 :height 16 :dx 0 :dy 16 :state 1)))
        (setf (y shot) (- (y ship) (height shot))         ; set shot position 
              (x shot) (+ (x ship) 14))
          (push shot (shot-list shot-manager)))
       (when (/= (balloon-cnt balloon-manager) 0)
          (dolist (balloon (balloon-list balloon-manager))
            (let ((shot (make-instance 'entity :id 3 :width 4 :height 16 :dx 0 :dy 16 :state 1)))          
              (setf (y shot) (- (y balloon) (height shot)); set balloon shot position
                    (x shot) (+ (x balloon) 14))	 
              (push shot (shot-list shot-manager))))))))

;; step6 <Remove Dead Shot>
;; -----------------------------------------------------------------------------------------------
(defgeneric Remove-dead-shot (shot-manager))
(defmethod Remove-dead-shot (shot-manager)
  "dead shot remove from list"
  (setf (shot-list shot-manager) 
	(delete-if #'(lambda (shot) (= (state shot) 0)) (shot-list shot-manager))))

;; step6 <Draw Shot>
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-shot (shot-manager))
(defmethod Draw-shot (shot-manager)
  (dolist (shot (shot-list shot-manager))
    (when (= (state shot) 1)
      (Draw shot))))                             ; draw shot

;; step7 <Generate Enemy> + Enemy Shot
;; -----------------------------------------------------------------------------------------------
(defgeneric Generate-enemy-item (map enemy-manager item-manager))
(defmethod Generate-enemy-item (map enemy-manager item-manager)
  (when (and (eql *enemy-generate-flag* t)
	     (= (mod *scroll-cnt* 64) 0)
             (<= (length (enemy-list enemy-manager)) 10)); max 10 enemy
     (dotimes (j 10)
       (when (/= (aref map *enemy-map-pointer* j) -1)
         (case (aref map *enemy-map-pointer* j)
                 ((7)                              ; when id is 7
                   (let ((enemy (make-instance 'foe      ; small class yellow enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 32 :height 32
                                 :life-cnt 3 :kind 1 :state 1
				 :beforetime 8 :pattern-number 0 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
	         ((80)                              ; when id is 80
                   (let ((enemy (make-instance 'foe      ; small class purple enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 32 :height 32
                                 :life-cnt 3 :kind 1 :state 1
		                 :beforetime 8 :pattern-number 1 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((50)                              ; when id is 50
                   (let ((enemy (make-instance 'foe      ; small class blue enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 32 :height 32
                                 :life-cnt 3 :kind 1 :state 1
		                 :beforetime 16 :pattern-number 2 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))		
                 ((76)                                ; when id is 76
                   (let ((enemy (make-instance 'foe      ; middle class gray enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 64 :height 64
                                 :life-cnt 20 :kind 2 :state 1
				 :beforetime 32 :pattern-number 3 :pattern-cnt 2 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((78)                                ; when id is 78
                   (let ((enemy (make-instance 'foe      ; middle class green enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 64 :height 64
                                 :life-cnt 20 :kind 2 :state 1
				 :beforetime 32 :pattern-number 5 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
                 ((70)                             ; when id is 70
                   (let ((enemy (make-instance 'foe      ; large class boss1 enemy generate
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 96 :height 96
                                  :life-cnt 300 :kind 3 :state 1
				  :beforetime 64 :pattern-number 6 :pattern-cnt 2 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((71)                             ; when id is 71
                   (let ((enemy (make-instance 'foe      ; large class boss2 enemy generate 
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 96 :height 96
                                  :life-cnt 300 :kind 3 :state 1
				  :beforetime 64 :pattern-number 8 :pattern-cnt 3 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((72)                             ; when id is 72
                   (let ((enemy (make-instance 'foe      ; large class boss3 enemy generate
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 96 :height 96
                                  :life-cnt 300 :kind 3 :state 1
				  :beforetime 64 :pattern-number 11 :pattern-cnt 3 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((17 18)                                ; when id is 17 or 18
                   (let ((item (make-instance 'foe       ; item generate
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 32 :height 32 :dx 0 :dy 2 :kind 4 :state 1)))
                   (push item (item-list item-manager)))))))     ; store items into item-list
     (if (/= *enemy-map-pointer* 0)
       (decf *enemy-map-pointer*)                        ; attention ! *enemy-map-pointer* 0 keep!
       (setf *enemy-generate-flag* nil))))               ; *enemy-map-pointer* 64 -> 0 (end position)  

;; step7 <Judge Stage End>
;; -----------------------------------------------------------------------------------------------
(defgeneric Judge-stage-end (stage enemy-manager score shot-manager))
(defmethod Judge-stage-end (stage enemy-manager score  shot-manager)
  (when (and (eql *stage-end-flag* t)             ; large enemy dead
             (/= (n-ship score) 0))               ; and not n-ship 0
    (incf *interval*)
    (when (= *interval* 200)                      ; original 150     
      (setf *interval* 0
	    *stage-end-flag* nil
            *repeat* nil
            *map-pointer* 64 
            *enemy-map-pointer* 64                ; map and enemy-map set start position
            (shot-list shot-manager) nil
            (enemy-list enemy-manager) nil
	    (stage-flag stage) t)
      (when (= (stage-number stage) 3)
	(Stop-sound)                              ; BGM Stop!
	(setf (ending-loop stage) t)))))          ; GAME OVER flag  ON

;; step7 <Move Enemy>
;; -----------------------------------------------------------------------------------------------
(defgeneric Move-enemy (enemy-manager game-field))
(defmethod Move-enemy (enemy-manager game-field)
  (dolist (enemy (enemy-list enemy-manager))              
    (when (or (= (state enemy) 1)
              (= (state enemy) 2))
      (case (id enemy)
        ((7 8 9 14 15 16 80 81 82 83 84 85)       ; id 7 8 9(yellow enemy) or id 80 81 82(purple enemy)
          (let((row (mod (move-cnt enemy) 16)))   ; row from 0 to 15
            (case (id enemy)
              ((7 8 9 14 15 16)       ; id 7 8 9(yellow enemy)
               (setf (dx enemy) (aref *enemy-move-pattern1* row 0)
                     (dy enemy) (aref *enemy-move-pattern1* row 1)))
              ((80 81 82 83 84 85)    ; id 80 81 82(purple enemy)
               (setf (dx enemy) (aref *enemy-move-pattern3* row 0)
                     (dy enemy) (aref *enemy-move-pattern3* row 1))))))    
        ((50 52 51 53)                ; id 50 52(blue enemy)
          (let((row (mod (move-cnt enemy) 12)))   ; row from 0 to 11
            (setf (dx enemy) (aref *enemy-move-pattern2* row 0)
                  (dy enemy) (aref *enemy-move-pattern2* row 1)))) 
        ((76 78 77 79)                ; id 76 78(middle class gray and green enemy)                 
           (if (or (= (id enemy) 76)
                   (= (id enemy) 77))
             (setf (dx enemy) (first *enemy-move-pattern4*)
                   (dy enemy) (second *enemy-move-pattern4*))
             (setf (dx enemy) (first *enemy-move-pattern5*)
                   (dy enemy) (second *enemy-move-pattern5*))))
        ((70 71 73 74)                ; id 70 71(large class enemy)       
          (let((row (mod (move-cnt enemy) 32)))   ; row from 0 to  31
            (if (or (= (id enemy) 70)
                    (= (id enemy) 73))   
              (setf (dx enemy) (aref *enemy-move-pattern6* row 0)
                    (dy enemy) (aref *enemy-move-pattern6* row 1))
              (setf (dx enemy) (aref *enemy-move-pattern7* row 0)
                    (dy enemy) (aref *enemy-move-pattern7* row 1)))))
        ((72 75)                      ; id 72(large class enemy)
          (setf (dx enemy) (first *enemy-move-pattern8*)
                (dy enemy) (second *enemy-move-pattern8*))))
      (incf (x enemy) (dx enemy))
      (incf (y enemy) (dy enemy))
      (incf (move-cnt enemy) 1)
      (when (or (>= (y enemy) (height game-field))                           ; bottom of game field
                (>= (x enemy) (width game-field))                            ; right of game field   
                (<= (x enemy) (- (field-x game-field) (* 32 (kind enemy))))) ; left of game field
        (setf (state enemy) 0)))))     

;; step10 <Set Reset Id>
;; -----------------------------------------------------------------------------------------------
(defun Set-id (enemy)
  "Set enemy id"
  (case (id enemy)
    (7  (setf (id enemy) 14))
    (8  (setf (id enemy) 15))
    (9  (setf (id enemy) 16))
    (50 (setf (id enemy) 51))
    (52 (setf (id enemy) 53))
    (80 (setf (id enemy) 83))
    (81 (setf (id enemy) 84))
    (82 (setf (id enemy) 85))
    (76 (setf (id enemy) 77))
    (78 (setf (id enemy) 79))
    (70 (setf (id enemy) 73))
    (71 (setf (id enemy) 74))
    (72 (setf (id enemy) 75))))

(defun Reset-id (enemy)
  "Reset enemy id"
  (case (id enemy)
    (14 (setf (id enemy) 7))
    (15 (setf (id enemy) 8))
    (16 (setf (id enemy) 9))
    (51 (setf (id enemy) 50))
    (53 (setf (id enemy) 52))
    (83 (setf (id enemy) 80))
    (84 (setf (id enemy) 81))
    (85 (setf (id enemy) 82))
    (77 (setf (id enemy) 76))
    (79 (setf (id enemy) 78))
    (73 (setf (id enemy) 70))
    (74 (setf (id enemy) 71))
    (75 (setf (id enemy) 72))))

;; step7 <Change Id> + explode
;; -----------------------------------------------------------------------------------------------
(defun Change-id (enemy)
  (when (= (state enemy) 1)
    (Reset-id enemy) 
    (case (id enemy)
      ((7 8 9)
         (case (mod (floor (move-cnt enemy) 16) 4)            ; enemy id change
            (0 (setf (id enemy) 7))                           ; change pattern --> 0~~0, 1~~1, 2~~2 , 3~~3
            (1 (setf (id enemy) 8))                           ;                    id7 , id8 , id9  , id8
            (2 (setf (id enemy) 9))
            (3 (setf (id enemy) 8))))
      ((50 52)
         (case (mod (floor (move-cnt enemy) 16) 2)            ; enemy id change
           (0 (setf (id enemy) 50))                           ; change pattern --> 0~~0, 1~~1
           (1 (setf (id enemy) 52))))                         ;                    id50 , id52
      ((80 81 82)
         (case (mod (floor (move-cnt enemy) 16) 4)            ; enemy id change
           (0 (setf (id enemy) 80))                           ; change pattern --> 0~~0, 1~~1 , 2~~2 , 3~~3
           (1 (setf (id enemy) 81))                           ;                    id80 ,id81 , id82 , id81
           (2 (setf (id enemy) 82))
           (3 (setf (id enemy) 81)))))))

;; step10 <Change Damaged Id>
;; -----------------------------------------------------------------------------------------------
(defun Change-damaged-id (enemy)
  (when (= (state enemy) 2)
    (Set-id enemy)
    (case (id enemy)
      ((14 15 16)
         (case (mod (floor (move-cnt enemy) 16) 4)           ; enemy id change
            (0 (setf (id enemy) 14))                         ; change pattern --> 0~~0, 1~~1 , 2~~2 , 3~~3
            (1 (setf (id enemy) 15))                         ;                    id14 ,id15 , id16  ,id15
            (2 (setf (id enemy) 16))
            (3 (setf (id enemy) 15))))
      ((51 53)
         (case (mod (floor (move-cnt enemy) 16) 2)           ; enemy id change
           (0 (setf (id enemy) 51))                          ; change pattern --> 0~~0, 1~~1
           (1 (setf (id enemy) 53))))                        ;                    id51 , id53
      ((83 84 85)
         (case (mod (floor (move-cnt enemy) 16) 4)           ; enemy id change
           (0 (setf (id enemy) 83))                          ; change pattern --> 0~~0, 1~~1 , 2~~2 , 3~~3
           (1 (setf (id enemy) 84))                          ;                    id83 ,id84 , id85 , id84
           (2 (setf (id enemy) 85))
           (3 (setf (id enemy) 84)))))))

;; step7 <Remove Enemy>
;; -----------------------------------------------------------------------------------------------
(defgeneric Remove-enemy (enemy-manager))
(defmethod Remove-enemy (enemy-manager)
  (setf (enemy-list enemy-manager) 
	(delete-if #'(lambda (enemy) (= (state enemy) 0)) (enemy-list enemy-manager))))

;; step7 <Draw Enemy> + damage
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-enemy (enemy-manager))
(defmethod Draw-enemy (enemy-manager)
  (dolist (enemy (enemy-list enemy-manager))
    (Change-id enemy)
    (Change-damaged-id enemy)
    (when (or (= (state enemy) 1)
              (= (state enemy) 2))
      (Draw enemy))))

;; step8 <Move Balloon> + radian-degree
;; -----------------------------------------------------------------------------------------------
(declaim (inline degree-radian))
(defun degree-radian (degree)                       ; convert from radian to degree
  (/ (* degree pi) 180))                            ; degree -> radian

(declaim (inline radian-degree))
(defun radian-degree (radian)                       ; convert from radian to degree
  (/ (* radian 180) pi))                            ; radian -> degree

(defvar *angle* 0)

(defgeneric Move-balloon (balloon-manager ship))
(defmethod Move-balloon (balloon-manager ship)
  (when (or (= (state ship) 1)
            (= (state ship) 3))
    (when (> *angle* 360)
      (setf *angle* 0))
    (incf *angle* 4)
    (when (<= *angle* 360)
      (let ((i (balloon-cnt balloon-manager))) 
        (dolist (balloon (balloon-list balloon-manager))                   
          (if (= i 2)            ; 48 is distance from left balloon to right balloon
            (setf (x balloon) (+ (x ship) (* (cos (degree-radian *angle*)) 48))
                  (y balloon) (+ (y ship) (* (sin (degree-radian *angle*)) 48)))
            (setf (x balloon) (- (x ship) (* (cos (degree-radian *angle*)) 48))
                  (y balloon) (- (y ship) (* (sin (degree-radian *angle*)) 48))))
          (decf i 1))))))

;; Step8 <Generate Balloon>
;; -----------------------------------------------------------------------------------------------  
(defgeneric Generate-balloon (balloon-manager ship))
(defmethod Generate-balloon (balloon-manager ship)
  "balloon appear position set"
  (when (and (/= (balloon-cnt balloon-manager) 0)
             (< (length (balloon-list balloon-manager)) 2)) ; max 2 balloon   
    (dotimes (i (balloon-cnt balloon-manager))
      (let ((balloon (make-instance 'entity :id 10 :state 1)))
           (if (= i 0)
             (setf (x balloon) (- (x ship) 48)) 
           (setf (x balloon) (+ (x ship) 48)))          
           (setf (y balloon) (y ship))
           (push balloon (balloon-list balloon-manager))))))

;; step8 <Draw Balloon>
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-balloon (balloon-manager ship))
(defmethod Draw-balloon (balloon-manager ship)
  (when (and (or (= (state ship) 1)
                 (= (state ship) 3))
             (/= (balloon-cnt balloon-manager) 0))
    (dolist (balloon (balloon-list balloon-manager))
      (Draw balloon))))

;; Step8 <Move Item>
;; ----------------------------------------------------------------------------------------------- 
(defgeneric Move-item (item-manager game-field))
(defmethod Move-item (item-manager game-field)
  "item move"
  (dolist (item (item-list item-manager))               
    (when (= (state item) 1)                       ; option-item is alive
      (incf (y item) (dy item)))                   ; option-item 16 dot down 
    (when (> (y item) (height game-field))         ; out of screen 
      (setf (state item) 0))))

;; Step8 <Hit Item>
;; ----------------------------------------------------------------------------------------------- 
(defvar *itemget-flag* nil)

(defgeneric Hit-item-p (item-manager balloon-manager score ship))
(defmethod Hit-item-p (item-manager balloon-manager score ship)
  (when (/= (state ship) 2)                                                            
    (dolist (item (item-list item-manager))
      (when(and (> (+ (x ship) 32) (x item))
                (< (x ship) (+ (x item) 32))
                (> (+ (y ship) 32) (y item))
                (< (y ship) (+ (y item) 32)))
          (setf (state item) 0)                    ; item is disappered
          (when (eql *itemget-flag* nil)
            (setf *itemget-flag* t)
            (Play-sample *itemget*))  
          (when (= (id item) 17)
            (if (< (balloon-cnt balloon-manager) 2)
              (incf (balloon-cnt balloon-manager) 1)
              (incf (score score) 500)))
          (when (= (id item) 18)
            (incf (n-bomb score) 1))
          (setf *itemget-flag* nil)))))

;; Step8 <Remove Item>
;; -----------------------------------------------------------------------------------------------      
(defgeneric Remove-item (item-manager))
(defmethod Remove-item (item-manager)
  "item remove from list"
  (setf (item-list item-manager) 
	(delete-if #'(lambda (item) (= (state item) 0)) (item-list item-manager))))

;; step8 <Draw Item>
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-item (item-manager))
(defmethod Draw-item (item-manager)
  (dolist (item (item-list item-manager))
    (Draw item)))

;; Step9 <Move Enemy Shot>
;; -----------------------------------------------------------------------------------------------
(defgeneric Move-enemy-shot (enemy-manager game-field))
(defmethod Move-enemy-shot (enemy-manager game-field)
  "enemy shot move"
  (dolist (enemy-shot (enemy-shot-list enemy-manager))               
    (when (= (state enemy-shot) 1)           ; set enemy-shot state alive
        (incf (x enemy-shot) (dx enemy-shot))
        (incf (y enemy-shot) (dy enemy-shot))
      (when (or (< (x enemy-shot) (- (field-x game-field) 8))
                (> (x enemy-shot) (width game-field))
                (< (y enemy-shot) (- (field-y game-field) 8))
                (> (y enemy-shot) (height game-field)))
        (setf (state enemy-shot) 0)))))

;; Step13 <Charge Enemy Shot>
;; ---------------------------------------------------------------------------------------------
(defun Charge-enemy-shot (enemy enemy-manager)
  (dotimes (i (shotdata-number-battery (aref *shot-pattern-data* (pattern-number enemy))))
    (let ((enemy-shot (make-instance 'entity :id 4 :width 8 :height 8 :dx 0 :dy 0 :state 0)))
      (push enemy-shot (enemy-shot-list enemy-manager)))))

;; Step13 <Set Enemy center>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-center (enemy enemy-shot)
  (case (kind enemy)
    ((1) ; small class enemy
      (setf (y enemy-shot) (+ (y enemy) 12))    ; center of small class enemy x
      (setf (x enemy-shot) (+ (x enemy) 12)))   ; center of small class enemy y 
    ((2) ; middle class enemy
      (setf (y enemy-shot) (+ (y enemy) 28))    ; center of middle class enemy x
      (setf (x enemy-shot) (+ (x enemy) 28)))   ; center of middle class enemy y 
    ((3) ; large class enemy
      (setf (y enemy-shot) (+ (y enemy) 44))    ; center of large class enemy x
      (setf (x enemy-shot) (+ (x enemy) 44))))) ; center of large class enemy y

;; Step13 <Set Repeat Flag OFF>
;; ---------------------------------------------------------------------------------------------
(defun Set-repeat-flag-OFF (enemy)
  (case (id enemy)  ; if enemy is blue or purple, repeat-flag OFF    
    ((80 81 82 83 84 85)                
      (setf (repeat-flag enemy) 0))       
    ((50 51 52 53)
      (setf (repeat-flag enemy) 0))))

;; Step13 <Set Enemy Variables>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-variables (enemy)
  (when (= (count-flag enemy) 0)   ; --- if flag ON, set variables
    (setf (shot-counter enemy)                                  ; set shotcounter    (number of shot per 1 pattern)
	  (shotdata-number-battery-shot (aref *shot-pattern-data* (pattern-number enemy))))
    (setf (timing enemy) (beforetime enemy))                    ; set shot beforetime 
    (setf (pattern-cnt-store enemy) (pattern-cnt enemy))        ; each enemy has 0-2 patterns
    (setf (pattern-number-store enemy) (pattern-number enemy))  ; store patternnumber
    (setf (count-flag enemy) 1)))   ; --- flag OFF, no more set
  
;; Step13 <Set Enemy Shot angle>
;; ---------------------------------------------------------------------------------------------
(defvar *range-x*)
(defvar *range-y*)
(defvar *distance*)

(defun Set-enemy-shot-angle (shotangle ship enemy enemy-shot)
  (let ((angle (nth shotangle (shotdata-battery-angle (aref *shot-pattern-data* (pattern-number enemy)))))
	(rotation-angle (shotdata-direction-battery-angle (aref *shot-pattern-data* (pattern-number enemy))))
   	(speed (shotdata-shotspeed (aref *shot-pattern-data* (pattern-number enemy))))
        (ship-x  (+ (x ship) (/ (width ship) 2)))                  ; ship x position
   	(ship-y  (+ (y ship) (/ (height ship) 2)))                 ; ship y position
   	(ene-shot-x (+ (x enemy-shot) (/ (width enemy-shot) 2)))   ; enemy-shot x position
   	(ene-shot-y (+ (y enemy-shot) (/ (height enemy-shot) 2)))) ; enemy-shot y position
    (case (shotdata-battery-direction (aref *shot-pattern-data* (pattern-number enemy)))
      ((0)  ; beneath
        (when (= rotation-angle 0)  ; not rotation
	     (setf (dx enemy-shot) (* (cos (degree-radian angle)) speed)) ; dx from angle list
	     (setf (dy enemy-shot) (* (sin (degree-radian angle)) speed))); dy from angle list
	(when (/= rotation-angle 0) ; rotation
	     (if (= shotangle 0)
	       (setf (angle-store enemy) (+ (angle-store enemy) rotation-angle)))	
	     (setf (dx enemy-shot) (* (cos (degree-radian (+ angle (angle-store enemy)))) speed)) ; dx from angle list
	     (setf (dy enemy-shot) (* (sin (degree-radian (+ angle (angle-store enemy)))) speed)))); dy from angle list
      ((1)  ; direction of ship
	(setf *range-x* (- ship-x ene-shot-x))
        (setf *range-y* (- ship-y ene-shot-y))
        (setf *distance* (sqrt (+ (* *range-x* *range-x*) (* *range-y* *range-y*))))
        (setf (first-x enemy) (* (/ *range-x* *distance*) speed))    ; x distance from enemy to ship
        (setf (first-y enemy) (* (/ *range-y* *distance*) speed))    ; y distance form enemy to ship  
        (if (< (atan (/ (first-y enemy) (first-x enemy))) 0)         ; find angle in Arc tangent
          (setf (first-angle enemy) (radian-degree (+ (atan (/ (first-y enemy) (first-x enemy))) (/ pi 2))))
          (setf (first-angle enemy) (radian-degree (- (atan (/ (first-y enemy) (first-x enemy))) (/ pi 2)))))
        (when (= rotation-angle 0)  ; not rotation	  
	   (setf (dx enemy-shot) (* (cos (degree-radian (+ angle (first-angle enemy)))) speed))
	   (setf (dy enemy-shot) (* (sin (degree-radian (+ angle (first-angle enemy)))) speed)))
        (when (/= rotation-angle 0) ; rotation 
	     (if (= shotangle 0)
	       (setf (angle-store enemy) (+ (angle-store enemy) rotation-angle)))	   
	   (setf (dx enemy-shot) 
		 (* (cos (degree-radian (+ angle (first-angle enemy) (angle-store enemy)))) speed)) ; dx from angle list
	   (setf (dy enemy-shot)
		 (* (sin (degree-radian (+ angle (first-angle enemy) (angle-store enemy)))) speed))))))); dy from angle list

;; Step13 <Set Enemy Shot Timing>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-shot-timing (ship enemy enemy-manager) 
  (when(and (= (move-cnt enemy) (timing enemy))            ; equal move-cnt and timing 
	    (= (repeat-flag enemy) 1))                     ; and shot repeat
    (let ((shotangle 0))                                   ; set enemy shot direction (start <- 0)
      (dolist (enemy-shot (enemy-shot-list enemy-manager))
        (when (= (state enemy-shot) 0)      
	  (Set-enemy-center enemy enemy-shot)                      ; set enemy center position
	  (Set-enemy-shot-angle shotangle ship enemy enemy-shot)   ; set enemy shot angle
	  (incf shotangle)                                         ; judge length of battery-angle-list
	  (if (= shotangle (length (shotdata-battery-angle (aref *shot-pattern-data* (pattern-number enemy)))))
	    (setf shotangle 0))                                    ; reset shotangle
	  (setf (state enemy-shot) 1))))                           ; shot state ON into battery-angle list
    (setf (shot-counter enemy) (decf (shot-counter enemy))) ; go to next shot timing
    (cond ((/= (shot-counter enemy) 0)            ; when shot counter not 0
	    (setf (timing enemy)                 ; set betweentime
	          (+ (timing enemy) (shotdata-betweentime (aref *shot-pattern-data* (pattern-number enemy))))))
          ((= (shot-counter enemy) 0)             ; when  shot counter 0
	    (setf (timing enemy)                 ; set aftertime
	          (+ (timing enemy) (shotdata-aftertime (aref *shot-pattern-data* (pattern-number enemy)))))
	    (setf (angle-store enemy) 0)    ; angle-store reset 0
	    (setf (pattern-cnt enemy) (decf (pattern-cnt enemy)))       ; go to next pattern  (ex: 1 -> 0)
	    (Set-repeat-flag-OFF enemy))))) ; blue and purple enemy repeat OFF

;; Step13 <Set Enemy Shot Pattern>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-shot-pattern (enemy)
  (when (= (shot-counter enemy) 0)
    (if (= (pattern-cnt enemy) 0)	      ; reset shot pattern 
        (progn	  
          (setf (pattern-cnt enemy) (pattern-cnt-store enemy))        ; back to first pattern count
          (setf (pattern-number enemy) (pattern-number-store enemy))  ; back to first pattern number   
          (setf (shot-counter enemy)                ; back to first shotcounter
   	        (shotdata-number-battery-shot (aref *shot-pattern-data* (pattern-number enemy)))))
	(progn	    
          (setf (pattern-number enemy) (incf (pattern-number enemy))) ; pattern number + 1 (ex: 3 -> 4 etc)   
          (setf (shot-counter enemy)               ; set shotcounter (number of shot per 1 pattern)
	        (shotdata-number-battery-shot (aref *shot-pattern-data* (pattern-number enemy))))))))
    
;; Step9 <Set Enemy Shot>
;; ---------------------------------------------------------------------------------------------
(defgeneric Set-enemy-shot (enemy-manager ship game-field))
(defmethod Set-enemy-shot (enemy-manager ship game-field)
  "enemy shot appear position set and move" 
  (dolist (enemy (enemy-list enemy-manager))
    (when (and (or (= (state enemy) 1)                           ; enemy is alive or damaged
      	           (= (state enemy) 2))		   
	       (>= (x enemy) 0)                                  ; and into the game field
    	       (< (x enemy) (- (width game-field) (width enemy)))
	       (>= (y enemy) 0)
	       (< (y enemy) (- (height game-field) (width enemy))))
      (unless (and (> (+ (x ship) 16) (x enemy))                 ; if ship and enemy are not collision
	      	   (< (+ (x ship) 16) (+ (x enemy) (width enemy)))
		   (> (+ (y ship) 16) (y enemy))
		   (< (+ (y ship) 16) (+ (y enemy) (height enemy))))        
        (Charge-enemy-shot enemy enemy-manager)                  ; charge enemy shot
	(Set-enemy-variables enemy)  
        (Set-enemy-shot-timing ship enemy enemy-manager)
	(Set-enemy-shot-pattern enemy)))))                       ; set enemy shot timing
	     
;; Step9 <Remove Dead Enemy Shot>
;; -----------------------------------------------------------------------------------------------
(defgeneric Remove-dead-enemy-shot (enemy-manager))
(defmethod Remove-dead-enemy-shot (enemy-manager)
  "dead enemy shot remove from list"
  (setf (enemy-shot-list enemy-manager) 
	(delete-if #'(lambda (enemy-shot) (= (state enemy-shot) 0)) (enemy-shot-list enemy-manager))))

;; Step9 <DrawEnemy Shot>
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-enemy-shot (enemy-manager))
(defmethod Draw-enemy-shot (enemy-manager)
  (dolist (enemy-shot (enemy-shot-list enemy-manager))
    (when (= (state enemy-shot) 1)
      (Draw enemy-shot))))

;; Step10 <Enemy Hit P>
;; -----------------------------------------------------------------------------------------------
(defvar *oneup-flag* nil)

(defgeneric Enemy-hit-p (shot-manager enemy-manager))
(defmethod Enemy-hit-p (shot-manager enemy-manager)
  (dolist (shot (shot-list shot-manager))
    (when (= (state shot) 1)                       ; if shot is on                                  
      (dolist (enemy (enemy-list enemy-manager))                
        (when (and (or (= (state enemy) 1)         ; if enemy is alive
                       (= (state enemy) 2))        ; or enemy is damaged 
                   (> (+ (x shot) 4) (x enemy))
                   (< (x shot) (+ (x enemy) (width enemy)))
                   (> (+ (y shot) 16) (y enemy))
                   (< (y shot) (+ (y enemy) (height enemy))))
          (setf (state enemy) 2                    ; enemy is damaged
                (damage-cnt enemy) 0               ; damage counter on
                (state shot) 0)                    ; shot is off
          (when (> (life-cnt enemy) 0)
            (decf (life-cnt enemy) 1)))))))

;; Step10 <Score Up>
;; -----------------------------------------------------------------------------------------------
(defgeneric Score-up (score))
(defmethod Score-up (score)                          
  (when (> (score score) (highscore score))
    (setf (highscore score) (score score)))
  (when (>= (score score) (oneup score))
    (when (eql *oneup-flag* nil)
        (setf *oneup-flag* t)                      ; oneup sound on
        (Play-sample *oneup*))                     ; oneup sound    
    (incf (n-ship score) 1)                        ; plus one ship
    (setf (oneup score) (+ (oneup score) 100000)
          *oneup-flag* nil)))                      ; oneup sound off    

;; Step10 <Damage Counter>
;; -----------------------------------------------------------------------------------------------
(defvar *damage-flag* nil)

(defgeneric Damage-counter (enemy-manager score))
(defmethod Damage-counter (enemy-manager score)
  (dolist (enemy (enemy-list enemy-manager))
    (when (= (state enemy) 2)                     ; if enemy is damaged
      (incf (damage-cnt enemy) 1)                 ; damage-cnt is 3 times loop (from 0 to 3)
      (when (eql *damage-flag* nil)
        (setf *damage-flag* t)                    ; damage sound on
        (Play-sample *damage*))                   ; damage sound         
      (when (= (damage-cnt enemy) 3)        
        (decf (life-cnt enemy) 1)                 ; life-cnt is 3 times loop (form 3 to 0)
        (setf (damage-cnt enemy) 0                ; enemy's damage-cnt reset 0
              (state enemy) 1
              *damage-flag* nil))                 ; damage sound off
      (when (= (life-cnt enemy) 0)
        (case (kind enemy)
          ((1)    
            (incf (score score) 200))             ; small class enemy    200 point 
          ((2)
            (incf (score score) 10000))           ; middle class enemy 10000 point
          ((3)
            (incf (score score) 30000)))          ; large class enemy  30000 point
        (setf (state enemy) 3)))))                ; enemy explode

;; Step10 <Explode Enemy>
;; -----------------------------------------------------------------------------------------------
(defvar *explodes-flag* nil)
(defvar *large-enemy-explosion-flag* nil)

(defgeneric Explode-enemy (enemy-manager))
(defmethod Explode-enemy (enemy-manager)
  "enemy explosion while 16 times loop"
  (dolist (enemy (enemy-list enemy-manager))
    (when (and (= (state enemy) 3)
               (or (= (kind enemy) 1)
                   (= (kind enemy) 2)))    
            (incf (explode-cnt enemy) 1)
            (when (eql *explodes-flag* nil)
              (setf *explodes-flag* t)                  ; explode sound on
              (Play-sample *explodes*))                 ; explode sound              
            (when (= (explode-cnt enemy) 15)            ; enemy explode count 15	      
              (setf (state enemy) 0 
                    *explodes-flag* nil)))))

;; Step10 <Draw Enemy Explosion>
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-enemy-explosion (enemy-explosion enemy-manager))
(defmethod Draw-enemy-explosion (enemy-explosion enemy-manager)
  (dolist (enemy (enemy-list enemy-manager))
    (when (and (= (state enemy) 3)
               (or (= (kind enemy) 1)
                   (= (kind enemy) 2)))    
      (setf (x enemy-explosion) (x enemy)
            (y enemy-explosion) (y enemy))
        (cond ((and (>= (explode-cnt enemy) 0)
                    (<  (explode-cnt enemy) 5))
                (case (kind enemy)
                  ((1)      
                    (setf (id enemy-explosion) 11))    ; bomb id 11
                  ((2)
                    (setf (id enemy-explosion) 64))))  ; bomb id 64     
              ((and (>= (explode-cnt enemy) 5) 
                    (<  (explode-cnt enemy) 10))
	        (case (kind enemy)
		  ((1)
                    (setf (id enemy-explosion) 12))    ; bomb id 12 
		  ((2)
	            (setf (id enemy-explosion) 65))))  ; bomb id 65 
              ((and (>= (explode-cnt enemy) 10)
                    (<  (explode-cnt enemy) 15))
	        (case (kind enemy)
	          ((1)
                    (setf (id enemy-explosion) 13))    ; bomb id 13
		  ((2)
		    (setf (id enemy-explosion) 66))))) ; bomb id 66
      (Draw enemy-explosion))))   

;; step12 <Set Explosion>
;; -----------------------------------------------------------------------------------------------
(defvar *rnd1*)
(defvar *rnd2*)

(defgeneric Set-explosion (explosion-manager enemy-manager))
(defmethod Set-explosion (explosion-manager enemy-manager)
  "set explosion"
  (dolist (enemy (enemy-list enemy-manager))
    (when (and (= (state enemy) 3)
               (= (kind enemy) 3))
      (when (and (= (mod (bomb-cnt explosion-manager) 15) 0)  ; bomb-cnt is 150 -> 10 times
                 (/= (bomb-cnt explosion-manager) 0))     
        (dotimes (i (bomb-number explosion-manager))          ; 5 bomb
          (let ((bomb (make-instance 'entity :id 64 :width 64 :height 64 :state 1)))
            (setf *rnd1* (random 96)                          ;  x: from -32 to 96
                  *rnd2* (random 96))                         ;  y: from -32 to 96 
            (setf (x bomb) (- (+ (x enemy) *rnd1*) 32)
                  (y bomb) (- (+ (y enemy) *rnd2*) 32)) 
            (push bomb (bomb-list explosion-manager)))))                 
            (decf (bomb-cnt explosion-manager))                     ; decrement bomb-cnt 150 -> 0        
            (when (= (bomb-cnt explosion-manager) 0)                ; if bomb counter is 0 , reset 150
              (setf (bomb-cnt explosion-manager) 150
		    (state enemy) 0
                    *stage-end-flag* t)                             ; stage end!
              (Stop-sound)))))                                      ; BGM stop!

;; step12 <Explode Large Enemy>
;; -----------------------------------------------------------------------------------------------
(defvar *large-enemy-explodes-flag* nil)

(defgeneric Explode-large-enemy (explosion-manager))
(defmethod Explode-large-enemy (explosion-manager)
  "large enemy explosion while 15 times loop"
    (dolist (bomb (bomb-list explosion-manager))   
      (incf (explode-cnt bomb) 1)      
      (when (eql *large-enemy-explodes-flag* nil)
        (setf *large-enemy-explodes-flag* t)          ; bomb explode sound on
        (Play-sample *bomb*))                         ; bomb explode sound                           
      (when (= (explode-cnt bomb) 15)                 ; when bomb explode count is 15
        (setf (state bomb) 0                          ; set state of bomb  0
              *large-enemy-explodes-flag* nil)))) 

;; step12 <Remove Explode large enemy>
;; -----------------------------------------------------------------------------------------------
(defgeneric Remove-explode-large-enemy (explosion-manager))
(defmethod Remove-explode-large-enemy (explosion-manager)
  "explode bomb remove from list"
  (setf (bomb-list explosion-manager) 
	(delete-if #'(lambda (bomb) (= (state bomb) 0)) (bomb-list explosion-manager))))

;; step12 <Draw Explosion Large Enemy>
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-explosion-large-enemy (explosion-manager))
(defmethod Draw-explosion-large-enemy (explosion-manager)
  (dolist (bomb (bomb-list explosion-manager))
    (when (= (state bomb) 1)
      (cond ((and (>= (explode-cnt bomb) 0)
                  (<  (explode-cnt bomb) 5))
              (setf (id bomb) 64))
            ((and (>= (explode-cnt bomb) 5) 
                  (<  (explode-cnt bomb) 10))
              (setf (id bomb) 65))
            ((and (>= (explode-cnt bomb) 10)
                  (<  (explode-cnt bomb) 15))          
              (setf (id bomb) 66)))
      (Draw bomb))))                                     ; draw  bomb

;; step11 <Set Bomb Key>
;; -----------------------------------------------------------------------------------------------
(define-class bomb-manager ()
  (bomb-list bomb-cnt bomb-flag bomb-number) nil)
; bomb-list    list of bomb       
; bomb-cnt     60 times waiting   
; bomb-flag    on (exploding) / off(not exploding)
; bomb-number  max 10

(defgeneric Set-bomb-key (ship bomb-manager keystate score))
(defmethod Set-bomb-key (ship bomb-manager keystate score)
  "bomb key push"
  (when (and (/= (state ship) 2)
             (/= (n-bomb score) 0)
             (eql (bomb-flag bomb-manager) nil)
             (eql (lshift keystate) t)
	     (eql *stage-end-flag* nil))        ; not stage end
    (decf (n-bomb score) 1)                     ; decrement n-bomb    3 -> 0     
    (setf (bomb-flag bomb-manager) t            ; bomb-flag ON
          (lshift keystate) nil)))              ; reset lshift key
        
;; step11 <Set Bomb>
;; -----------------------------------------------------------------------------------------------
(defgeneric Set-bomb (bomb-manager enemy-manager))
(defmethod Set-bomb (bomb-manager enemy-manager)
  "set bomb"
  (when (eql (bomb-flag bomb-manager) t)          ; when bomb-flag is ON
    (when (and (= (mod (bomb-cnt bomb-manager) 15) 0)
               (> (bomb-cnt bomb-manager) 0))      
      (dotimes (i (bomb-number bomb-manager))
        (let ((bomb (make-instance 'entity :id 67 :width 64 :height 64 :state 1)))
	  (setf *rnd1* (random 256)
                *rnd2* (random 384))
          (setf (x bomb) (+ 160 *rnd1*)
                (y bomb) (+ 16  *rnd2*)) 
          (push bomb (bomb-list bomb-manager))))      
      (dolist (enemy (enemy-list enemy-manager))
        (when (or (= (state enemy) 1)               ; if enemy is alive
                  (= (state enemy) 2))              ; or enemy is damaged
          (setf (state enemy) 2
                (damage-cnt enemy) 0)
          (decf (life-cnt enemy) 1))))
    (decf (bomb-cnt bomb-manager) 1)              ; decrement bomb-cnt 60 -> 0
    (when (= (bomb-cnt bomb-manager) 0)           ; if bomb counter is 0 , reset 60
      (setf (bomb-cnt bomb-manager) 60            ; and set bomb flag nil 
            (bomb-flag bomb-manager) nil))))    
                                                      
;; step11 <Explode Bomb>
;; -----------------------------------------------------------------------------------------------
(defvar *bomb-explodes-flag* nil)

(defgeneric Explode-bomb (bomb-manager enemy-manager))
(defmethod Explode-bomb (bomb-manager enemy-manager)
  "bomb explosion while 15 times loop"
  (dolist (bomb (bomb-list bomb-manager))
     (incf (explode-cnt bomb) 1)      
      (when (eql *bomb-explodes-flag* nil)
        (setf *bomb-explodes-flag* t)             ; bomb explode sound on
        (Play-sample *bomb*))                     ; bomb explode sound                           
      (when (= (explode-cnt bomb) 15)             ; when bomb explode count is 15
        (setf (state bomb) 0                      ; set state of bomb  0
              *bomb-explodes-flag* nil)
        (dolist (enemy-shot (enemy-shot-list enemy-manager))
          (setf (state enemy-shot) 0)))))         ; set state of enemy-shot 0

;; step11 <Remove Explode Bomb>
;; -----------------------------------------------------------------------------------------------
(defgeneric Remove-explode-bomb (bomb-manager))
(defmethod Remove-explode-bomb (bomb-manager)
  "explode bomb remove from list"
  (setf (bomb-list bomb-manager) 
	(delete-if #'(lambda (bomb) (= (state bomb) 0)) (bomb-list bomb-manager))))

;; step11 <Draw Bomb>
;; -----------------------------------------------------------------------------------------------
(defgeneric Draw-bomb (bomb-manager))
(defmethod Draw-bomb (bomb-manager)
  (dolist (bomb (bomb-list bomb-manager))
    (when (= (state bomb) 1)
      (cond ((and (>= (explode-cnt bomb) 0)
                  (<  (explode-cnt bomb) 5))
              (setf (id bomb) 67))
            ((and (>= (explode-cnt bomb) 5) 
                  (<  (explode-cnt bomb) 10))
              (setf (id bomb) 68))
            ((and (>= (explode-cnt bomb) 10)
                  (<  (explode-cnt bomb) 15))          
              (setf (id bomb) 69)))
      (Draw bomb))))                                     ; draw  bomb

;; Step12 <Ship Hit P>
;; -----------------------------------------------------------------------------------------------
(defgeneric Ship-hit-p (ship enemy-manager balloon-manager score shot-manager))
(defmethod Ship-hit-p (ship enemy-manager balloon-manager score shot-manager)
  (when (= (state ship) 1)
    (let ((hit 0))
      (dolist (enemy (enemy-list enemy-manager))
        (when (and (or (= (state enemy) 1)              ; if enemy is alive
                       (= (state enemy) 2))             ; or enemy is damaged
                 (> (+ (x ship) 16) (x enemy))          ; 16 is center of ship
                 (< (+ (x ship) 16) (+ (x enemy) (width enemy)))    ; width enemy
                 (> (+ (y ship) 16) (y enemy))
                 (< (+ (y ship) 16) (+ (y enemy) (height enemy))))  ; height enemy
            (if (/= (kind enemy) 3)      ; when not large enemy
              (setf (state enemy) 0      ; small or middle enemy explosion
                     hit 1)
              (setf (state enemy) 3      ; large enemy is dameged
	             hit 1))))
      (dolist (enemy-shot (enemy-shot-list enemy-manager))
        (when (and (= (state enemy-shot) 1)            ; enemies shot and ship hit
                  (> (+ (x ship) 16) (x enemy-shot))
                  (< (+ (x ship) 16) (+ (x enemy-shot) (width enemy-shot)))
                  (> (+ (y ship) 16) (y enemy-shot))
                  (< (+ (y ship) 16) (+ (y enemy-shot) (height enemy-shot))))
          (setf (state enemy-shot) 0
                 hit 1)))
      (when (= hit 1)                                  ; hit on ship  
        (Play-sample *crushed*)                        ; ship crushed sound
        (setf (state ship) 2                           ; ship is explode
	      (shot-list shot-manager) nil
              (balloon-cnt balloon-manager) 0
	      (balloon-list balloon-manager) nil
              (n-bomb score) 3
              (explode-cnt ship) 0)))))                ; ship explode count 0

;; Step12 <Explode Counter>
;; ----------------------------------------------------------------------------------------------- 
(defgeneric Explode-counter (ship score game-field stage))
(defmethod Explode-counter (ship score game-field stage)     
  (when (= (state ship) 2)                    ; ship is explode
    (incf (explode-cnt ship) 1)      
    (when (= (explode-cnt ship) 100)
      (decf (n-ship score) 1)
      (when (> (n-ship score) 0)
        (setf (state ship) 3                  ; set ship revival
	      (revival-cnt ship) 0
	      (x ship) (- (* (field-x game-field) 2) (/ (width ship) 2))
	      (y ship) (- (height game-field) (* (height ship) 2)))))))    

;; Step12 <Revive Counter>
;; ----------------------------------------------------------------------------------------------- 
(defgeneric Revive-counter (ship enemy-manager))
(defmethod Revive-counter (ship enemy-manager)
  (when (= (state ship) 3)                            ; ship is revival
    (incf (revival-cnt ship) 1)
    (when (>= (revival-cnt ship) 200)                 ; revival counter is over 200
    (dolist (enemy (enemy-list enemy-manager))
      (unless (and (or (= (state enemy) 1)            ; if enemy is alive
                       (= (state enemy) 2))           ; or enemy is damaged
                 (> (+ (x ship) 16) (x enemy))        ; 16 is center of ship
                 (< (+ (x ship) 16) (+ (x enemy) (width enemy)))      ; width enemy
                 (> (+ (y ship) 16) (y enemy))
                 (< (+ (y ship) 16) (+ (y enemy) (height enemy))))))  ; height enemy
      (setf (state ship) 1))))

;; Step12 <Draw Ship Explosion>
;; ----------------------------------------------------------------------------------------------- 
(defgeneric Draw-ship-explosion (ship explosion))
(defmethod Draw-ship-explosion (ship explosion)
  (when (and (= (state ship) 2)
                (< (explode-cnt ship) 30))               
    (setf (x explosion) (- (x ship) 16)           ; x : center of explosion 
          (y explosion) (y ship))                 ; y : center of explosion
    (cond ((<= (explode-cnt ship) 10)
            (setf (id explosion) 47))
          ((and (> (explode-cnt ship) 10) 
                (<= (explode-cnt ship) 20))
            (setf (id explosion) 48))
         ((> (explode-cnt ship) 20)          
            (setf (id explosion) 49)))
     (Draw explosion)))                           ; draw ship explosion

;; Step12 <Draw Ship>
;; ----------------------------------------------------------------------------------------------- 
(defgeneric Draw-ship (ship))
(defmethod Draw-ship (ship)
  (when (or (= (state ship) 1)
            (and (= (state ship) 3)
       	         (> 5 (mod (revival-cnt ship) 10))))   ; ship flushes on and off
    (Draw ship)))                                      ; draw ship revival
  
;; step1 <Game Frame>
;; -----------------------------------------------------------------------------------------------
(defun Common-abogadro ()
  "main routine"
  (sdl:with-init (sdl:sdl-init-video sdl:sdl-init-audio) ; use video and audio
    (sdl:window 640 480 :position 'center                ; size 640*480, position center
                      ; :position #(192 50)              ;               position x(192) y(50)
                        :title-caption "ABOGADRO"
                        :icon-caption  "ABOGADRO"  
                        :flags '(sdl:sdl-doublebuf sdl:sdl-sw-surface))

    ; <Initialize>
      (Initialize)                                       ; graphics initialize

    ; <Set Font>
      (Set-font)                                         ; set font

    ; <Audio>
      (Open-sound)                                       ; sound open

    ; <Set Charactor Object>
      (let((ship (make-instance         'entity :id 0 :x 304 :y 416 :width 32 :height 32 :dx 4 :dy 4 :state 1))
           (keystate (make-instance     'keystate))         
           (game-field (make-instance   'game-field :field-x 160 :field-y 16 :width 480 :height 464))
           (stage (make-instance        'stage :stage-number (or nil 0) :title-loop t :ending-loop nil)) 
           (character (make-instance    'object :id 19 :y 100))
           (pointer (make-instance      'object :x 208 :y 328))
           (score (make-instance        'score  :highscore 50000 :oneup 50000 :n-ship 3 :n-bomb 3))           
           (score-ship (make-instance   'object :id 5 :x 160 :y 48))
           (score-bomb (make-instance   'object :id 6 :x 160 :y 448))
           (shot-manager (make-instance 'shot-manager))
           (enemy-manager (make-instance 'enemy-manager))
           (balloon-manager (make-instance 'balloon-manager :balloon-cnt (or nil 0)))
           (item-manager (make-instance 'item-manager))
	   (enemy-explosion (make-instance 'object :id 11))
	   (bomb-manager (make-instance 'bomb-manager :bomb-cnt (or nil 60) :bomb-number (or nil 10)))
	   (explosion (make-instance 'object :id 47))
           (explosion-manager (make-instance 'explosion-manager :bomb-cnt (or nil 150) :bomb-number (or nil 5)))) 

      (sdl:with-events (:poll)
        (:quit-event ()
          (setf *screen-mode* 1
                *switch* nil)
          (Reset-variables stage enemy-manager balloon-manager score ship shot-manager)
	  (Stop-sound)
          (Close-sound)
          t)

      ; <Update Key State> 
        (:key-down-event (:key key)
          (if (sdl:key= key :SDL-KEY-ESCAPE)
              (sdl:push-quit-event)
	  (Update-keystate key t keystate)))
        (:key-up-event (:key key)
          (Update-keystate key nil keystate)
          (setf (id ship) 0))                                 ; set ship id 0 (normal form)  

        (:idle ()
        ;<Title Loop> 
	  (when (and (eql (title-loop stage) t)               ; GAME TITLE flag   ON
                     (eql (ending-loop stage) nil))           ; GAME OVER flag    OFF
            (Game-start-message pointer character stage keystate))

	;<Game Over Loop>  
	  (when (and (eql (title-loop stage) nil)             ; GAME TITLE flag   OFF
                     (eql (ending-loop stage) t))             ; GAME OVER flag    ON
	    (Game-over-message stage enemy-manager score balloon-manager ship shot-manager keystate))
                   
        ; <Game Loop> 
          (when (and (eql (title-loop stage) nil)             ; GAME TITLE flag   OFF
	             (eql (ending-loop stage) nil))           ; GAME OVER flag    OFF

          ; <Set Screen Mode> 
            (Set-screen-mode)
          ; <Clear Display>                  
            (sdl:clear-display sdl:*black*)
          ; <Show Message and sound start>
            (Stage-start-message stage keystate)
          ; <Draw Map>
            (Scroll-background *atlas*)          
          ; <Move Ship> 
	    (Move-ship ship keystate)
          ; <Fix Ship Position>
	    (Fix-ship-position ship game-field)

          ; <Enemy :Move Generate Draw Remove>
            (Move-enemy enemy-manager game-field)
	    (Remove-enemy enemy-manager)
            (Generate-enemy-item *enemymap* enemy-manager item-manager)	    
            (Draw-enemy enemy-manager)
                       
          ; <Item : Move Draw Remove Hit>
	    (Move-item item-manager game-field)	        
            (hit-item-p item-manager balloon-manager score ship)
	    (Remove-item item-manager)
            (Draw-item item-manager)
	
          ; <Balloon :Move Set Draw>
            (Move-balloon balloon-manager ship)
            (Generate-balloon balloon-manager ship)
            (Draw-balloon balloon-manager ship)

	  ; <Enemy-shot :Move Set Draw Remove>  
	    (Move-enemy-shot enemy-manager game-field)
	    (Remove-dead-enemy-shot enemy-manager)
	    (Set-enemy-shot enemy-manager ship game-field)
            (Draw-enemy-shot enemy-manager)               ; draw enemy shot

	  ; <Enemy-hit-p :Damage Draw Explode>
	    (Enemy-hit-p shot-manager enemy-manager)
            (Damage-counter enemy-manager score)
            (Explode-enemy enemy-manager)
	    (Draw-enemy-explosion enemy-explosion enemy-manager)
            (Score-up score)

	  ; <Large Enemy Explosion>  
	    (Set-explosion explosion-manager enemy-manager)
	    (Explode-large-enemy explosion-manager)
	    (Remove-explode-large-enemy explosion-manager)
	    (Draw-explosion-large-enemy explosion-manager)	    

	  ; <Bomb :Set Explode Draw Remove>  
	    (Set-bomb-key ship bomb-manager keystate score)
            (Set-bomb bomb-manager enemy-manager)
            (Explode-bomb bomb-manager enemy-manager)	    
	    (Remove-explode-bomb bomb-manager)
	    (Remove-dead-enemy-shot enemy-manager)
	    (Draw-bomb bomb-manager)
     
          ; <Shot :Move Set Draw Delete> 
            (Move-shot shot-manager)
	    (Remove-dead-shot shot-manager)
	    (Set-shot shot-manager ship keystate balloon-manager)            
            (Draw-shot shot-manager)            

	  ; <Ship :Hit Explode Revive Draw>  
	    (Ship-hit-p ship enemy-manager balloon-manager score shot-manager)
	    (Remove-dead-shot shot-manager)
	    (Explode-counter ship score game-field stage)
	    (Draw-ship-explosion ship explosion)
            (Revive-counter ship enemy-manager)
	    (Draw-ship ship)
	    
          ; <Upper and Lower Window Mask>
            (Scroll-mask)
          ; <Draw Score Panel>
            (Score-panel score score-ship score-bomb)
          ; <Set Map Pinter> 
            (Set-map-pointer)                                         ; set map draw point
	  ; <Judge Stage End>	    
            (Judge-stage-end stage enemy-manager score shot-manager)  ; judge GAME OVER
	  ; <N-ship Zero P>  
	    (N-ship-zero-p score stage)                               ; judge GAME OVER

            (sdl:update-display)))))))

(common-abogadro)

Lisp Game Programming 2 <Stage 13-2 Barrage>

Road to the Programmer

Stage1のボスキャラの弾幕(ショットパターン:6、7)
f:id:tomekame0126:20151019222841p:plain
Stage2のボスキャラの弾幕(ショットパターン:8、9、10)
※8と9は32方向に円形の弾幕を張り、10はshipに向かって10連発
f:id:tomekame0126:20151019222924p:plain
ミドルクラスの敵の弾幕(ショットパターン:3、4)
※3は回転しながら4方向に5連発、4はshipに向かって5連発
f:id:tomekame0126:20151019222931p:plain
Stage3のボスキャラの弾幕(ショットパターン:11、12、13)
f:id:tomekame0126:20151021232402p:plain
f:id:tomekame0126:20151028220154p:plain
さて今回作成したものは以下。
先に作成したショットパターンを読み込むためのプログラムを追加。

;; step13 <Enemy Shot Data>
;; -----------------------------------------------------------------------------------------------  
(load "C:\\work\\shot-data.lisp")

ショットパターンのためのクラスは、データ保存のために作成。

;;step13 <Enemy Shot Pattern>
;; -----------------------------------------------------------------------------------------------
(define-class shotpattern ()
  (timing angle-store shot-counter beforetime pattern-number pattern-number-store 
   pattern-cnt pattern-cnt-store repeat-flag count-flag first-x first-y first-angle) 0)
 ; timing                shottiming
 ; angle-store           angle-store
 ; shot-counter          number of shot per battery 
 ; beforetime            interval before shot
 ; pattern-number        shotpattern0-13
 ; pattern-number-store  store pattern number
 ; pattern-cnt           number of shotpattern
 ; pattern-cnt-store     store pattern counter
 ; repeat-flag           0:once 1:repeat
 ; count-flag            repeat count
 ; first-x               x position of first shot
 ; first-y               y position of first shot
 ; first-angle           angle of first shot

敵クラスfoeは、ショットパターンも継承するように変更

(define-class foe (entity shotpattern)
  (move-cnt damage-cnt life-cnt kind) 0)
 ; move-cnt   moving counter      (distance)  
 ; damage-cnt enemy damage counter(wait)
 ; life-cnt   enemy life counter  (life time)
 ; kind       kind of enemy

Step9で作成した敵弾の扱いは以下のように大幅に変更。

;; Step13 <Charge Enemy Shot>
;; ---------------------------------------------------------------------------------------------
(defun Charge-enemy-shot (enemy enemy-manager)
  (dotimes (i (shotdata-number-battery (aref *shot-pattern-data* (pattern-number enemy))))
    (let ((enemy-shot (make-instance 'entity :id 4 :width 8 :height 8 :dx 0 :dy 0 :state 0)))
      (push enemy-shot (enemy-shot-list enemy-manager)))))

;; Step13 <Set Enemy center>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-center (enemy enemy-shot)
  (case (kind enemy)
    ((1) ; small class enemy
      (setf (y enemy-shot) (+ (y enemy) 12))    ; center of small class enemy x
      (setf (x enemy-shot) (+ (x enemy) 12)))   ; center of small class enemy y 
    ((2) ; middle class enemy
      (setf (y enemy-shot) (+ (y enemy) 28))    ; center of middle class enemy x
      (setf (x enemy-shot) (+ (x enemy) 28)))   ; center of middle class enemy y 
    ((3) ; large class enemy
      (setf (y enemy-shot) (+ (y enemy) 44))    ; center of large class enemy x
      (setf (x enemy-shot) (+ (x enemy) 44))))) ; center of large class enemy y

;; Step13 <Set Repeat Flag OFF>
;; ---------------------------------------------------------------------------------------------
(defun Set-repeat-flag-OFF (enemy)
  (case (id enemy)  ; if enemy is blue or purple, repeat-flag OFF    
    ((80 81 82 83 84 85)                
      (setf (repeat-flag enemy) 0))       
    ((50 51 52 53)
      (setf (repeat-flag enemy) 0))))

;; Step13 <Set Enemy Variables>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-variables (enemy)
  (when (= (count-flag enemy) 0)   ; --- if flag ON, set variables
    (setf (shot-counter enemy)                                  ; set shotcounter    (number of shot per 1 pattern)
	  (shotdata-number-battery-shot (aref *shot-pattern-data* (pattern-number enemy))))
    (setf (timing enemy) (beforetime enemy))                    ; set shot beforetime 
    (setf (pattern-cnt-store enemy) (pattern-cnt enemy))        ; each enemy has 0-2 patterns
    (setf (pattern-number-store enemy) (pattern-number enemy))  ; store patternnumber
    (setf (count-flag enemy) 1)))   ; --- flag OFF, no more set
  
;; Step13 <Set Enemy Shot angle>
;; ---------------------------------------------------------------------------------------------
(defvar *range-x*)
(defvar *range-y*)
(defvar *distance*)

(defun Set-enemy-shot-angle (shotangle ship enemy enemy-shot)
  (let ((angle (nth shotangle (shotdata-battery-angle (aref *shot-pattern-data* (pattern-number enemy)))))
	(rotation-angle (shotdata-direction-battery-angle (aref *shot-pattern-data* (pattern-number enemy))))
   	(speed (shotdata-shotspeed (aref *shot-pattern-data* (pattern-number enemy))))
        (ship-x  (+ (x ship) (/ (width ship) 2)))                  ; ship x position
   	(ship-y  (+ (y ship) (/ (height ship) 2)))                 ; ship y position
   	(ene-shot-x (+ (x enemy-shot) (/ (width enemy-shot) 2)))   ; enemy-shot x position
   	(ene-shot-y (+ (y enemy-shot) (/ (height enemy-shot) 2)))) ; enemy-shot y position
    (case (shotdata-battery-direction (aref *shot-pattern-data* (pattern-number enemy)))
      ((0)  ; beneath
        (when (= rotation-angle 0)  ; not rotation
	     (setf (dx enemy-shot) (* (cos (degree-radian angle)) speed)) ; dx from angle list
	     (setf (dy enemy-shot) (* (sin (degree-radian angle)) speed))); dy from angle list
	(when (/= rotation-angle 0) ; rotation
	     (if (= shotangle 0)
	       (setf (angle-store enemy) (+ (angle-store enemy) rotation-angle)))	
	     (setf (dx enemy-shot) (* (cos (degree-radian (+ angle (angle-store enemy)))) speed)) ; dx from angle list
	     (setf (dy enemy-shot) (* (sin (degree-radian (+ angle (angle-store enemy)))) speed)))); dy from angle list
      ((1)  ; direction of ship
	(setf *range-x* (- ship-x ene-shot-x))
        (setf *range-y* (- ship-y ene-shot-y))
        (setf *distance* (sqrt (+ (* *range-x* *range-x*) (* *range-y* *range-y*))))
        (setf (first-x enemy) (* (/ *range-x* *distance*) speed))    ; x distance from enemy to ship
        (setf (first-y enemy) (* (/ *range-y* *distance*) speed))    ; y distance form enemy to ship  
        (if (< (atan (/ (first-y enemy) (first-x enemy))) 0)         ; find angle in Arc tangent
          (setf (first-angle enemy) (radian-degree (+ (atan (/ (first-y enemy) (first-x enemy))) (/ pi 2))))
          (setf (first-angle enemy) (radian-degree (- (atan (/ (first-y enemy) (first-x enemy))) (/ pi 2)))))
        (when (= rotation-angle 0)  ; not rotation	  
	   (setf (dx enemy-shot) (* (cos (degree-radian (+ angle (first-angle enemy)))) speed))
	   (setf (dy enemy-shot) (* (sin (degree-radian (+ angle (first-angle enemy)))) speed)))
        (when (/= rotation-angle 0) ; rotation 
	     (if (= shotangle 0)
	       (setf (angle-store enemy) (+ (angle-store enemy) rotation-angle)))	   
	   (setf (dx enemy-shot) 
		 (* (cos (degree-radian (+ angle (first-angle enemy) (angle-store enemy)))) speed)) ; dx from angle list
	   (setf (dy enemy-shot)
		 (* (sin (degree-radian (+ angle (first-angle enemy) (angle-store enemy)))) speed))))))); dy from angle list

;; Step13 <Set Enemy Shot Timing>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-shot-timing (ship enemy enemy-manager) 
  (when(and (= (move-cnt enemy) (timing enemy))            ; equal move-cnt and timing 
	    (= (repeat-flag enemy) 1))                     ; and shot repeat
    (let ((shotangle 0))                                   ; set enemy shot direction (start <- 0)
      (dolist (enemy-shot (enemy-shot-list enemy-manager))
        (when (= (state enemy-shot) 0)      
	  (Set-enemy-center enemy enemy-shot)                      ; set enemy center position
	  (Set-enemy-shot-angle shotangle ship enemy enemy-shot)   ; set enemy shot angle
	  (incf shotangle)                                         ; judge length of battery-angle-list
	  (if (= shotangle (length (shotdata-battery-angle (aref *shot-pattern-data* (pattern-number enemy)))))
	    (setf shotangle 0))                                    ; reset shotangle
	  (setf (state enemy-shot) 1))))                           ; shot state ON into battery-angle list
    (setf (shot-counter enemy) (decf (shot-counter enemy))) ; go to next shot timing
    (cond ((/= (shot-counter enemy) 0)            ; when shot counter not 0
	    (setf (timing enemy)                 ; set betweentime
	          (+ (timing enemy) (shotdata-betweentime (aref *shot-pattern-data* (pattern-number enemy))))))
          ((= (shot-counter enemy) 0)             ; when  shot counter 0
	    (setf (timing enemy)                 ; set aftertime
	          (+ (timing enemy) (shotdata-aftertime (aref *shot-pattern-data* (pattern-number enemy)))))
	    (setf (angle-store enemy) 0)    ; angle-store reset 0
	    (setf (pattern-cnt enemy) (decf (pattern-cnt enemy)))       ; go to next pattern  (ex: 1 -> 0)
	    (Set-repeat-flag-OFF enemy))))) ; blue and purple enemy repeat OFF

;; Step13 <Set Enemy Shot Pattern>
;; ---------------------------------------------------------------------------------------------
(defun Set-enemy-shot-pattern (enemy)
  (when (= (shot-counter enemy) 0)
    (if (= (pattern-cnt enemy) 0)	      ; reset shot pattern 
        (progn	  
          (setf (pattern-cnt enemy) (pattern-cnt-store enemy))        ; back to first pattern count
          (setf (pattern-number enemy) (pattern-number-store enemy))  ; back to first pattern number   
          (setf (shot-counter enemy)                ; back to first shotcounter
   	        (shotdata-number-battery-shot (aref *shot-pattern-data* (pattern-number enemy)))))
	(progn	    
          (setf (pattern-number enemy) (incf (pattern-number enemy))) ; pattern number + 1 (ex: 3 -> 4 etc)   
          (setf (shot-counter enemy)               ; set shotcounter (number of shot per 1 pattern)
	        (shotdata-number-battery-shot (aref *shot-pattern-data* (pattern-number enemy))))))))

なお、弾幕を設定するにあたり、Step7も以下のように各敵ごとのショットパターンの設定を行った。

茶色の敵:連射  :初弾までのタイミング  8 :ショットパターン 0
紫色の敵:単射  :初弾までのタイミング  8 :ショットパターン 1
青色の敵:単射  :初弾までのタイミング 16 :ショットパターン 2
灰色の敵:連射  :初弾までのタイミング 32 :ショットパターン 3  4
緑色の敵:連射  :初弾までのタイミング 32 :ショットパターン 5
ボス1 :連射  :初弾までのタイミング 64 :ショットパターン 6  7
ボス2 :連射  :初弾までのタイミング 64 :ショットパターン 8  9 10
ボス3 :連射  :初弾までのタイミング 64 :ショットパターン 11 12 13 

;; step7 <Generate Enemy> + Enemy Shot
;; -----------------------------------------------------------------------------------------------
(defgeneric Generate-enemy-item (map enemy-manager item-manager))
(defmethod Generate-enemy-item (map enemy-manager item-manager)
  (when (and (eql *enemy-generate-flag* t)
	     (= (mod *scroll-cnt* 64) 0)
             (<= (length (enemy-list enemy-manager)) 10)); max 10 enemy
     (dotimes (j 10)
       (when (/= (aref map *enemy-map-pointer* j) -1)
         (case (aref map *enemy-map-pointer* j)
                 ((7)                              ; when id is 7
                   (let ((enemy (make-instance 'foe      ; small class yellow enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 32 :height 32
                                 :life-cnt 3 :kind 1 :state 1
				 :beforetime 8 :pattern-number 0 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
	         ((80)                              ; when id is 80
                   (let ((enemy (make-instance 'foe      ; small class purple enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 32 :height 32
                                 :life-cnt 3 :kind 1 :state 1
		                 :beforetime 8 :pattern-number 1 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((50)                              ; when id is 50
                   (let ((enemy (make-instance 'foe      ; small class blue enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 32 :height 32
                                 :life-cnt 3 :kind 1 :state 1
		                 :beforetime 16 :pattern-number 2 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))		
                 ((76)                                ; when id is 76
                   (let ((enemy (make-instance 'foe      ; middle class gray enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 64 :height 64
                                 :life-cnt 20 :kind 2 :state 1
				 :beforetime 32 :pattern-number 3 :pattern-cnt 2 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((78)                                ; when id is 78
                   (let ((enemy (make-instance 'foe      ; middle class green enemy generate
                                 :id (aref map *enemy-map-pointer* j)
                                 :x (+ 160 (* j 32)) :y 0 :width 64 :height 64
                                 :life-cnt 20 :kind 2 :state 1
				 :beforetime 32 :pattern-number 5 :pattern-cnt 1 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
                 ((70)                             ; when id is 70
                   (let ((enemy (make-instance 'foe      ; large class boss1 enemy generate
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 96 :height 96
                                  :life-cnt 300 :kind 3 :state 1
				  :beforetime 64 :pattern-number 6 :pattern-cnt 2 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((71)                             ; when id is 71
                   (let ((enemy (make-instance 'foe      ; large class boss2 enemy generate 
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 96 :height 96
                                  :life-cnt 300 :kind 3 :state 1
				  :beforetime 64 :pattern-number 8 :pattern-cnt 3 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((72)                             ; when id is 72
                   (let ((enemy (make-instance 'foe      ; large class boss3 enemy generate
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 96 :height 96
                                  :life-cnt 300 :kind 3 :state 1
				  :beforetime 64 :pattern-number 11 :pattern-cnt 3 :repeat-flag 1)))
                   (push enemy (enemy-list enemy-manager))))
		 ((17 18)                                ; when id is 17 or 18
                   (let ((item (make-instance 'foe       ; item generate
                                  :id (aref map *enemy-map-pointer* j)
                                  :x (+ 160 (* j 32)) :y 0 :width 32 :height 32 :dx 0 :dy 2 :kind 4 :state 1)))
                   (push item (item-list item-manager)))))))     ; store items into item-list
     (if (/= *enemy-map-pointer* 0)
       (decf *enemy-map-pointer*)                        ; attention ! *enemy-map-pointer* 0 keep!
       (setf *enemy-generate-flag* nil))))               ; *enemy-map-pointer* 64 -> 0 (end position)  

H27.10.28追記
stage3の渦巻き型の弾幕がなかなか見事なので掲載。