-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathitem-explorer-panel.rkt
125 lines (110 loc) · 4.62 KB
/
item-explorer-panel.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
#lang racket/gui
(provide item-explorer-panel%)
(require "items.rkt"
"recipes.rkt")
(define item-explorer-panel%
(class vertical-panel%
(super-new)
(define root-selection-area
(new horizontal-panel%
[parent this]
[alignment '(left top)]
[stretchable-height #f]))
(define item-selection
(new choice%
[parent root-selection-area]
[label "Item"]
[choices (map item-name->label (get-sorted-item-names))]
[callback (λ (ignore ...)
(show-root-item))]))
(define item-info
(new vertical-pane%
[parent root-selection-area]))
(define recipe-explorer-panel%
(class vertical-panel%
(super-new [alignment '(left top)]
[style '(auto-vscroll)])
(define item #f)
(define recipes-using null)
(define recipes-for null)
(define/public (set-item item)
(define (make-recipe-list lst)
(define recipes-panel (new horizontal-panel%
[parent this]
[stretchable-height #f]))
(define outputs-column (new vertical-pane%
[parent recipes-panel]
[alignment '(left top)]
[stretchable-width #f]
[stretchable-height #f]))
(define inputs-column (new vertical-pane%
[parent recipes-panel]
[alignment '(left top)]
[stretchable-width #f]
[stretchable-height #f]))
(for ([recipe lst])
(new message%
[parent outputs-column]
[label (format " ~a ~a"
(item->label (recipe$-output recipe))
(recipe$-count recipe))]
[stretchable-height #t])
(define inputs
(for/fold ([result null])
([i (recipe$-inputs recipe)])
(cons (format "~a ~a" (cdr i) (item->label (car i))) result)))
(new message%
[parent (new pane%
[parent inputs-column]
[stretchable-height #t]
[alignment '(left center)])]
[label (format " <== ~a ~a" (recipe$-action recipe) (string-join inputs ", "))]))
recipes-panel)
(set! recipes-using (get-recipes-using item))
(set! recipes-for (get-recipes-for item))
(define children null)
(unless (null? recipes-for)
(define recipes-for-header
(new message%
[parent this]
[stretchable-width #t]
[label (format "~a recipes for ~a ..."
(length recipes-for) (item->label item))]))
(set! children (list* recipes-for-header (make-recipe-list recipes-for) children)))
(unless (null? recipes-using)
(define recipes-using-header
(new message%
[parent this]
[stretchable-width #t]
[label (format "~a recipes using ~a..."
(length recipes-using) (item->label item))]))
(set! children (list* recipes-using-header (make-recipe-list recipes-using) children)))
(send this change-children (λ (c) children)))))
(define root-recipe-explorer (new recipe-explorer-panel% [parent this]))
(define (show-root-item)
(define item (get-item (list-ref (get-sorted-item-names)
(send item-selection get-selection))))
(send item-info
change-children
(λ (c)
(list
(new message%
[parent item-info]
[label (format "Value: ~a" (item$-base-value item))])
(new message%
[parent item-info]
[label (format "ID: ~a" (item$-id item))]))))
(send root-recipe-explorer set-item item)
(void))
(show-root-item)
(define (add-recipe-areas parent)
(void))
(define (show-recipes parent)
(void))
(define (hide-recipes parent)
(void))
(define (show-recipe-detail parent)
(void))
(define (hide-recipe-detail parent)
(void))
))