Commit 737ffa9a authored by csr21's avatar csr21
Browse files

Add GLX extension support (Janis Dzerins on the portable-clx mailing list)

darcs-hash:20050314195313-ed5a3-91f1a458d851defe9dbe61539f59ac4ce33adced.gz
parent d3ee06a2
......@@ -2,6 +2,8 @@
--- Changes in SBCL CLX 0.6.1, FILL IN TIMESTAMP ---
experimental GLX extension support (from Janis Dzerins)
The ICCCM-compliant selection handling in demo/clipboard.lisp is now
more ICCCM-compliant.
......
......@@ -65,7 +65,9 @@
:components
((:file "shape")
(:file "xvidmode")
(:xrender-source-file "xrender")))
(:xrender-source-file "xrender")
(:file "glx")
(:file "gl" :depends-on ("glx"))))
(:module demo
:default-component-class example-source-file
:components
......@@ -77,6 +79,7 @@
(:file "clclock")
(:file "clipboard")
(:file "clx-demos")
(:file "gl-test")
;; FIXME: compiling this generates 30-odd spurious code
;; deletion notes. Find out why, and either fix or
;; workaround the problem.
......
......@@ -646,7 +646,7 @@
:configure-request :circulate-notify :circulate-request :property-notify
:selection-clear :selection-request :selection-notify
:colormap-notify :client-message :mapping-notify
:shape-notify :xfree86-vidmode-notify))
:shape-notify :xfree86-vidmode-notify :glx-pbuffer-clobber))
(deftype error-key ()
'(member :access :alloc :atom :colormap :cursor :drawable :font :gcontext :id-choice
......
(defpackage :gl-test
(:use :common-lisp :xlib)
(:export "TEST" "CLX-TEST"))
(in-package :gl-test)
(defun test (function &key (host "localhost") (display 1) (width 200) (height 200))
(let* ((display (open-display host :display display))
(screen (display-default-screen display))
(root (screen-root screen))
ctx)
(unwind-protect
(progn
;;; Inform the server about us.
(glx::client-info display)
(let* ((visual (glx:choose-visual screen '(:glx-rgba
(:glx-red-size 1)
(:glx-green-size 1)
(:glx-blue-size 1)
:glx-double-buffer)))
(colormap (create-colormap (glx:visual-id visual) root))
(window (create-window :parent root
:x 10 :y 10 :width width :height height
:class :input-output
:background (screen-black-pixel screen)
:border (screen-black-pixel screen)
:visual (glx:visual-id visual)
:depth 24
:colormap colormap
:event-mask '(:structure-notify :exposure)))
(gc (create-gcontext :foreground (screen-white-pixel screen)
:background (screen-black-pixel screen)
:drawable window
:font (open-font display "fixed"))))
(set-wm-properties window
:name "glx-test"
:resource-class "glx-test"
:command (list "glx-test")
:x 10 :y 10 :width width :height height
:min-width width :min-height height
:initial-state :normal)
(setf ctx (glx:create-context screen (glx:visual-id visual)))
(map-window window)
(glx:make-current window ctx)
(funcall function display window)
(unmap-window window)
(free-gcontext gc)))
(when ctx (glx:destroy-context ctx))
(close-display display))))
;;; Tests
(defun no-floats (display window)
(declare (ignore display window))
(gl:color-3s #x7fff #x7fff 0)
(gl:begin gl:+polygon+)
(gl:vertex-2s 0 0)
(gl:vertex-2s 1 0)
(gl:vertex-2s 1 1)
(gl:vertex-2s 0 1)
(gl:end)
(glx:swap-buffers)
(sleep 5))
(defun anim (display window)
(declare (ignore display window))
(gl:ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
(gl:clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
(gl:line-width 2.0s0)
(loop
repeat 361
for angle upfrom 0.0s0 by 1.0s0
do (progn
(gl:clear gl:+color-buffer-bit+)
(gl:push-matrix)
(gl:translate-f 0.5s0 0.5s0 0.0s0)
(gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
(gl:translate-f -0.5s0 -0.5s0 0.0s0)
(gl:begin gl:+polygon+ #-(and) gl:+line-loop+)
(gl:color-3ub 255 0 0)
(gl:vertex-2f 0.25s0 0.25s0)
(gl:color-3ub 0 255 0)
(gl:vertex-2f 0.75s0 0.25s0)
(gl:color-3ub 0 0 255)
(gl:vertex-2f 0.75s0 0.75s0)
(gl:color-3ub 255 255 255)
(gl:vertex-2f 0.25s0 0.75s0)
(gl:end)
(gl:pop-matrix)
(glx:swap-buffers)
(sleep 0.02)))
(sleep 3))
(defun anim/list (display window)
(declare (ignore display window))
(gl:ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
(gl:clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
(let ((list (gl:gen-lists 1)))
(gl:new-list list gl:+compile+)
(gl:begin gl:+polygon+)
(gl:color-3ub 255 0 0)
(gl:vertex-2f 0.25s0 0.25s0)
(gl:color-3ub 0 255 0)
(gl:vertex-2f 0.75s0 0.25s0)
(gl:color-3ub 0 0 255)
(gl:vertex-2f 0.75s0 0.75s0)
(gl:color-3ub 255 255 255)
(gl:vertex-2f 0.25s0 0.75s0)
(gl:end)
(glx:render)
(gl:end-list)
(loop
repeat 361
for angle upfrom 0.0s0 by 1.0s0
do (progn
(gl:clear gl:+color-buffer-bit+)
(gl:push-matrix)
(gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
(gl:call-list list)
(gl:pop-matrix)
(glx:swap-buffers)
(sleep 0.02))))
(sleep 3))
;;; glxgears
(defconstant +pi+ (coerce pi 'single-float))
(declaim (type single-float +pi+))
(defun gear (inner-radius outer-radius width teeth tooth-depth)
(let ((r0 inner-radius)
(r1 (/ (- outer-radius tooth-depth) 2.0s0))
(r2 (/ (+ outer-radius tooth-depth) 2.0s0))
(da (/ (* 2.0s0 +pi+) teeth 4.0s0)))
(gl:shade-model gl:+flat+)
(gl:normal-3f 0.0s0 0.0s0 1.0s0)
;; Front face.
(gl:begin gl:+quad-strip+)
(dotimes (i (1+ teeth))
(let ((angle (/ (* i 2.0 +pi+) teeth)))
(declare (type single-float angle))
(gl:vertex-3f (* r0 (cos angle))
(* r0 (sin angle))
(* width 0.5s0))
(gl:vertex-3f (* r1 (cos angle))
(* r1 (sin angle))
(* width 0.5s0))
(when (< i teeth)
(gl:vertex-3f (* r0 (cos angle))
(* r0 (sin angle))
(* width 0.5s0))
(gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
(* r1 (sin (+ angle (* 3 da))))
(* width 0.5s0)))))
(gl:end)
;; Draw front sides of teeth.
(gl:begin gl:+quads+)
(setf da (/ (* 2.0s0 +pi+) teeth 4.0s0))
(dotimes (i teeth)
(let ((angle (/ (* i 2.0s0 +pi+) teeth)))
(declare (type single-float angle))
(gl:vertex-3f (* r1 (cos angle))
(* r1 (sin angle))
(* width 0.5s0))
(gl:vertex-3f (* r2 (cos (+ angle da)))
(* r2 (sin (+ angle da)))
(* width 0.5s0))
(gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
(* r2 (sin (+ angle (* 2 da))))
(* width 0.5s0))
(gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
(* r1 (sin (+ angle (* 3 da))))
(* width 0.5s0))))
(gl:end)
(gl:normal-3f 0.0s0 0.0s0 -1.0s0)
;; Draw back face.
(gl:begin gl:+quad-strip+)
(dotimes (i (1+ teeth))
(let ((angle (/ (* i 2.0s0 +pi+) teeth)))
(declare (type single-float angle))
(gl:vertex-3f (* r1 (cos angle))
(* r1 (sin angle))
(* width -0.5s0))
(gl:vertex-3f (* r0 (cos angle))
(* r0 (sin angle))
(* width -0.5s0))
(when (< i teeth)
(gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
(* r1 (sin (+ angle (* 3 da))))
(* width -0.5s0))
(gl:vertex-3f (* r0 (cos angle))
(* r0 (sin angle))
(* width 0.5s0)))))
(gl:end)
;; Draw back sides of teeth.
(gl:begin gl:+quads+)
(setf da (/ (* 2.0s0 +pi+) teeth 4.0s0))
(dotimes (i teeth)
(let ((angle (/ (* i 2.0s0 +pi+) teeth)))
(declare (type single-float angle))
(gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
(* r1 (sin (+ angle (* 3 da))))
(* width -0.5s0))
(gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
(* r2 (sin (+ angle (* 2 da))))
(* width -0.5s0))
(gl:vertex-3f (* r2 (cos (+ angle da)))
(* r2 (sin (+ angle da)))
(* width -0.5s0))
(gl:vertex-3f (* r1 (cos angle))
(* r1 (sin angle))
(* width -0.5s0))))
(gl:end)
;; Draw outward faces of teeth.
(gl:begin gl:+quad-strip+)
(dotimes (i teeth)
(let ((angle (/ (* i 2.0s0 +pi+) teeth)))
(declare (type single-float angle))
(gl:vertex-3f (* r1 (cos angle))
(* r1 (sin angle))
(* width 0.5s0))
(gl:vertex-3f (* r1 (cos angle))
(* r1 (sin angle))
(* width -0.5s0))
(let* ((u (- (* r2 (cos (+ angle da))) (* r1 (cos angle))))
(v (- (* r2 (sin (+ angle da))) (* r1 (sin angle))))
(len (sqrt (+ (* u u) (* v v)))))
(setf u (/ u len)
v (/ v len))
(gl:normal-3f v u 0.0s0)
(gl:vertex-3f (* r2 (cos (+ angle da)))
(* r2 (sin (+ angle da)))
(* width 0.5s0))
(gl:vertex-3f (* r2 (cos (+ angle da)))
(* r2 (sin (+ angle da)))
(* width -0.5s0))
(gl:normal-3f (cos angle) (sin angle) 0.0s0)
(gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
(* r2 (sin (+ angle (* 2 da))))
(* width 0.5s0))
(gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
(* r2 (sin (+ angle (* 2 da))))
(* width -0.5s0))
(setf u (- (* r1 (cos (+ angle (* 3 da)))) (* r2 (cos (+ angle (* 2 da)))))
v (- (* r1 (sin (+ angle (* 3 da)))) (* r2 (sin (+ angle (* 2 da))))))
(gl:normal-3f v (- u) 0.0s0)
(gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
(* r1 (sin (+ angle (* 3 da))))
(* width 0.5s0))
(gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
(* r1 (sin (+ angle (* 3 da))))
(* width -0.5s0))
(gl:normal-3f (cos angle) (sin angle) 0.0s0))))
(gl:vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5s0))
(gl:vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width -0.5s0))
(gl:end)
(gl:shade-model gl:+smooth+)
;; Draw inside radius cylinder.
(gl:begin gl:+quad-strip+)
(dotimes (i (1+ teeth))
(let ((angle (/ (* i 2.0s0 +pi+) teeth)))
(declare (type single-float angle))
(gl:normal-3f (- (cos angle)) (- (sin angle)) 0.0s0)
(gl:vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5s0))
(gl:vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0))))
(gl:end)))
(defun draw (gear-1 gear-2 gear-3 view-rotx view-roty view-rotz angle)
(gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
(gl:push-matrix)
(gl:rotate-f view-rotx 1.0s0 0.0s0 0.0s0)
(gl:rotate-f view-roty 0.0s0 1.0s0 0.0s0)
(gl:rotate-f view-rotz 0.0s0 0.0s0 1.0s0)
(gl:push-matrix)
(gl:translate-f -3.0s0 -2.0s0 0.0s0)
(gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
(gl:call-list gear-1)
(gl:pop-matrix)
(gl:push-matrix)
(gl:translate-f 3.1s0 -2.0s0 0.0s0)
(gl:rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
(gl:call-list gear-2)
(gl:pop-matrix)
(gl:push-matrix)
(gl:translate-f -3.1s0 4.2s0 0.0s0)
(gl:rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
(gl:call-list gear-3)
(gl:pop-matrix)
(gl:pop-matrix))
(defun reshape (width height)
(gl:viewport 0 0 width height)
(let ((h (coerce (/ height width) 'double-float)))
(gl:matrix-mode gl:+projection+)
(gl:load-identity)
(gl:frustum -1.0d0 1.0d0 (- h) h 5.0d0 60.0d0))
(gl:matrix-mode gl:+modelview+)
(gl:load-identity)
(gl:translate-f 0.0s0 0.0s0 -40.0s0))
(defun init ()
(let (gear-1 gear-2 gear-3)
;;(gl:light-fv gl:+light0+ gl:+position+ '(5.0s0 5.0s0 10.0s0 0.0s0))
;;(gl:enable gl:+cull-face+)
;;(gl:enable gl:+lighting+)
;;(gl:enable gl:+light0+)
;;(gl:enable gl:+depth-test+)
;; Make the gears.
(setf gear-1 (gl:gen-lists 1))
(gl:new-list gear-1 gl:+compile+)
(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
(gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
(gl:end-list)
(setf gear-2 (gl:gen-lists 1))
(gl:new-list gear-2 gl:+compile+)
(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
(gear 0.5s0 2.0s0 2.0s0 10 0.7s0)
(gl:end-list)
(setf gear-3 (gl:gen-lists 1))
(gl:new-list gear-3 gl:+compile+)
(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
(gear 1.3s0 2.0s0 0.5s0 10 0.7s0)
(gl:end-list)
;;(gl:enable gl:+normalize+)
(values gear-1 gear-2 gear-3)))
(defun gears* (display window)
(declare (ignore display window))
(gl:enable gl:+cull-face+)
(gl:enable gl:+lighting+)
(gl:enable gl:+light0+)
(gl:enable gl:+normalize+)
(gl:enable gl:+depth-test+)
(reshape 300 300)
;;(gl:light-fv gl:+light0+ gl:+position+ #(5.0s0 5.0s0 10.0s0 0.0s0))
(let (list)
(declare (ignore list))
#-(and)
(progn
(setf list (gl:gen-lists 1))
(gl:new-list list gl:+compile+)
;;(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
(gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
(glx:render)
(gl:end-list))
(loop
;;for angle from 0.0s0 below 361.0s0 by 1.0s0
with angle single-float = 0.0s0
with dt = 0.004s0
repeat 2500
do (progn
(incf angle (* 70.0s0 dt)) ; 70 degrees per second
(when (< 3600.0s0 angle)
(decf angle 3600.0s0))
(gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
(gl:push-matrix)
(gl:rotate-f 20.0s0 0.0s0 1.0s0 0.0s0)
(gl:push-matrix)
(gl:translate-f -3.0s0 -2.0s0 0.0s0)
(gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
(gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
(gl:pop-matrix)
(gl:push-matrix)
(gl:translate-f 3.1s0 -2.0s0 0.0s0)
(gl:rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
(gear 0.5s0 2.0s0 2.0s0 10 0.7s0)
(gl:pop-matrix)
(gl:push-matrix)
(gl:translate-f -3.1s0 4.2s0 0.0s0)
(gl:rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
(gear 1.3s0 2.0s0 0.5s0 10 0.7s0)
(gl:pop-matrix)
(gl:pop-matrix)
(glx:swap-buffers)
;;(sleep 0.025)
)))
;;(sleep 3)
)
(defun gears (display window)
(declare (ignore window))
(let ((view-rotx 20.0s0)
(view-roty 30.0s0)
(view-rotz 0.0s0)
(angle 0.0s0)
(frames 0)
(dt 0.004s0) ; *** This is dynamically adjusted
;;(t-rot-0 -1.0d0)
;;(t-rate-0 -1.d0)
gear-1 gear-2 gear-3)
(multiple-value-setq (gear-1 gear-2 gear-3)
(init))
(loop
(event-case (display :timeout 0.01 :force-output-p t)
(configure-notify (width height)
(reshape width height)
t)
(key-press (code)
(format t "Key pressed: ~S~%" code)
(return-from gears t)))
(incf angle (* 70.0s0 dt)) ; 70 degrees per second
(when (< 3600.0s0 angle)
(decf angle 3600.0s0))
(draw gear-1 gear-2 gear-3 view-rotx view-roty view-rotz angle)
(glx:swap-buffers)
(incf frames)
;; FPS calculation goes here
)))
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment