File:  [gforth] / gforth / kernel / saccept.fs
Revision 1.15: download - view: text, annotated - select for diffs
Mon Dec 31 18:40:26 2007 UTC (16 years, 3 months ago) by anton
Branches: MAIN
CVS tags: HEAD
updated copyright notices for GPL v3

    1: \ a very simple accept approach
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2006 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation, either version 3
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program. If not, see http://www.gnu.org/licenses/.
   19: 
   20: require ./io.fs
   21: 
   22: \ : xon $11 emit ;
   23: \ : xoff $13 emit ;
   24: 
   25: Variable eof
   26: Variable echo  -1 echo !
   27: 
   28: : accept ( adr len -- len )
   29:   ( xon ) over + over ( start end pnt )  eof off
   30:   BEGIN
   31:    key dup #del = IF drop #bs THEN
   32:    dup bl u<
   33:    IF
   34:        dup #cr = over #lf = or IF
   35: 	   echo @ IF  space  THEN  drop nip swap - ( xoff ) EXIT THEN
   36:        dup #eof = IF  eof on  THEN
   37:        #bs = IF 2 pick over <>
   38: 	   IF 1 chars -
   39: 	       echo @ IF  #bs emit bl emit #bs emit  THEN
   40: 	   ELSE  echo @ IF  bell  THEN  THEN  THEN
   41:    ELSE	>r 2dup <> IF r>
   42: 	   echo @ IF  dup emit  THEN
   43: 	   over c! char+ ELSE r> drop bell THEN
   44:    THEN 
   45:   AGAIN ;
   46:   

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>