blob: 78d116b3483a06a205b4df846b5b831948c05cf1 (
plain)
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
|
;;;; examples/07-scrollarea.lisp
(defpackage #:ww.examples/7
(:use #:cl)
(:export #:start))
(in-package #:ww.examples/7)
(defclass scrollarea-example (ww::application)
((cube :initarg :cube :accessor cube)))
(ww::defhandler move-cube
(ww::on-keydown (app scancode)
(with-slots (cube) app
(case scancode
(:scancode-v
(setf (ww::unit-visiblep cube)
(not (ww::unit-visiblep cube))))
(:scancode-left
(decf (ww::x cube) 15))
(:scancode-right
(incf (ww::x cube) 15))
(:scancode-up
(incf (ww::y cube) 15))
(:scancode-down
(decf (ww::y cube) 15))))))
(ww::defhandler clicked
(ww::on-mousedown ()
(format t "~a was clicked~%" target)))
(defmethod ww::boot ((app scrollarea-example))
(let ((cube
(make-instance
'ww::bitmap
:texture (ww::get-asset "GelatinousCube.png")))
(cube-container
(make-instance
'ww::container
:bottom 200 :top 400
:left 200 :right 600)))
(setf (cube app) cube)
(ww::add-handler app #'move-cube)
(ww::add-handler cube #'clicked)
(setf (ww::x cube) 400
(ww::y cube) 300)
(ww::scale-by cube 2.0)
(ww::add-unit cube-container cube)
(ww::add-unit app cube-container)
(describe cube-container)))
(defun start ()
(ww::start (make-instance
'scrollarea-example
:fps 30
:width 800
:height 600
:refocus-on-mousedown-p nil
:title "A scrollable area."
:asset-root (merge-pathnames
"examples/"
(asdf:system-source-directory :wheelwork)))))
|
