1*22028508SToomas Soome\ Copyright (c) 2008-2015 Devin Teske <dteske@FreeBSD.org> 2*22028508SToomas Soome\ All rights reserved. 3*22028508SToomas Soome\ 4*22028508SToomas Soome\ Redistribution and use in source and binary forms, with or without 5*22028508SToomas Soome\ modification, are permitted provided that the following conditions 6*22028508SToomas Soome\ are met: 7*22028508SToomas Soome\ 1. Redistributions of source code must retain the above copyright 8*22028508SToomas Soome\ notice, this list of conditions and the following disclaimer. 9*22028508SToomas Soome\ 2. Redistributions in binary form must reproduce the above copyright 10*22028508SToomas Soome\ notice, this list of conditions and the following disclaimer in the 11*22028508SToomas Soome\ documentation and/or other materials provided with the distribution. 12*22028508SToomas Soome\ 13*22028508SToomas Soome\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 14*22028508SToomas Soome\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 15*22028508SToomas Soome\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 16*22028508SToomas Soome\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 17*22028508SToomas Soome\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18*22028508SToomas Soome\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 19*22028508SToomas Soome\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 20*22028508SToomas Soome\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 21*22028508SToomas Soome\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 22*22028508SToomas Soome\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 23*22028508SToomas Soome\ SUCH DAMAGE. 24*22028508SToomas Soome\ 25*22028508SToomas Soome\ $FreeBSD$ 26*22028508SToomas Soome 27*22028508SToomas Soomemarker task-delay.4th 28*22028508SToomas Soome 29*22028508SToomas Soomevocabulary delay-processing 30*22028508SToomas Soomeonly forth also delay-processing definitions 31*22028508SToomas Soome 32*22028508SToomas Soome2 constant delay_default \ Default delay (in seconds) 33*22028508SToomas Soome3 constant etx_key \ End-of-Text character produced by Ctrl+C 34*22028508SToomas Soome13 constant enter_key \ Carriage-Return character produce by ENTER 35*22028508SToomas Soome27 constant esc_key \ Escape character produced by ESC or Ctrl+[ 36*22028508SToomas Soome 37*22028508SToomas Soomevariable delay_tstart \ state variable used for delay timing 38*22028508SToomas Soomevariable delay_delay \ determined configurable delay duration 39*22028508SToomas Soomevariable delay_cancelled \ state variable for user cancellation 40*22028508SToomas Soomevariable delay_showdots \ whether continually print dots while waiting 41*22028508SToomas Soome 42*22028508SToomas Soomeonly forth definitions also delay-processing 43*22028508SToomas Soome 44*22028508SToomas Soome: delay_execute ( -- ) 45*22028508SToomas Soome 46*22028508SToomas Soome \ make sure that we have a command to execute 47*22028508SToomas Soome s" delay_command" getenv dup -1 = if 48*22028508SToomas Soome drop exit 49*22028508SToomas Soome then 50*22028508SToomas Soome 51*22028508SToomas Soome \ read custom time-duration (if set) 52*22028508SToomas Soome s" loader_delay" getenv dup -1 = if 53*22028508SToomas Soome drop \ no custom duration (remove dup'd bunk -1) 54*22028508SToomas Soome delay_default \ use default setting (replacing bunk -1) 55*22028508SToomas Soome else 56*22028508SToomas Soome \ make sure custom duration is a number 57*22028508SToomas Soome ?number 0= if 58*22028508SToomas Soome delay_default \ use default if otherwise 59*22028508SToomas Soome then 60*22028508SToomas Soome then 61*22028508SToomas Soome 62*22028508SToomas Soome \ initialize state variables 63*22028508SToomas Soome delay_delay ! \ stored value is on the stack from above 64*22028508SToomas Soome seconds delay_tstart ! \ store the time we started 65*22028508SToomas Soome 0 delay_cancelled ! \ boolean flag indicating user-cancelled event 66*22028508SToomas Soome 67*22028508SToomas Soome false delay_showdots ! \ reset to zero and read from environment 68*22028508SToomas Soome s" delay_showdots" getenv dup -1 <> if 69*22028508SToomas Soome 2drop \ don't need the value, just existence 70*22028508SToomas Soome true delay_showdots ! 71*22028508SToomas Soome else 72*22028508SToomas Soome drop 73*22028508SToomas Soome then 74*22028508SToomas Soome 75*22028508SToomas Soome \ Loop until we have exceeded the desired time duration 76*22028508SToomas Soome begin 77*22028508SToomas Soome 25 ms \ sleep for 25 milliseconds (40 iterations/sec) 78*22028508SToomas Soome 79*22028508SToomas Soome \ throw some dots up on the screen if desired 80*22028508SToomas Soome delay_showdots @ if 81*22028508SToomas Soome ." ." \ dots visually aid in the perception of time 82*22028508SToomas Soome then 83*22028508SToomas Soome 84*22028508SToomas Soome \ was a key depressed? 85*22028508SToomas Soome key? if 86*22028508SToomas Soome key \ obtain ASCII value for keystroke 87*22028508SToomas Soome dup enter_key = if 88*22028508SToomas Soome -1 delay_delay ! \ break loop 89*22028508SToomas Soome then 90*22028508SToomas Soome dup etx_key = swap esc_key = OR if 91*22028508SToomas Soome -1 delay_delay ! \ break loop 92*22028508SToomas Soome -1 delay_cancelled ! \ set cancelled flag 93*22028508SToomas Soome then 94*22028508SToomas Soome then 95*22028508SToomas Soome 96*22028508SToomas Soome \ if the time duration is set to zero, loop forever 97*22028508SToomas Soome \ waiting for either ENTER or Ctrl-C/Escape to be pressed 98*22028508SToomas Soome delay_delay @ 0> if 99*22028508SToomas Soome \ calculate elapsed time 100*22028508SToomas Soome seconds delay_tstart @ - delay_delay @ > 101*22028508SToomas Soome else 102*22028508SToomas Soome -1 \ break loop 103*22028508SToomas Soome then 104*22028508SToomas Soome until 105*22028508SToomas Soome 106*22028508SToomas Soome \ if we were throwing up dots, throw up a line-break 107*22028508SToomas Soome delay_showdots @ if 108*22028508SToomas Soome cr 109*22028508SToomas Soome then 110*22028508SToomas Soome 111*22028508SToomas Soome \ did the user press either Ctrl-C or Escape? 112*22028508SToomas Soome delay_cancelled @ if 113*22028508SToomas Soome 2drop \ we don't need the command string anymore 114*22028508SToomas Soome else 115*22028508SToomas Soome evaluate \ evaluate/execute the command string 116*22028508SToomas Soome then 117*22028508SToomas Soome; 118*22028508SToomas Soome 119*22028508SToomas Soomeonly forth definitions 120