/[cello]/cello/wm-mouse.lisp
ViewVC logotype

Contents of /cello/wm-mouse.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations)
Mon Jun 16 12:39:24 2008 UTC (5 years, 10 months ago) by ktilton
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +0 -15 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 (defstruct (os-event
20 (:conc-name nil))
21 modifiers
22 where
23 realtime
24 c-event)
25
26 (defun mk-os-event (modifiers where)
27 (make-os-event :modifiers modifiers
28 :where where
29 :realtime (now)))
30
31 (defun evt-when (os-event)
32 (realtime os-event))
33
34 (defun evt-buttons (os-event)
35 (modifiers os-event))
36
37 (defun evt-shift-key-down (os-event)
38 (shift-key-down (evt-buttons os-event)))
39
40 (defun evt-control-key-down (os-event)
41 (control-key-down (evt-buttons os-event)))
42
43 (defun evt-where (os-event)
44 (where os-event))
45
46 (export! evt-c-event evt-shift-key-down evt-control-key-down)
47 (defun evt-c-event (os-event)
48 (c-event os-event))
49
50 (defun evt-wherex (os-event)
51 (declare (optimize (speed 3) (safety 0) (debug 0)))
52 ;; (logand (the fixnum (evtLParam os-event)) (1- 65536))
53 (v2-h (evt-where os-event)))
54
55 (defun evt-where-y (os-event)
56 (declare (optimize (speed 3) (safety 0) (debug 0)))
57 (v2-v (evt-where os-event)))
58
59
60
61

  ViewVC Help
Powered by ViewVC 1.1.5