;;;;

;;;;
;;; Nehe Lesson #11 - A Waving Flag

(in-package :xlui)

(defun draw-cube (twidth theight)
  "Assumes the GLContext has been set!"
  (let ((v0 {1.0 1.0 1.0})
        (v1 {-1.0 1.0 1.0})
        (v2 {-1.0 -1.0 1.0})
        (v3 {1.0 -1.0 1.0})
        (v4 {1.0 -1.0 -1.0})
        (v5 {1.0 1.0 -1.0})
        (v6 {-1.0 1.0 -1.0})
        (v7 {-1.0 -1.0 -1.0}))
    (gl:with-gl GL_QUADS

      ;; Front Face
      (glNormal3f 0.0 0.0 1.0)
      (glTexCoord2f 0.0 0.0)         (glVertex3fv v2)
      (glTexCoord2f twidth 0.0)      (glVertex3fv v3)
      (glTexCoord2f twidth theight)  (glVertex3fv v0)
      (glTexCoord2f 0.0 theight)     (glVertex3fv v1)
      ;; Back Face
      (glNormal3f 0.0 0.0 -1.0)
      (glTexCoord2f twidth 0.0)      (glVertex3fv v7)
      (glTexCoord2f twidth theight)  (glVertex3fv v6)
      (glTexCoord2f 0.0 theight)     (glVertex3fv v5)
      (glTexCoord2f 0.0 0.0)         (glVertex3fv v4)
      ;; Top Face
      (glNormal3f 0.0 1.0 0.0)
      (glTexCoord2f 0.0 theight)     (glVertex3fv v6)
      (glTexCoord2f 0.0 0.0)         (glVertex3fv v1)
      (glTexCoord2f twidth 0.0)      (glVertex3fv v0)
      (glTexCoord2f twidth theight)  (glVertex3fv v5)
      ;; Bottom Face
      (glNormal3f 0.0 -1.0 0.0)
      (glTexCoord2f twidth theight)  (glVertex3fv v4)
      (glTexCoord2f 0.0 theight)     (glVertex3fv v7)
      (glTexCoord2f 0.0 0.0)         (glVertex3fv v2)
      (glTexCoord2f twidth 0.0)      (glVertex3fv v3)
      ;; Right Face
      (glNormal3f 1.0 0.0 0.0)
      (glTexCoord2f twidth 0.0)      (glVertex3fv v4)
      (glTexCoord2f twidth theight)  (glVertex3fv v5)
      (glTexCoord2f 0.0 theight)     (glVertex3fv v0)
      (glTexCoord2f 0.0 0.0)         (glVertex3fv v3)
      ;; Left Face
      (glNormal3f -1.0 0.0 0.0)
      (glTexCoord2f 0.0 0.0)         (glVertex3fv v2)
      (glTexCoord2f twidth 0.0)      (glVertex3fv v1)
      (glTexCoord2f twidth theight)  (glVertex3fv v6)
      (glTexCoord2f 0.0 theight)     (glVertex3fv v7))))

;;;; **** ;;;;

(defclass nehe-view (agent-3d-view)
  ())

(defmethod texture-file ((view nehe-view) texture-name)
  (native-path "dt:data;nehe" texture-name))

(defmethod init ((view nehe-view))
  (glShadeModel GL_SMOOTH)
  (glClearColor 0.0 0.0 0.0 0.5)
  (glClearDepth 1.0d0)
  (glEnable GL_DEPTH_TEST)
  (glDepthFunc GL_LEQUAL)
  (glEnable GL_LIGHT0)
  (glEnable GL_LIGHTING)
  (glEnable GL_COLOR_MATERIAL)
  (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST))

(defclass nehe-lesson-11 (nehe-view)
  ())

(defmethod init  ((view nehe-lesson-11))
;; Back facing polygons are filled, while front facing are only outlined.
;; Apparently this is a setting of "personal preference" and the topic is more
;; fully discussedin the Red Book.
  (glShadeModel GL_SMOOTH)
  (glEnable GL_TEXTURE_2D)
  (glClearColor 0.0 0.0 0.0 0.5)
  (glClearDepth 1.0d0)
  (glEnable GL_DEPTH_TEST)
  (glDepthFunc GL_LEQUAL)
  (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
  (glPolygonMode GL_BACK GL_FILL)
  (glPolygonMode GL_FRONT GL_LINE))
  
(defclass flag (agent-3d)
  ((wiggle-count :accessor wiggle-count :initarg :wiggle-count :initform 0
                 :documentation "How fast the flag waves.")
   (points :accessor points :documentation "Points on the mesh of the texture that will be 'waved.'")))

(defmethod initialize-instance :after ((self flag) &rest initargs)
  (declare (ignore initargs))
  (let ((arr (make-array '(45 45 3) :initial-element 0.0)))
    (dotimes (x 45)
      (dotimes (y 45)
        (setf (aref arr x y 0) (- (/ x 5.0) 4.5)
              (aref arr x y 1) (- (/ y 5.0) 4.5)
              (aref arr x y 2) (sin (* 2 (coerce PI 'single-float) (/ (* (/ x 5.0) 40.0) 360.0))))))
    (setf (points self) arr)))

(defmethod draw ((agent flag))
  (with-slots (points) agent
    (use-texture (view agent) "Tim.bmp")
    (gl:with-gl GL_QUADS
      (dotimes (x 44)
        (dotimes (y 44)
          (let ((xb (1+ x))           (yb (1+ y))
                (fx (/ x 44.0))       (fy (/ y 44.0))
                (fxb (/ (1+ x) 44.0)) (fyb (/ (1+ y) 44.0))) ;; Texture coordinates for the flag.
            (glTexCoord2f fx fy)
            (glVertex3f (aref points x y 0) (aref points x y 1) (aref points x y 2))
            (glTexCoord2f fx fyb)
            (glVertex3f (aref points x yb 0) (aref points x yb 1) (aref points x yb 2))
            (glTexCoord2f fxb fyb)
            (glVertex3f (aref points xb yb 0) (aref points xb yb 1) (aref points xb yb 2))
            (glTexCoord2f fxb fy)
            (glVertex3f (aref points xb y 0) (aref points xb y 1) (aref points xb y 2))))))
    (if (= (wiggle-count agent) 10)
      (progn
        (dotimes (y 45)
          (let ((hold (aref points 0 y 2)))
            (dotimes (x 44)
              (setf (aref points x y 2) (aref points (1+ x) y 2)))
            (setf (aref points 44 y 2) hold)))
        (setf (wiggle-count agent) 0)))
    (incf (wiggle-count agent))
    (incf (pitch agent) 0.03) ;; Rotation around x plane.
    (incf (heading agent) 0.02) ;; Rotation around y plane.
    (incf (roll agent) 0.04) ;; Rotation around z plane.
    (glDisable GL_TEXTURE_2D)))

(defun nehe-lesson-11 ()
  (slui (:application-window :title "Nehe Lesson #10"
         (:nehe-lesson-11 :name "FlagView"
          (:flag :name "Flag")))))

;;;;
;;; Nehe Lesson #12 - Display Lists

(defparameter *initial-box-colors* (list {1.0 0.0 0.0}
                                         {1.0 0.5 0.0}
                                         {1.0 1.0 0.0}
                                         {0.0 1.0 0.0}
                                         {0.0 1.0 1.0}))
(defparameter *initial-top-colors* (list {0.5 0.0 0.0}
                                         {0.5 0.25 0.0}
                                         {0.5 0.5 0.0}
                                         {0.0 0.5 0.0}
                                         {0.0 0.5 0.5}))
(defclass q-bert-blocks (agent-3d)
  ((box-colors :accessor box-colors
               :initform (make-array '(5) :initial-contents *initial-box-colors*))
   (top-colors :accessor top-colors
               :initform (make-array '(5) :initial-contents *initial-top-colors*))
   (box :accessor box :initform nil :documentation "Reference for the display lists.")
   (top :accessor top :initform nil)))

(defun build-lists (q-bert)
  (with-slots (box top) q-bert
    (setf box (glGenLists 2))
    (glNewList box GL_COMPILE)
    (draw-cube 1.0 1.0)
    (glEndList)

    (setf top (1+ box))
    (glNewList top GL_COMPILE)
    (gl:with-gl GL_QUADS
      (glTexCoord2f 0.0 1.0) (glVertex3f -1.0 1.0 -1.0)
      (glTexCoord2f 0.0 0.0) (glVertex3f -1.0 1.0 1.0)
      (glTexCoord2f 1.0 0.0) (glVertex3f 1.0 1.0 1.0)
      (glTexCoord2f 1.0 1.0) (glVertex3f 1.0 1.0 -1.0))
    (glEndList)))

(defmethod draw ((agent q-bert-blocks))
  (unless (and (slot-boundp agent 'box)
               (not (null (box agent))))
    (build-lists agent))
  (dotimes (yloop 5)
    (dotimes (xloop (1+ yloop))
      (glPushMatrix)
      (glTranslatef (+ 1.4 (- (* xloop 2.8) (* yloop 1.4)))
                    (- 6.0 (* yloop 2.4) 7.0)
                    (- 20.0))
      (glRotatef (- 45.0 (+ (* 2.0 yloop) (pitch agent))) 1.0 0.0 0.0)
      (glRotatef (+ 45.0 (heading agent)) 0.0 1.0 0.0)
      (glColor3fv (aref (box-colors agent) yloop))
      (glCallList (box agent))
      (glColor3fv (aref (top-colors agent) yloop))
      (glCallList (top agent))
      (glPopMatrix))))
      
(defun nehe-lesson-12 ()
  (slui (:application-window :title "NeHe Lesson #12"
                             (:nehe-view :name "QBert"
                                         (:q-bert-blocks)))))
      
;;;;
;;; NeHe Lesson #16 - Fog

(defclass nehe-fog-view (nehe-view)
  ((filter :accessor filter :initarg :filter)
   (fog-modes :accessor fog-mode :initarg :fog-mode :initform (list GL_EXP GL_EXP2 GL_LINEAR))
   (fog-filter :accessor fog-filter :initarg :fog-filter :initform 0)
   (fog-color :accessor fog-color :initarg :fog-color :initform {0.5 0.5 0.5 1.0})))

(defmethod init ((view nehe-fog-view))
  (with-slots (fog-modes fog-filter fog-color) view
    (glShadeModel GL_SMOOTH)
    (glClearColor 0.5 0.5 0.5 1.0)
    (glClearDepth 1.0d0)
    (glEnable GL_DEPTH_TEST)
    (glDepthFunc GL_LEQUAL)
    (glEnable GL_LIGHT0)
    (glEnable GL_LIGHTING)
    (glEnable GL_COLOR_MATERIAL)
    (glHint GL_PERSPECTIVE_CORRECTION_HINT GL_NICEST)
    (glFogi GL_FOG_MODE (nth fog-filter fog-modes))
    (glFogfv GL_FOG_COLOR fog-color)
    (glFogf GL_FOG_DENSITY 0.35)
    (glHint GL_FOG_HINT GL_DONT_CARE)
    (glFogf GL_FOG_START 1.0)
    (glFogf GL_FOG_END 5.0)
    (glEnable GL_FOG)))

(defmethod draw ((view nehe-fog-view))
  (glEnable GL_TEXTURE_2D)
  (use-texture view "BoxImg01.jpg")
  (glScalef 3.0 3.0 3.0)
  (draw-cube 1.0 1.0)
  (glDisable GL_TEXTURE_2D))
    
(defun nehe-lesson-16 ()
  (slui (:application-window :title "NeHe Lesson #16 - Fog"
                             (:nehe-fog-view :name "FogView"))))