This file is indexed.

/usr/share/common-lisp/source/clx/graphics.lisp is in cl-clx-sbcl 0.7.4-5.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: XLIB; Base: 10; Lowercase: Yes -*-

;;; CLX drawing requests

;;;
;;;			 TEXAS INSTRUMENTS INCORPORATED
;;;				  P.O. BOX 2909
;;;			       AUSTIN, TEXAS 78769
;;;
;;; Copyright (C) 1987 Texas Instruments Incorporated.
;;;
;;; Permission is granted to any individual or institution to use, copy, modify,
;;; and distribute this software, provided that this complete copyright and
;;; permission notice is maintained, intact, in all copies and supporting
;;; documentation.
;;;
;;; Texas Instruments Incorporated provides this software "as is" without
;;; express or implied warranty.
;;;

(in-package :xlib)

(defvar *inhibit-appending* nil)

(defun draw-point (drawable gcontext x y)
  ;; Should be clever about appending to existing buffered protocol request.
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type int16 x y))
  (let ((display (drawable-display drawable)))
    (declare (type display display))
    (with-display (display)
      (force-gcontext-changes-internal gcontext)
      (with-buffer-output (display :length +requestsize+)
	(let* ((last-request-byte (display-last-request display))
	       (current-boffset buffer-boffset))
	  ;; To append or not append, that is the question
	  (if (and (not *inhibit-appending*)
		   last-request-byte
		   ;; Same request?
		   (= (aref-card8 buffer-bbuf last-request-byte) +x-polypoint+)
		   (progn ;; Set buffer pointers to last request
		     (set-buffer-offset last-request-byte)
		     ;; same drawable and gcontext?
		     (or (compare-request (4)
			   (data 0)
			   (drawable drawable)
			   (gcontext gcontext))
			 (progn ;; If failed, reset buffer pointers
			   (set-buffer-offset current-boffset)
			   nil))))
	      ;; Append request
	      (progn
		;; Set new request length		
		(card16-put 2 (index+ 1 (index-ash (index- current-boffset last-request-byte)
						   -2)))
		(set-buffer-offset current-boffset)
		(put-items (0)			; Insert new point
		  (int16 x y))
		(setf (display-boffset display) (index+ buffer-boffset 4)))
	    ;; New Request
	    (progn
	      (put-items (4)
		(code +x-polypoint+)
		(data 0) ;; Relative-p false
		(length 4)
		(drawable drawable)
		(gcontext gcontext)
		(int16 x y))
	      (buffer-new-request-number display)
	      (setf (buffer-last-request display) buffer-boffset)
	      (setf (display-boffset display) (index+ buffer-boffset 16)))))))
    (display-invoke-after-function display))) 


(defun draw-points (drawable gcontext points &optional relative-p)
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type sequence points)		;(repeat-seq (integer x) (integer y))
	   (type generalized-boolean relative-p))
  (with-buffer-request ((drawable-display drawable) +x-polypoint+ :gc-force gcontext)
    ((data boolean) relative-p)
    (drawable drawable)
    (gcontext gcontext)
    ((sequence :format int16) points)))

(defun draw-line (drawable gcontext x1 y1 x2 y2 &optional relative-p)
  ;; Should be clever about appending to existing buffered protocol request.
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type int16 x1 y1 x2 y2)
	   (type generalized-boolean relative-p))
  (let ((display (drawable-display drawable)))
    (declare (type display display))
    (when relative-p
      (incf x2 x1)
      (incf y2 y1))
    (with-display (display)
      (force-gcontext-changes-internal gcontext)
      (with-buffer-output (display :length +requestsize+)
	(let* ((last-request-byte (display-last-request display))
	       (current-boffset buffer-boffset))
	  ;; To append or not append, that is the question
	  (if (and (not *inhibit-appending*)
		   last-request-byte
		   ;; Same request?
		   (= (aref-card8 buffer-bbuf last-request-byte) +x-polysegment+)
		   (progn ;; Set buffer pointers to last request
		     (set-buffer-offset last-request-byte)
		     ;; same drawable and gcontext?
		     (or (compare-request (4)
			   (drawable drawable)
			   (gcontext gcontext))
			 (progn ;; If failed, reset buffer pointers
			   (set-buffer-offset current-boffset)
			   nil))))
	      ;; Append request
	      (progn
		;; Set new request length
		(card16-put 2 (index+ 2 (index-ash (index- current-boffset last-request-byte)
						   -2)))
		(set-buffer-offset current-boffset)
		(put-items (0)			; Insert new point
		  (int16 x1 y1 x2 y2))
		(setf (display-boffset display) (index+ buffer-boffset 8)))
	    ;; New Request
	    (progn
	      (put-items (4)
		(code +x-polysegment+)
		(length 5)
		(drawable drawable)
		(gcontext gcontext)
		(int16 x1 y1 x2 y2))
	      (buffer-new-request-number display)
	      (setf (buffer-last-request display) buffer-boffset)
	      (setf (display-boffset display) (index+ buffer-boffset 20)))))))
    (display-invoke-after-function display))) 

(defun draw-lines (drawable gcontext points &key relative-p fill-p (shape :complex))
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type sequence points) ;(repeat-seq (integer x) (integer y))
	   (type generalized-boolean relative-p fill-p)
	   (type (member :complex :non-convex :convex) shape))
  (if fill-p
      (fill-polygon drawable gcontext points relative-p shape)
    (with-buffer-request ((drawable-display drawable)  +x-polyline+ :gc-force gcontext)
      ((data boolean) relative-p)
      (drawable drawable)
      (gcontext gcontext)
      ((sequence :format int16) points))))

;; Internal function called from DRAW-LINES
(defun fill-polygon (drawable gcontext points relative-p shape)
  ;; This is clever about appending to previous requests.  Should it be?
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type sequence points)		;(repeat-seq (integer x) (integer y))
	   (type generalized-boolean relative-p)
	   (type (member :complex :non-convex :convex) shape))
  (with-buffer-request ((drawable-display drawable)  +x-fillpoly+ :gc-force gcontext)
    (drawable drawable)
    (gcontext gcontext)
    ((member8 :complex :non-convex :convex) shape)
    (boolean relative-p)
    ((sequence :format int16) points)))

(defun draw-segments (drawable gcontext segments)
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   ;; (repeat-seq (integer x1) (integer y1) (integer x2) (integer y2)))
	   (type sequence segments)) 
  (with-buffer-request ((drawable-display drawable) +x-polysegment+ :gc-force gcontext)
    (drawable drawable)
    (gcontext gcontext)
    ((sequence :format int16) segments)))

(defun draw-rectangle (drawable gcontext x y width height &optional fill-p)
  ;; Should be clever about appending to existing buffered protocol request.
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type int16 x y)
	   (type card16 width height)
	   (type generalized-boolean fill-p))
  (let ((display (drawable-display drawable))
	(request (if fill-p +x-polyfillrectangle+ +x-polyrectangle+)))
    (declare (type display display)
	     (type card16 request))
    (with-display (display)
      (force-gcontext-changes-internal gcontext)
      (with-buffer-output (display :length +requestsize+)
	(let* ((last-request-byte (display-last-request display))
	       (current-boffset buffer-boffset))
	  ;; To append or not append, that is the question
	  (if (and (not *inhibit-appending*)
		   last-request-byte
		   ;; Same request?
		   (= (aref-card8 buffer-bbuf last-request-byte) request)
		   (progn ;; Set buffer pointers to last request
		     (set-buffer-offset last-request-byte)
		     ;; same drawable and gcontext?
		     (or (compare-request (4)
			   (drawable drawable)
			   (gcontext gcontext))
			 (progn ;; If failed, reset buffer pointers
			   (set-buffer-offset current-boffset)
			   nil))))
	      ;; Append request
	      (progn
		;; Set new request length
		(card16-put 2 (index+ 2 (index-ash (index- current-boffset last-request-byte)
						   -2)))
		(set-buffer-offset current-boffset)
		(put-items (0)			; Insert new point
		  (int16 x y)
		  (card16 width height))
		(setf (display-boffset display) (index+ buffer-boffset 8)))
	    ;; New Request
	    (progn
	      (put-items (4)
		(code request)
		(length 5)
		(drawable drawable)
		(gcontext gcontext)
		(int16 x y)
		(card16 width height))
	      (buffer-new-request-number display)
	      (setf (buffer-last-request display) buffer-boffset)
	      (setf (display-boffset display) (index+ buffer-boffset 20)))))))
    (display-invoke-after-function display))) 

(defun draw-rectangles (drawable gcontext rectangles &optional fill-p)
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   ;; (repeat-seq (integer x) (integer y) (integer width) (integer height)))
	   (type sequence rectangles)
	   (type generalized-boolean fill-p))
  (with-buffer-request ((drawable-display drawable)
			(if fill-p +x-polyfillrectangle+ +x-polyrectangle+)
			:gc-force gcontext)
    (drawable drawable)
    (gcontext gcontext)
    ((sequence :format int16) rectangles)))

(defun draw-arc (drawable gcontext x y width height angle1 angle2 &optional fill-p)
  ;; Should be clever about appending to existing buffered protocol request.
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type int16 x y)
	   (type card16 width height)
	   (type angle angle1 angle2)
	   (type generalized-boolean fill-p))
  (let ((display (drawable-display drawable))
	(request (if fill-p +x-polyfillarc+ +x-polyarc+)))
    (declare (type display display)
	     (type card16 request))
    (with-display (display)
      (force-gcontext-changes-internal gcontext)
      (with-buffer-output (display :length +requestsize+)
	(let* ((last-request-byte (display-last-request display))
	       (current-boffset buffer-boffset))
	  ;; To append or not append, that is the question
	  (if (and (not *inhibit-appending*)
		   last-request-byte
		   ;; Same request?
		   (= (aref-card8 buffer-bbuf last-request-byte) request)
		   (progn ;; Set buffer pointers to last request
		     (set-buffer-offset last-request-byte)
		     ;; same drawable and gcontext?
		     (or (compare-request (4)
			   (drawable drawable)
			   (gcontext gcontext))
			 (progn ;; If failed, reset buffer pointers
			   (set-buffer-offset current-boffset)
			   nil))))
	      ;; Append request
	      (progn
		;; Set new request length		
		(card16-put 2 (index+ 3 (index-ash (index- current-boffset last-request-byte)
						   -2)))
		(set-buffer-offset current-boffset)
		(put-items (0)			; Insert new point
		  (int16 x y)
		  (card16 width height)
		  (angle angle1 angle2))
		(setf (display-boffset display) (index+ buffer-boffset 12)))
	    ;; New Request
	    (progn
	      (put-items (4)
		(code request)
		(length 6)
		(drawable drawable)
		(gcontext gcontext)
		(int16 x y)
		(card16 width height)
		(angle angle1 angle2))
	      (buffer-new-request-number display)
	      (setf (buffer-last-request display) buffer-boffset)
	      (setf (display-boffset display) (index+ buffer-boffset 24)))))))
    (display-invoke-after-function display))) 

(defun draw-arcs-list (drawable gcontext arcs &optional fill-p)
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type list arcs) 
	   (type generalized-boolean fill-p))
  (let* ((display (drawable-display drawable))
	 (limit (index- (buffer-size display) 12))
	 (length (length arcs))
	 (request (if fill-p +x-polyfillarc+ +x-polyarc+)))
    (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)
      (drawable drawable)
      (gcontext gcontext)
      (progn
	(card16-put 2 (index+ (index-ash length -1) 3))	; Set request length (in words)
	(set-buffer-offset (index+ buffer-boffset 12))  ; Position to start of data
	(do ((arc arcs))
	    ((endp arc)
	     (setf (buffer-boffset display) buffer-boffset))
	  ;; Make sure there's room
	  (when (index>= buffer-boffset limit)
	    (setf (buffer-boffset display) buffer-boffset)
	    (buffer-flush display)
	    (set-buffer-offset (buffer-boffset display)))
	  (int16-put  0 (pop arc))
	  (int16-put  2 (pop arc))
	  (card16-put 4 (pop arc))
	  (card16-put 6 (pop arc))
	  (angle-put  8 (pop arc))
	  (angle-put 10 (pop arc))
	  (set-buffer-offset (index+ buffer-boffset 12)))))))

(defun draw-arcs-vector (drawable gcontext arcs &optional fill-p)
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type vector arcs) 
	   (type generalized-boolean fill-p))
  (let* ((display (drawable-display drawable))
	 (limit (index- (buffer-size display) 12))
	 (length (length arcs))
	 (request (if fill-p +x-polyfillarc+ +x-polyarc+)))
    (with-buffer-request ((drawable-display drawable) request :gc-force gcontext)
      (drawable drawable)
      (gcontext gcontext)
      (progn
	(card16-put 2 (index+ (index-ash length -1) 3))	; Set request length (in words)
	(set-buffer-offset (index+ buffer-boffset 12))  ; Position to start of data
	(do ((n 0 (index+ n 6))
	     (length (length arcs)))
	    ((index>= n length)
	     (setf (buffer-boffset display) buffer-boffset))
	  ;; Make sure there's room
	  (when (index>= buffer-boffset limit)
	    (setf (buffer-boffset display) buffer-boffset)
	    (buffer-flush display)
	    (set-buffer-offset (buffer-boffset display)))
	  (int16-put  0 (aref arcs (index+ n 0)))
	  (int16-put  2 (aref arcs (index+ n 1)))
	  (card16-put 4 (aref arcs (index+ n 2)))
	  (card16-put 6 (aref arcs (index+ n 3)))
	  (angle-put  8 (aref arcs (index+ n 4)))
	  (angle-put 10 (aref arcs (index+ n 5)))
	  (set-buffer-offset (index+ buffer-boffset 12)))))))

(defun draw-arcs (drawable gcontext arcs &optional fill-p)
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type sequence arcs) 
	   (type generalized-boolean fill-p))
  (etypecase arcs
    (list (draw-arcs-list drawable gcontext arcs fill-p))
    (vector (draw-arcs-vector drawable gcontext arcs fill-p))))

;; The following image routines are bare minimum.  It may be useful to define
;; some form of "image" object to hide representation details and format
;; conversions.  It also may be useful to provide stream-oriented interfaces
;; for reading and writing the data.

(defun put-raw-image (drawable gcontext data &key
		      (start 0)
		      (depth (required-arg depth))
		      (x (required-arg x))
		      (y (required-arg y))
		      (width (required-arg width))
		      (height (required-arg height))
		      (left-pad 0)
		      (format (required-arg format)))
  ;; Data must be a sequence of 8-bit quantities, already in the appropriate format
  ;; for transmission; the caller is responsible for all byte and bit swapping and
  ;; compaction.  Start is the starting index in data; the end is computed from the
  ;; other arguments.
  (declare (type drawable drawable)
	   (type gcontext gcontext)
	   (type sequence data) ; Sequence of integers
	   (type array-index start)
	   (type card8 depth left-pad) ;; required
	   (type int16 x y) ;; required
	   (type card16 width height) ;; required
	   (type (member :bitmap :xy-pixmap :z-pixmap) format))
  (with-buffer-request ((drawable-display drawable) +x-putimage+ :gc-force gcontext)
    ((data (member :bitmap :xy-pixmap :z-pixmap)) format)
    (drawable drawable)
    (gcontext gcontext)
    (card16 width height)
    (int16 x y)
    (card8 left-pad depth)
    (pad16 nil)
    ((sequence :format card8 :start start) data)))

(defun get-raw-image (drawable &key
		      data
		      (start 0)
		      (x (required-arg x))
		      (y (required-arg y))
		      (width (required-arg width))
		      (height (required-arg height))
		      (plane-mask #xffffffff)
		      (format (required-arg format))
		      (result-type '(vector card8)))
  ;; If data is given, it is modified in place (and returned), otherwise a new sequence
  ;; is created and returned, with a size computed from the other arguments and the
  ;; returned depth.  The sequence is filled with 8-bit quantities, in transmission
  ;; format; the caller is responsible for any byte and bit swapping and compaction
  ;; required for further local use.
  (declare (type drawable drawable)
	   (type (or null sequence) data) ;; sequence of integers
	   (type int16 x y) ;; required
	   (type card16 width height) ;; required
	   (type array-index start)
	   (type pixel plane-mask)
	   (type (member :xy-pixmap :z-pixmap) format))
  (declare (clx-values (clx-sequence integer) depth visual-info))
  (let ((display (drawable-display drawable)))
    (with-buffer-request-and-reply (display +x-getimage+ nil :sizes (8 32))
	 (((data (member error :xy-pixmap :z-pixmap)) format)
	  (drawable drawable)
	  (int16 x y)
	  (card16 width height)
	  (card32 plane-mask))
      (let ((depth (card8-get 1))
	    (length (* 4 (card32-get 4)))
	    (visual (resource-id-get 8)))
	(values (sequence-get :result-type result-type :format card8
			      :length length :start start :data data
			      :index +replysize+)
		depth
		(visual-info display visual))))))