blob: e22c6f319249a5e79c3c07e9a847cc541dc5e06f (
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
|
(use-modules (chickadee)
(chickadee graphics color)
(chickadee graphics path)
(chickadee graphics text)
(chickadee math)
(chickadee math vector)
(chickadee scripting)
(ice-9 format))
(set! *random-state* (random-state-from-platform))
(define (stats-message)
(format #f "fps: ~1,2f" (/ 1.0 avg-frame-time)))
(define start-time 0.0)
(define avg-frame-time 0.0)
(define stats-text (stats-message))
(define stats-text-pos (vec2 4.0 464.0))
(define last-update start-time)
(define canvas (make-empty-canvas))
(define rss-orange (string->color "#FF8800"))
(define rss-feed-logo
(superimpose
(with-style ((fill-color rss-orange))
(fill
(rounded-rectangle (vec2 0.0 3.0) 95.0 95.0 #:radius 15.0)))
(with-style ((fill-color white))
(fill
(circle (vec2 18.0 18.0) 9.0)))
(with-style ((stroke-color white)
(stroke-cap 'round)
(stroke-width 15.0))
(stroke
(path
(arc (vec2 18.0 18.0) 30.0 30.0 0.0 pi/2))
(path
(arc (vec2 18.0 18.0) 60.0 60.0 0.0 pi/2))))))
(define polylines
(with-style ((stroke-color tango-plum)
(stroke-width 6.0))
(stroke
(apply polyline (map (lambda (i)
(vec2 (* (+ i 1) 30) (+ (random 240) 100)))
(iota 20))))))
(define (make-example-painter s)
(superimpose (translate (vec2 30.0 10.0)
(scale s rss-feed-logo))
polylines))
(define (load)
(script
(forever
(tween 1.0 1.0 4.0
(lambda (s)
(set-canvas-painter! canvas (make-example-painter s))))
(tween 1.0 4.0 1.0
(lambda (s)
(set-canvas-painter! canvas (make-example-painter s)))))))
(define (draw alpha)
(pk 'draw-canvas)
(draw-canvas canvas)
(pk 'draw-text)
(draw-text stats-text stats-text-pos)
(let ((current-time (elapsed-time)))
(set! avg-frame-time
(+ (* (- current-time start-time) 0.1)
(* avg-frame-time 0.9)))
(set! start-time current-time)
(when (>= (- current-time last-update) 1.0)
(set! stats-text (stats-message))
(set! last-update current-time))))
(define (update dt)
(update-agenda 1))
(define (key-press key modifiers repeat?)
(case key
((q) (abort-game))))
(run-game #:window-title "Vector paths"
#:load load
#:draw draw
#:key-press key-press
#:update update)
|
