delay.4th revision 298831
1280937Sdteske\ Copyright (c) 2008-2015 Devin Teske <dteske@FreeBSD.org> 2222417Sjulian\ All rights reserved. 3222417Sjulian\ 4222417Sjulian\ Redistribution and use in source and binary forms, with or without 5222417Sjulian\ modification, are permitted provided that the following conditions 6222417Sjulian\ are met: 7222417Sjulian\ 1. Redistributions of source code must retain the above copyright 8222417Sjulian\ notice, this list of conditions and the following disclaimer. 9222417Sjulian\ 2. Redistributions in binary form must reproduce the above copyright 10222417Sjulian\ notice, this list of conditions and the following disclaimer in the 11222417Sjulian\ documentation and/or other materials provided with the distribution. 12222417Sjulian\ 13222417Sjulian\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 14222417Sjulian\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 15222417Sjulian\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 16222417Sjulian\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 17222417Sjulian\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18222417Sjulian\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 19222417Sjulian\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 20222417Sjulian\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 21222417Sjulian\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 22222417Sjulian\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 23222417Sjulian\ SUCH DAMAGE. 24222417Sjulian\ 25222417Sjulian\ $FreeBSD: head/sys/boot/forth/delay.4th 298831 2016-04-30 02:47:41Z pfg $ 26222417Sjulian 27222417Sjulianmarker task-delay.4th 28222417Sjulian 29280937Sdteskevocabulary delay-processing 30280937Sdteskeonly forth also delay-processing definitions 31280937Sdteske 32222417Sjulian2 constant delay_default \ Default delay (in seconds) 33222417Sjulian3 constant etx_key \ End-of-Text character produced by Ctrl+C 34222417Sjulian13 constant enter_key \ Carriage-Return character produce by ENTER 35222417Sjulian27 constant esc_key \ Escape character produced by ESC or Ctrl+[ 36222417Sjulian 37222417Sjulianvariable delay_tstart \ state variable used for delay timing 38222417Sjulianvariable delay_delay \ determined configurable delay duration 39222417Sjulianvariable delay_cancelled \ state variable for user cancellation 40222417Sjulianvariable delay_showdots \ whether continually print dots while waiting 41222417Sjulian 42280937Sdteskeonly forth definitions also delay-processing 43280937Sdteske 44222417Sjulian: delay_execute ( -- ) 45222417Sjulian 46222417Sjulian \ make sure that we have a command to execute 47222417Sjulian s" delay_command" getenv dup -1 = if 48222417Sjulian drop exit 49222417Sjulian then 50222417Sjulian 51222417Sjulian \ read custom time-duration (if set) 52222417Sjulian s" loader_delay" getenv dup -1 = if 53222417Sjulian drop \ no custom duration (remove dup'd bunk -1) 54222417Sjulian delay_default \ use default setting (replacing bunk -1) 55222417Sjulian else 56222417Sjulian \ make sure custom duration is a number 57222417Sjulian ?number 0= if 58222417Sjulian delay_default \ use default if otherwise 59222417Sjulian then 60222417Sjulian then 61222417Sjulian 62222417Sjulian \ initialize state variables 63222417Sjulian delay_delay ! \ stored value is on the stack from above 64222417Sjulian seconds delay_tstart ! \ store the time we started 65222417Sjulian 0 delay_cancelled ! \ boolean flag indicating user-cancelled event 66222417Sjulian 67222417Sjulian false delay_showdots ! \ reset to zero and read from environment 68222417Sjulian s" delay_showdots" getenv dup -1 <> if 69298831Spfg 2drop \ don't need the value, just existence 70222417Sjulian true delay_showdots ! 71222417Sjulian else 72222417Sjulian drop 73222417Sjulian then 74222417Sjulian 75222417Sjulian \ Loop until we have exceeded the desired time duration 76222417Sjulian begin 77222417Sjulian 25 ms \ sleep for 25 milliseconds (40 iterations/sec) 78222417Sjulian 79222417Sjulian \ throw some dots up on the screen if desired 80222417Sjulian delay_showdots @ if 81222417Sjulian ." ." \ dots visually aid in the perception of time 82222417Sjulian then 83222417Sjulian 84222417Sjulian \ was a key depressed? 85222417Sjulian key? if 86222417Sjulian key \ obtain ASCII value for keystroke 87222417Sjulian dup enter_key = if 88222417Sjulian -1 delay_delay ! \ break loop 89222417Sjulian then 90222417Sjulian dup etx_key = swap esc_key = OR if 91222417Sjulian -1 delay_delay ! \ break loop 92222417Sjulian -1 delay_cancelled ! \ set cancelled flag 93222417Sjulian then 94222417Sjulian then 95222417Sjulian 96222417Sjulian \ if the time duration is set to zero, loop forever 97222417Sjulian \ waiting for either ENTER or Ctrl-C/Escape to be pressed 98222417Sjulian delay_delay @ 0> if 99222417Sjulian \ calculate elapsed time 100222417Sjulian seconds delay_tstart @ - delay_delay @ > 101222417Sjulian else 102222417Sjulian -1 \ break loop 103222417Sjulian then 104222417Sjulian until 105222417Sjulian 106222417Sjulian \ if we were throwing up dots, throw up a line-break 107222417Sjulian delay_showdots @ if 108222417Sjulian cr 109222417Sjulian then 110222417Sjulian 111222417Sjulian \ did the user press either Ctrl-C or Escape? 112222417Sjulian delay_cancelled @ if 113222417Sjulian 2drop \ we don't need the command string anymore 114222417Sjulian else 115222417Sjulian evaluate \ evaluate/execute the command string 116222417Sjulian then 117222417Sjulian; 118280937Sdteske 119280937Sdteskeonly forth definitions 120