blob: 24008c26f6621334631beacdf4b0ca7957d103e2 (
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
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
|
;;;; examples/13-canvas-drawing-language.lisp
(defpackage #:ww.examples/12
(:use #:cl)
(:export #:start))
(in-package :ww.examples/12)
(defclass canvas-lang-demo (ww:application) ())
(ww:defhandler quit
(ww::on-keydown (app scancode)
(when (eql :scancode-q scancode)
(ww::stop))))
(ww:defhandler clear-and-draw
(ww::on-perframe (canvas time)
(ww::clear-canvas canvas :r 255 :g 255 :b 255)
(draw-stuff canvas)
(ww::blit canvas)))
(defun triangle-at (x y)
(ww::move-to x y)
(ww::canvas-pen-color (list 0 200 200 255))
(ww::stroke-rel 150 0)
(ww::canvas-pen-color (list 0 0 200 255))
(ww::stroke-rel -50 100)
(ww::canvas-pen-color (list 0 200 0 255))
(ww::stroke-rel -100 -100))
(defun filled-triangle-at (x y)
(ww::move-to x y)
(ww::fill-rel-path
'((100 100)
(100 -100))))
(defun lower-the-bluer (x y)
(list (* 256 (/ x 500))
(* 256 (/ y 500))
255
255))
(defun plaid1 (x y)
(list (mod (* x x) 256)
(mod (* y y) 256)
(mod (* x y) 256)
255))
(defun flower (&optional (petals 5))
(ww::canvas-pen-width 1)
(let ((r (sqrt (+ (* 25 25) (* 100 100))))
(psw (* pi 0.08)))
(loop for a from 0 to (* 2 pi) by (/ (* 2 pi) petals) do
(ww::stroke-rel-bezier
(list (list (* r (sin (- a psw)))
(* r (cos (- a psw))))
(list (* r (sin (+ a psw)))
(* r (cos (+ a psw))))
(list 0 0))
12))))
(defun draw-stuff (canvas)
(ww::with-canvas canvas
(ww::canvas-pen-color #'plaid1)
(filled-triangle-at 250 200)
(ww::canvas-pen-width 2)
;; temporarily use a different pen
(ww::with-pen-color #'lower-the-bluer
(ww::stroke-bezier
'((0 0) (200 120) (50 350) (200 100) (300 400))
12)) ;; back to plaid pen after this
(flower 28)
(ww::canvas-pen-width 1)
(dotimes (x 50)
(when (evenp x)
(triangle-at 30 (+ 250 x))))))
(defmethod ww:boot ((app canvas-lang-demo ))
(let ((canvas
(make-instance 'ww:canvas
:pixel-width 500
:pixel-height 500)))
;; stretch canvas over the whole app
(setf (ww:width canvas) (ww::application-width app)
(ww:height canvas) (ww::application-height app))
;; add it to the display tree
(ww:add-unit app canvas)
;; handlers
(ww:add-handler canvas #'clear-and-draw)
(ww:add-handler app #'quit)
(ww:add-handler canvas #'quit)))
(defun start (&optional (side 500))
(ww::start
(make-instance
'canvas-lang-demo
:fps 10
:width side
:height side
:title "Canvas demo")))
|
