source: trunk/source/examples/rubix/lights.lisp @ 13474

Last change on this file since 13474 was 6230, checked in by gb, 13 years ago

Use new syntax: OBJC:DEFMETHOD, #/, MAKE-INSTANCE.

Handle CGFLOAT issues in mouse event handlers.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.2 KB
Line 
1(in-package :cl-user)
2
3;; ah, lights, one of my favorite subjects in OpenGL -- because they way
4;; they work when you're using C++ stinks! I seem to recall i have extensive
5;; discussions of how i would rather deal with TL&M if i was using lisp in
6;; one of my code files somewhere, but first let me get it working then i can
7;; get it working properly
8
9(defclass light ()
10  ((lightid :initform 0 :initarg :lightid :accessor lightid)
11   (on-p :initform nil :accessor on-p)
12   (pointsourcep :initform nil :initarg :pointsourcep :accessor pointsourcep)
13   (location :initform nil :initarg :location :accessor location)
14   (ambient :initform nil :initarg :ambient :accessor ambient)
15   (diffuse :initform nil :initarg :diffuse :accessor diffuse)
16   (specular :initform nil :initarg :specular :accessor specular))
17  (:default-initargs :location (make-array 4 :initial-element 0.0 ; lights are special!
18                                           :element-type 'single-float)
19                     :ambient (make-array 4 :initial-element 0.0
20                                           :element-type 'single-float)
21                     :diffuse (make-array 4 :initial-element 0.0
22                                           :element-type 'single-float)
23                     :specular (make-array 4 :initial-element 0.0
24                                           :element-type 'single-float)))
25
26(defmethod on ((light light))
27  (#_glEnable (lightid light))
28  (setf (on-p light) t))
29(defmethod off ((light light))
30  (#_glDisable (lightid light))
31  (setf (on-p light) nil))
32
33(defmethod setlocation ((light light) pos)
34  (dotimes (i 3) (setf (elt (location light) i) (elt pos i)))
35  (ccl::%stack-block ((foreign-float-vector (* 4 4))) ; make room for 4 single-floats
36    (ccl::%copy-ivector-to-ptr (location light) ; source
37      0     ; offset to first element (alignment padding)
38      foreign-float-vector ; destination
39      0                    ; byte offset in destination
40      (* 4 4))             ; number of bytes to copy
41    (#_glLightfv (lightid light) #$GL_POSITION foreign-float-vector)))
42(defmethod setpointsource ((light light) bool)
43  (setf (pointsourcep light) (if bool t nil) ; <- don't hang on to non-nils
44        (elt (location light) 3) (if bool 1.0 0.0))
45  (ccl::%stack-block ((foreign-float-vector (* 4 4))) ; make room for 4 single-floats
46    (ccl::%copy-ivector-to-ptr (location light) ; source
47      0     ; offset to first element (alignment padding)
48      foreign-float-vector ; destination
49      0                    ; byte offset in destination
50      (* 4 4))             ; number of bytes to copy
51    (#_glLightfv (lightid light) #$GL_POSITION foreign-float-vector)))
52
53(defmethod setambient ((light light) color)
54  (dotimes (i 4) (setf (elt (ambient light) i) (elt color i)))
55  (ccl::%stack-block ((foreign-float-vector (* 4 4))) ; make room for 4 single-floats
56    (ccl::%copy-ivector-to-ptr (ambient light) ; source
57      0     ; offset to first element (alignment padding)
58      foreign-float-vector ; destination
59      0                    ; byte offset in destination
60      (* 4 4))             ; number of bytes to copy
61    (#_glLightfv (lightid light) #$GL_AMBIENT foreign-float-vector)))
62(defmethod setdiffuse ((light light) color)
63  (dotimes (i 4) (setf (elt (diffuse light) i) (elt color i)))
64  (ccl::%stack-block ((foreign-float-vector (* 4 4))) ; make room for 4 single-floats
65    (ccl::%copy-ivector-to-ptr (diffuse light) ; source
66      0     ; offset to first element (alignment padding)
67      foreign-float-vector ; destination
68      0                    ; byte offset in destination
69      (* 4 4))             ; number of bytes to copy
70    (#_glLightfv (lightid light) #$GL_DIFFUSE foreign-float-vector)))
71(defmethod setspecular ((light light) color)
72  (dotimes (i 4) (setf (elt (specular light) i) (elt color i)))
73  (ccl::%stack-block ((foreign-float-vector (* 4 4))) ; make room for 4 single-floats
74    (ccl::%copy-ivector-to-ptr (specular light) ; source
75      0     ; offset to first element (alignment padding)
76      foreign-float-vector ; destination
77      0                    ; byte offset in destination
78      (* 4 4))             ; number of bytes to copy
79    (#_glLightfv (lightid light) #$GL_SPECULAR foreign-float-vector)))
Note: See TracBrowser for help on using the repository browser.