aboutsummaryrefslogtreecommitdiffhomepage
path: root/examples/12-canvas-drawing-language.lisp
blob: a727f7b24443628a8d467b58b95b12663a032a75 (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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
;;;; 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)))

;; draw a triangle, each side is a different color
(defun triangle-at (x y)
  (ww:with-current-pen  
    (ww:move-pen-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)))


;; draw a filled triangle using the current pen
(defun filled-triangle-at (x y)
  (ww:with-current-pen 
    (ww:move-pen-to x y)
    (ww:fill-rel-path
     '((100 100)
       (100 -100)))))

;; a pen function - gets more blue the closer x y is to 0 0
(defun lower-the-bluer (x y)
  (list (* 256 (/ x 500))
        (* 256 (/ y 500))
        255
        255))

;; a pen function - makes a plaid like pattern
(defun plaid1 (x y)
  (list (mod (* x x) 256)
        (mod (* y y) 256)
        (mod (* x y) 256)
        255))

;; draws a "flower" like pinwheel using bezier curves
(defun flower (&optional (petals 5))
  (ww:with-pen (:width 1) 
    (let ((r                              ; radius
            #.(sqrt (+ (* 25 25) (* 100 100))))
          (psw                            ; petal semi-width
            (* pi 0.08))) 
      ;; for each angle a between 0 and 2π draw a petal as a bezier
      ;; curve.  the curve uses two control points that are R away
      ;; from the starting point and PSW radians on either side of the
      ;; line at angle a
      (loop for a from 0 to (* 2 pi) by (/ (* 2 pi) petals)
            for ctls = (list (list (* r (sin (- a psw)))
                                   (* r (cos (- a psw))))
                             (list (* r (sin (+ a psw)))
                                   (* r (cos (+ a psw))))
                             (list 0 0))
            do
               (ww:fill-rel-bezier ctls 12)
               ;; draw border of each petal
               (ww:with-pen (:color (list 0 50 200 255))
                 (ww:stroke-rel-bezier ctls 20))))))

(defun draw-stuff (canvas)
  (ww:with-canvas canvas
    ;; set canvas color. 
    (ww:canvas-pen-color #'plaid1)
    (filled-triangle-at 250 200)

    ;; temporarily use a different pen configuration
    (ww:with-pen (:color #'lower-the-bluer :width 2) 
      ;; draw a flower stem
      (ww:stroke-bezier
       '((0 0) (200 120) (50 350) (200 100) (300 400)))
      ;; draw a flower
      (flower 28)) 

    (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 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 3
    :width side
    :height side
    :title "Canvas demo")))