-
Notifications
You must be signed in to change notification settings - Fork 10
/
sketch.lisp
104 lines (86 loc) · 2.71 KB
/
sketch.lisp
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
(defpackage :nature-of-code.fractals.example-8.5
(:export :start-sketch)
(:use :cl :trivial-gamekit))
(in-package :nature-of-code.fractals.example-8.5)
(defvar *width* 800)
(defvar *height* 600)
(defvar *center-x* (/ *width* 2))
(defvar *center-y* (/ *height* 2))
(defvar *black* (vec4 0 0 0 1))
(defun rotate (vector theta)
(let* ((cos (cos theta))
(sin (sin theta))
(x1 (x vector))
(y1 (y vector))
(x2 (- (* cos x1) (* sin y1)))
(y2 (+ (* sin x1) (* cos y1))))
(vec2 x2 y2)))
(defun empty-array ()
(make-array 0 :adjustable t :fill-pointer 0))
(defclass koch-line ()
((origin
:initarg :origin
:accessor origin)
(end
:initarg :end
:accessor end)))
(defun make-koch-line (origin end)
(make-instance 'koch-line :origin origin :end end))
(defmethod display ((line koch-line))
(draw-line (origin line) (end line) *black*))
(defmethod koch-a ((line koch-line))
(origin line))
(defmethod koch-b ((line koch-line))
(let* ((v (subt (end line) (origin line)))
(v (div v 3))
(v (add v (origin line))))
v))
(defmethod koch-c ((line koch-line))
(let* ((v (subt (end line) (origin line)))
(v (div v 3))
(a (add v (origin line)))
(v (rotate v (/ pi 3)))
(a (add a v)))
a))
(defmethod koch-d ((line koch-line))
(let* ((v (subt (end line) (origin line)))
(v (mult v (/ 2 3)))
(v (add v (origin line))))
v))
(defmethod koch-e ((line koch-line))
(end line))
(defmethod split ((line koch-line))
(let ((a (koch-a line))
(b (koch-b line))
(c (koch-c line))
(d (koch-d line))
(e (koch-e line))
(new-lines (empty-array)))
(vector-push-extend (make-koch-line a b) new-lines)
(vector-push-extend (make-koch-line b c) new-lines)
(vector-push-extend (make-koch-line c d) new-lines)
(vector-push-extend (make-koch-line d e) new-lines)
new-lines))
(defun generate (lines)
(let ((new-lines (empty-array)))
(loop for line across lines do
(loop for new-line across (split line) do
(vector-push-extend new-line new-lines)))
new-lines))
(defgame sketch ()
((lines
:initform (empty-array)
:accessor lines))
(:viewport-width *width*)
(:viewport-height *height*)
(:viewport-title "Koch curve"))
(defmethod post-initialize ((this sketch))
(let* ((left (vec2 0 *center-y*))
(right (vec2 *width* *center-y*))
(first-line (make-koch-line left right)))
(vector-push-extend first-line (lines this))
(loop repeat 5 do (setf (lines this) (generate (lines this))))))
(defmethod draw ((this sketch))
(loop for line across (lines this) do (display line)))
(defun start-sketch ()
(start 'sketch))