/[cello]/cello/nehe-14x.lisp
ViewVC logotype

Contents of /cello/nehe-14x.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Sat Jun 3 12:05:54 2006 UTC (7 years, 10 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +4 -4 lines
Somewhat resurrected; clean compile anyway
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;; nehe-14.lisp --- Celtk/Togl version of
3 ;;; nehe lesson 14 spinning text string
4 ;;;
5
6 (defpackage :nehe-06
7 (:use :common-lisp :utils-kt :cells :celtk :kt-opengl :cl-ftgl))
8
9 (in-package :nehe-06)
10
11 (defparameter g_rot 0.0f0)
12 (defvar *frames*)
13 (defvar *start*)
14 (defvar *test-fonts*)
15
16 (defun test-font (mode)
17 (cdr (assoc mode *test-fonts*)))
18
19 #+test
20 (nehe-14)
21
22 (defun nehe-14 () ;; ACL project manager needs a zero-argument function, in project package
23 (setf ogl::*gl-begun* nil)
24 (setq *test-fonts*
25 (mapcar (lambda (mode)
26 (cons mode (ftgl-make mode *gui-style-default-face* 48 96 18)))
27 '(:texture :pixmap :bitmap :outline :polygon :extruded)))
28 (test-window 'nehe-14-demo))
29
30 (defmodel nehe-14-demo (window)
31 ()
32 (:default-initargs
33 :title$ "NeHe's OpenGL Framework"
34 :kids (c? (the-kids
35 (mk-stack (:packing (c?pack-self))
36 (make-instance 'nehe14
37 :fm-parent *parent*
38 :width 400 :height 400
39 :timer-interval 1 #+later (c? (let ((n$ (md-value (fm-other :vtime))))
40 (format nil "~a" (max 1 (or (parse-integer n$ :junk-allowed t) 0)))))
41 :double 1 ;; "yes"
42 ))))))
43
44 (defmodel nehe14 (togl)
45 ((frame-count :cell nil :initform 0 :accessor frame-count)
46 (t0 :cell nil :initform 0 :accessor t0)
47 ;
48 (width :initarg :wdith :initform 640 :accessor width)
49 (height :initarg :wdith :initform 400 :accessor height)))
50
51 (defmethod togl-timer-using-class ((self nehe14))
52 (trc nil "enter nehe-14 timer" self (togl-ptr self) (get-internal-real-time))
53 (togl-post-redisplay (togl-ptr self)))
54
55 (defmethod togl-reshape-using-class ((self nehe14))
56 (let ((width (togl-width (togl-ptr self)))
57 (height (togl-height (togl-ptr self))))
58 (trc "reshape" width height)
59 (unless (or (zerop width) (zerop height))
60 (trc "reshape" width height)
61 (gl-viewport 0 0 width height)
62 (gl-matrix-mode gl_projection)
63 (gl-load-identity)
64 (glu-perspective 70 1 1 1000)
65 (glu-look-at 0d0 0d0 5d0 0d0 0d0 0d0 0d0 1d0 0d0)
66
67 (gl-matrix-mode gl_modelview)
68 (gl-load-identity)
69 (gl-clear-depth 1d0))))
70
71 (defmethod togl-display-using-class ((self nehe14))
72 (incf *frames*)
73 (gl-load-identity) ;; Reset The Current Modelview Matrix
74 (gl-clear-color 0 0 0 1)
75 (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit))
76
77 (gl-translatef 0.0f0 0.0f0 2.0f0) ;; Move Into The Screen
78 ;; Pulsing Colors Based On The Rotation
79 (gl-color3f (* 1.0f0 (cos (/ g_rot 20.0f0)))
80 (* 1.0f0 (sin (/ g_rot 25.0f0)))
81 (- 1.0f0 (* 0.5f0 (cos (/ g_rot 17.0f0)))))
82
83 (gl-scalef 0.006 0.006 0.0)
84 (gl-disable gl_lighting)
85 (gl-translatef -100 -200 0)
86 (gl-enable gl_texture_2d)
87 (ftgl-render (test-font :texture)
88 (format nil "texture ~d" (floor (/ *frames*
89 (max 1 (- (now) *start*))))))
90 (gl-translatef 100 200 0)
91
92 (gl-translatef -100 200 0)
93 (gl-line-width 3)
94 (ftgl-render (test-font :outline) "un-rotated outline")
95 (gl-translatef 100 -200 0)
96
97 (gl-translatef -200 100 0)
98 (ftgl-render (test-font :polygon) "un-rotated polygon")
99 (gl-translatef 200 -100 0)
100
101 (with-matrix ()
102 (gl-polygon-mode gl_front_and_back gl_line)
103 (gl-rotatef g_rot 1.0f0 0.5f0 0.0f0)
104 (gl-scalef 4 4 4)
105 (gl-translatef -70 -20 0)
106 (ftgl-render (test-font :extruded) "NeHe")
107 (gl-polygon-mode gl_front_and_back gl_fill)
108 )
109
110 (gl-rotatef g_rot 1.0f0 0.0f0 0.0f0) ;; Rotate On The X Axis
111 (gl-rotatef (* g_rot 1.5f0) 0.0f0 1.0f0 0.0f0) ;; Rotate On The Y Axis
112 (gl-rotatef (* g_rot 1.4f0) 0.0f0 0.0f0 1.0f0) ;; Rotate On The Z Axis
113
114 (gl-push-matrix)
115
116 (gl-enable gl_texture_2d)
117 (gl-disable gl_lighting)
118 (ftgl-render (test-font :texture) "NeHe 14 texture")
119
120 (gl-raster-pos3i 10 10 0)
121 (ftgl-render (test-font :pixmap) "NeHe 14 pixmap")
122
123 (gl-raster-pos3i 10 -30 0)
124 (ftgl-render (test-font :bitmap) "NeHe 14 bitmap")
125
126 (gl-pop-matrix)
127 (togl-swap-buffers (togl-ptr self))
128 (incf g_rot 0.4f0))
129
130
131 (defmethod togl-create-using-class ((self nehe14))
132 (setf *start* (now)
133 *frames* 0)
134 (gl-matrix-mode gl_projection)
135 (gl-load-identity)
136 (glu-perspective 70 1 1 1000)
137 (glu-look-at 0d0 0d0 5d0 0d0 0d0 0d0 0d0 1d0 0d0)
138
139 (gl-matrix-mode gl_modelview)
140 (gl-load-identity)
141 (gl-clear-depth 1d0))
142
143 #+wait
144 (defmethod togl-display-using-class ((win nehe14))
145 (progn ;; flet ((test-font (id) (cdr (assoc id (font-cache win)))))
146 (ogl::with-matrix-mode GL_MODELVIEW
147 (gl-load-identity)
148 (gl-clear-color 0.0 0.0 0.0 1.0)
149
150 (gl-clear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
151
152 ;; --- you are here ---
153 (gl-color3f 1.0 1.0 0.0)
154 (gl-rectf -0.01 0.01 0.01 -0.01)
155
156 ;; --- pulsating color ---
157 (gl-color3f (* 1.0f0 (cos (/ (rot win) 20.0f0)))
158 (* 1.0f0 (sin (/ (rot win) 25.0f0)))
159 (- 1.0f0 (* 0.5f0 (cos (/ (rot win) 17.0f0)))))
160 (incf (rot win) (rot-delta win))
161
162 (gl-scalef 0.003 0.003 0.0)
163 (gl-disable gl_lighting)
164
165 ;; --- bitmap ---
166 (gl-raster-pos3i 10 -30 0)
167 (ftgl-render (test-font :bitmap) "un-rotated bitmap")
168
169 ;; --- pixmap ---
170 (gl-raster-pos3i 10 10 0)
171 (ftgl-render (test-font :pixmap) "un-rotated pixmap")
172
173 ;; --- pixmap ---
174 (gl-raster-pos3i 60 -120 0)
175 (ftgl-render (test-font :pixmap)
176 (format nil "fps=~d"
177 (floor (/ (rot win) (rot-delta win))
178 (max 1 (- (time-now win) (start-time win))))))
179
180 ;; --- polygon ---
181 (with-matrix ()
182 (gl-translatef -100 100 0)
183 (ftgl-render (test-font :polygon) "un-rotated polygon"))
184
185 ;; --- outline ---
186 (with-matrix ()
187 (gl-translatef -100 50 0)
188 (gl-line-width 3)
189 (ftgl-render (test-font :outline) "un-rotated outline"))
190
191 ;; --- extruded polygon ---
192 (with-matrix ()
193 (gl-polygon-mode gl_front_and_back gl_line)
194 (gl-rotatef (rot win) 1.0f0 0.5f0 0.0f0)
195 (gl-scalef 5 5 5)
196 (gl-translatef -70 -20 0)
197 (gl-line-width 1)
198 (ftgl-render (test-font :extruded) "NeHe")
199 (gl-polygon-mode gl_front_and_back gl_fill))
200
201 ;;; --- texture ---
202 (with-matrix ()
203 (gl-rotatef (rot win) 1.0f0 0.0f0 0.0f0)
204 (gl-rotatef (* (rot win) 1.5f0) 0.0f0 1.0f0 0.0f0)
205 (gl-rotatef (* (rot win) 1.4f0) 0.0f0 0.0f0 1.0f0)
206 (gl-enable gl_texture_2d)
207 (gl-disable gl_lighting)
208 (ftgl-render (test-font :texture) "NeHe Lesson 14"))
209 )
210
211 (glut-swap-buffers)
212 (glut-post-redisplay)))

  ViewVC Help
Powered by ViewVC 1.1.5