forked from eugenkiss/7guis
/
flight-booking-2.red
54 lines (50 loc) · 1.99 KB
/
flight-booking-2.red
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
Red [author: "Gregg Irwin"]
; Really needs date! type, which isn't implemented in Red yet.
def-date: [2017 12 24]
dates: reduce ['depart def-date 'return def-date]
;return-before-depart?: does [attempt [dates/return < dates/depart]]
depart-before-return?: does [all [both-dates-OK? dates/return > dates/depart]]
one-way?: does [flight-type/selected = 1]
;return-flight?: does [flight-type/selected = 2]
flight-desc: does [pick flight-type/data flight-type/selected]
flight-date: does [either one-way? [depart-date/text][return-date/text]]
book-ticket: has [str] [
str: form reduce ["You have booked a" flight-desc "on" flight-date]
view/flags [below text str button "OK" [unview]] [modal popup]
]
parse-date: func [input [string! object!] /local dig sep yr mo dy][
dig: charset [#"0" - #"9"]
sep: charset "/-."
if object? input [input: input/text]
all [
parse input [copy yr 4 dig sep copy mo 1 2 dig sep copy dy 1 2 dig]
attempt [parse reduce [yr: load yr mo: load mo dy: load dy] [3 integer!]]
yr >= 2017 ;yr < 2020
mo >= 1 mo <= 12
dy >= 1 dy <= 31 ; No special checking by month.
reduce [yr mo dy]
]
]
date-valid?: func [input][block? parse-date input]
both-dates-OK?: does [all [dates/depart dates/return]] ; OK as long as they're not none
ok-to-book?: does [
to logic! either one-way? [dates/depart][
all [both-dates-OK? depart-before-return?]
]
]
view [
style field: field 150 on-change [
face/color: either any [date-valid? face empty? face/text] [none][red]
dates/(face/extra): parse-date face
book-it/enabled?: ok-to-book?
]
below
flight-type: drop-list 150 data ["one-way flight" "return flight"] select 1 on-change [
return-date/enabled?: not one-way?
book-it/enabled?: ok-to-book?
]
text italic snow navy "Enter dates in yyyy-mm-dd format"
depart-date: field "2017-12-24" extra 'depart hint "depart date"
return-date: field "2017-12-24" extra 'return hint "return date" disabled
book-it: button "Book" [book-ticket]
]