Return to saccept.fs CVS log

Up to [gforth] / gforth / kernel-ec

Annotation of gforth/kernel-ec/saccept.fs, revision 1.1

1.1     ! pazsan      1: \ a very simple accept approach
        !             2: 
        !             3: \ Copyright (C) 1995,1996,1997,1998,1999,2000,2003,2006,2007,2010 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: 
        !            47: \ simple include for terminal.fs
        !            48: 
        !            49: : refill-loop ( -- )
        !            50:     BEGIN  3 emit refill  WHILE  interpret  REPEAT ;   
        !            51: : included ( addr u -- )
        !            52:     2 emit dup $20 + emit type
        !            53:     echo @ IF
        !            54:        echo off ['] refill-loop catch
        !            55:        dup IF  4 emit  THEN  echo on  throw
        !            56:     THEN ;
        !            57: : include ( "file" -- )  parse-name included ;