Raymond Toy pushed to branch rtoy-update-clx-with-cmucl-fixes at cmucl / cmucl

Commits:

9 changed files:

Changes:

  • src/clx/README-CMUCL
    1 
    -$Id: README-CMUCL,v 1.2 2009/06/11 16:03:56 rtoy Rel $
    1 
    +This is an import of Telent-CLX from the fork
    2 
    +https://github.com/sharplispers/clx, version
    3 
    +6e39a0df2a0a1d083166f405d4b8bbc463d54d85.
    2 4
    3 
    -This is an import of Telent-CLX as of 0.7.3.
    5 
    +All (almost?) files are included.  A few changes to fix bugs related
    6 
    +to CMUCL have been added, as well as the CVS id.  I've tried to make
    7 
    +few changes so it will be easy to merge again when desired.
    4 8
    5 
    -All files are included.  A few changes to fix bugs related to CMUCL
    6 
    -have been added, as well as the CVS id.  I've tried to make few
    7 
    -changes so it will be easy to merge again when desired.
    8 
    -
    9 
    -The following files from this directory are compiled and loaded by
    10 
    -CMUCL when it builds utilities:
    11 
    -
    12 
    -clx-library.lisp
    13 
    -package.lisp
    14 
    -depdefs.lisp
    15 
    -clx.lisp
    16 
    -dependent.lisp
    17 
    -macros.lisp
    18 
    -bufmac.lisp
    19 
    -buffer.lisp
    20 
    -display.lisp
    21 
    -gcontext.lisp
    22 
    -input.lisp
    23 
    -requests.lisp
    24 
    -fonts.lisp
    25 
    -graphics.lisp
    26 
    -text.lisp
    27 
    -attributes.lisp
    28 
    -translate.lisp
    29 
    -keysyms.lisp
    30 
    -manager.lisp
    31 
    -image.lisp
    32 
    -resource.lisp
    33 
    -shape.lisp
    34 
    -big-requests.lisp
    35 
    -xvidmode.lisp
    36 
    -xrender.lisp
    37 
    -glx.lisp
    38 
    -gl.lisp
    39 
    -dpms.lisp
    40 
    -provide.lisp
    9 
    +See src/tools/clxcom.lisp to see what files are compiled.

  • src/clx/demo/bezier.lisp
    ... ... @@ -18,9 +18,6 @@
    18 18 
     ;;; express or implied warranty.
    19 19 
     ;;;
    20 20
    21 
    -#+cmu
    22 
    -(ext:file-comment "$Id: bezier.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
    23 
    -
    24 21 
     (in-package :xlib)
    25 22
    26 23 
     (export 'draw-curves)

  • src/clx/demo/beziertest.lisp
    ... ... @@ -18,9 +18,6 @@
    18 18 
     ;;; express or implied warranty.
    19 19 
     ;;;
    20 20
    21 
    -#+cmu
    22 
    -(ext:file-comment "$Id: beziertest.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
    23 
    -
    24 21 
     (in-package :xlib)
    25 22
    26 23 
     (defun bezier-test (host &optional (pathname "/usr/X.V11R1/extensions/test/datafile"))

  • src/clx/demo/clclock.lisp
    1 
    -#+cmu
    2 
    -(ext:file-comment "$Id: clclock.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
    3 
    -
    4 
    -(defpackage "XCLCLOCK"
    1 
    +(defpackage #:xlib-demo/clclock
    5 2 
       (:use "CL")
    6 3 
       (:export "CLOCK"))
    7 4
    8 
    -(in-package "XCLCLOCK")
    5 
    +(in-package #:xlib-demo/clclock)
    9 6
    10 7 
     (defvar *display* (xlib:open-default-display))
    11 8 
     (defvar *screen* (xlib:display-default-screen *display*))

  • src/clx/demo/clipboard.lisp
    ... ... @@ -59,14 +59,11 @@
    59 59 
     ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
    60 60 
     ;;; DEALINGS IN THE SOFTWARE.
    61 61
    62 
    -#+cmu
    63 
    -(ext:file-comment "$Id: clipboard.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
    64 
    -
    65 
    -(defpackage "CLIPBOARD"
    62 
    +(defpackage #:xlib-demo/clipboard
    66 63 
       (:use "CL" "XLIB")
    67 64 
       (:export "MAIN"))
    68 65
    69 
    -(in-package "CLIPBOARD")
    66 
    +(in-package #:xlib-demo/clipboard)
    70 67
    71 68 
     ;;; This is "traditional" XLIB style; I don't really know if it's the
    72 69 
     ;;; best way -- in developing this program, style of XLIB programming

  • src/clx/demo/clx-demos.lisp
    ... ... @@ -6,13 +6,10 @@
    6 6 
     ;;; This file should be portable to any valid Common Lisp with CLX -- DEC 88.
    7 7 
     ;;;
    8 8
    9 
    -#+cmu
    10 
    -(ext:file-comment "$Id: clx-demos.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
    11 
    -
    12 
    -(defpackage :demos (:use :common-lisp)
    9 
    +(defpackage #:xlib-demo/demos (:use :common-lisp)
    13 10 
       (:export do-all-demos demo))
    14 11
    15 
    -(in-package :demos)
    12 
    +(in-package :xlib-demo/demos)
    16 13
    17 14
    18 15 
     ;;;; Graphic demos wrapper macro.
    ... ... @@ -39,11 +36,11 @@
    39 36 
            (unless *display*
    40 37 
     	 #+:cmu
    41 38 
     	 (multiple-value-setq (*display* *screen*) (ext:open-clx-display))
    42 
    -	 #+(or sbcl allegro clisp)
    39 
    +	 #+(or sbcl allegro clisp lispworks)
    43 40 
     	 (progn
    44 41 
     	   (setf *display* (xlib::open-default-display))
    45 42 
     	   (setf *screen* (xlib:display-default-screen *display*)))
    46 
    -	 #-(or cmu sbcl allegro clisp)
    43 
    +	 #-(or cmu sbcl allegro clisp lispworks)
    47 44 
     	 (progn
    48 45 
     	   ;; Portable method
    49 46 
     	   (setf *display* (xlib:open-display (machine-instance)))

  • src/clx/demo/gl-test.lisp
    1 
    -#+cmu
    2 
    -(ext:file-comment "$Id: gl-test.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
    3 
    -
    4 
    -(defpackage :gl-test
    5 
    -  (:use :common-lisp :xlib)
    1 
    +(defpackage #:xlib-demo/gl-test
    2 
    +  (:use :common-lisp :xlib :xlib/gl)
    6 3 
       (:export "TEST" "CLX-TEST"))
    7 4
    8 
    -(in-package :gl-test)
    5 
    +(in-package #:xlib-demo/gl-test)
    9 6
    10 7
    11 8 
     (defun test (function &key (host "localhost") (display 1) (width 200) (height 200))
    ... ... @@ -16,19 +13,19 @@
    16 13 
         (unwind-protect
    17 14 
              (progn
    18 15 
                ;;; Inform the server about us.
    19 
    -           (glx::client-info display)
    20 
    -           (let* ((visual (glx:choose-visual screen '(:glx-rgba
    16 
    +           (xlib/glx::client-info display)
    17 
    +           (let* ((visual (xlib/glx:choose-visual screen '(:glx-rgba
    21 18 
                                                           (:glx-red-size 1)
    22 19 
                                                           (:glx-green-size 1)
    23 20 
                                                           (:glx-blue-size 1)
    24 21 
                                                           :glx-double-buffer)))
    25 
    -                  (colormap (create-colormap (glx:visual-id visual) root))
    22 
    +                  (colormap (create-colormap (xlib/glx:visual-id visual) root))
    26 23 
                       (window (create-window :parent root
    27 24 
                                              :x 10 :y 10 :width width :height height
    28 25 
                                              :class :input-output
    29 26 
                                              :background (screen-black-pixel screen)
    30 27 
                                              :border (screen-black-pixel screen)
    31 
    -                                         :visual (glx:visual-id visual)
    28 
    +                                         :visual (xlib/glx:visual-id visual)
    32 29 
                                              :depth 24
    33 30 
                                              :colormap colormap
    34 31 
                                              :event-mask '(:structure-notify :exposure)))
    ... ... @@ -44,16 +41,16 @@
    44 41 
                                     :min-width width :min-height height
    45 42 
                                     :initial-state :normal)
    46 43
    47 
    -             (setf ctx (glx:create-context screen (glx:visual-id visual)))
    44 
    +             (setf ctx (xlib/glx:create-context screen (xlib/glx:visual-id visual)))
    48 45 
                  (map-window window)
    49 
    -             (glx:make-current window ctx)
    46 
    +             (xlib/glx:make-current window ctx)
    50 47
    51 48 
                  (funcall function display window)
    52 49
    53 50 
                  (unmap-window window)
    54 51 
                  (free-gcontext gc)))
    55 52
    56 
    -      (when ctx (glx:destroy-context ctx))
    53 
    +      (when ctx (xlib/glx:destroy-context ctx))
    57 54 
           (close-display display))))
    58 55
    59 56
    ... ... @@ -62,76 +59,76 @@
    62 59
    63 60 
     (defun no-floats (display window)
    64 61 
       (declare (ignore display window))
    65 
    -  (gl:color-3s #x7fff #x7fff 0)
    66 
    -  (gl:begin gl:+polygon+)
    67 
    -  (gl:vertex-2s 0 0)
    68 
    -  (gl:vertex-2s 1 0)
    69 
    -  (gl:vertex-2s 1 1)
    70 
    -  (gl:vertex-2s 0 1)
    71 
    -  (gl:end)
    72 
    -  (glx:swap-buffers)
    62 
    +  (color-3s #x7fff #x7fff 0)
    63 
    +  (begin +polygon+)
    64 
    +  (vertex-2s 0 0)
    65 
    +  (vertex-2s 1 0)
    66 
    +  (vertex-2s 1 1)
    67 
    +  (vertex-2s 0 1)
    68 
    +  (end)
    69 
    +  (xlib/glx:swap-buffers)
    73 70 
       (sleep 5))
    74 71
    75 72
    76 73 
     (defun anim (display window)
    77 74 
       (declare (ignore display window))
    78 
    -  (gl:ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
    79 
    -  (gl:clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
    80 
    -  (gl:line-width 2.0s0)
    75 
    +  (ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
    76 
    +  (clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
    77 
    +  (line-width 2.0s0)
    81 78 
       (loop
    82 79 
          repeat 361
    83 80 
          for angle upfrom 0.0s0 by 1.0s0
    84 81 
          do (progn
    85 
    -          (gl:clear gl:+color-buffer-bit+)
    86 
    -          (gl:push-matrix)
    87 
    -          (gl:translate-f 0.5s0 0.5s0 0.0s0)
    88 
    -          (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
    89 
    -          (gl:translate-f -0.5s0 -0.5s0 0.0s0)
    90 
    -          (gl:begin gl:+polygon+ #-(and) gl:+line-loop+)
    91 
    -          (gl:color-3ub 255 0 0)
    92 
    -          (gl:vertex-2f 0.25s0 0.25s0)
    93 
    -          (gl:color-3ub 0 255 0)
    94 
    -          (gl:vertex-2f 0.75s0 0.25s0)
    95 
    -          (gl:color-3ub 0 0 255)
    96 
    -          (gl:vertex-2f 0.75s0 0.75s0)
    97 
    -          (gl:color-3ub 255 255 255)
    98 
    -          (gl:vertex-2f 0.25s0 0.75s0)
    99 
    -          (gl:end)
    100 
    -          (gl:pop-matrix)
    101 
    -          (glx:swap-buffers)
    82 
    +          (clear +color-buffer-bit+)
    83 
    +          (push-matrix)
    84 
    +          (translate-f 0.5s0 0.5s0 0.0s0)
    85 
    +          (rotate-f angle 0.0s0 0.0s0 1.0s0)
    86 
    +          (translate-f -0.5s0 -0.5s0 0.0s0)
    87 
    +          (begin +polygon+ #-(and) +line-loop+)
    88 
    +          (color-3ub 255 0 0)
    89 
    +          (vertex-2f 0.25s0 0.25s0)
    90 
    +          (color-3ub 0 255 0)
    91 
    +          (vertex-2f 0.75s0 0.25s0)
    92 
    +          (color-3ub 0 0 255)
    93 
    +          (vertex-2f 0.75s0 0.75s0)
    94 
    +          (color-3ub 255 255 255)
    95 
    +          (vertex-2f 0.25s0 0.75s0)
    96 
    +          (end)
    97 
    +          (pop-matrix)
    98 
    +          (xlib/glx:swap-buffers)
    102 99 
               (sleep 0.02)))
    103 100 
       (sleep 3))
    104 101
    105 102
    106 103 
     (defun anim/list (display window)
    107 104 
       (declare (ignore display window))
    108 
    -  (gl:ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
    109 
    -  (gl:clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
    110 
    -  (let ((list (gl:gen-lists 1)))
    111 
    -    (gl:new-list list gl:+compile+)
    112 
    -    (gl:begin gl:+polygon+)
    113 
    -    (gl:color-3ub 255 0 0)
    114 
    -    (gl:vertex-2f 0.25s0 0.25s0)
    115 
    -    (gl:color-3ub 0 255 0)
    116 
    -    (gl:vertex-2f 0.75s0 0.25s0)
    117 
    -    (gl:color-3ub 0 0 255)
    118 
    -    (gl:vertex-2f 0.75s0 0.75s0)
    119 
    -    (gl:color-3ub 255 255 255)
    120 
    -    (gl:vertex-2f 0.25s0 0.75s0)
    121 
    -    (gl:end)
    122 
    -    (glx:render)
    123 
    -    (gl:end-list)
    105 
    +  (ortho 0.0d0 1.0d0 0.0d0 1.0d0 -1.0d0 1.0d0)
    106 
    +  (clear-color 0.0s0 0.0s0 0.0s0 0.0s0)
    107 
    +  (let ((list (gen-lists 1)))
    108 
    +    (new-list list +compile+)
    109 
    +    (begin +polygon+)
    110 
    +    (color-3ub 255 0 0)
    111 
    +    (vertex-2f 0.25s0 0.25s0)
    112 
    +    (color-3ub 0 255 0)
    113 
    +    (vertex-2f 0.75s0 0.25s0)
    114 
    +    (color-3ub 0 0 255)
    115 
    +    (vertex-2f 0.75s0 0.75s0)
    116 
    +    (color-3ub 255 255 255)
    117 
    +    (vertex-2f 0.25s0 0.75s0)
    118 
    +    (end)
    119 
    +    (xlib/glx:render)
    120 
    +    (end-list)
    124 121
    125 122 
         (loop
    126 123 
            repeat 361
    127 124 
            for angle upfrom 0.0s0 by 1.0s0
    128 125 
            do (progn
    129 
    -            (gl:clear gl:+color-buffer-bit+)
    130 
    -            (gl:push-matrix)
    131 
    -            (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
    132 
    -            (gl:call-list list)
    133 
    -            (gl:pop-matrix)
    134 
    -            (glx:swap-buffers)
    126 
    +            (clear +color-buffer-bit+)
    127 
    +            (push-matrix)
    128 
    +            (rotate-f angle 0.0s0 0.0s0 1.0s0)
    129 
    +            (call-list list)
    130 
    +            (pop-matrix)
    131 
    +            (xlib/glx:swap-buffers)
    135 132 
                 (sleep 0.02))))
    136 133
    137 134 
       (sleep 3))
    ... ... @@ -148,101 +145,101 @@
    148 145 
             (r1 (/ (- outer-radius tooth-depth) 2.0s0))
    149 146 
             (r2 (/ (+ outer-radius tooth-depth) 2.0s0))
    150 147 
             (da (/ (* 2.0s0 +pi+) teeth 4.0s0)))
    151 
    -    (gl:shade-model gl:+flat+)
    152 
    -    (gl:normal-3f 0.0s0 0.0s0 1.0s0)
    148 
    +    (shade-model +flat+)
    149 
    +    (normal-3f 0.0s0 0.0s0 1.0s0)
    153 150
    154 151 
         ;; Front face.
    155 
    -    (gl:begin gl:+quad-strip+)
    152 
    +    (begin +quad-strip+)
    156 153 
         (dotimes (i (1+ teeth))
    157 154 
           (let ((angle (/ (* i 2.0 +pi+) teeth)))
    158 155 
             (declare (type single-float angle))
    159 
    -        (gl:vertex-3f (* r0 (cos angle))
    156 
    +        (vertex-3f (* r0 (cos angle))
    160 157 
                           (* r0 (sin angle))
    161 158 
                           (* width 0.5s0))
    162 
    -        (gl:vertex-3f (* r1 (cos angle))
    159 
    +        (vertex-3f (* r1 (cos angle))
    163 160 
                           (* r1 (sin angle))
    164 161 
                           (* width 0.5s0))
    165 162 
             (when (< i teeth)
    166 
    -          (gl:vertex-3f (* r0 (cos angle))
    163 
    +          (vertex-3f (* r0 (cos angle))
    167 164 
                             (* r0 (sin angle))
    168 165 
                             (* width 0.5s0))
    169 
    -          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
    166 
    +          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
    170 167 
                             (* r1 (sin (+ angle (* 3 da))))
    171 168 
                             (* width 0.5s0)))))
    172 
    -    (gl:end)
    169 
    +    (end)
    173 170
    174 171
    175 172 
         ;; Draw front sides of teeth.
    176 
    -    (gl:begin gl:+quads+)
    173 
    +    (begin +quads+)
    177 174 
         (setf da (/ (* 2.0s0 +pi+) teeth 4.0s0))
    178 175 
         (dotimes (i teeth)
    179 176 
           (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
    180 177 
             (declare (type single-float angle))
    181 
    -        (gl:vertex-3f (* r1 (cos angle))
    178 
    +        (vertex-3f (* r1 (cos angle))
    182 179 
                           (* r1 (sin angle))
    183 180 
                           (* width 0.5s0))
    184 
    -        (gl:vertex-3f (* r2 (cos (+ angle da)))
    181 
    +        (vertex-3f (* r2 (cos (+ angle da)))
    185 182 
                           (* r2 (sin (+ angle da)))
    186 183 
                           (* width 0.5s0))
    187 
    -        (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
    184 
    +        (vertex-3f (* r2 (cos (+ angle (* 2 da))))
    188 185 
                           (* r2 (sin (+ angle (* 2 da))))
    189 186 
                           (* width 0.5s0))
    190 
    -        (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
    187 
    +        (vertex-3f (* r1 (cos (+ angle (* 3 da))))
    191 188 
                           (* r1 (sin (+ angle (* 3 da))))
    192 189 
                           (* width 0.5s0))))
    193 
    -    (gl:end)
    190 
    +    (end)
    194 191
    195 
    -    (gl:normal-3f 0.0s0 0.0s0 -1.0s0)
    192 
    +    (normal-3f 0.0s0 0.0s0 -1.0s0)
    196 193
    197 194 
         ;; Draw back face.
    198 
    -    (gl:begin gl:+quad-strip+)
    195 
    +    (begin +quad-strip+)
    199 196 
         (dotimes (i (1+ teeth))
    200 197 
           (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
    201 198 
             (declare (type single-float angle))
    202 
    -        (gl:vertex-3f (* r1 (cos angle))
    199 
    +        (vertex-3f (* r1 (cos angle))
    203 200 
                           (* r1 (sin angle))
    204 201 
                           (* width -0.5s0))
    205 
    -        (gl:vertex-3f (* r0 (cos angle))
    202 
    +        (vertex-3f (* r0 (cos angle))
    206 203 
                           (* r0 (sin angle))
    207 204 
                           (* width -0.5s0))
    208 205 
             (when (< i teeth)
    209 
    -          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
    206 
    +          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
    210 207 
                             (* r1 (sin (+ angle (* 3 da))))
    211 208 
                             (* width -0.5s0))
    212 
    -          (gl:vertex-3f (* r0 (cos angle))
    209 
    +          (vertex-3f (* r0 (cos angle))
    213 210 
                             (* r0 (sin angle))
    214 211 
                             (* width 0.5s0)))))
    215 
    -    (gl:end)
    212 
    +    (end)
    216 213
    217 214 
         ;; Draw back sides of teeth.
    218 
    -    (gl:begin gl:+quads+)
    215 
    +    (begin +quads+)
    219 216 
         (setf da (/ (* 2.0s0 +pi+) teeth 4.0s0))
    220 217 
         (dotimes (i teeth)
    221 218 
           (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
    222 219 
             (declare (type single-float angle))
    223 
    -        (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
    220 
    +        (vertex-3f (* r1 (cos (+ angle (* 3 da))))
    224 221 
                           (* r1 (sin (+ angle (* 3 da))))
    225 222 
                           (* width -0.5s0))
    226 
    -        (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
    223 
    +        (vertex-3f (* r2 (cos (+ angle (* 2 da))))
    227 224 
                           (* r2 (sin (+ angle (* 2 da))))
    228 225 
                           (* width -0.5s0))
    229 
    -        (gl:vertex-3f (* r2 (cos (+ angle da)))
    226 
    +        (vertex-3f (* r2 (cos (+ angle da)))
    230 227 
                           (* r2 (sin (+ angle da)))
    231 228 
                           (* width -0.5s0))
    232 
    -        (gl:vertex-3f (* r1 (cos angle))
    229 
    +        (vertex-3f (* r1 (cos angle))
    233 230 
                           (* r1 (sin angle))
    234 231 
                           (* width -0.5s0))))
    235 
    -    (gl:end)
    232 
    +    (end)
    236 233
    237 234 
         ;; Draw outward faces of teeth.
    238 
    -    (gl:begin gl:+quad-strip+)
    235 
    +    (begin +quad-strip+)
    239 236 
         (dotimes (i teeth)
    240 237 
           (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
    241 238 
             (declare (type single-float angle))
    242 
    -        (gl:vertex-3f (* r1 (cos angle))
    239 
    +        (vertex-3f (* r1 (cos angle))
    243 240 
                           (* r1 (sin angle))
    244 241 
                           (* width 0.5s0))
    245 
    -        (gl:vertex-3f (* r1 (cos angle))
    242 
    +        (vertex-3f (* r1 (cos angle))
    246 243 
                           (* r1 (sin angle))
    247 244 
                           (* width -0.5s0))
    248 245 
             (let* ((u (- (* r2 (cos (+ angle da))) (* r1 (cos angle))))
    ... ... @@ -250,118 +247,118 @@
    250 247 
                    (len (sqrt (+ (* u u) (* v v)))))
    251 248 
               (setf u (/ u len)
    252 249 
                     v (/ v len))
    253 
    -          (gl:normal-3f v u 0.0s0)
    254 
    -          (gl:vertex-3f (* r2 (cos (+ angle da)))
    250 
    +          (normal-3f v u 0.0s0)
    251 
    +          (vertex-3f (* r2 (cos (+ angle da)))
    255 252 
                             (* r2 (sin (+ angle da)))
    256 253 
                             (* width 0.5s0))
    257 
    -          (gl:vertex-3f (* r2 (cos (+ angle da)))
    254 
    +          (vertex-3f (* r2 (cos (+ angle da)))
    258 255 
                             (* r2 (sin (+ angle da)))
    259 256 
                             (* width -0.5s0))
    260 
    -          (gl:normal-3f (cos angle) (sin angle) 0.0s0)
    261 
    -          (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
    257 
    +          (normal-3f (cos angle) (sin angle) 0.0s0)
    258 
    +          (vertex-3f (* r2 (cos (+ angle (* 2 da))))
    262 259 
                             (* r2 (sin (+ angle (* 2 da))))
    263 260 
                             (* width 0.5s0))
    264 
    -          (gl:vertex-3f (* r2 (cos (+ angle (* 2 da))))
    261 
    +          (vertex-3f (* r2 (cos (+ angle (* 2 da))))
    265 262 
                             (* r2 (sin (+ angle (* 2 da))))
    266 263 
                             (* width -0.5s0))
    267 264 
               (setf u (- (* r1 (cos (+ angle (* 3 da)))) (* r2 (cos (+ angle (* 2 da)))))
    268 265 
                     v (- (* r1 (sin (+ angle (* 3 da)))) (* r2 (sin (+ angle (* 2 da))))))
    269 
    -          (gl:normal-3f v (- u) 0.0s0)
    270 
    -          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
    266 
    +          (normal-3f v (- u) 0.0s0)
    267 
    +          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
    271 268 
                             (* r1 (sin (+ angle (* 3 da))))
    272 269 
                             (* width 0.5s0))
    273 
    -          (gl:vertex-3f (* r1 (cos (+ angle (* 3 da))))
    270 
    +          (vertex-3f (* r1 (cos (+ angle (* 3 da))))
    274 271 
                             (* r1 (sin (+ angle (* 3 da))))
    275 272 
                             (* width -0.5s0))
    276 
    -          (gl:normal-3f (cos angle) (sin angle) 0.0s0))))
    273 
    +          (normal-3f (cos angle) (sin angle) 0.0s0))))
    277 274
    278 
    -    (gl:vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5s0))
    279 
    -    (gl:vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width -0.5s0))
    275 
    +    (vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width 0.5s0))
    276 
    +    (vertex-3f (* r1 (cos 0)) (* r1 (sin 0)) (* width -0.5s0))
    280 277
    281 
    -    (gl:end)
    278 
    +    (end)
    282 279
    283 
    -    (gl:shade-model gl:+smooth+)
    280 
    +    (shade-model +smooth+)
    284 281
    285 282 
         ;; Draw inside radius cylinder.
    286 
    -    (gl:begin gl:+quad-strip+)
    283 
    +    (begin +quad-strip+)
    287 284 
         (dotimes (i (1+ teeth))
    288 285 
           (let ((angle (/ (* i 2.0s0 +pi+) teeth)))
    289 286 
             (declare (type single-float angle))
    290 
    -        (gl:normal-3f (- (cos angle)) (- (sin angle)) 0.0s0)
    291 
    -        (gl:vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5s0))
    292 
    -        (gl:vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0))))
    293 
    -    (gl:end)))
    287 
    +        (normal-3f (- (cos angle)) (- (sin angle)) 0.0s0)
    288 
    +        (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width -0.5s0))
    289 
    +        (vertex-3f (* r0 (cos angle)) (* r0 (sin angle)) (* width 0.5s0))))
    290 
    +    (end)))
    294 291
    295 292
    296 293 
     (defun draw (gear-1 gear-2 gear-3 view-rotx view-roty view-rotz angle)
    297 
    -  (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
    294 
    +  (clear (logior +color-buffer-bit+ +depth-buffer-bit+))
    298 295
    299 
    -  (gl:push-matrix)
    300 
    -  (gl:rotate-f view-rotx 1.0s0 0.0s0 0.0s0)
    301 
    -  (gl:rotate-f view-roty 0.0s0 1.0s0 0.0s0)
    302 
    -  (gl:rotate-f view-rotz 0.0s0 0.0s0 1.0s0)
    296 
    +  (push-matrix)
    297 
    +  (rotate-f view-rotx 1.0s0 0.0s0 0.0s0)
    298 
    +  (rotate-f view-roty 0.0s0 1.0s0 0.0s0)
    299 
    +  (rotate-f view-rotz 0.0s0 0.0s0 1.0s0)
    303 300
    304 
    -  (gl:push-matrix)
    305 
    -  (gl:translate-f -3.0s0 -2.0s0 0.0s0)
    306 
    -  (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
    307 
    -  (gl:call-list gear-1)
    308 
    -  (gl:pop-matrix)
    301 
    +  (push-matrix)
    302 
    +  (translate-f -3.0s0 -2.0s0 0.0s0)
    303 
    +  (rotate-f angle 0.0s0 0.0s0 1.0s0)
    304 
    +  (call-list gear-1)
    305 
    +  (pop-matrix)
    309 306
    310 
    -  (gl:push-matrix)
    311 
    -  (gl:translate-f 3.1s0 -2.0s0 0.0s0)
    312 
    -  (gl:rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
    313 
    -  (gl:call-list gear-2)
    314 
    -  (gl:pop-matrix)
    307 
    +  (push-matrix)
    308 
    +  (translate-f 3.1s0 -2.0s0 0.0s0)
    309 
    +  (rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
    310 
    +  (call-list gear-2)
    311 
    +  (pop-matrix)
    315 312
    316 
    -  (gl:push-matrix)
    317 
    -  (gl:translate-f -3.1s0 4.2s0 0.0s0)
    318 
    -  (gl:rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
    319 
    -  (gl:call-list gear-3)
    320 
    -  (gl:pop-matrix)
    313 
    +  (push-matrix)
    314 
    +  (translate-f -3.1s0 4.2s0 0.0s0)
    315 
    +  (rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
    316 
    +  (call-list gear-3)
    317 
    +  (pop-matrix)
    321 318
    322 
    -  (gl:pop-matrix))
    319 
    +  (pop-matrix))
    323 320
    324 321
    325 322 
     (defun reshape (width height)
    326 
    -  (gl:viewport 0 0 width height)
    323 
    +  (viewport 0 0 width height)
    327 324 
       (let ((h (coerce (/ height width) 'double-float)))
    328 
    -    (gl:matrix-mode gl:+projection+)
    329 
    -    (gl:load-identity)
    330 
    -    (gl:frustum -1.0d0 1.0d0 (- h) h 5.0d0 60.0d0))
    325 
    +    (matrix-mode +projection+)
    326 
    +    (load-identity)
    327 
    +    (frustum -1.0d0 1.0d0 (- h) h 5.0d0 60.0d0))
    331 328
    332 
    -  (gl:matrix-mode gl:+modelview+)
    333 
    -  (gl:load-identity)
    334 
    -  (gl:translate-f 0.0s0 0.0s0 -40.0s0))
    329 
    +  (matrix-mode +modelview+)
    330 
    +  (load-identity)
    331 
    +  (translate-f 0.0s0 0.0s0 -40.0s0))
    335 332
    336 333
    337 334 
     (defun init ()
    338 335 
       (let (gear-1 gear-2 gear-3)
    339 
    -    ;;(gl:light-fv gl:+light0+ gl:+position+ '(5.0s0 5.0s0 10.0s0 0.0s0))
    340 
    -    ;;(gl:enable gl:+cull-face+)
    341 
    -    ;;(gl:enable gl:+lighting+)
    342 
    -    ;;(gl:enable gl:+light0+)
    343 
    -    ;;(gl:enable gl:+depth-test+)
    336 
    +    ;;(light-fv +light0+ +position+ '(5.0s0 5.0s0 10.0s0 0.0s0))
    337 
    +    ;;(enable +cull-face+)
    338 
    +    ;;(enable +lighting+)
    339 
    +    ;;(enable +light0+)
    340 
    +    ;;(enable +depth-test+)
    344 341
    345 342 
         ;; Make the gears.
    346 
    -    (setf gear-1 (gl:gen-lists 1))
    347 
    -    (gl:new-list gear-1 gl:+compile+)
    348 
    -    (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
    343 
    +    (setf gear-1 (gen-lists 1))
    344 
    +    (new-list gear-1 +compile+)
    345 
    +    (material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
    349 346 
         (gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
    350 
    -    (gl:end-list)
    347 
    +    (end-list)
    351 348
    352 
    -    (setf gear-2 (gl:gen-lists 1))
    353 
    -    (gl:new-list gear-2 gl:+compile+)
    354 
    -    (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
    349 
    +    (setf gear-2 (gen-lists 1))
    350 
    +    (new-list gear-2 +compile+)
    351 
    +    (material-fv +front+ +ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
    355 352 
         (gear 0.5s0 2.0s0 2.0s0 10 0.7s0)
    356 
    -    (gl:end-list)
    353 
    +    (end-list)
    357 354
    358 
    -    (setf gear-3 (gl:gen-lists 1))
    359 
    -    (gl:new-list gear-3 gl:+compile+)
    360 
    -    (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
    355 
    +    (setf gear-3 (gen-lists 1))
    356 
    +    (new-list gear-3 +compile+)
    357 
    +    (material-fv +front+ +ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
    361 358 
         (gear 1.3s0 2.0s0 0.5s0 10 0.7s0)
    362 
    -    (gl:end-list)
    359 
    +    (end-list)
    363 360
    364 
    -    ;;(gl:enable gl:+normalize+)
    361 
    +    ;;(enable +normalize+)
    365 362
    366 363 
         (values gear-1 gear-2 gear-3)))
    367 364
    ... ... @@ -369,31 +366,31 @@
    369 366 
     (defun gears* (display window)
    370 367 
       (declare (ignore display window))
    371 368
    372 
    -  (gl:enable gl:+cull-face+)
    373 
    -  (gl:enable gl:+lighting+)
    374 
    -  (gl:enable gl:+light0+)
    375 
    -  (gl:enable gl:+normalize+)
    376 
    -  (gl:enable gl:+depth-test+)
    369 
    +  (enable +cull-face+)
    370 
    +  (enable +lighting+)
    371 
    +  (enable +light0+)
    372 
    +  (enable +normalize+)
    373 
    +  (enable +depth-test+)
    377 374
    378 375 
       (reshape 300 300)
    379 376
    380 
    -  ;;(gl:light-fv gl:+light0+ gl:+position+ #(5.0s0 5.0s0 10.0s0 0.0s0))
    377 
    +  ;;(light-fv +light0+ +position+ #(5.0s0 5.0s0 10.0s0 0.0s0))
    381 378
    382 379 
       (let (list)
    383 380 
         (declare (ignore list))
    384 381 
         #-(and)
    385 382 
         (progn
    386 
    -      (setf list (gl:gen-lists 1))
    387 
    -      (gl:new-list list gl:+compile+)
    388 
    -      ;;(gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
    383 
    +      (setf list (gen-lists 1))
    384 
    +      (new-list list +compile+)
    385 
    +      ;;(material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
    389 386 
           (gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
    390 
    -      (glx:render)
    391 
    -      (gl:end-list))
    387 
    +      (xlib/glx:render)
    388 
    +      (end-list))
    392 389
    393 390
    394 391 
         (loop
    395 392 
            ;;for angle from 0.0s0 below 361.0s0 by 1.0s0
    396 
    -       with angle single-float = 0.0s0
    393 
    +       with angle of-type single-float = 0.0s0
    397 394 
            with dt = 0.004s0
    398 395 
            repeat 2500
    399 396 
            do (progn
    ... ... @@ -402,39 +399,39 @@
    402 399 
                 (when (< 3600.0s0 angle)
    403 400 
                   (decf angle 3600.0s0))
    404 401
    405 
    -            (gl:clear (logior gl:+color-buffer-bit+ gl:+depth-buffer-bit+))
    402 
    +            (clear (logior +color-buffer-bit+ +depth-buffer-bit+))
    406 403
    407 
    -            (gl:push-matrix)
    408 
    -            (gl:rotate-f 20.0s0 0.0s0 1.0s0 0.0s0)
    404 
    +            (push-matrix)
    405 
    +            (rotate-f 20.0s0 0.0s0 1.0s0 0.0s0)
    409 406
    410 407
    411 
    -            (gl:push-matrix)
    412 
    -            (gl:translate-f -3.0s0 -2.0s0 0.0s0)
    413 
    -            (gl:rotate-f angle 0.0s0 0.0s0 1.0s0)
    414 
    -            (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
    408 
    +            (push-matrix)
    409 
    +            (translate-f -3.0s0 -2.0s0 0.0s0)
    410 
    +            (rotate-f angle 0.0s0 0.0s0 1.0s0)
    411 
    +            (material-fv +front+ +ambient-and-diffuse+ '(0.8s0 0.1s0 0.0s0 1.0s0))
    415 412 
                 (gear 1.0s0 4.0s0 1.0s0 20 0.7s0)
    416 
    -            (gl:pop-matrix)
    413 
    +            (pop-matrix)
    417 414
    418 415
    419 
    -            (gl:push-matrix)
    420 
    -            (gl:translate-f 3.1s0 -2.0s0 0.0s0)
    421 
    -            (gl:rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
    422 
    -            (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
    416 
    +            (push-matrix)
    417 
    +            (translate-f 3.1s0 -2.0s0 0.0s0)
    418 
    +            (rotate-f (- (* angle -2.0s0) 9.0s0) 0.0s0 0.0s0 1.0s0)
    419 
    +            (material-fv +front+ +ambient-and-diffuse+ '(0.0s0 0.8s0 0.2s0 1.0s0))
    423 420 
                 (gear 0.5s0 2.0s0 2.0s0 10 0.7s0)
    424 
    -            (gl:pop-matrix)
    421 
    +            (pop-matrix)
    425 422
    426 423
    427 
    -            (gl:push-matrix)
    428 
    -            (gl:translate-f -3.1s0 4.2s0 0.0s0)
    429 
    -            (gl:rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
    430 
    -            (gl:material-fv gl:+front+ gl:+ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
    424 
    +            (push-matrix)
    425 
    +            (translate-f -3.1s0 4.2s0 0.0s0)
    426 
    +            (rotate-f (- (* angle -2.s0) 25.0s0) 0.0s0 0.0s0 1.0s0)
    427 
    +            (material-fv +front+ +ambient-and-diffuse+ '(0.2s0 0.2s0 1.0s0 1.0s0))
    431 428 
                 (gear 1.3s0 2.0s0 0.5s0 10 0.7s0)
    432 
    -            (gl:pop-matrix)
    429 
    +            (pop-matrix)
    433 430
    434 431
    435 
    -            (gl:pop-matrix)
    432 
    +            (pop-matrix)
    436 433
    437 
    -            (glx:swap-buffers)
    434 
    +            (xlib/glx:swap-buffers)
    438 435 
                 ;;(sleep 0.025)
    439 436 
                 )))
    440 437
    ... ... @@ -472,7 +469,7 @@
    472 469 
              (decf angle 3600.0s0))
    473 470
    474 471 
            (draw gear-1 gear-2 gear-3 view-rotx view-roty view-rotz angle)
    475 
    -       (glx:swap-buffers)
    472 
    +       (xlib/glx:swap-buffers)
    476 473
    477 474 
            (incf frames)
    478 475

  • src/clx/demo/hello.lisp
    1 1 
     ;;; -*- Mode:Lisp; Syntax: Common-lisp; Package:XLIB; Base:10; Lowercase: Yes -*-
    2 2
    3 
    -#+cmu
    4 
    -(ext:file-comment "$Id: hello.lisp,v 1.3 2009/06/17 18:22:46 rtoy Rel $")
    5 
    -
    6 3 
     (in-package :xlib)
    7 4
    8 5 
     (defun hello-world (host &rest args &key (string "Hello World") (font "fixed"))

  • src/clx/demo/mandel.lisp
    1 
    -#+cmu
    2 
    -(ext:file-comment "$Id: mandel.lisp,v 1.2 2009/06/17 18:22:46 rtoy Rel $")
    3 
    -
    4 
    -(defpackage "XMANDEL"
    1 
    +(defpackage #:xlib-demo/mandel
    5 2 
       (:use "CL")
    6 3 
       (:export "NEW-WINDOW" "EVENT-LOOP"))
    7 4
    8 
    -(in-package "XMANDEL")
    5 
    +(in-package #:xlib-demo/mandel)
    9 6
    10 7 
     (defvar *display* (xlib:open-default-display))
    11 8 
     (defvar *screen* (xlib:display-default-screen *display*))

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.common-lisp.net. If you'd like to receive fewer emails, you can adjust your notification settings.