-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path3d-vis_execute-draw-stack.scm
166 lines (150 loc) · 7.68 KB
/
3d-vis_execute-draw-stack.scm
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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
;;; 3d-vis_execute-draw-stack.scm
;;; Piirtää draw-stackin sisällön annetun kameran mukaan projisoituna
(define (execute-draw-stack draw-stack xo camera)
(let ((window-width (car ((camera 'get-window-size-x.y))))
(window-height (cdr ((camera 'get-window-size-x.y))))
; sis valmiiksilaskettuja ikkunakoordinaatteja
(window-coord-cache (generate-vector ((draw-stack 'get-maze-corner-index-count))
(lambda ()
(list 'dummy))))
; the projektiomatriisi!
(the-projection-matrix (make-projection-matrix-for-camera camera)))
;;; ==================================================
;;; Apufunktiot
;;; ==================================================
; Projisoi ja piirtää annetun monikulmion
(define (project-and-draw-polygon polygon)
; project-and-draw-polygon -apufunktiot ---------------------------
; Projisoi yksittäisen vektorin ikkunakoordinaateiksi
(define (project-maze-vector->window-coords-list vector maze-corner-index)
(let* ((cache-ref (if maze-corner-index
(vector-ref window-coord-cache
maze-corner-index)
'(dummy)))
(window-coords-list (cdr cache-ref)))
; Löytyykö valmiina cachesta?
(if (not (null? window-coords-list))
window-coords-list
; Ei löytynyt, lasketaan uudet koordinaatit
(begin
(set! window-coords-list
(let ((window-coords-vec (vector-homogenic->normal
(mul the-projection-matrix
(vector-normal->homogenic vector)))))
(let ((x-coord (vector-ref window-coords-vec 0))
(y-coord (vector-ref window-coords-vec 1)))
; Ei anneta x-drawille liian isoja koordinaatteja
(list (cond ((< -30000 x-coord 30000) x-coord)
((< x-coord -30000) -30000)
(else 30000))
(cond ((< -30000 y-coord 30000) y-coord)
((< y-coord -30000) -30000)
(else 30000))))))
(if maze-corner-index
(set-cdr! cache-ref window-coords-list))
window-coords-list))))
; Projisoi vektorilistan ikkunakoordinaateiksi.
(define (project-to-window-coords vectors indexes)
(if (null? vectors)
'()
(cons (project-maze-vector->window-coords-list (car vectors)
(if indexes
(car indexes)
false))
(project-to-window-coords (cdr vectors)
(if indexes
(cdr indexes)
false)))))
; Convex FillPolygon kusee viivamaisissa monikulmioissa..
(define (check-and-convert-if-line window-polygon-list)
(cond ((< (- (apply max (map car window-polygon-list))
(apply min (map car window-polygon-list)))
1.5) ; vertical
(list (apply min (map car window-polygon-list))
(apply min (map cadr window-polygon-list))
(apply min (map car window-polygon-list))
(apply max (map cadr window-polygon-list))))
((< (- (apply max (map cadr window-polygon-list))
(apply min (map cadr window-polygon-list)))
1.5) ; horizontal
(list (apply min (map car window-polygon-list))
(apply min (map cadr window-polygon-list))
(apply max (map car window-polygon-list))
(apply min (map cadr window-polygon-list))))
(else false)))
; project-and-draw-polygon -runko --------------------------------
(let ((window-polygon-list (project-to-window-coords
(polygon-get-vectors polygon)
(polygon-get-unique-maze-corner-indexes polygon))))
(xo 'send 'SetForeground (polygon-get-color-string polygon))
; Piste, viiva vai monikulmio?
(if (null? (cdr window-polygon-list))
; Piste
(xo 'send
'FillRectangle
(- (caar window-polygon-list) 3)
(- (cadar window-polygon-list) 3)
7
7)
; Viiva/monikulmio? (Jos h-phase < 0.5, ei tarkisteta viivavaihtoehtoa)
(if (>= ((camera 'get-h-phase)) 0.5)
(let ((line-conversion (check-and-convert-if-line window-polygon-list)))
(if line-conversion
(apply xo
(append (list 'send
'DrawLine)
line-conversion))
(xo 'send
'FillPolygon
window-polygon-list
'Convex
'Origin)))
(xo 'send
'FillPolygon
window-polygon-list
'Convex
'Origin)))))
; Piirtää draw-stackista jokaisen monikulmion
(define (draw-loop direct-stack)
;(display (list 'direct-stack direct-stack)) (newline)
(if (not (null? direct-stack))
(begin
(project-and-draw-polygon (car direct-stack))
(draw-loop (cdr direct-stack)))))
;(display 'execute-draw-stack) (newline)
(draw-loop ((draw-stack 'get-direct-ref)))))
;;; Luo annetun kameran näkymään muuntavan projektiomatriisin.
;;; (matriisi sisältää skaalauksen ikkunan kokoon nähden)
(define (make-projection-matrix-for-camera camera)
; Luo ikkunan kokoa vastaavan skaalausmatriisin.
; ( x-scale 0 0 )
; ( 0 y-scale 0 )
; ( 0 0 1 )
(define (make-scale-matrix camera)
(let ((x-scale (* zoom-factor (car ((camera 'get-window-size-x.y)))))
(y-scale (* zoom-factor (cdr ((camera 'get-window-size-x.y)))))
(scale-matrix (make-matrix 3 3)))
(matrix-set-cell! scale-matrix 0 0 x-scale)
(matrix-set-cell! scale-matrix 1 1 y-scale)
(matrix-set-cell! scale-matrix 2 2 1.0)
scale-matrix))
; field-of-view fiksattu 53.13 asteeksi.
; ikkunan keskipisteen koordinaatti = ahead-vec
; projektiokeskus c = (0 0 0)
; ex = -right-vec (eli kääntää y:n ympäri,
; ikkunan alaspäin kasvavaa y:tä varten)
; ey = up-vec
; r0 = ikkunan vas. yläkulma = ahead-vec + 0.5ex + 0.5ey
; tason normaali n = -(ahead-vec)
(define (make-unscaling-projection-matrix-from-cam-3d-vecs cam-3d-vecs)
(let* ((c (vector 0 0 0))
(ex (sub 0 (cam-3d-vecs 'right-vec)))
(ey (cam-3d-vecs 'up-vec))
(r0 (add (add (cam-3d-vecs 'ahead-vec)
(mul 0.5 ex))
(mul 0.5 ey)))
(n (sub 0 (cam-3d-vecs 'ahead-vec))))
;(display (list 'make-matrix: 'c c 'ex ex 'ey ey 'r0 r0 'n n)) (newline)
(make-projection-matrix c r0 ex ey n)))
(mul (make-scale-matrix camera)
(make-unscaling-projection-matrix-from-cam-3d-vecs (camera '3d-vectors))))