(defpackage "NEHE-CL-GL" (:use :cl) (:export #:nehe1 #:nehe2 #:nehe3 #:nehe4 #:nehe5 #:nehe6)) (in-package :nehe-cl-gl) (defclass first-window (glut:window) () (:default-initargs :pos-x 100 :pos-y 100 :width 640 :height 480 :title "NEHE 1" :mode '(:single :rgb :depth))) (defmethod initialize-instance :after ((w first-window) &key) (gl:shade-model :smooth) (gl:clear-color 0 0 0 0) (gl:clear-depth 1) (gl:enable :depth-test) (gl:depth-func :lequal) (gl:hint :perspective-correction-hint :nicest)) (defmethod glut:display ((w first-window)) (gl:clear :color-buffer-bit :depth-buffer-bit) (gl:load-identity)) (defmethod glut:reshape ((w first-window) width height) (if (zerop height) (setq height 1)) (gl:viewport 0 0 width height) (gl:matrix-mode :projection) (gl:load-identity) (glu:perspective 45 (/ width height) 0.1 100) (gl:matrix-mode :modelview) (gl:load-identity)) (defmethod glut:keyboard ((w first-window) key x y) (case (character key) (#\Escape (glut:leave-main-loop)))) (defun nehe1 () (unwind-protect (glut:display-window (make-instance 'first-window)))) ;; ----- NEHE 5 -------- (defclass color-3D-polygon-rotate (first-window) ((triangle-rotation :accessor triangle-rotation :initform 0.0) (quad-rotation :accessor quad-rotation :initform 0.0)) (:default-initargs :title "NEHE 5" :mode '(:double :rgb :depth))) (defmethod initialize-instance :after ((w color-3D-polygon-rotate) &key)) (defmethod draw-pyramid ((w color-3D-polygon-rotate)) (gl:with-primitives :triangles (gl:color 1 0 0) (gl:vertex 0 1 0) ; Top (gl:color 0 1 0) (gl:vertex -1 -1 1) ; Bottom (gl:color 0 0 1) (gl:vertex 1 -1 1) ; Bottom (gl:color 1 0 0) (gl:vertex 0 1 0) ; Top (gl:color 0 1 0) (gl:vertex 1 -1 1) ; Bottom (gl:color 0 0 1) (gl:vertex 1 -1 -1) ; Bottom (gl:color 1 0 0) (gl:vertex 0 1 0) ; Top (gl:color 0 1 0) (gl:vertex 1 -1 -1) ; Bottom (gl:color 0 0 1) (gl:vertex -1 -1 -1) ; Bottom (gl:color 1 0 0) (gl:vertex 0 1 0) ; Top (gl:color 0 1 0) (gl:vertex -1 -1 -1) ; Bottom (gl:color 0 0 1) (gl:vertex -1 -1 1) ; Bottom )) (defmethod draw-cube ((w color-3D-polygon-rotate)) (gl:with-primitives :quads (gl:Color 0 1 0); Set The Color To Green (gl:Vertex 1 1 -1); Top Right Of The Quad (Top) (gl:Vertex -1 1 -1); Top Left Of The Quad (Top) (gl:Vertex -1 1 1); Bottom Left Of The Quad (Top) (gl:Vertex 1 1 1); Bottom Right Of The Quad (Top) (gl:Color 1 0.5 0); Set The Color To Orange (gl:Vertex 1 -1 1); Top Right Of The Quad (Bottom) (gl:Vertex -1 -1 1); Top Left Of The Quad (Bottom) (gl:Vertex -1 -1 -1); Bottom Left Of The Quad (Bottom) (gl:Vertex 1 -1 -1); Bottom Right Of The Quad (Bottom) (gl:Color 1 0 0); Set The Color To Red (gl:Vertex 1 1 1); Top Right Of The Quad (Front) (gl:Vertex -1 1 1); Top Left Of The Quad (Front) (gl:Vertex -1 -1 1); Bottom Left Of The Quad (Front) (gl:Vertex 1 -1 1); Bottom Right Of The Quad (Front) (gl:Color 1 1 0); Set The Color To Yellow (gl:Vertex 1 -1 -1); Bottom Left Of The Quad (Back) (gl:Vertex -1 -1 -1); Bottom Right Of The Quad (Back) (gl:Vertex -1 1 -1); Top Right Of The Quad (Back) (gl:Vertex 1 1 -1); Top Left Of The Quad (Back) (gl:Color 0 0 1); Set The Color To Blue (gl:Vertex -1 1 1); Top Right Of The Quad (Left) (gl:Vertex -1 1 -1); Top Left Of The Quad (Left) (gl:Vertex -1 -1 -1); Bottom Left Of The Quad (Left) (gl:Vertex -1 -1 1); Bottom Right Of The Quad (Left) (gl:Color 1 0 1); Set The Color To Violet (gl:Vertex 1 1 -1); Top Right Of The Quad (Right) (gl:Vertex 1 1 1); Top Left Of The Quad (Right) (gl:Vertex 1 -1 1); Bottom Left Of The Quad (Right) (gl:Vertex 1 -1 -1); Bottom Right Of The Quad (Right) )) (defmethod glut:display ((w color-3D-polygon-rotate)) (call-next-method) (gl:load-identity) (gl:translate -1.5 0.0 -6) (gl:rotate (triangle-rotation w) 0 1 0) (draw-pyramid w) (gl:load-identity) (gl:translate 1.5 0.0 -7) (gl:rotate (quad-rotation w) 1 0 0) (draw-cube w) (glut:swap-buffers) (gl:flush)) (defmethod glut:idle ((w color-3D-polygon-rotate)) (incf (triangle-rotation w) 2.0) (decf (quad-rotation w) 1.5) (glut:post-redisplay)) (defun nehe5 () (unwind-protect (glut:display-window (make-instance 'color-3D-polygon-rotate))))