/[mcclim]/mcclim/repaint.lisp
ViewVC logotype

Contents of /mcclim/repaint.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (hide annotations)
Fri May 30 02:23:45 2003 UTC (10 years, 10 months ago) by hefner1
Branch: MAIN
Changes since 1.7: +4 -0 lines
 * Presentation output records now ask their children to highlight
   themselves. This makes user-defined highlight methods work, and leads
   to slightly saner behavior for objects that span multiple lines.
 * Unhighlighting now works by triggering a repaint on the appropriate
   area of the sheet. This allows proper highlighting over things other
   than the background color, without using flipping ink.
 * HANDLE-REPAINT modified to restore the background color. Some work
   needs to be done here to prevent unneeded clearing of the background
   in response to expose events.
1 rouanet 1.1 ;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
2    
3     ;;; (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com),
4     ;;; (c) copyright 2000 by
5     ;;; Iban Hatchondo (hatchond@emi.u-bordeaux.fr)
6     ;;; Julien Boninfante (boninfan@emi.u-bordeaux.fr)
7     ;;; Robert Strandh (strandh@labri.u-bordeaux.fr)
8    
9     ;;; This library is free software; you can redistribute it and/or
10     ;;; modify it under the terms of the GNU Library General Public
11     ;;; License as published by the Free Software Foundation; either
12     ;;; version 2 of the License, or (at your option) any later version.
13     ;;;
14     ;;; This library is distributed in the hope that it will be useful,
15     ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16     ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17     ;;; Library General Public License for more details.
18     ;;;
19     ;;; You should have received a copy of the GNU Library General Public
20     ;;; License along with this library; if not, write to the
21     ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22     ;;; Boston, MA 02111-1307 USA.
23    
24    
25    
26     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27     ;;;
28     ;;; The Repaint Protocol
29    
30 mikemac 1.7 (in-package :clim-internals)
31 rouanet 1.1
32     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33     ;;;
34     ;;; repaint protocol functions
35    
36     (defmethod queue-repaint ((sheet basic-sheet) (event window-repaint-event))
37     (queue-event sheet event))
38    
39     (defmethod handle-repaint ((sheet basic-sheet) region)
40     (declare (ignore region))
41     nil)
42    
43 moore 1.3 (defmethod repaint-sheet ((sheet basic-sheet) region)
44 hefner1 1.8 ;; FIXME: Change things so the rectangle below is only drawn in response
45     ;; to explicit repaint requests from the user, not exposes from X
46     (with-slots (x1 x2 y1 y2) region
47     (draw-rectangle* sheet x1 y1 x2 y2 :filled T :ink +background-ink+))
48 moore 1.3 (map-over-sheets-overlapping-region #'(lambda (s)
49     (handle-repaint s region))
50     sheet
51     region))
52    
53 rouanet 1.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54     ;;;
55     ;;; repaint protocol classes
56    
57     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58     ;;;
59     ;;; standard repainting mixin
60    
61     (defclass standard-repainting-mixin () ())
62    
63 moore 1.3 (defmethod dispatch-event
64     ((sheet standard-repainting-mixin) (event window-repaint-event))
65     (queue-repaint sheet event))
66    
67 rouanet 1.1 (defmethod dispatch-repaint ((sheet standard-repainting-mixin) region)
68 gilbert 1.6 (when (sheet-mirror sheet) ;only dispatch repaints, when the sheet has a mirror
69     (queue-repaint sheet (make-instance 'window-repaint-event
70     :sheet sheet
71     :region (transform-region
72     (sheet-native-transformation sheet)
73     region)))))
74 rouanet 1.1
75 moore 1.3 (defmethod handle-event ((sheet standard-repainting-mixin)
76     (event window-repaint-event))
77     (handle-repaint sheet (window-event-region event)))
78    
79 rouanet 1.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80     ;;;
81     ;;; immediate repainting mixin
82    
83     (defclass immediate-repainting-mixin () ())
84    
85 moore 1.3 (defmethod dispatch-event
86     ((sheet immediate-repainting-mixin) (event window-repaint-event))
87     (handle-repaint sheet (window-event-region event)))
88    
89 rouanet 1.1 (defmethod dispatch-repaint ((sheet immediate-repainting-mixin) region)
90     (handle-repaint sheet region))
91    
92 moore 1.3 (defmethod handle-event ((sheet immediate-repainting-mixin)
93     (event window-repaint-event))
94     (handle-repaint sheet (window-event-region event)))
95    
96 rouanet 1.1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
97     ;;;
98     ;;; sheet mute repainting mixin
99    
100     (defclass sheet-mute-repainting-mixin () ())
101    
102     (defmethod dispatch-repaint ((sheet sheet-mute-repainting-mixin) region)
103 gilbert 1.6 (when (sheet-mirror sheet) ;only dispatch repaints, when the sheet has a mirror
104     (queue-repaint sheet (make-instance 'window-repaint-event
105     :sheet sheet
106     :region (transform-region
107     (sheet-native-transformation sheet)
108     region)))))
109 rouanet 1.1
110 moore 1.3 ;;; I know what the spec says about sheet-mute-repainting-mixin, but I don't
111     ;;; think it's right; "repaint-sheet that does nothing" makes no sense.
112     ;;; -- moore
113     #+nil
114 rouanet 1.1 (defmethod repaint-sheet ((sheet sheet-mute-repainting-mixin) region)
115     (declare (ignorable sheet region))
116     (format *debug-io* "repaint ~S~%" sheet)
117     (values))
118 gilbert 1.2
119 moore 1.3 (defmethod handle-repaint ((sheet sheet-mute-repainting-mixin) region)
120     (declare (ignore region))
121     nil)
122 gilbert 1.2
123 moore 1.3 (defclass clim-repainting-mixin
124     (#+clim-mp standard-repainting-mixin #-clim-mp immediate-repainting-mixin)
125     ()
126     (:documentation "Internal class that implements repainting protocol based on
127     whether or not multiprocessing is supported."))

  ViewVC Help
Powered by ViewVC 1.1.5