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

`(kakko ,man)

Find a guide into tomorrow by taking lessons from the past

cl-glut pre-study <page 7>

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

レッスン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)

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