/[cello]/cello/cello-window.lisp
ViewVC logotype

Contents of /cello/cello-window.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations)
Mon Jun 16 12:39:20 2008 UTC (5 years, 10 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.8: +1 -0 lines
nothing special
1 ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: cello; -*-
2 #|
3
4 Copyright (C) 2004 by Kenneth William Tilton
5
6 This library is free software; you can redistribute it and/or
7 modify it under the terms of the Lisp Lesser GNU Public License
8 (http://opensource.franz.com/preamble.html), known as the LLGPL.
9
10 This library is distributed WITHOUT ANY WARRANTY; without even
11 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
12
13 See the Lisp Lesser GNU Public License for more details.
14
15 |#
16
17 (in-package :cello)
18
19 ;------------- Window ---------------
20 ;
21
22 (defmodel cello-window (celtk:window focuser)
23 (
24 (gl-name-highest :cell nil :initarg :gl-name-highest
25 :initform 0
26 :accessor gl-name-highest))
27 (:default-initargs
28 :px 0 :py 0
29 ;;:gl-name (c-in nil)
30 ;;:focus (c-in nil)
31 :ll 0 :lt 0
32 :lr (c-in (scr2log 1400))
33 :lb (c-in (scr2log -800))
34 ;; :tick-count (c-in (os-tickcount))
35 :event-handler 'cello-window-event-handler
36 :registry? t
37 ))
38
39 (defmethod path ((self cello-window)) ".")
40 (defmethod parent-path ((self cello-window)) "")
41
42 (defmethod g-offset ((self cello-window) &optional (accum-h 0) (accum-v 0) within)
43 (declare (ignorable self within))
44 (mkv2 accum-h accum-v))
45
46 (defmethod cello-window-event-handler (self xe)
47 (declare (ignorable self))
48 (TRC nil "cello-window-event-handler" self (ctk::tk-event-type (ctk::xsv type xe)) )
49 ;
50 ; this next bit is actually offered as a template. suggest users subclass cello-window,
51 ; specialize cello-window-event-handler on that subclass, handle what you want else
52 ; call-next-method. eventually some generic stuff will be landing in here.
53 ;
54 (case (ctk::tk-event-type (ctk::xsv type xe))
55 (:virtualevent )
56 (:KeyPress ) ;; this and next handled as app virtual events because Tcl events useless
57 (:KeyRelease )
58 (:ButtonPress )
59 (:ButtonRelease )
60 (:MotionNotify (trc "we got motion!!!!"))
61 (:EnterNotify )
62 (:LeaveNotify )
63 (:FocusIn (TRC "cello-window-event-handler" self :FocusIn ))
64 (:FocusOut )
65 (:KeymapNotify )
66 (:Expose )
67 (:GraphicsExpose )
68 (:NoExpose )
69 (:VisibilityNotify )
70 (:CreateNotify )
71 (:DestroyNotify )
72 (:UnmapNotify )
73 (:MapNotify )
74 (:MapRequest )
75 (:ReparentNotify )
76 (:ConfigureNotify )
77 (:ConfigureRequest )
78 (:GravityNotify )
79 (:ResizeRequest )
80 (:CirculateNotify )
81 (:CirculateRequest )
82 (:PropertyNotify )
83 (:SelectionClear )
84 (:SelectionRequest )
85 (:SelectionNotify )
86 (:ColormapNotify )
87 (:ClientMessage )
88 (:MappingNotify )
89 (:ActivateNotify )
90 (:DeactivateNotify )
91 (:MouseWheelEvent)))
92
93 (defmethod context-cursor (other kbd-modifiers)
94 (if (and other (fm-parent other))
95 (context-cursor (fm-parent other) kbd-modifiers)
96 (cello-cursor :arrow)))
97
98 (defun cello-cursor (cursor-id)
99 (ecase cursor-id
100 (:crosshair #+celtk 'crosshair #+glut GLUT_CURSOR_CROSSHAIR)
101 (:arrow #+celtk 'arrow #+glut GLUT_CURSOR_LEFT_ARROW)
102 (:i-beam #+celtk 'ibeam #+glut (break))
103 (:watch #+celtk 'watch #+glut (break))))
104
105
106 ;------------------------------------------
107
108 (defmethod ix-selectable ((self cello-window)) t)
109

  ViewVC Help
Powered by ViewVC 1.1.5