14a5d661aSToomas Soome\ Copyright (c) 2008-2015 Devin Teske <dteske@FreeBSD.org> 24a5d661aSToomas Soome\ All rights reserved. 34a5d661aSToomas Soome\ 44a5d661aSToomas Soome\ Redistribution and use in source and binary forms, with or without 54a5d661aSToomas Soome\ modification, are permitted provided that the following conditions 64a5d661aSToomas Soome\ are met: 74a5d661aSToomas Soome\ 1. Redistributions of source code must retain the above copyright 84a5d661aSToomas Soome\ notice, this list of conditions and the following disclaimer. 94a5d661aSToomas Soome\ 2. Redistributions in binary form must reproduce the above copyright 104a5d661aSToomas Soome\ notice, this list of conditions and the following disclaimer in the 114a5d661aSToomas Soome\ documentation and/or other materials provided with the distribution. 124a5d661aSToomas Soome\ 134a5d661aSToomas Soome\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND 144a5d661aSToomas Soome\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 154a5d661aSToomas Soome\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 164a5d661aSToomas Soome\ ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE 174a5d661aSToomas Soome\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 184a5d661aSToomas Soome\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 194a5d661aSToomas Soome\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 204a5d661aSToomas Soome\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 214a5d661aSToomas Soome\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 224a5d661aSToomas Soome\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 234a5d661aSToomas Soome\ SUCH DAMAGE. 244a5d661aSToomas Soome\ 254a5d661aSToomas Soome\ $FreeBSD$ 264a5d661aSToomas Soome 274a5d661aSToomas Soomemarker task-delay.4th 284a5d661aSToomas Soome 294a5d661aSToomas Soomevocabulary delay-processing 304a5d661aSToomas Soomeonly forth also delay-processing definitions 314a5d661aSToomas Soome 324a5d661aSToomas Soome2 constant delay_default \ Default delay (in seconds) 334a5d661aSToomas Soome3 constant etx_key \ End-of-Text character produced by Ctrl+C 344a5d661aSToomas Soome13 constant enter_key \ Carriage-Return character produce by ENTER 354a5d661aSToomas Soome27 constant esc_key \ Escape character produced by ESC or Ctrl+[ 364a5d661aSToomas Soome 374a5d661aSToomas Soomevariable delay_tstart \ state variable used for delay timing 384a5d661aSToomas Soomevariable delay_delay \ determined configurable delay duration 394a5d661aSToomas Soomevariable delay_cancelled \ state variable for user cancellation 404a5d661aSToomas Soomevariable delay_showdots \ whether continually print dots while waiting 414a5d661aSToomas Soome 424a5d661aSToomas Soomeonly forth definitions also delay-processing 434a5d661aSToomas Soome 444a5d661aSToomas Soome: delay_execute ( -- ) 454a5d661aSToomas Soome 464a5d661aSToomas Soome \ make sure that we have a command to execute 474a5d661aSToomas Soome s" delay_command" getenv dup -1 = if 484a5d661aSToomas Soome drop exit 494a5d661aSToomas Soome then 504a5d661aSToomas Soome 514a5d661aSToomas Soome \ read custom time-duration (if set) 524a5d661aSToomas Soome s" loader_delay" getenv dup -1 = if 534a5d661aSToomas Soome drop \ no custom duration (remove dup'd bunk -1) 544a5d661aSToomas Soome delay_default \ use default setting (replacing bunk -1) 554a5d661aSToomas Soome else 564a5d661aSToomas Soome \ make sure custom duration is a number 574a5d661aSToomas Soome ?number 0= if 584a5d661aSToomas Soome delay_default \ use default if otherwise 594a5d661aSToomas Soome then 604a5d661aSToomas Soome then 614a5d661aSToomas Soome 624a5d661aSToomas Soome \ initialize state variables 634a5d661aSToomas Soome delay_delay ! \ stored value is on the stack from above 644a5d661aSToomas Soome seconds delay_tstart ! \ store the time we started 654a5d661aSToomas Soome 0 delay_cancelled ! \ boolean flag indicating user-cancelled event 664a5d661aSToomas Soome 674a5d661aSToomas Soome false delay_showdots ! \ reset to zero and read from environment 684a5d661aSToomas Soome s" delay_showdots" getenv dup -1 <> if 69*57164215SToomas Soome 2drop \ don't need the value, just existence 704a5d661aSToomas Soome true delay_showdots ! 714a5d661aSToomas Soome else 724a5d661aSToomas Soome drop 734a5d661aSToomas Soome then 744a5d661aSToomas Soome 754a5d661aSToomas Soome \ Loop until we have exceeded the desired time duration 764a5d661aSToomas Soome begin 774a5d661aSToomas Soome 25 ms \ sleep for 25 milliseconds (40 iterations/sec) 784a5d661aSToomas Soome 794a5d661aSToomas Soome \ throw some dots up on the screen if desired 804a5d661aSToomas Soome delay_showdots @ if 814a5d661aSToomas Soome ." ." \ dots visually aid in the perception of time 824a5d661aSToomas Soome then 834a5d661aSToomas Soome 844a5d661aSToomas Soome \ was a key depressed? 854a5d661aSToomas Soome key? if 864a5d661aSToomas Soome key \ obtain ASCII value for keystroke 874a5d661aSToomas Soome dup enter_key = if 884a5d661aSToomas Soome -1 delay_delay ! \ break loop 894a5d661aSToomas Soome then 904a5d661aSToomas Soome dup etx_key = swap esc_key = OR if 914a5d661aSToomas Soome -1 delay_delay ! \ break loop 924a5d661aSToomas Soome -1 delay_cancelled ! \ set cancelled flag 934a5d661aSToomas Soome then 944a5d661aSToomas Soome then 954a5d661aSToomas Soome 964a5d661aSToomas Soome \ if the time duration is set to zero, loop forever 974a5d661aSToomas Soome \ waiting for either ENTER or Ctrl-C/Escape to be pressed 984a5d661aSToomas Soome delay_delay @ 0> if 994a5d661aSToomas Soome \ calculate elapsed time 1004a5d661aSToomas Soome seconds delay_tstart @ - delay_delay @ > 1014a5d661aSToomas Soome else 1024a5d661aSToomas Soome -1 \ break loop 1034a5d661aSToomas Soome then 1044a5d661aSToomas Soome until 1054a5d661aSToomas Soome 1064a5d661aSToomas Soome \ if we were throwing up dots, throw up a line-break 1074a5d661aSToomas Soome delay_showdots @ if 1084a5d661aSToomas Soome cr 1094a5d661aSToomas Soome then 1104a5d661aSToomas Soome 1114a5d661aSToomas Soome \ did the user press either Ctrl-C or Escape? 1124a5d661aSToomas Soome delay_cancelled @ if 1134a5d661aSToomas Soome 2drop \ we don't need the command string anymore 1144a5d661aSToomas Soome else 1154a5d661aSToomas Soome evaluate \ evaluate/execute the command string 1164a5d661aSToomas Soome then 1174a5d661aSToomas Soome; 1184a5d661aSToomas Soome 1194a5d661aSToomas Soomeonly forth definitions 120