forked from slyrus/mcclim-old
-
Notifications
You must be signed in to change notification settings - Fork 0
/
repaint.lisp
123 lines (96 loc) · 4.5 KB
/
repaint.lisp
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
;;; -*- Mode: Lisp; Package: CLIM-INTERNALS -*-
;;; (c) copyright 1998,1999,2000 by Michael McDonald ([email protected]),
;;; (c) copyright 2000 by
;;; Iban Hatchondo ([email protected])
;;; Julien Boninfante ([email protected])
;;; Robert Strandh ([email protected])
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; The Repaint Protocol
(in-package :clim-internals)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; repaint protocol functions
(defmethod queue-repaint ((sheet basic-sheet) (event window-repaint-event))
(queue-event sheet event))
(defmethod handle-repaint ((sheet basic-sheet) region)
(declare (ignore region))
nil)
(defmethod repaint-sheet ((sheet basic-sheet) region)
(map-over-sheets-overlapping-region #'(lambda (s)
(handle-repaint s region))
sheet
region))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; repaint protocol classes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; standard repainting mixin
(defclass standard-repainting-mixin () ())
(defmethod dispatch-event
((sheet standard-repainting-mixin) (event window-repaint-event))
(queue-repaint sheet event))
(defmethod dispatch-repaint ((sheet standard-repainting-mixin) region)
(when (sheet-mirror sheet) ;only dispatch repaints, when the sheet has a mirror
(queue-repaint sheet (make-instance 'window-repaint-event
:sheet sheet
:region (transform-region
(sheet-native-transformation sheet)
region)))))
(defmethod handle-event ((sheet standard-repainting-mixin)
(event window-repaint-event))
(handle-repaint sheet (window-event-region event)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; immediate repainting mixin
(defclass immediate-repainting-mixin () ())
(defmethod dispatch-event
((sheet immediate-repainting-mixin) (event window-repaint-event))
(handle-repaint sheet (window-event-region event)))
(defmethod dispatch-repaint ((sheet immediate-repainting-mixin) region)
(handle-repaint sheet region))
(defmethod handle-event ((sheet immediate-repainting-mixin)
(event window-repaint-event))
(handle-repaint sheet (window-event-region event)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; sheet mute repainting mixin
(defclass sheet-mute-repainting-mixin () ())
(defmethod dispatch-repaint ((sheet sheet-mute-repainting-mixin) region)
(when (sheet-mirror sheet) ;only dispatch repaints, when the sheet has a mirror
(queue-repaint sheet (make-instance 'window-repaint-event
:sheet sheet
:region (transform-region
(sheet-native-transformation sheet)
region)))))
;;; I know what the spec says about sheet-mute-repainting-mixin, but I don't
;;; think it's right; "repaint-sheet that does nothing" makes no sense.
;;; -- moore
#+nil
(defmethod repaint-sheet ((sheet sheet-mute-repainting-mixin) region)
(declare (ignorable sheet region))
(format *trace-output* "repaint ~S~%" sheet)
(values))
(defmethod handle-repaint ((sheet sheet-mute-repainting-mixin) region)
(declare (ignore region))
nil)
(defclass clim-repainting-mixin
(#+clim-mp standard-repainting-mixin #-clim-mp immediate-repainting-mixin)
()
(:documentation "Internal class that implements repainting protocol based on
whether or not multiprocessing is supported."))