blob: 7d701dfb977a82673e98e99790a2740612cd810d (
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
|
;;;; examples/10-canvas.lisp
(defpackage #:ww.examples/10
(:use #:cl)
(:export #:start)
(:import-from #:defclass-std #:defclass/std))
(in-package #:ww.examples/10)
;;; CLASSES
(defclass/std canvas-example (ww::application)
())
(defun color-clamp ( x)
(max (min (round x) 255) 0))
(ww:defhandler color-shifts
(ww:on-perframe ()
(let ((time-class (1+ (mod time 256))))
(ww::with-pixels-rect (x y r g b a) (target)
(if (or (zerop (mod time-class (1+ x)))
(zerop (mod time-class (1+ y))))
(setf
r (mod (* x time) time-class)
g (mod (* y time) time-class)
b (mod time time-class)
a 255)
(ww::setf-many r g b a 0))))
(ww::blit target)))
(defmethod ww::boot ((app canvas-example))
"Adds the intro text and sets up the start button handler."
(let ((c (make-instance
'ww::canvas
:pixel-height 10
:pixel-width 10)))
(ww::with-pixels-rect (x y r g b a) (c)
(setf r (- 255 (* 25 x))
g (- 255 (* 25 y))
b (color-clamp (* 25 (+ x y)))))
(ww::blit c)
(setf (ww:width c) 800
(ww:height c) 600)
(ww:add-unit app c)
(ww:add-handler c #'color-shifts )))
(defun start (&optional (scale 1.0))
(ww::start
(make-instance
'canvas-example
:fps 30
:width (round (* 800 scale))
:height (round (* 600 scale))
:scale scale
:refocus-on-mousedown-p nil
:title "canvas demo"
:asset-root
(merge-pathnames
"examples/"
(asdf:system-source-directory :wheelwork)))))
|
