-
Notifications
You must be signed in to change notification settings - Fork 0
/
shapes-test.lisp
148 lines (131 loc) · 5.23 KB
/
shapes-test.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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
(in-package #:opticl-more-test)
(defun test-circles (&key (height 480) (width 640))
(declare (optimize (speed 3) (safety 0))
(type (unsigned-byte 16) height width))
(let ((img (make-8-bit-rgb-image height width)))
(declare (type 8-bit-rgb-image img))
(fill-image img 20 20 90)
(loop for i below 100
do (let ((y (random height))
(x (random width))
(rad (random 100))
(r (random 256))
(g (random 256))
(b (random 256))
(fill (random 2)))
(if (plusp fill)
(fill-circle img y x rad r g b)
(draw-circle img y x rad r g b))))
img))
(defun test-circles-and-squares ()
(declare (optimize (speed 3) (safety 0)))
(let ((height 600) (width 1000))
(let ((img (make-8-bit-rgb-image height width)))
(declare (type 8-bit-rgb-image img))
(fill-image img 10 10 20)
(loop for i below 100
do (let ((y (random height))
(x (random width))
(rad (random 100))
(r (random 256))
(g (random 256))
(b (random 256))
(square (random 2))
(fill (> (random 1.d0) .66d0)))
(if (plusp square)
(if fill
(fill-rectangle img (- y rad) (- x rad) (+ y rad) (+ x rad) r g b)
(draw-rectangle img (- y rad) (- x rad) (+ y rad) (+ x rad) r g b))
(if fill
(fill-circle img y x rad r g b)
(draw-circle img y x rad r g b)))))
img)))
(defun write-circle-images ()
(let ((img (test-circles)))
(write-jpeg-file (output-image "circles.jpeg") img)
(write-png-file (output-image "circles.png") img)))
(write-circle-images)
(defun test-circles-2 ()
(let ((height 480) (width 640))
(let ((img (make-8-bit-rgba-image height width)))
(fill-image img 20 20 90 #xff)
(loop for i below 100
do (let ((y (random height))
(x (random width))
(rad (random 100))
(r (random 256))
(g (random 256))
(b (random 256))
(fill (random 2)))
(if (plusp fill)
(fill-circle img y x rad r g b #xff)
(draw-circle img y x rad r g b #xff))))
img)))
(defun write-circle-images-2 ()
(let ((img (test-circles-2)))
(write-jpeg-file (output-image "circles2.jpeg") img)
(write-png-file (output-image "circles2.png") img)))
(write-circle-images)
(defun test-circles-3 (&key
(height 768)
(width 1024)
(radius 10)
(spacing 12)
(background '(10 10 10)))
(declare (optimize (speed 3) (safety 0))
(type fixnum height width radius spacing))
(let ((img (make-8-bit-rgb-image height width)))
(declare (type 8-bit-rgb-image img))
(fill-image* img background)
(let* ((unit (+ (logand most-positive-fixnum (ash radius 1)) spacing))
(half (ash unit -1)))
(loop for i fixnum below height by unit
do (loop for j fixnum below width by unit
do
(fill-circle img
(the fixnum (+ half i))
(the fixnum (+ half j))
(the fixnum (- radius (random 4)))
(random 256)
(random 256)
(random 256)))))
img))
(defun test-shapes ()
(declare (optimize (speed 3) (safety 0)))
(let ((height 480) (width 640))
(let ((img (make-8-bit-rgb-image height width)))
(fill-image img 20 20 20)
(draw-rectangle img 10 10 200 200 #x90 #x40 #x00)
(horizontal-line img 20 20 180 #x75 #x12 #xB0)
(vertical-line img 20 180 180 #x75 #x12 #xB0)
(draw-line img 300 20 10 100 #x40 #x80 #xA0)
(draw-line* img 400 20 110 100 (list #xA0 #x80 #x40))
(draw-triangle img 200 20 10 80 100 160 #x90 #x30 #x00)
img)))
(write-jpeg-file (output-image "shapes.jpeg") (test-shapes))
(defun test-gray-circles ()
(declare (optimize (speed 3) (safety 0)))
(let ((height 480) (width 640))
(let ((img (make-8-bit-gray-image height width)))
(fill-image img 20)
(loop for i below 100
do (let ((y (random 480))
(x (random 640))
(rad (random 100))
(k (random 256))
(fill (random 2)))
(if (plusp fill)
(fill-circle img y x rad k)
#+nil (draw-circle img y x rad k))))
img)))
(write-jpeg-file (output-image "gray-circles.jpeg") (test-gray-circles))
(write-png-file (output-image "gray-circles.png") (test-gray-circles))
(defun test-lines ()
(declare (optimize (speed 3) (safety 0)))
(let ((height 480) (width 640))
(let ((img (make-8-bit-rgb-image height width)))
(horizontal-line img -20 20 180 #x75 #x12 #xB0)
(horizontal-line img 20 -20 180 #x75 #x12 #xB0)
(horizontal-line img 100 40 1380 #x75 #x12 #xB0)
img)))
(write-jpeg-file (output-image "lines.jpeg") (test-lines))