/[cmucl]/src/clx/graphics.lisp
ViewVC logotype

Diff of /src/clx/graphics.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3.2.2 by pw, Tue May 23 16:36:00 2000 UTC revision 1.7 by rtoy, Wed Jun 17 18:22:46 2009 UTC
# Line 17  Line 17 
17  ;;; Texas Instruments Incorporated provides this software "as is" without  ;;; Texas Instruments Incorporated provides this software "as is" without
18  ;;; express or implied warranty.  ;;; express or implied warranty.
19  ;;;  ;;;
20    
21  #+cmu  #+cmu
22  (ext:file-comment  (ext:file-comment "$Id$")
   "$Header$")  
23    
24  (in-package :xlib)  (in-package :xlib)
25    
# Line 34  Line 34 
34      (declare (type display display))      (declare (type display display))
35      (with-display (display)      (with-display (display)
36        (force-gcontext-changes-internal gcontext)        (force-gcontext-changes-internal gcontext)
37        (with-buffer-output (display :length *requestsize*)        (with-buffer-output (display :length +requestsize+)
38          (let* ((last-request-byte (display-last-request display))          (let* ((last-request-byte (display-last-request display))
39                 (current-boffset buffer-boffset))                 (current-boffset buffer-boffset))
40            ;; To append or not append, that is the question            ;; To append or not append, that is the question
41            (if (and (not *inhibit-appending*)            (if (and (not *inhibit-appending*)
42                     last-request-byte                     last-request-byte
43                     ;; Same request?                     ;; Same request?
44                     (= (aref-card8 buffer-bbuf last-request-byte) *x-polypoint*)                     (= (aref-card8 buffer-bbuf last-request-byte) +x-polypoint+)
45                     (progn ;; Set buffer pointers to last request                     (progn ;; Set buffer pointers to last request
46                       (set-buffer-offset last-request-byte)                       (set-buffer-offset last-request-byte)
47                       ;; same drawable and gcontext?                       ;; same drawable and gcontext?
# Line 64  Line 64 
64              ;; New Request              ;; New Request
65              (progn              (progn
66                (put-items (4)                (put-items (4)
67                  (code *x-polypoint*)                  (code +x-polypoint+)
68                  (data 0) ;; Relative-p false                  (data 0) ;; Relative-p false
69                  (length 4)                  (length 4)
70                  (drawable drawable)                  (drawable drawable)
# Line 81  Line 81 
81             (type gcontext gcontext)             (type gcontext gcontext)
82             (type sequence points)               ;(repeat-seq (integer x) (integer y))             (type sequence points)               ;(repeat-seq (integer x) (integer y))
83             (type generalized-boolean relative-p))             (type generalized-boolean relative-p))
84    (with-buffer-request ((drawable-display drawable) *x-polypoint* :gc-force gcontext)    (with-buffer-request ((drawable-display drawable) +x-polypoint+ :gc-force gcontext)
85      ((data boolean) relative-p)      ((data boolean) relative-p)
86      (drawable drawable)      (drawable drawable)
87      (gcontext gcontext)      (gcontext gcontext)
# Line 100  Line 100 
100        (incf y2 y1))        (incf y2 y1))
101      (with-display (display)      (with-display (display)
102        (force-gcontext-changes-internal gcontext)        (force-gcontext-changes-internal gcontext)
103        (with-buffer-output (display :length *requestsize*)        (with-buffer-output (display :length +requestsize+)
104          (let* ((last-request-byte (display-last-request display))          (let* ((last-request-byte (display-last-request display))
105                 (current-boffset buffer-boffset))                 (current-boffset buffer-boffset))
106            ;; To append or not append, that is the question            ;; To append or not append, that is the question
107            (if (and (not *inhibit-appending*)            (if (and (not *inhibit-appending*)
108                     last-request-byte                     last-request-byte
109                     ;; Same request?                     ;; Same request?
110                     (= (aref-card8 buffer-bbuf last-request-byte) *x-polysegment*)                     (= (aref-card8 buffer-bbuf last-request-byte) +x-polysegment+)
111                     (progn ;; Set buffer pointers to last request                     (progn ;; Set buffer pointers to last request
112                       (set-buffer-offset last-request-byte)                       (set-buffer-offset last-request-byte)
113                       ;; same drawable and gcontext?                       ;; same drawable and gcontext?
# Line 129  Line 129 
129              ;; New Request              ;; New Request
130              (progn              (progn
131                (put-items (4)                (put-items (4)
132                  (code *x-polysegment*)                  (code +x-polysegment+)
133                  (length 5)                  (length 5)
134                  (drawable drawable)                  (drawable drawable)
135                  (gcontext gcontext)                  (gcontext gcontext)
# Line 147  Line 147 
147             (type (member :complex :non-convex :convex) shape))             (type (member :complex :non-convex :convex) shape))
148    (if fill-p    (if fill-p
149        (fill-polygon drawable gcontext points relative-p shape)        (fill-polygon drawable gcontext points relative-p shape)
150      (with-buffer-request ((drawable-display drawable)  *x-polyline* :gc-force gcontext)      (with-buffer-request ((drawable-display drawable)  +x-polyline+ :gc-force gcontext)
151        ((data boolean) relative-p)        ((data boolean) relative-p)
152        (drawable drawable)        (drawable drawable)
153        (gcontext gcontext)        (gcontext gcontext)
# Line 161  Line 161 
161             (type sequence points)               ;(repeat-seq (integer x) (integer y))             (type sequence points)               ;(repeat-seq (integer x) (integer y))
162             (type generalized-boolean relative-p)             (type generalized-boolean relative-p)
163             (type (member :complex :non-convex :convex) shape))             (type (member :complex :non-convex :convex) shape))
164    (with-buffer-request ((drawable-display drawable)  *x-fillpoly* :gc-force gcontext)    (with-buffer-request ((drawable-display drawable)  +x-fillpoly+ :gc-force gcontext)
165      (drawable drawable)      (drawable drawable)
166      (gcontext gcontext)      (gcontext gcontext)
167      ((member8 :complex :non-convex :convex) shape)      ((member8 :complex :non-convex :convex) shape)
# Line 173  Line 173 
173             (type gcontext gcontext)             (type gcontext gcontext)
174             ;; (repeat-seq (integer x1) (integer y1) (integer x2) (integer y2)))             ;; (repeat-seq (integer x1) (integer y1) (integer x2) (integer y2)))
175             (type sequence segments))             (type sequence segments))
176    (with-buffer-request ((drawable-display drawable) *x-polysegment* :gc-force gcontext)    (with-buffer-request ((drawable-display drawable) +x-polysegment+ :gc-force gcontext)
177      (drawable drawable)      (drawable drawable)
178      (gcontext gcontext)      (gcontext gcontext)
179      ((sequence :format int16) segments)))      ((sequence :format int16) segments)))
# Line 186  Line 186 
186             (type card16 width height)             (type card16 width height)
187             (type generalized-boolean fill-p))             (type generalized-boolean fill-p))
188    (let ((display (drawable-display drawable))    (let ((display (drawable-display drawable))
189          (request (if fill-p *x-polyfillrectangle* *x-polyrectangle*)))          (request (if fill-p +x-polyfillrectangle+ +x-polyrectangle+)))
190      (declare (type display display)      (declare (type display display)
191               (type card16 request))               (type card16 request))
192      (with-display (display)      (with-display (display)
193        (force-gcontext-changes-internal gcontext)        (force-gcontext-changes-internal gcontext)
194        (with-buffer-output (display :length *requestsize*)        (with-buffer-output (display :length +requestsize+)
195          (let* ((last-request-byte (display-last-request display))          (let* ((last-request-byte (display-last-request display))
196                 (current-boffset buffer-boffset))                 (current-boffset buffer-boffset))
197            ;; To append or not append, that is the question            ;; To append or not append, that is the question
# Line 239  Line 239 
239             (type sequence rectangles)             (type sequence rectangles)
240             (type generalized-boolean fill-p))             (type generalized-boolean fill-p))
241    (with-buffer-request ((drawable-display drawable)    (with-buffer-request ((drawable-display drawable)
242                          (if fill-p *x-polyfillrectangle* *x-polyrectangle*)                          (if fill-p +x-polyfillrectangle+ +x-polyrectangle+)
243                          :gc-force gcontext)                          :gc-force gcontext)
244      (drawable drawable)      (drawable drawable)
245      (gcontext gcontext)      (gcontext gcontext)
# Line 254  Line 254 
254             (type angle angle1 angle2)             (type angle angle1 angle2)
255             (type generalized-boolean fill-p))             (type generalized-boolean fill-p))
256    (let ((display (drawable-display drawable))    (let ((display (drawable-display drawable))
257          (request (if fill-p *x-polyfillarc* *x-polyarc*)))          (request (if fill-p +x-polyfillarc+ +x-polyarc+)))
258      (declare (type display display)      (declare (type display display)
259               (type card16 request))               (type card16 request))
260      (with-display (display)      (with-display (display)
261        (force-gcontext-changes-internal gcontext)        (force-gcontext-changes-internal gcontext)
262        (with-buffer-output (display :length *requestsize*)        (with-buffer-output (display :length +requestsize+)
263          (let* ((last-request-byte (display-last-request display))          (let* ((last-request-byte (display-last-request display))
264                 (current-boffset buffer-boffset))                 (current-boffset buffer-boffset))
265            ;; To append or not append, that is the question            ;; To append or not append, that is the question
# Line 310  Line 310 
310    (let* ((display (drawable-display drawable))    (let* ((display (drawable-display drawable))
311           (limit (index- (buffer-size display) 12))           (limit (index- (buffer-size display) 12))
312           (length (length arcs))           (length (length arcs))
313           (request (if fill-p *x-polyfillarc* *x-polyarc*)))           (request (if fill-p +x-polyfillarc+ +x-polyarc+)))
314      (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)      (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)
315        (drawable drawable)        (drawable drawable)
316        (gcontext gcontext)        (gcontext gcontext)
# Line 341  Line 341 
341    (let* ((display (drawable-display drawable))    (let* ((display (drawable-display drawable))
342           (limit (index- (buffer-size display) 12))           (limit (index- (buffer-size display) 12))
343           (length (length arcs))           (length (length arcs))
344           (request (if fill-p *x-polyfillarc* *x-polyarc*)))           (request (if fill-p +x-polyfillarc+ +x-polyarc+)))
345      (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)      (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)
346        (drawable drawable)        (drawable drawable)
347        (gcontext gcontext)        (gcontext gcontext)
# Line 400  Line 400 
400             (type int16 x y) ;; required             (type int16 x y) ;; required
401             (type card16 width height) ;; required             (type card16 width height) ;; required
402             (type (member :bitmap :xy-pixmap :z-pixmap) format))             (type (member :bitmap :xy-pixmap :z-pixmap) format))
403    (with-buffer-request ((drawable-display drawable) *x-putimage* :gc-force gcontext)    (with-buffer-request ((drawable-display drawable) +x-putimage+ :gc-force gcontext)
404      ((data (member :bitmap :xy-pixmap :z-pixmap)) format)      ((data (member :bitmap :xy-pixmap :z-pixmap)) format)
405      (drawable drawable)      (drawable drawable)
406      (gcontext gcontext)      (gcontext gcontext)
# Line 434  Line 434 
434             (type (member :xy-pixmap :z-pixmap) format))             (type (member :xy-pixmap :z-pixmap) format))
435    (declare (clx-values (clx-sequence integer) depth visual-info))    (declare (clx-values (clx-sequence integer) depth visual-info))
436    (let ((display (drawable-display drawable)))    (let ((display (drawable-display drawable)))
437      (with-buffer-request-and-reply (display *x-getimage* nil :sizes (8 32))      (with-buffer-request-and-reply (display +x-getimage+ nil :sizes (8 32))
438           (((data (member error :xy-pixmap :z-pixmap)) format)           (((data (member error :xy-pixmap :z-pixmap)) format)
439            (drawable drawable)            (drawable drawable)
440            (int16 x y)            (int16 x y)
# Line 445  Line 445 
445              (visual (resource-id-get 8)))              (visual (resource-id-get 8)))
446          (values (sequence-get :result-type result-type :format card8          (values (sequence-get :result-type result-type :format card8
447                                :length length :start start :data data                                :length length :start start :data data
448                                :index *replysize*)                                :index +replysize+)
449                  depth                  depth
450                  (visual-info display visual))))))                  (visual-info display visual))))))

Legend:
Removed from v.1.3.2.2  
changed lines
  Added in v.1.7

  ViewVC Help
Powered by ViewVC 1.1.5