request-date
The following request date can be customized in every aspect:
Here is the source code:
REBOL [
title: "request-date object/func optimization and enhancment"
file: %request-date.r
Author: "Didier Cadieu"
email: to-email rejoin ["Didec" #"@" "wanadoo.fr"] ; (f.ck the bot)
date: 23-dec-2003
version: 1.1
purpose: {
This is an enhanced replacement for the original request-date function,
the embedded date picker in view (datepicker).
- Clean, correct and optimize the code.
- add day names at top of window (use system/locales/days).
- add first-day-of-week value to choose starting with Sunday
or Monday.
(I think this value should be part of system/locales)
- add Today button at bottom.
- Today is shown with red circle in calendar.
- New refinment: 'request-date/date a-date to initialize the calendar.
This date is shown with red square in calendar, and is
retuned instead of none if the window is closed.
WARNING ! It needs View 1.2.8+ to work
}
]
;***** MOD function will be included in View 1.3
; Here is a quick define for older version
if not value? 'mod [mod: func [a b][a // b]]
req-funcs: make req-funcs [
req-date: make object! [
base: date-lay: last-f: mo-box: today-draw: this-draw: result: none
cell-size: 24x24
; NEW WORD: DETERMINE FIRST DAY OF WEEK (1=monday or 7=sunday)
; THE BETTER WILL BE TO ADD THIS WORD TO system/locales
; IT COULD BE INITIALIZE ACCORDING TO THE O.S. VALUE (if possible).
first-day-of-week: 7
; THE COMPUTATION WAS CHANGED TO MANAGE FIRST-DAY-OF-WEEK
; AND AVOID HAVING AN EMPTY FIRST LINE
calc-month: func [/local month bas tod d][
bas: base
month: bas/month
bas/day: 1
bas: bas - (mod bas/weekday 14 - first-day-of-week) + mod first-day-of-week 7
tod: now/date
foreach face skip date-lay/pane 11 [
either bas/month <> month [face/text: none] [
face/text: bas/day
d: copy either bas = tod [today-draw][[]]
if bas = result [append d this-draw]
face/effect: compose/only [draw (d)]
]
bas: bas + 1
]
mo-box/text: md base
show [date-lay mo-box]
]
md: func [date][join pick system/locale/months date/month [" " date/year]]
init: func [/local cell-feel offs fon cs2][
if none? base [base: now/date]
fon: make face/font [valign: 'middle align: 'center]
cell-feel: make face/feel [
over: func [f a] [
f/color: either all [a f/text] [yellow] [f/color2]
show f
]
engage: func [f a e] [
if all [a = 'down f/text] [
either f/data [base: f/data][base/day: f/text]
f/color: f/color2 result: base hide-popup
]
]
]
cs2: cell-size / 2
today-draw: reduce ['pen red 'circle cs2 - 1 cs2/x - 3 'circle cs2 cs2/x - 3]
this-draw: reduce ['pen red 'box 1x1 cell-size - 2x2]
date-lay: layout [
size cell-size * 7x9
origin 0x0 space 0
across
arrow left cell-size [base/month: base/month - 1 calc-month]
mo-box: box cell-size * 5x1 md base font [size: 12]
arrow right cell-size [base/month: base/month + 1 calc-month]
return
offs: at
at cell-size * 0x8
box rejoin ["Today: " now/date] cell-size * 7x1 with [
color2: color font: fon
effect: compose/only [draw (today-draw)] feel: cell-feel
data: now/date
]
]
last-f: func [num][
append date-lay/pane make face [
offset: offs size: cell-size feel: edge: none
text: copy/part pick system/locale/days num 2
]
offs/x: offs/x + cell-size/x
]
last-f first-day-of-week
repeat slot 6 [last-f first-day-of-week // 7 + slot 2]
offs: offs + cell-size * 0x1
last-f: none
repeat slot 42 [
append date-lay/pane make face [
offset: offs size: cell-size color: color2: white
font: fon feel: cell-feel data: edge: none
]
offs/x: offs/x + cell-size/x
if zero? slot // 7 [offs: offs + cell-size * 0x1]
]
calc-month
]
set 'request-date func [
"Requests a date."
/date dat [date!] "Initial date to show"
/offset xy [pair!]
][
; ON CLOSE WITHOUT SELECTION, IF /DATE, RETURN "DAT" ELSE RETURN NONE
base: any [result: either date [dat][none] now/date]
either none? date-lay [init][calc-month]
either offset [inform/offset date-lay xy] [inform date-lay]
result
]
]
]
;***************** TEST-CODE ******************
; Delete from here to end to use in your own script
sl-en: make system/locale []
sl-fr: make system/locale [
months: [
"Janvier" "Février" "Mars" "Avril" "Mai" "Juin"
"Juillet" "Août" "Septembre" "Octobre" "Novembre" "Décembre"
]
days: ["Lundi" "Mardi" "Mercredi" "Jeudi" "Vendredi" "Samedi" "Dimanche" ]
]
view layout [
style tx text 100 right
vh3 "Test request-date"
across
tx "Locales:"
rotary "English" "French" [
system/locale: select reduce ["English" sl-en "French" sl-fr] face/text
; Reinitialize the layout
req-funcs/req-date/date-lay: none
] return
tx "First day of week:"
rotary "Sunday" "Monday" [
req-funcs/req-date/first-day-of-week: select ["Sunday" 7 "Monday" 1] face/text
; Reinitialize the layout
req-funcs/req-date/date-lay: none
] return
button 208 "Request-date" [f-r/text: form request-date show f-r] return
button 208 "Request-date/date result" [
if any [empty? f-r/text "none" = f-r/text] [f-r/text: now/date]
f-r/text: to string! request-date/date to date! f-r/text
show f-r
] return
tx "Result:" f-r: field 100
]
request-dir
Very nice and made all in Rebol, so it's absolutely cross-platform:
Here is the source code:
REBOL [
file: %request-dir.r
title: "Directory selector (treeview)"
name:
author: "Didier CADIEU"
email: didec@wanadoo.fr
date: 11-09-2003
version: 1.0.0
needs: {Work only on View 1.2.8+}
purpose: {
Open a requestor to select a directory.
The current directories path is shown as a tree, and sub-dirs are shown for selection.
}
comment: {
The make-dir button does not work as you can expect due to a bug in the management
of modale window in view : the directory is created only when the function return.
You can use the patch from Romano Paolo Tenca to correct this behaviour.
This script is based on a work from Carl Sassenrath, found in the Mailing list
}
]
ctx-req-dir: context [
max-dirs:
cnt: 0
f-list:
f-txt:
f-slid:
f-path:
path:
last-path:
result:
dirs: none
list-data: copy []
links: [[draw [pen 0.0.0 line 6x0 6x9 12x9]] [draw [pen 0.0.0 line 6x0 6x18 line 6x9 12x9]] ]
lib: pth: lev: none
dec: 11
dirout: [
origin 8x8 space 0x0
vh3 "Select a directory"
across pad 0x4
f-list: list 300x292 180.180.180 [
origin 0 space 0 across
box 16x18
f-txt: text 300 font-size 11 font [colors: [0.0.0 0.0.0]] [chg-dir face/user-data]
] supply [
count: count + cnt
if count > length? list-data [face/show?: false exit]
face/show?: true
set [lib pth lev] pick list-data count
either index = 1 [
face/offset/x: lev - dec
face/effect: pick links not attempt [(third pick list-data count + 1) = lev]
] [
face/text: lib
face/color: pick [240.240.240 220.220.220] odd? count
face/offset/x: lev
if path = face/user-data: pth [face/color: 255.190.80 250.150.150]
]
]
f-slid: scroller 16x292 [
c: to-integer value * ((length? list-data) - max-dirs)
if c <> cnt [cnt: c show f-list]
] return
space 60x4
f-path: field wrap font-size 11 316x40 [
value: attempt [to-rebol-file to-file f-path/text]
if all [value exists? value] [path: value show-dir]
] return
btn-enter 65 "Open" [result: dirize path hide-popup]
btn 65 "Make Dir" [
value: request-text/title "Directory name:"
if value [
trim value
if not empty? value [
either error? try [make-dir rejoin [dirize path value]] [
alert "Cannot create directory."
path: copy last-path
] [chg-dir path]
]
]
]
btn-cancel 65 "Cancel" [hide-popup]
]
chg-dir: func [file][
if none? file [exit]
last-path: copy path
path: copy file
show-dir
]
; build a tree of dirs from first to last in the path, recursively
build-tree: func [p /local b l] [
b: split-path p
l: 0
if not none? second b [l: dec + build-tree first b]
either b/2 [any [slash <> last b/2 remove back tail b/2]][change at b 2 "(root)"]
append/only list-data reduce [any [second b "(root)"] p l]
l
]
show-dir: has [l d] [
; read contents of path
dirs: attempt [load dirize path]
if not dirs [
path: last-path
if not dirs: attempt [load dirize path][
alert reform ["Invalid directory:" path]
dirs: load path: %/
]
]
; keep only sub-dirs
remove-each file dirs [slash <> last file]
clear list-data
; recontruct the tree for the path
l: dec + build-tree path
; append the sub-dirs
foreach file sort dirs [
replace/all file #"/" ""
append/only list-data reduce [file rejoin [dirize path file] l]
]
; show everything
f-path/text: any [attempt [to-local-file path] copy ""]
f-slid/redrag max-dirs / max 1 length? list-data
f-slid/step: either 0 >= d: (length? list-data) - max-dirs [0][1 / d]
f-slid/data: 0.0
cnt: 0
show [f-list f-slid f-path]
]
set 'request-dir func [
"Requests a directory using pseudo treeview."
/keep "Keep previous directory path"
/dir "Set starting directory" where [file!]
/offset xy /local
][
if block? dirout [
dirout: layout dirout
max-dirs: to-integer f-list/size/y - 4 / f-txt/size/y
center-face dirout
]
if not all [keep path] [path: any [where what-dir]]
if all [not empty? path slash = last path][remove back tail path]
last-path: path
result: none
show-dir
either offset [inform/offset dirout xy][inform dirout]
result
]
]
request-list
Very useful request that support any type of string:
Here is the source code:
rebol [
Title: "Request List Enhanced"
Date: 10-Dec-2005
Author: ["Mike Yaunish"]
Version: 0.9.1
Email: [%mike.yaunish--shaw--ca]
file: %request-list-enhanced.r
Comment: {Text-list Improvements by Carl Sassenrath & Updates by Paul Tretter.
request-list-auto-fill from REBOL mailing list author unknown.
request-list-enhanced by Mike Yaunish.
}
Rights: "Copyright 2000-2005 REBOL Technologies. All rights reserved."
License: {
Users can freely modify and publish this code under the condition that it is
executed only with languages from REBOL Technologies, and user must include this
header as is. All changes may be freely included by other users in their software
(even commercial uses) as long as they abide by these conditions.
}
Purpose: {
An enhancement to the regular request-list that allows selecting items from a request list
by typing in the first few characters of the item. Works with text, word and number lists.
Designed to make optimum use of the keyboard.
- New refinement request-list-enhanced/return-index will return the index of the item not the value.
- Keys used; cursor up, down, page-up, page-down, control+home, control+end, escape
}
History: [
0.9.0 [ 9-Dec-2005 {Initial beta version published to rebol.org} mike.yaunish@shaw.ca ]
0.9.1 [12-Dec-2005 {Changed the following behaviours so that the user can't escape without a valid selection:
- Changed the behaviour when the enter key is pressed with a non-matching string.
- Added handling of tab key and shift+tab to move up and down the list.}
]
]
]
request-list-enhanced-ctx: make object! [
request-list-styles: stylize [
request-list-auto-fill: field with [
feel: make feel [
engage: func [
face act event index
] [
switch act [
down [
either face <> system/view/focal-face [
focus face
] [system/view/highlight-start: system/view/highlight-end: none system/view/caret: offset-to-caret face event/offset show face ]
]
over [
if system/view/caret <> offset-to-caret face event/offset [
if not system/view/highlight-start [
system/view/highlight-start: system/view/caret
]
system/view/highlight-end: system/view/caret: offset-to-caret face event/offset show face
]
]
key [
ctx-text/edit-text face event act
; Added these event keys here because insert-event-func has caused some
; problems with previously opened windows.
switch event/key [
down [move-selection 1]
#"^-" [; tab key
either event/shift [
move-selection -1
][move-selection 1 ]
]
page-down [move-selection (a-text-list/lc - 1)]
page-up [move-selection (-1 * ( a-text-list/lc - 1) )]
home [
if event/control [move-selection (-1 * (length? a-text-list/data))]
]
end [if event/control [move-selection (length? a-text-list/data)]
]
up [move-selection -1]
#"^M" [; return key
face/action face face/text
]
]
if all [char? event/key not empty? face/text find ctx-text/keys-to-insert event/key ] [search face ]
]
]
]
]
search: func [face /local word ] [
word: copy face/text
foreach item face/user-data [
if equal? word copy/part item (
length? word
) [
face/text: copy item system/view/focal-face: face system/view/highlight-start: skip face/text length? word system/view/highlight-end: tail face/text system/view/caret: tail face/text
show face
if flag-face? face search-action [
face/search-action face
]
exit
]
]
]
words: [
data [
new/user-data: second args next args
]
search-action [flag-face new search-action args ]
]
]
; end of request-list-auto-fill style. ********************************************************************************************************************
request-text-list: txt 200x200 with [
feel: none
color: snow
colors: reduce [snow snow - 32 ]
sz: ; size of the list window
iter: ; the text face displayed on each line
sub-area: ; the face that shows the list
sld: ; scroll bar face
sn: ; scroll bar integer offset into the data
lc: ; lines of text to display
picked: ; selected items
picked-index: ; current index of picked item
cnt: ; current index into the data
act: ; action taken on click
action-single: ; action taken on single click
slf: ; pointer to list-face (self)
text-pane: func [face id ] [
if pair? id [
return 1 + second id / iter/size
]
iter/offset: iter/old-offset: id - 1 * iter/size * 0x1
if iter/offset/y + iter/size/y > size/y [return none ]
cnt: id: id + sn
if iter/text: pick data id [
if flag-face? slf format [
iface: slf/iter reduce first iter-format
]
iter
]
]
update: has [item value old-sn cur-index old-index ] [
sld/redrag lc / max 1 length? data
if item: find data picked/1 [
old-sn: sn
cur-index: index? item
if not all [( cur-index > old-sn ) ( cur-index < ( old-sn + lc + 1 )) ] [
either cur-index <= old-sn [
sn: max (cur-index - 1) 0
] [sn: cur-index - lc ]
old-index: cur-index
]
sld/data: ((max 1 sn) / (length? data) )
] [
sld/value: 0.0
pane/offset: 0x0
]
self
]
resize: func [new /x /y /local tmp ] [
either any [
x y
] [
if x [
size/x: new
]
if y [size/y: new ]
] [
size: any [
new size
]
]
pane/size: sz: size
sld/offset/x: first sub-area/size: size - 16x0
sld/resize/y: size/y
iter/size/x: first sub-area/size - sub-area/edge/size
lc: to-integer sz/y / iter/size/y
self
]
append init [
sz: size
sn: 0
slf: :self
act: :action
if none? data [ data: any [ texts copy [] ]
]
picked: copy [
]
iter: make-face/size 'txt sz * 1x0 + -16x20
iter/para: make self/para [origin: 2x0 ]
iter/font: make self/font [
]
lc: to-integer sz/y / iter/size/y: second size-text iter
iter/feel: make iter/feel [
redraw: func [
f a i
] [
iter/color: color
if flag-face? slf striped [
iter/color: pick next colors odd? cnt
]
if all [find picked iter/text cnt = picked-index ] [iter/color: svvc/field-select ]
]
engage: func [f a e ] [
if a = 'down [
if cnt > length? slf/data [
exit
]
; If not extended selection, clear other selections:
if not e/control [f/state: cnt clear picked ]
alter picked f/text
picked-index: cnt
if flag-face? slf single-click [do :single-click-action slf f/text ]
if e/double-click [do :act slf f/text ]
]
if a = 'up [f/state: none ]
show pane
]
]
pane: layout/size [
origin 0 space 0
sub-area: box slf/color sz - 16x0 ibevel with [
pane: :text-pane
]
at sz * 1x0 - 16x0
sld: scroller sz * 0x1 + 16x0 [
if sn = value: max 0 to-integer value * ((
1 + length? slf/data
)
- lc
) [
exit
]
sn: value
show sub-area
]
]
size
pane/offset: 0x0
sld/redrag lc / max 1 length? data
]
words: [
data [
new/text: pick new/texts: second args 1 next args
]
striped [flag-face new striped args ]
single-click [flag-face new single-click args ]
format [flag-face new format iter-format: next args ]
]
]
]
select-this-item: func [new-index] [
a-text-list/picked-index: new-index
a-text-list/picked: reduce [to-string ( pick a-text-list/data a-text-list/picked-index )]
show a-text-list/update
a-field/text: copy first a-text-list/picked
show a-field
focus a-field
]
move-selection: func [direction /local new-index] [
new-index: ((a-text-list/picked-index) + direction)
if (new-index < 1) [
new-index: 1
]
if (new-index > (length? a-text-list/data)) [new-index: length? a-text-list/data ]
select-this-item new-index
]
set 'request-list-enhanced func [
titl [ string!] {Title of requester}
alist [block! ] {List of data}
/offset where [pair!] "xy -- Offset of window on screen"
/return-index "return the index value"
/local return-value all-strings orig-alist
] [
all-strings: true
orig-alist: copy alist
alist: copy []
foreach i orig-alist [
either type? i <> string![
all-strings: false
append alist to-string i
][append alist i ]
]
inform/title/offset l: layout [
styles request-list-styles
a-text-list: request-text-list
single-click ; default action is double-click
with [
single-click-action: func [
f v
] [
a-field/text: copy first a-text-list/picked show a-field
focus a-field
]
]
data alist [
; double-click-action
return-the-selection
]
across
a-field: request-list-auto-fill data alist search-action
with [
search-action: func [f] [
a-text-list/picked-index: index? find a-text-list/data f/text
a-text-list/picked: reduce [to-string ( pick a-text-list/data a-text-list/picked-index) ]
show a-text-list/update
]
] [return-the-selection ]
return
button "OK" [return-the-selection ]
button "CANCEL" keycode escape [return-the-selection/value none ]
do [
return-the-selection: func [ /value the-value ] [
either value [
return-value: the-value
hide-popup
][
either (a-field/text = first a-text-list/picked) [
either return-index [
return-value: a-text-list/picked-index
] [
either not all-strings [
return-value: pick orig-alist a-text-list/picked-index
][return-value: first a-text-list/picked ]
]
hide-popup
][focus a-field ]
]
]
select-this-item 1
]
] titl either offset [where] [system/view/screen-face/size - l/size / 2 ]
return return-value
]
]
; *** end of object ***
demo: does [
sample-word-list: sort first system/words
sample-numeric-list: [ 1 2 3 4 12 13 14 15 31 32 33 34 35 36 125 305 315 344 678 987 1003 ]
sample-text-list: []
foreach i first system/words [append sample-text-list to-string i ]
sort sample-text-list
view layout [
across
button 150 keycode 'F3 "word list ^-(F3)" [ g/text: type? f/text: request-list-enhanced "Type some text in:" sample-word-list show [ f g ]] return
button 150 keycode 'F4 "text list ^-(F4)" [g/text: type? f/text: request-list-enhanced "Type some text in:" sample-text-list show [ f g ]] return
button 150 keycode 'F5 "numberic ^- (F5)" [g/text: type? f/text: request-list-enhanced "Type some numbers in:" sample-numeric-list show [ f g ] ] return
button 150 keycode 'F6 "return-index ^- (F6)" [g/text: type? f/text: request-list-enhanced/return-index "Type some text in:" sample-text-list show [ f g ] ] return
return
label "return type:" g: field return
label "return value:" f: field
]
]
; uncomment line below to see how it works
demo halt
request-time
Very nice requester, to use it you must give a time:request-time 13:21:32
Here is the source code:
rebol[
file: %request-time.r
Title: "request time"
Author: "Tom Conlin"
Date: 1-Mar-2003
Purpose: "widget to return a valid time datatype"
example: [do %request-time.r request-time 4:20]
]
req-time-ctx: make object! [
time-lay: none
result: none
; precomputed endpoints
big: [
87x5 95x6 103x8 110x11 117x15 124x19 130x24 136x30 141x36 145x42 149x50 152x57
154x65 155x73 156x80 155x87 154x95 152x103 149x110 145x117 141x124 136x130
130x136 124x141 117x145 110x149 103x152 95x154 87x155 80x156 73x155 65x154
57x152 50x149 42x145 36x141 30x136 24x130 19x124 15x118 11x110 8x103 6x95 5x87
4x80 5x73 6x65 8x57 11x50 15x42 19x36 24x30 30x24 36x19 42x15 50x11 57x8 65x6
73x5 80x4]
lil: [
85x29 90x30 96x31 101x33 105x35 110x38 114x42 118x46 122x50 125x54 127x59 129x64
130x70 131x75 132x80 131x85 130x90 129x96 127x101 125x105 122x110 118x114 114x118
110x122 105x125 101x127 96x129 90x130 85x131 80x132 75x131 70x130 64x129 59x127
54x125 50x122 46x118 42x114 38x110 35x106 33x101 31x96 30x90 29x85 28x80 29x75
30x70 31x64 33x59 35x54 38x50 42x46 46x42 50x38 54x35 59x33 64x31 70x30 75x29
80x28]
sec: [
88x4 96x5 103x7 111x10 118x14 125x18 131x23 137x29 142x35 146x42 150x49 153x57
155x64 156x72 157x80 156x88 155x96 153x103 150x111 146x118 142x125 137x131
131x137 125x142 118x146 111x150 103x153 96x155 88x156 80x157 72x156 64x155
57x153 49x150 42x146 35x142 29x137 23x131 18x125 14x118 10x111 7x103 5x96 4x88
3x80 4x72 5x64 7x57 10x49 14x42 18x35 23x29 29x23 35x18 42x14 49x10 57x7 64x5
72x4 80x3]
edg: [
88x1 96x2 104x4 112x7 119x11 127x16 133x21 139x27 144x33 149x40 153x48 156x56
158x64 159x72 160x80 159x88 158x96 156x104 153x112 149x119 144x127 139x133
133x139 127x144 119x149 112x153 104x156 96x158 88x159 80x160 72x159 64x158
56x156 48x153 40x149 33x144 27x139 21x133 16x127 11x120 7x112 4x104 2x96 1x88
0x80 1x72 2x64 4x56 7x48 11x40 16x33 21x27 27x21 33x16 40x11 48x7 56x4 64x2
72x1 80x0]
tic-toc: func "emit DRAW clock face @ time t" t[time!]/local h m s drw-blk radius][
radius: 80x80
drw-blk: make block! 256
insert drw-blk
either t < 12:00
[[pen white fill-pen white]]
[[pen black fill-pen black]]
for i 1 60 1[
either zero? i // 5
[insert tail drw-blk compose[circle (sec/:i) 2]] ; hour marks
[insert tail drw-blk compose[line (sec/:i) (edg/:i)]]; minute marks
]
s: either zero? t/3 [60][t/3]
m: either zero? t/2 [60][t/2]
h: add multiply t/1 // 12 5 to integer! divide t/2 12
h: either zero? h [60][h]
insert tail drw-blk compose; hands
pen red line (RADIUS) (lil/:h)
pen blue line (RADIUS) (big/:m)
pen yellow line (RADIUS) (sec/:s)
]
drw-blk
]
the-time: func [start [time! none!] /local lbl alm alarm civil][
either start [alarm: start][alarm: now/time]
civil: either greater-or-equal? alarm 13:00:00
[alarm // 12:00:00]
[either zero? alarm/1[alarm + 12:00][alarm]]
time-lay: layout [
origin 0x0
across
panel [ size 220x160
across
lbl: label 180 coal rejoin[civil either lesser? alarm 12:00 [" AM"][" PM"]tab tab alarm]
return
label 60 "Hours:"
slider 120x16 gray red with[data: alarm/1 / 24]
[alarm/1: minimum 23 to integer! value * 24
civil: either greater-or-equal? alarm 13:00:00
[alarm // 12:00:00]
[either zero? alarm/1[alarm + 12:00][alarm]]
lbl/text: rejoin[civil either lesser? alarm 12:00 [" AM"][" PM"]tab tab alarm]
alm/effect: reduce ['draw tic-toc alarm]
show [lbl alm]
]
return
label 60 "Minutes:"
slider 120x16 gray blue with[data: alarm/2 / 60]
[civil/2: alarm/2: minimum 59 to integer! value * 60
lbl/text: rejoin[civil either lesser? alarm 12:00 [" AM"][" PM"]tab tab alarm]
alm/effect: reduce ['draw tic-toc alarm]
show [lbl alm]
]
return
label 60 "Seconds:"
slider 120x16 gray yellow with[data: alarm/3 / 60]
[civil/3: alarm/3: minimum 59 to integer! value * 60
lbl/text: rejoin[civil either lesser? alarm 12:00 [" AM"][" PM"]tab tab alarm]
alm/effect: reduce ['draw tic-toc alarm]
show [lbl alm]
]
return
pad 16 btn-enter "Set" 64 hide-popup result: alarm]
pad 16 btn-cancel "Off" escape 64 hide-popup result: 24:00:00]
]
alm: box 160x160 effect reduce ['draw tic-toc alarm]
]
]
set 'request-time func "Returns a time. 0:00:00 thru 23:59:59 are set. 24:00:00 is unset"
t [time! none!] /offset xy
][
result: either t [t][24:00:00]
the-time either t [t][now/time]
either offset [inform/offset/title time-lay xy "what time?"] [inform/title time-lay "what time?"]
result
]
]
No comments:
Post a Comment