Raymond Toy pushed to branch rtoy-update-clx-with-cmucl-fixes at cmucl / cmucl
Commits: c1864fe6 by Raymond Toy at 2018-01-27T09:23:20-08:00 Merge upstream demo files
[skip-ci]
- - - - - f09962e2 by Raymond Toy at 2018-01-27T09:24:57-08:00 Merge branch 'rtoy-update-clx' into rtoy-update-clx-with-cmucl-fixes
- - - - - 87bd6d9d by Raymond Toy at 2018-01-27T09:30:02-08:00 Update comments to reflect what we've done.
- - - - -
9 changed files:
- src/clx/README-CMUCL - src/clx/demo/bezier.lisp - src/clx/demo/beziertest.lisp - src/clx/demo/clclock.lisp - src/clx/demo/clipboard.lisp - src/clx/demo/clx-demos.lisp - src/clx/demo/gl-test.lisp - src/clx/demo/hello.lisp - src/clx/demo/mandel.lisp
Changes:
===================================== src/clx/README-CMUCL ===================================== --- a/src/clx/README-CMUCL +++ b/src/clx/README-CMUCL @@ -1,40 +1,9 @@ -$Id: README-CMUCL,v 1.2 2009/06/11 16:03:56 rtoy Rel $ +This is an import of Telent-CLX from the fork +https://github.com/sharplispers/clx, version +6e39a0df2a0a1d083166f405d4b8bbc463d54d85.
-This is an import of Telent-CLX as of 0.7.3. +All (almost?) files are included. A few changes to fix bugs related +to CMUCL have been added, as well as the CVS id. I've tried to make +few changes so it will be easy to merge again when desired.
-All files are included. A few changes to fix bugs related to CMUCL -have been added, as well as the CVS id. I've tried to make few -changes so it will be easy to merge again when desired. - -The following files from this directory are compiled and loaded by -CMUCL when it builds utilities: - -clx-library.lisp -package.lisp -depdefs.lisp -clx.lisp -dependent.lisp -macros.lisp -bufmac.lisp -buffer.lisp -display.lisp -gcontext.lisp -input.lisp -requests.lisp -fonts.lisp -graphics.lisp -text.lisp -attributes.lisp -translate.lisp -keysyms.lisp -manager.lisp -image.lisp -resource.lisp -shape.lisp -big-requests.lisp -xvidmode.lisp -xrender.lisp -glx.lisp -gl.lisp -dpms.lisp -provide.lisp +See src/tools/clxcom.lisp to see what files are compiled.
===================================== src/clx/demo/bezier.lisp ===================================== --- a/src/clx/demo/bezier.lisp +++ b/src/clx/demo/bezier.lisp @@ -18,9 +18,6 @@ ;;; express or implied warranty. ;;;
-#+cmu -(ext:file-comment "$Id: bezier.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $") - (in-package :xlib)
(export 'draw-curves)
===================================== src/clx/demo/beziertest.lisp ===================================== --- a/src/clx/demo/beziertest.lisp +++ b/src/clx/demo/beziertest.lisp @@ -18,9 +18,6 @@ ;;; express or implied warranty. ;;;
-#+cmu -(ext:file-comment "$Id: beziertest.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $") - (in-package :xlib)
(defun bezier-test (host &optional (pathname "/usr/X.V11R1/extensions/test/datafile"))
===================================== src/clx/demo/clclock.lisp ===================================== --- a/src/clx/demo/clclock.lisp +++ b/src/clx/demo/clclock.lisp @@ -1,11 +1,8 @@ -#+cmu -(ext:file-comment "$Id: clclock.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $") - -(defpackage "XCLCLOCK" +(defpackage #:xlib-demo/clclock (:use "CL") (:export "CLOCK"))
-(in-package "XCLCLOCK") +(in-package #:xlib-demo/clclock)
(defvar *display* (xlib:open-default-display)) (defvar *screen* (xlib:display-default-screen *display*))
===================================== src/clx/demo/clipboard.lisp ===================================== --- a/src/clx/demo/clipboard.lisp +++ b/src/clx/demo/clipboard.lisp @@ -59,14 +59,11 @@ ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER ;;; DEALINGS IN THE SOFTWARE.
-#+cmu -(ext:file-comment "$Id: clipboard.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $") - -(defpackage "CLIPBOARD" +(defpackage #:xlib-demo/clipboard (:use "CL" "XLIB") (:export "MAIN"))
-(in-package "CLIPBOARD") +(in-package #:xlib-demo/clipboard)
;;; This is "traditional" XLIB style; I don't really know if it's the ;;; best way -- in developing this program, style of XLIB programming
===================================== src/clx/demo/clx-demos.lisp ===================================== --- a/src/clx/demo/clx-demos.lisp +++ b/src/clx/demo/clx-demos.lisp @@ -6,13 +6,10 @@ ;;; This file should be portable to any valid Common Lisp with CLX -- DEC 88. ;;;
-#+cmu -(ext:file-comment "$Id: clx-demos.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $") - -(defpackage :demos (:use :common-lisp) +(defpackage #:xlib-demo/demos (:use :common-lisp) (:export do-all-demos demo))
-(in-package :demos) +(in-package :xlib-demo/demos)
;;;; Graphic demos wrapper macro. @@ -39,11 +36,11 @@ (unless *display* #+:cmu (multiple-value-setq (*display* *screen*) (ext:open-clx-display)) - #+(or sbcl allegro clisp) + #+(or sbcl allegro clisp lispworks) (progn (setf *display* (xlib::open-default-display)) (setf *screen* (xlib:display-default-screen *display*))) - #-(or cmu sbcl allegro clisp) + #-(or cmu sbcl allegro clisp lispworks) (progn ;; Portable method (setf *display* (xlib:open-display (machine-instance)))
===================================== src/clx/demo/gl-test.lisp ===================================== --- a/src/clx/demo/gl-test.lisp +++ b/src/clx/demo/gl-test.lisp @@ -1,11 +1,8 @@ -#+cmu -(ext:file-comment "$Id: gl-test.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $") - -(defpackage :gl-test - (:use :common-lisp :xlib) +(defpackage #:xlib-demo/gl-test + (:use :common-lisp :xlib :xlib/gl) (:export "TEST" "CLX-TEST"))
-(in-package :gl-test) +(in-package #:xlib-demo/gl-test)
(defun test (function &key (host "localhost") (display 1) (width 200) (height 200)) @@ -16,19 +13,19 @@ (unwind-protect (progn ;;; Inform the server about us. - (glx::client-info display) - (let* ((visual (glx:choose-visual screen '(:glx-rgba + (xlib/glx::client-info display) + (let* ((visual (xlib/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)) + (colormap (create-colormap (xlib/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) + :visual (xlib/glx:visual-id visual) :depth 24 :colormap colormap :event-mask '(:structure-notify :exposure))) @@ -44,16 +41,16 @@ :min-width width :min-height height :initial-state :normal)
- (setf ctx (glx:create-context screen (glx:visual-id visual))) + (setf ctx (xlib/glx:create-context screen (xlib/glx:visual-id visual))) (map-window window) - (glx:make-current window ctx) + (xlib/glx:make-current window ctx)
(funcall function display window)
(unmap-window window) (free-gcontext gc)))
- (when ctx (glx:destroy-context ctx)) + (when ctx (xlib/glx:destroy-context ctx)) (close-display display))))
@@ -62,76 +59,76 @@
(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) + (color-3s #x7fff #x7fff 0) + (begin +polygon+) + (vertex-2s 0 0) + (vertex-2s 1 0) + (vertex-2s 1 1) + (vertex-2s 0 1) + (end) + (xlib/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) + (ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0) + (clear-color 0.0s0 0.0s0 0.0s0 0.0s0) + (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) + (clear +color-buffer-bit+) + (push-matrix) + (translate-f 0.5s0 0.5s0 0.0s0) + (rotate-f angle 0.0s0 0.0s0 1.0s0) + (translate-f -0.5s0 -0.5s0 0.0s0) + (begin +polygon+ #-(and) +line-loop+) + (color-3ub 255 0 0) + (vertex-2f 0.25s0 0.25s0) + (color-3ub 0 255 0) + (vertex-2f 0.75s0 0.25s0) + (color-3ub 0 0 255) + (vertex-2f 0.75s0 0.75s0) + (color-3ub 255 255 255) + (vertex-2f 0.25s0 0.75s0) + (end) + (pop-matrix) + (xlib/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) + (ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0) + (clear-color 0.0s0 0.0s0 0.0s0 0.0s0) + (let ((list (gen-lists 1))) + (new-list list +compile+) + (begin +polygon+) + (color-3ub 255 0 0) + (vertex-2f 0.25s0 0.25s0) + (color-3ub 0 255 0) + (vertex-2f 0.75s0 0.25s0) + (color-3ub 0 0 255) + (vertex-2f 0.75s0 0.75s0) + (color-3ub 255 255 255) + (vertex-2f 0.25s0 0.75s0) + (end) + (xlib/glx:render) + (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) + (clear +color-buffer-bit+) + (push-matrix) + (rotate-f angle 0.0s0 0.0s0 1.0s0) + (call-list list) + (pop-matrix) + (xlib/glx:swap-buffers) (sleep 0.02))))
(sleep 3)) @@ -148,101 +145,101 @@ (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) + (shade-model +flat+) + (normal-3f 0.0s0 0.0s0 1.0s0)
;; Front face. - (gl:begin gl:+quad-strip+) + (begin +quad-strip+) (dotimes (i (1+ teeth)) (let ((angle (/ (* i 2.0 +pi+) teeth))) (declare (type single-float angle)) - (gl:vertex-3f (* r0 (cos angle)) + (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0)) - (gl:vertex-3f (* r1 (cos angle)) + (vertex-3f (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5s0)) (when (< i teeth) - (gl:vertex-3f (* r0 (cos angle)) + (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0)) - (gl:vertex-3f (* r1 (cos (+ angle (* 3 da)))) + (vertex-3f (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5s0))))) - (gl:end) + (end)
;; Draw front sides of teeth. - (gl:begin gl:+quads+) + (begin +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)) + (vertex-3f (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5s0)) - (gl:vertex-3f (* r2 (cos (+ angle da))) + (vertex-3f (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* width 0.5s0)) - (gl:vertex-3f (* r2 (cos (+ angle (* 2 da)))) + (vertex-3f (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* width 0.5s0)) - (gl:vertex-3f (* r1 (cos (+ angle (* 3 da)))) + (vertex-3f (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5s0)))) - (gl:end) + (end)
- (gl:normal-3f 0.0s0 0.0s0 -1.0s0) + (normal-3f 0.0s0 0.0s0 -1.0s0)
;; Draw back face. - (gl:begin gl:+quad-strip+) + (begin +quad-strip+) (dotimes (i (1+ teeth)) (let ((angle (/ (* i 2.0s0 +pi+) teeth))) (declare (type single-float angle)) - (gl:vertex-3f (* r1 (cos angle)) + (vertex-3f (* r1 (cos angle)) (* r1 (sin angle)) (* width -0.5s0)) - (gl:vertex-3f (* r0 (cos angle)) + (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5s0)) (when (< i teeth) - (gl:vertex-3f (* r1 (cos (+ angle (* 3 da)))) + (vertex-3f (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width -0.5s0)) - (gl:vertex-3f (* r0 (cos angle)) + (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0))))) - (gl:end) + (end)
;; Draw back sides of teeth. - (gl:begin gl:+quads+) + (begin +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)))) + (vertex-3f (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width -0.5s0)) - (gl:vertex-3f (* r2 (cos (+ angle (* 2 da)))) + (vertex-3f (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* width -0.5s0)) - (gl:vertex-3f (* r2 (cos (+ angle da))) + (vertex-3f (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* width -0.5s0)) - (gl:vertex-3f (* r1 (cos angle)) + (vertex-3f (* r1 (cos angle)) (* r1 (sin angle)) (* width -0.5s0)))) - (gl:end) + (end)
;; Draw outward faces of teeth. - (gl:begin gl:+quad-strip+) + (begin +quad-strip+) (dotimes (i teeth) (let ((angle (/ (* i 2.0s0 +pi+) teeth))) (declare (type single-float angle)) - (gl:vertex-3f (* r1 (cos angle)) + (vertex-3f (* r1 (cos angle)) (* r1 (sin angle)) (* width 0.5s0)) - (gl:vertex-3f (* r1 (cos angle)) + (vertex-3f (* r1 (cos angle)) (* r1 (sin angle)) (* width -0.5s0)) (let* ((u (- (* r2 (cos (+ angle da))) (* r1 (cos angle)))) @@ -250,118 +247,118 @@ (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))) + (normal-3f v u 0.0s0) + (vertex-3f (* r2 (cos (+ angle da))) (* r2 (sin (+ angle da))) (* width 0.5s0)) - (gl:vertex-3f (* r2 (cos (+ angle da))) + (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)))) + (normal-3f (cos angle) (sin angle) 0.0s0) + (vertex-3f (* r2 (cos (+ angle (* 2 da)))) (* r2 (sin (+ angle (* 2 da)))) (* width 0.5s0)) - (gl:vertex-3f (* r2 (cos (+ angle (* 2 da)))) + (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)))) + (normal-3f v (- u) 0.0s0) + (vertex-3f (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width 0.5s0)) - (gl:vertex-3f (* r1 (cos (+ angle (* 3 da)))) + (vertex-3f (* r1 (cos (+ angle (* 3 da)))) (* r1 (sin (+ angle (* 3 da)))) (* width -0.5s0)) - (gl:normal-3f (cos angle) (sin angle) 0.0s0)))) + (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)) + (vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5s0)) + (vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width -0.5s0))
- (gl:end) + (end)
- (gl:shade-model gl:+smooth+) + (shade-model +smooth+)
;; Draw inside radius cylinder. - (gl:begin gl:+quad-strip+) + (begin +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))) + (normal-3f (- (cos angle)) (- (sin angle)) 0.0s0) + (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5s0)) + (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0)))) + (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+)) + (clear (logior +color-buffer-bit+ +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) + (push-matrix) + (rotate-f view-rotx 1.0s0 0.0s0 0.0s0) + (rotate-f view-roty 0.0s0 1.0s0 0.0s0) + (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) + (push-matrix) + (translate-f -3.0s0 -2.0s0 0.0s0) + (rotate-f angle 0.0s0 0.0s0 1.0s0) + (call-list gear-1) + (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) + (push-matrix) + (translate-f 3.1s0 -2.0s0 0.0s0) + (rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0) + (call-list gear-2) + (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) + (push-matrix) + (translate-f -3.1s0 4.2s0 0.0s0) + (rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0) + (call-list gear-3) + (pop-matrix)
- (gl:pop-matrix)) + (pop-matrix))
(defun reshape (width height) - (gl:viewport 0 0 width height) + (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)) + (matrix-mode +projection+) + (load-identity) + (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)) + (matrix-mode +modelview+) + (load-identity) + (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+) + ;;(light-fv +light0+ +position+ '(5.0s0 5.0s0 10.0s0 0.0s0)) + ;;(enable +cull-face+) + ;;(enable +lighting+) + ;;(enable +light0+) + ;;(enable +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)) + (setf gear-1 (gen-lists 1)) + (new-list gear-1 +compile+) + (material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0)) (gear 1.0s0 4.0s0 1.0s0 20 0.7s0) - (gl:end-list) + (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)) + (setf gear-2 (gen-lists 1)) + (new-list gear-2 +compile+) + (material-fv +front+ +ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0)) (gear 0.5s0 2.0s0 2.0s0 10 0.7s0) - (gl:end-list) + (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)) + (setf gear-3 (gen-lists 1)) + (new-list gear-3 +compile+) + (material-fv +front+ +ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0)) (gear 1.3s0 2.0s0 0.5s0 10 0.7s0) - (gl:end-list) + (end-list)
- ;;(gl:enable gl:+normalize+) + ;;(enable +normalize+)
(values gear-1 gear-2 gear-3)))
@@ -369,31 +366,31 @@ (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+) + (enable +cull-face+) + (enable +lighting+) + (enable +light0+) + (enable +normalize+) + (enable +depth-test+)
(reshape 300 300)
- ;;(gl:light-fv gl:+light0+ gl:+position+ #(5.0s0 5.0s0 10.0s0 0.0s0)) + ;;(light-fv +light0+ +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)) + (setf list (gen-lists 1)) + (new-list list +compile+) + ;;(material-fv +front+ +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)) + (xlib/glx:render) + (end-list))
(loop ;;for angle from 0.0s0 below 361.0s0 by 1.0s0 - with angle single-float = 0.0s0 + with angle of-type single-float = 0.0s0 with dt = 0.004s0 repeat 2500 do (progn @@ -402,39 +399,39 @@ (when (< 3600.0s0 angle) (decf angle 3600.0s0))
- (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+)) + (clear (logior +color-buffer-bit+ +depth-buffer-bit+))
- (gl:push-matrix) - (gl:rotate-f 20.0s0 0.0s0 1.0s0 0.0s0) + (push-matrix) + (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)) + (push-matrix) + (translate-f -3.0s0 -2.0s0 0.0s0) + (rotate-f angle 0.0s0 0.0s0 1.0s0) + (material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0)) (gear 1.0s0 4.0s0 1.0s0 20 0.7s0) - (gl:pop-matrix) + (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)) + (push-matrix) + (translate-f 3.1s0 -2.0s0 0.0s0) + (rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0) + (material-fv +front+ +ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0)) (gear 0.5s0 2.0s0 2.0s0 10 0.7s0) - (gl:pop-matrix) + (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)) + (push-matrix) + (translate-f -3.1s0 4.2s0 0.0s0) + (rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0) + (material-fv +front+ +ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0)) (gear 1.3s0 2.0s0 0.5s0 10 0.7s0) - (gl:pop-matrix) + (pop-matrix)
- (gl:pop-matrix) + (pop-matrix)
- (glx:swap-buffers) + (xlib/glx:swap-buffers) ;;(sleep 0.025) )))
@@ -472,7 +469,7 @@ (decf angle 3600.0s0))
(draw gear-1 gear-2 gear-3 view-rotx view-roty view-rotz angle) - (glx:swap-buffers) + (xlib/glx:swap-buffers)
(incf frames)
===================================== src/clx/demo/hello.lisp ===================================== --- a/src/clx/demo/hello.lisp +++ b/src/clx/demo/hello.lisp @@ -1,8 +1,5 @@ ;;; -*- Mode:Lisp; Syntax: Common-lisp; Package:XLIB; Base:10; Lowercase: Yes -*-
-#+cmu -(ext:file-comment "$Id: hello.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $") - (in-package :xlib)
(defun hello-world (host &rest args &key (string "Hello World") (font "fixed"))
===================================== src/clx/demo/mandel.lisp ===================================== --- a/src/clx/demo/mandel.lisp +++ b/src/clx/demo/mandel.lisp @@ -1,11 +1,8 @@ -#+cmu -(ext:file-comment "$Id: mandel.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $") - -(defpackage "XMANDEL" +(defpackage #:xlib-demo/mandel (:use "CL") (:export "NEW-WINDOW" "EVENT-LOOP"))
-(in-package "XMANDEL") +(in-package #:xlib-demo/mandel)
(defvar *display* (xlib:open-default-display)) (defvar *screen* (xlib:display-default-screen *display*))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/560af6217ba3f486ad0848863...
--- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/560af6217ba3f486ad0848863... You're receiving this email because of your account on gitlab.common-lisp.net.