Paste number 27272: Nehe Tutorail 6 in cl-opengl

Paste number 27272: Nehe Tutorail 6 in cl-opengl
Pasted by: charlieb
When:18 years, 5 months ago
Share:Tweet this! | http://paste.lisp.org/+L1K
Channel:None
Paste contents:
Raw Source | XML | Display As
(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))))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.