mcclim-cvs January 2008

mcclim-cvs@common-lisp.net

7 participants
255 discussions

[mcclim-cvs] CVS mcclim/Backends/CLX
by ahefner 17 Jan '08

17 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv12535 Modified Files: medium.lisp Log Message: Precompile indexed -> RGBA converter function for the most common pixel formats (that is, the ones my computers use), to avoid the delay while they're compiled the first time draw-pattern* is called. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/11 05:55:52 1.84 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/medium.lisp 2008/01/17 07:23:48 1.85 @@ -321,7 +321,7 @@ (:msbfirst #'identity)) (loop for i from 0 below num-bytes collect i))))) -(defun generate-indexed-converter-expr (rgb-masks num-bytes byte-order) +(defun generate-indexed-converter-expr (rgb-masks byte-order num-bytes) `(lambda (image-array converted-data mask-data width height inks) (declare (optimize (speed 3) (safety 0) @@ -409,13 +409,27 @@ (defparameter *pixel-converter-cache* (make-hash-table :test 'equal)) -(defun get-indexed-converter (visual-info byte-order bytes-per-pixel) - (let* ((rgb-masks (list (xlib:visual-info-red-mask visual-info) - (xlib:visual-info-green-mask visual-info) - (xlib:visual-info-blue-mask visual-info))) - (key (list rgb-masks byte-order bytes-per-pixel))) +(defun ensure-indexed-converter (rgb-masks byte-order bytes-per-pixel) + (let ((key (list rgb-masks byte-order bytes-per-pixel))) (symbol-macrolet ((fn (gethash key *pixel-converter-cache*))) - (or fn (setf fn (compile nil (generate-indexed-converter-expr rgb-masks bytes-per-pixel byte-order))))))) + (or fn (setf fn (compile nil (generate-indexed-converter-expr rgb-masks byte-order bytes-per-pixel))))))) + +(defun visual-get-indexed-converter (visual-info byte-order bytes-per-pixel) + (let ((rgb-masks (list (xlib:visual-info-red-mask visual-info) + (xlib:visual-info-green-mask visual-info) + (xlib:visual-info-blue-mask visual-info)))) + (ensure-indexed-converter rgb-masks byte-order bytes-per-pixel))) + +(defparameter *typical-pixel-formats* + '(((#xFF0000 #xFF00 #xFF) :LSBFIRST 4) + ((#xFF0000 #xFF00 #xFF) :MSBFIRST 4)) + "This is a table of the most likely pixel formats. Converters for +these should be compiled in advance. Compiling the indexed->rgba +converter in advance will eliminate the pause observable the first +time an indexed pattern is drawn.") + +(dolist (format *typical-pixel-formats*) + (apply 'ensure-indexed-converter format)) (defun fill-pixmap-indexed (visual-info depth byte-order array pm pm-gc mask mask-gc w h inks) (assert (= (array-total-size array) (* w h))) @@ -432,7 +446,8 @@ (if (and bytes-per-pixel (member byte-order '(:lsbfirst :msbfirst)) - (setf pixel-converter (get-indexed-converter visual-info byte-order bytes-per-pixel))) + (setf pixel-converter (visual-get-indexed-converter + visual-info byte-order bytes-per-pixel))) ;; Fast path - Image upload (let ((converted-data (make-array (* bytes-per-pixel (array-total-size array)) :element-type 'xlib:card8))) ;; Fill the pixel arrays

1 0

[mcclim-cvs] CVS mcclim/Backends/CLX
by ahefner 17 Jan '08

17 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Backends/CLX In directory clnet:/tmp/cvs-serv10674 Modified Files: port.lisp Log Message: Add a restart around the magic clx server path generator to use the local display. Somewhat redundant, but the restart provided by assert is not the friendliest interface, and what value it wants is not 100% obvious. --- /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/01/14 04:53:11 1.131 +++ /project/mcclim/cvsroot/mcclim/Backends/CLX/port.lisp 2008/01/17 07:11:15 1.132 @@ -167,7 +167,7 @@ (selection-timestamp :initform nil :accessor selection-timestamp) (font-families :accessor font-families))) -(defun automagic-clx-server-path () +(defun automagic-clx-server-path () (let ((name (get-environment-variable "DISPLAY"))) (assert name (name) "Environment variable DISPLAY is not set") @@ -198,6 +198,12 @@ :screen-id (or screen 0) :protocol protocol)))) +(defun helpfully-automagic-clx-server-path () + (restart-case (automagic-clx-server-path) + (use-localhost () + :report "Use local unix display" + (parse-clx-server-path '(:clx :host "" :protocol :unix))))) + (defun parse-clx-server-path (path) (pop path) (if path @@ -206,7 +212,7 @@ :display-id (getf path :display-id 0) :screen-id (getf path :screen-id 0) :protocol (getf path :protocol :internet)) - (automagic-clx-server-path))) + (helpfully-automagic-clx-server-path))) (setf (get :x11 :port-type) 'clx-port) (setf (get :x11 :server-path-parser) 'parse-clx-server-path)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv12491/Drei Modified Files: drei-clim.lisp Log Message: Accept all numbers, not just integers. McCLIM is very happy about fractional pixels, after all. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/16 17:11:52 1.30 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/16 22:50:06 1.31 @@ -345,8 +345,8 @@ (defmethod initialize-instance :after ((area drei-area) &key x-position y-position) - (check-type x-position integer) - (check-type y-position integer) + (check-type x-position number) + (check-type y-position number) (setf (input-editor-position area) (list x-position y-position) (extend-pane-bottom (view area)) t) (tree-recompute-extent area))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv10409/Drei Modified Files: drei-redisplay.lisp Log Message: Clean and fix some more Drei input-editor related redisplay stuff. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 18:32:33 1.40 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 22:40:14 1.41 @@ -954,7 +954,12 @@ (descent (text-style-descent style pane)) (height (+ ascent descent))) (multiple-value-bind (x1 y1 x2 y2) - (call-next-method) + (drei-bounding-rectangle* drei) + (when (= x1 y1 x2 y2 0) + ;; It hasn't been displayed yet, so stuff the position into + ;; it... + (setf x1 (first (input-editor-position drei)) + y1 (second (input-editor-position drei)))) (values x1 y1 (max x2 (+ x1 style-width) (cond ((numberp min-width) @@ -965,6 +970,10 @@ (t 0))) (max y2 (+ y1 height))))))) +(defmethod bounding-rectangle ((drei drei-area)) + (with-bounding-rectangle* (x1 y1 x2 y2) drei + (make-rectangle* x1 y1 x2 y2))) + ;; XXX: Full redraw for every replay, should probably use the `region' ;; parameter to only invalidate some strokes. (defmethod replay-output-record ((drei drei-area) (stream extended-output-stream) &optional @@ -986,7 +995,12 @@ (defun display-drei-area (drei) (with-accessors ((stream editor-pane) (view view)) drei + (clear-output-record drei) (replay drei stream) + (with-bounding-rectangle* (x1 y1 x2 y2) drei + (letf (((stream-current-output-record stream) drei)) + ;; XXX: This sets the size of the output record. + (draw-rectangle* stream x1 y1 x2 y2 :ink +transparent-ink+))) (when (point-cursor drei) (with-bounding-rectangle* (x1 y1 x2 y2) (point-cursor drei) (when (pane-viewport stream) @@ -1120,10 +1134,9 @@ (if (adjust-pane drei-pane) (display-drei-pane frame drei-pane) ;; Point must be on top of all other cursors. - (progn - (dolist (cursor (cursors drei-pane)) - (display-drei-view-cursor drei-pane view cursor)) - (fix-pane-viewport drei-pane (view drei-pane))))))) + (dolist (cursor (cursors drei-pane) + (fix-pane-viewport drei-pane (view drei-pane))) + (replay cursor drei-pane)))))) (defgeneric full-redisplay (pane) (:documentation "Queue a full redisplay for `pane'."))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv29581/Drei Modified Files: drei.lisp Log Message: Added simple print-object method for Drei instances. --- /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/13 10:33:09 1.26 +++ /project/mcclim/cvsroot/mcclim/Drei/drei.lisp 2008/01/16 21:30:04 1.27 @@ -343,6 +343,10 @@ (defmethod esa-current-window ((drei drei)) drei) +(defmethod print-object ((object drei) stream) + (print-unreadable-object (object stream :type t :identity t) + (format stream "~A" (type-of (view object))))) + ;; Main redisplay entry point. (defgeneric display-drei (drei) (:documentation "`Drei' must be an object of type `drei' and

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv29806/Drei Modified Files: drei-redisplay.lisp Log Message: Output recording must be enabled when drawing cursors, or auto-scrolling won't work. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 15:19:30 1.39 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 18:32:33 1.40 @@ -980,7 +980,7 @@ (x-offset 0) (y-offset 0) (region +everywhere+)) (declare (ignore x-offset y-offset region)) (clear-output-record cursor) - (with-output-recording-options (stream :record nil :draw t) + (with-output-recording-options (stream :record t :draw t) (when (active cursor) (display-drei-view-cursor stream (view cursor) cursor))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv11063/Drei Modified Files: drei-clim.lisp Log Message: Respect the :x-position and :y-position initargs for Drei areas. --- /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/15 18:43:28 1.29 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-clim.lisp 2008/01/16 17:11:52 1.30 @@ -344,9 +344,10 @@ record.")) (defmethod initialize-instance :after ((area drei-area) - &key) - (setf (input-editor-position area) - (multiple-value-list (output-record-position area)) + &key x-position y-position) + (check-type x-position integer) + (check-type y-position integer) + (setf (input-editor-position area) (list x-position y-position) (extend-pane-bottom (view area)) t) (tree-recompute-extent area))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv15022/Drei Modified Files: drei-redisplay.lisp Log Message: More input-editor redisplay simplications. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 13:12:40 1.38 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 15:19:30 1.39 @@ -972,19 +972,15 @@ (declare (ignore x-offset y-offset region)) (letf (((stream-cursor-position stream) (values-list (input-editor-position drei)))) (invalidate-all-strokes (view drei)) - (display-drei-view-contents stream (view drei)))) - -(defmethod replay-output-record :after ((drei drei-area) (stream extended-output-stream) &optional - (x-offset 0) (y-offset 0) (region +everywhere+)) - (declare (ignore x-offset y-offset region)) + (display-drei-view-contents stream (view drei))) (dolist (cursor (cursors drei)) (replay cursor stream))) -(defmethod replay-output-record :before ((cursor drei-cursor) stream &optional - (x-offset 0) (y-offset 0) (region +everywhere+)) +(defmethod replay-output-record ((cursor drei-cursor) stream &optional + (x-offset 0) (y-offset 0) (region +everywhere+)) (declare (ignore x-offset y-offset region)) (clear-output-record cursor) - (with-output-recording-options (stream :record t :draw nil) + (with-output-recording-options (stream :record nil :draw t) (when (active cursor) (display-drei-view-cursor stream (view cursor) cursor))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv13598/Drei Modified Files: drei-redisplay.lisp Log Message: More redisplay optimisations (so fast!). Also, don't end in an infinite loop if we can't even fit a single line on the screen. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 12:01:05 1.37 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 13:12:40 1.38 @@ -541,7 +541,9 @@ anything. Will use the function specified in the drawing-options of `stroke' to carry out the actual calculations." (unless (and (= cursor-x (x1 (stroke-dimensions stroke))) - (not (stroke-dirty stroke))) + (= cursor-y (y1 (stroke-dimensions stroke))) + (not (stroke-dirty stroke)) + (mark<= (stroke-end-offset stroke) (bot view))) (invalidate-stroke stroke :modified t)) (when (stroke-dirty stroke) (funcall (drawing-options-function (stroke-drawing-options stroke)) stream view stroke @@ -571,36 +573,14 @@ (x2 dimensions) (+ x1 line-width) (y2 dimensions) (+ y1 line-height)))) -(defun end-line-cleaning-up (view pane line line-x1 line-y1 +(defun end-line-cleaning-up (view line line-x1 line-y1 line-width line-height) "End the addition of strokes to `line' for now, and update the -dimensions of `line'. Update all undisplayed lines to have no -associated dimensions. Also clear from the bottom of strokes to -the bottom of the line, and from the end of the line to the end -of the sheet." +dimensions of `line'." (end-line line line-x1 line-y1 line-width line-height) - (with-accessors ((line-x1 x1) (line-y1 y1) - (line-x2 x2) (line-y2 y2)) (line-dimensions line) - (setf (max-line-width view) - (max (max-line-width view) - (dimensions-width (line-dimensions line)))) - ;; If a has a lesser height than the line, clear from the top of - ;; the line stroke to the top of the stroke, to avoid artifacts - ;; left over from previous redisplays. - (do-displayed-line-strokes (stroke line) - (let ((stroke-dimensions (stroke-dimensions stroke))) - (with-accessors ((stroke-x1 x1) (stroke-y1 y1) - (stroke-x2 x2) (stroke-y2 y2)) stroke-dimensions - (when (> line-height (dimensions-height stroke-dimensions)) - (clear-rectangle* pane stroke-x1 line-y1 - stroke-x2 stroke-y1))))) - ;; Reset the dimensions of undisplayed lines. - (do-undisplayed-line-strokes (stroke line) - (let ((stroke-dimensions (stroke-dimensions stroke))) - (with-accessors ((stroke-x1 x1) (stroke-y1 y1) - (stroke-x2 x2) (stroke-y2 y2)) stroke-dimensions - (setf stroke-x1 0 stroke-y1 0 - stroke-x2 0 stroke-y2 0)))))) + (setf (max-line-width view) + (max (max-line-width view) + (dimensions-width (line-dimensions line))))) (defun draw-line-strokes (pane view initial-pump-state start-offset cursor-x cursor-y) @@ -654,7 +634,7 @@ for stroke = (aref (line-strokes line) stroke-index) for stroke-dimensions = (stroke-dimensions stroke) do (draw-stroke pane view stroke (x1 stroke-dimensions) baseline) - finally (progn (end-line-cleaning-up view pane line orig-x-offset cursor-y + finally (progn (end-line-cleaning-up view line orig-x-offset cursor-y line-width line-height) (incf (displayed-lines-count view)) (return (values pump-state line-height))))))) @@ -1103,7 +1083,8 @@ 0 (round x1)) 0))) - (when (> y2 (+ y-position viewport-height)) + (when (and (> y2 (+ y-position viewport-height)) + (not (end-of-buffer-p (bot view)))) (full-redisplay pane) ;; We start all over! (display-drei-pane (pane-frame pane) pane)))))))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 16 Jan '08

16 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv18517/Drei Modified Files: drei-redisplay.lisp Log Message: Removed some seemingly unnecessary code from the input-editor Drei variant. I admit I never really fully grasped how it worked, and I may need someone with major output-record foo to help me figure out the last bugs. --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/15 19:31:54 1.36 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/16 12:01:05 1.37 @@ -990,19 +990,9 @@ (defmethod replay-output-record ((drei drei-area) (stream extended-output-stream) &optional (x-offset 0) (y-offset 0) (region +everywhere+)) (declare (ignore x-offset y-offset region)) - (letf (((stream-current-output-record stream) drei) - ((stream-cursor-position stream) (values-list (input-editor-position drei)))) - ;; XXX: If the display begins with a blank area - for example - ;; spaces - CLIM will (rightly) think the output records - ;; position is at the first output. This is not good, because - ;; it means that the output record will "walk" across the - ;; screen if the buffer starts with blanks. Therefore, we make - ;; sure that an output record exists at the very beginning of - ;; the output. - (with-new-output-record (stream 'standard-sequence-output-record record) - (invalidate-all-strokes (view drei)) - (display-drei-view-contents stream (view drei)) - (setf (output-record-position record) (values-list (input-editor-position drei)))))) + (letf (((stream-cursor-position stream) (values-list (input-editor-position drei)))) + (invalidate-all-strokes (view drei)) + (display-drei-view-contents stream (view drei)))) (defmethod replay-output-record :after ((drei drei-area) (stream extended-output-stream) &optional (x-offset 0) (y-offset 0) (region +everywhere+)) @@ -1014,10 +1004,9 @@ (x-offset 0) (y-offset 0) (region +everywhere+)) (declare (ignore x-offset y-offset region)) (clear-output-record cursor) - (when (active cursor) - (with-output-recording-options (stream :record t :draw nil) - (letf (((stream-current-output-record stream) cursor)) - (display-drei-view-cursor stream (view cursor) cursor))))) + (with-output-recording-options (stream :record t :draw nil) + (when (active cursor) + (display-drei-view-cursor stream (view cursor) cursor)))) (defun display-drei-area (drei) (with-accessors ((stream editor-pane) (view view)) drei

1 0

← Newer
1
...
9
10
11
12
13
14
15
...
26
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs January 2008