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