Steven White — 27-Feb-2017/17:08:37-8:00
I want to have my cake and eat it too.
With help from a previous posting, I have made a little status window. The difficulty I had was that if I tried to view a status window, the program would wait on the various events from the viewed window, so I never could update the window because the program would top running and just wait. If I used view/new to view the window, the program would continue running after showing the window. So I did that as shown below and all is working, but now, as a final touch, I would like to add a 'cancel' option to the status window so the operator can kill the program if it seems to be running too long. It appears that I can't do that, because the program is not waiting on window events, but is running along as desired.
Do we think there is a way to pop up a status window, update it as the program runs, but then allow the program to be canceled somehow through that same status window?
Thank you. Current efforts so far follow.
R E B O L [
Title: 'Status display'
Purpose: {Show a reassuring status box indicating what a program
is doing and how far along it is.}
]
;; [---------------------------------------------------------------------------]
;; [ This module is a few functions you can use to show a status display ]
;; [ for a running program. You have to use them properly, because they ]
;; [ don't do any checking. ]
;; [ ]
;; [ SHOW-STATUS-WINDOW: Do this first, to get a the status window showing. ]
;; [ The view/new function shows the status box but lets your program ]
;; [ continue. ]
;; [ SHOW-PHASE (phase-literal): Display one line of text indicating what ]
;; [ the program is doing. Every time you call this function, the ]
;; [ previous phase gets put into a history display above the current. ]
;; [ SHOW-PROGRESS: (total-to-do amount-done): This function modifies the ]
;; [ progress bar with a fraction calculated as the amount done divided ]
;; [ by the total that must be done. Usually these are record counts, ]
;; [ as in 500 records processed out of a total of 20000. ]
;; [ That would look like this: STATUS-BAR/SHOW-PROGRESS 20000 500 ]
;; [ It is your job to keep track of those numbers. ]
;; [ RESET-PROGRESS: Reset the progress bar to zero. This function exists ]
;; [ in case you want to show several progress bars, one after another. ]
;; [ CLOSE-STATUS-WINDOW: This just executes the unview function to make ]
;; [ the status window disappear. ]
;; [---------------------------------------------------------------------------]
STATUS-BOX: context [
MAIN-WINDOW: layout [
MAIN-BANNER: banner 'Program status'
MAIN-HISTORY: text 200x50 wrap
label 200 'Current phase:'
MAIN-PHASE: info 200
label 200 'Progress on this phase'
MAIN-PROGRESS: progress 200
;;;; button 'Cancel' [alert 'Operation canceled' quit] ;;; Does not work.
]
SHOW-STATUS-WINDOW: does [
view/new center-face MAIN-WINDOW
]
SHOW-PHASE: func [
PHASE
] [
append MAIN-HISTORY/TEXT rejoin [
MAIN-PHASE/text
newline
]
MAIN-HISTORY/line-list: none
MAIN-HISTORY/para/scroll/y: negate
(max 0 (second size-text MAIN-HISTORY) - (MAIN-HISTORY/size/y))
show MAIN-HISTORY
MAIN-PHASE/text: copy PHASE
show MAIN-PHASE
]
SHOW-PROGRESS: func [
FULL-SIZE
AMOUNT-DONE
] [
set-face MAIN-PROGRESS (AMOUNT-DONE / FULL-SIZE)
]
RESET-PROGRESS: does [
set-face MAIN-PROGRESS 0
]
CLOSE-STATUS-WINDOW: does [
unview
]
]
;; Uncomment to test
STATUS-BOX/SHOW-STATUS-WINDOW
wait 2
STATUS-BOX/SHOW-PHASE 'Initializing'
wait 2
STATUS-BOX/SHOW-PHASE 'Phase 1'
wait 2
STATUS-BOX/SHOW-PHASE 'Extracting data'
CNT: 0
TOT: 100
loop 100 [CNT: CNT + 1 STATUS-BOX/SHOW-PROGRESS TOT CNT wait 0.1]
wait 2
STATUS-BOX/SHOW-PHASE 'Processing data'
STATUS-BOX/RESET-PROGRESS
CNT: 0
TOT: 100
loop 100 [CNT: CNT + 1 STATUS-BOX/SHOW-PROGRESS TOT CNT wait 0.1]
wait 2
STATUS-BOX/SHOW-PHASE 'Finishing'
wait 3
STATUS-BOX/CLOSE-STATUS-WINDOW
OneArb — 1-Mar-2017/19:28:49-8:00
Steve,
I was reflecting of your status bar implementation when I realized "oh shoot I forgot checking the existence of threads in Rebol".
Although not part of the language(yet :-) here is a solution:
https://stackoverflow.com/questions/2708494/rebol-how-to-do-another-task-while-waiting-an-alarm-to-trigger
I speculate Rebol can use the OS context switching through the graphic library timer.
Look for this line:
rate 1 feel [engage: :periodic]
in https://stackoverflow.com/questions/2708494/rebol-how-to-do-another-task-while-waiting-an-alarm-to-trigger
I modified to allow dynamic rate increase which in turn increases the number of context switching as reported by Sysinternal Process Explorer (in properties).
Have fun!
R E B O L [
Title: "Alarmer"
Original File: %alarm.r
Author: oofoe
Date: 2010-04-28
Purpose: "Demonstrate non-blocking alarm."
File: %thread-alarm02.r
Modified: "by OneArb to dynamic change rate"
Date: 2017-03-02
]
myrate: 1
alarm-data: none
digit: charset "0123456789"
alarm: func [
"Set alarm for future time."
seconds "Seconds from now to ring alarm."
message [string! unset!] "Message to print on alarm."
] [
alarm-data: reduce [now/time/precise + seconds message]
]
ring: func [
"Action for when alarm comes due."
message [string! unset!]
] [
set-face monitor either message [message]["RIIIING!"]
; Your sound playing can also go here (my computer doesn't have speakers).
]
periodic: func [
"Called every second / myrate, checks alarms."
fact action event
] [
print now/time/precise
if alarm-data [
; Update alarm countdown.
set-face monitor rejoin [
"Alarm will ring in "
to time! alarm-data/1 - now/time/precise
]
; Check alarm.
if now/time/precise > alarm-data/1 [
ring alarm-data/2
alarm-data: none ; Reset once fired.
]
]
]
screen: [
text "Try change rate"
myrate-field: field form myrate [
if (parse myrate-field/text [any digit]) [
myrate: to-integer myrate-field/text
]
view center-face layout screen
focus myrate-field
]
monitor: text 256 bold "Alarm messages will be shown here."
rate myrate feel [
engage: :periodic
]
button 256 "re/start countdown" [
alarm 10 "This is the alarm message."
set-face monitor "Alarm set."
]
]
print ""
view/new center-face layout screen
focus myrate-field
do-events
Nick — 2-Mar-2017/4:47:41-8:00
You can do this:
R E B O L []
;; [---------------------------------------------------------------------------]
;; [ This module is a few functions you can use to show a status display ]
;; [ for a running program. You have to use them properly, because they ]
;; [ don"t do any checking. ]
;; [ ]
;; [ SHOW-STATUS-WINDOW: Do this first, to get a the status window showing. ]
;; [ The view/new function shows the status box but lets your program ]
;; [ continue. ]
;; [ SHOW-PHASE (phase-literal): Display one line of text indicating what ]
;; [ the program is doing. Every time you call this function, the ]
;; [ previous phase gets put into a history display above the current. ]
;; [ SHOW-PROGRESS: (total-to-do amount-done): This function modifies the ]
;; [ progress bar with a fraction calculated as the amount done divided ]
;; [ by the total that must be done. Usually these are record counts, ]
;; [ as in 500 records processed out of a total of 20000. ]
;; [ That would look like this: STATUS-BAR/SHOW-PROGRESS 20000 500 ]
;; [ It is your job to keep track of those numbers. ]
;; [ RESET-PROGRESS: Reset the progress bar to zero. This function exists ]
;; [ in case you want to show several progress bars, one after another. ]
;; [ CLOSE-STATUS-WINDOW: This just executes the unview function to make ]
;; [ the status window disappear. ]
;; [---------------------------------------------------------------------------]
write %status-window.r {
R E B O L [title: "status"]
SHOW-PHASE: func [
PHASE
] [
append MAIN-HISTORY/TEXT rejoin [
MAIN-PHASE/text
newline
]
MAIN-HISTORY/line-list: none
MAIN-HISTORY/para/scroll/y: negate
(max 0 (second size-text MAIN-HISTORY) - (MAIN-HISTORY/size/y))
show MAIN-HISTORY
MAIN-PHASE/text: copy PHASE
show MAIN-PHASE
]
SHOW-PROGRESS: func [
FULL-SIZE
AMOUNT-DONE
] [
set-face MAIN-PROGRESS (AMOUNT-DONE / FULL-SIZE)
]
RESET-PROGRESS: does [
set-face MAIN-PROGRESS 0
]
CLOSE-STATUS-WINDOW: does [
quit
]
MAIN-WINDOW: layout [
MAIN-BANNER: banner "Program status"
MAIN-HISTORY: text 200x50 wrap
label 200 "Current phase:"
MAIN-PHASE: info 200
label 200 "Progress on this phase"
MAIN-PROGRESS: progress 200
button "Cancel" [alert "Operation canceled" quit]
]
view/new center-face MAIN-WINDOW
forever [
old: read %status.r
wait .5
if not viewed? MAIN-WINDOW [quit]
if old <> current: read %status.r [do current]
]
}
write %status.r ""
launch %status-window.r
;; Uncomment to test
wait 2
write %status.r {SHOW-PHASE "Initializing"}
wait 2
write %status.r {SHOW-PHASE "Phase 1"}
wait 2
write %status.r {SHOW-PHASE "Extracting data"}
CNT: 0
TOT: 100
loop 100 [CNT: CNT + 1 write %status.r rejoin [{SHOW-PROGRESS } TOT { } CNT] wait 0.1]
wait 2
write %status.r {SHOW-PHASE "Processing data"}
write %status.r {RESET-PROGRESS}
CNT: 0
TOT: 100
loop 100 [CNT: CNT + 1 write %status.r rejoin [{SHOW-PROGRESS } TOT { }CNT] wait 0.1]
wait 2
write %status.r {SHOW-PHASE "Finishing"}
wait 3
write %status.r {CLOSE-STATUS-WINDOW}
Better yet, send the messages through a network connection.
Why not avoid all this and just print status updates to the console?
Steven White — 2-Mar-2017/22:41:01-8:00
The console is the way I have been doing it. I just wanted to try something different.