-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathchoice-page.rkt
139 lines (122 loc) · 4.32 KB
/
choice-page.rkt
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
#lang racket/base
(require 2htdp-raven/image
"page.rkt"
"text-box.rkt")
(provide (struct-out choice-page)
(struct-out choice-opt)
render-choice-page
choice-button-bboxes
in-bbox?
bbox-tag)
(struct choice-opt (label pages))
(struct choice-page page (opts))
(define (render-choice-page page text hovered)
(define page-base
(put-page-image-pinhole (render-page page text)))
(define options-img
(apply above
(for/list ([opt (choice-page-opts page)]
[idx (length (choice-page-opts page))])
(above
(rectangle 1 10 'solid (color 0 0 0 0))
(render-choice-button (choice-opt-label opt)
(if (equal? idx hovered)
(color 39 193 155)
(page-frame-color page))
(page-text-color page))
(rectangle 1 10 'solid (color 0 0 0 0))))))
(clear-pinhole (overlay/pinhole
options-img
page-base)))
; TODO param
(define width 640)
(define height 480)
(define (render-choice-button text frame-color text-color)
(render-centered-text-box text frame-color text-color
(* 1/3 width)
(* 1/10 height)
5))
(struct bbox (tag tl br) #:transparent)
(struct pt (x y) #:transparent)
(define (pt+y a n)
(pt (pt-x a)
(+ (pt-y a) n)))
(define (bbox-tl-x b) (pt-x (bbox-tl b)))
(define (bbox-tl-y b) (pt-y (bbox-tl b)))
(define (bbox-br-x b) (pt-x (bbox-br b)))
(define (bbox-br-y b) (pt-y (bbox-br b)))
(define (in-bbox? b x y)
(and (<= (bbox-tl-x b) x (bbox-br-x b))
(<= (bbox-tl-y b) y (bbox-br-y b))))
(define (choice-button-bbox-at tag x y)
(define half-width ( * 1/2 1/3 width))
(define half-height (* 1/2 1/10 height))
(bbox tag
(pt (- x half-width)
(- y half-height))
(pt (+ x half-width)
(+ y half-height))))
(define (choice-button-bboxes n)
(if (even? n)
(choice-button-bboxes-even n)
(choice-button-bboxes-odd n)))
(define (choice-button-bboxes-even n)
(define center-x (/ width 2))
(define center-y (/ height 3))
(define center-tag (floor (/ n 2)))
(define dist (+ 10 (* 1/2 1/10 height)))
(for/fold
([acc '()])
([idx (in-range (/ n 2))])
(append (list (choice-button-bbox-at
(+ center-tag idx)
center-x (+ center-y idx dist))
(choice-button-bbox-at
(- center-tag idx 1)
center-x (+ center-y (* -1 (add1 idx) dist))))
acc)))
(define (choice-button-bboxes-odd n)
(define center-x (/ width 2))
(define center-y (/ height 3))
(define center-tag (floor (/ n 2)))
(define dist (+ 10 (* 1/2 1/10 height)))
(cons (choice-button-bbox-at center-tag center-x center-y)
(for/fold
([acc '()])
([idx (in-range (/ n 2))])
(append (list (choice-button-bbox-at
(+ center-tag idx)
center-x (+ center-y (* (add1 idx) dist)))
(choice-button-bbox-at
(- center-tag idx)
center-x (+ center-y (* -1 (add1 idx) dist))))
acc))))
;;;;
#|
(define blue (color 39 193 155))
(define purple (color 161 28 224))
(define red (color 211 56 85))
(define ex-page
(render-choice-page
(choice-page
(bitmap/file "train.png") "choose awoo(1) or arf(2)?" purple blue
(list (choice-opt "wolf"
(list (page (bitmap/file "trees.png") "awoo awoo" purple blue)
(page (bitmap/file "train.png") "awooooooooooooooooooooooooooo" red blue)))
(choice-opt "dog"
(list (page (bitmap/file "train.png") "arf arf arf" purple blue)))
(choice-opt "meow"
(list))))
"pick"))
(define (debug-render-choice-bboxes page-img n)
(define bboxes (choice-button-bboxes n))
(for/fold
([img page-img])
([bbox bboxes]
[color '(red green blue)])
(printf "~a: ~a ~n" (bbox-tag bbox) color)
(add-line img
(bbox-tl-x bbox) (bbox-tl-y bbox)
(bbox-br-x bbox) (bbox-br-y bbox) color)))
(debug-render-choice-bboxes ex-page 3)
|#