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 26*ca987d46SWarner Loshmarker task-delay.4th 27*ca987d46SWarner Losh 28*ca987d46SWarner Loshvocabulary delay-processing 29*ca987d46SWarner Loshonly forth also delay-processing definitions 30*ca987d46SWarner Losh 31*ca987d46SWarner Losh2 constant delay_default \ Default delay (in seconds) 32*ca987d46SWarner Losh3 constant etx_key \ End-of-Text character produced by Ctrl+C 33*ca987d46SWarner Losh13 constant enter_key \ Carriage-Return character produce by ENTER 34*ca987d46SWarner Losh27 constant esc_key \ Escape character produced by ESC or Ctrl+[ 35*ca987d46SWarner Losh 36*ca987d46SWarner Loshvariable delay_tstart \ state variable used for delay timing 37*ca987d46SWarner Loshvariable delay_delay \ determined configurable delay duration 38*ca987d46SWarner Loshvariable delay_cancelled \ state variable for user cancellation 39*ca987d46SWarner Loshvariable delay_showdots \ whether continually print dots while waiting 40*ca987d46SWarner Losh 41*ca987d46SWarner Loshonly forth definitions also delay-processing 42*ca987d46SWarner Losh 43*ca987d46SWarner Losh: delay_execute ( -- ) 44*ca987d46SWarner Losh 45*ca987d46SWarner Losh \ make sure that we have a command to execute 46*ca987d46SWarner Losh s" delay_command" getenv dup -1 = if 47*ca987d46SWarner Losh drop exit 48*ca987d46SWarner Losh then 49*ca987d46SWarner Losh 50*ca987d46SWarner Losh \ read custom time-duration (if set) 51*ca987d46SWarner Losh s" loader_delay" getenv dup -1 = if 52*ca987d46SWarner Losh drop \ no custom duration (remove dup'd bunk -1) 53*ca987d46SWarner Losh delay_default \ use default setting (replacing bunk -1) 54*ca987d46SWarner Losh else 55*ca987d46SWarner Losh \ make sure custom duration is a number 56*ca987d46SWarner Losh ?number 0= if 57*ca987d46SWarner Losh delay_default \ use default if otherwise 58*ca987d46SWarner Losh then 59*ca987d46SWarner Losh then 60*ca987d46SWarner Losh 61*ca987d46SWarner Losh \ initialize state variables 62*ca987d46SWarner Losh delay_delay ! \ stored value is on the stack from above 63*ca987d46SWarner Losh seconds delay_tstart ! \ store the time we started 64*ca987d46SWarner Losh 0 delay_cancelled ! \ boolean flag indicating user-cancelled event 65*ca987d46SWarner Losh 66*ca987d46SWarner Losh false delay_showdots ! \ reset to zero and read from environment 67*ca987d46SWarner Losh s" delay_showdots" getenv dup -1 <> if 68*ca987d46SWarner Losh 2drop \ don't need the value, just existence 69*ca987d46SWarner Losh true delay_showdots ! 70*ca987d46SWarner Losh else 71*ca987d46SWarner Losh drop 72*ca987d46SWarner Losh then 73*ca987d46SWarner Losh 74*ca987d46SWarner Losh \ Loop until we have exceeded the desired time duration 75*ca987d46SWarner Losh begin 76*ca987d46SWarner Losh 25 ms \ sleep for 25 milliseconds (40 iterations/sec) 77*ca987d46SWarner Losh 78*ca987d46SWarner Losh \ throw some dots up on the screen if desired 79*ca987d46SWarner Losh delay_showdots @ if 80*ca987d46SWarner Losh ." ." \ dots visually aid in the perception of time 81*ca987d46SWarner Losh then 82*ca987d46SWarner Losh 83*ca987d46SWarner Losh \ was a key depressed? 84*ca987d46SWarner Losh key? if 85*ca987d46SWarner Losh key \ obtain ASCII value for keystroke 86*ca987d46SWarner Losh dup enter_key = if 87*ca987d46SWarner Losh -1 delay_delay ! \ break loop 88*ca987d46SWarner Losh then 89*ca987d46SWarner Losh dup etx_key = swap esc_key = OR if 90*ca987d46SWarner Losh -1 delay_delay ! \ break loop 91*ca987d46SWarner Losh -1 delay_cancelled ! \ set cancelled flag 92*ca987d46SWarner Losh then 93*ca987d46SWarner Losh then 94*ca987d46SWarner Losh 95*ca987d46SWarner Losh \ if the time duration is set to zero, loop forever 96*ca987d46SWarner Losh \ waiting for either ENTER or Ctrl-C/Escape to be pressed 97*ca987d46SWarner Losh delay_delay @ 0> if 98*ca987d46SWarner Losh \ calculate elapsed time 99*ca987d46SWarner Losh seconds delay_tstart @ - delay_delay @ > 100*ca987d46SWarner Losh else 101*ca987d46SWarner Losh -1 \ break loop 102*ca987d46SWarner Losh then 103*ca987d46SWarner Losh until 104*ca987d46SWarner Losh 105*ca987d46SWarner Losh \ if we were throwing up dots, throw up a line-break 106*ca987d46SWarner Losh delay_showdots @ if 107*ca987d46SWarner Losh cr 108*ca987d46SWarner Losh then 109*ca987d46SWarner Losh 110*ca987d46SWarner Losh \ did the user press either Ctrl-C or Escape? 111*ca987d46SWarner Losh delay_cancelled @ if 112*ca987d46SWarner Losh 2drop \ we don't need the command string anymore 113*ca987d46SWarner Losh else 114*ca987d46SWarner Losh evaluate \ evaluate/execute the command string 115*ca987d46SWarner Losh then 116*ca987d46SWarner Losh; 117*ca987d46SWarner Losh 118*ca987d46SWarner Loshonly forth definitions 119