\ 
\ Last change: KS 18.07.2010 22:44:59
\ 
\ Terminal for R8C
\ Hacked by UHO 2009-02-15 to run under windows
\
\ Copyright (C) 2006,2007,2008 Free Software Foundation, Inc.
\
\ This file is part of Gforth.
\
\ Gforth is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation, either version 3
\ of the License, or (at your option) any later version.
\
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU General Public License for more details.
\
\ You should have received a copy of the GNU General Public License
\ along with this program. If not, see http://www.gnu.org/licenses/.

require lib.fs

\ Cygwin terminal adoption
library kernel32 kernel32

kernel32 GetCommState int ptr (int) GetCommState ( handle addr -- r )
kernel32 SetCommState int ptr (int) SetCommState ( handle addr -- r )
kernel32 CreateFile ptr int int ptr int int ptr (int) CreateFileA ( name access share security disp attr temp -- handle )
kernel32 WriteFile int ptr int ptr ptr (int) WriteFile ( handle data size &len &data -- flag )
kernel32 ReadFile int ptr int ptr ptr (int) ReadFile ( handle data size &len &data -- flag )
kernel32 SetCommTimeouts int ptr (int) SetCommTimeouts ( handle addr -- flag )
kernel32 GetCommTimeouts int ptr (int) GetCommTimeouts ( handle addr -- flag )
kernel32 CloseHandle int (int) CloseHandle ( handle -- flag )

	    
$80000000 Constant GENERIC_READ
$40000000 Constant GENERIC_WRITE
        3 Constant OPEN_EXISTING
	    
     4 4 2Constant int%
     2 2 2Constant word%
	    
struct
   int% field DCBlength
   int% field BaudRate
   int% field flags
  word% field wReserved
  word% field XonLim
  word% field XoffLim
  char% field ByteSize
  char% field Parity
  char% field StopBits
  char% field XonChar
  char% field XoffChar
  char% field ErrorChar
  char% field EofChar
  char% field EvtChar
  word% field wReserved1
end-struct DCB

struct
  int% field ReadIntervalTimeout
  int% field ReadTotalTimeoutMultiplier
  int% field ReadTotalTimeoutConstant
  int% field WriteTotalTimeoutMultiplier
  int% field WriteTotalTimeoutConstant
end-struct COMMTIMEOUTS

Create t_buf     DCB %allot drop
Create tout_buf  COMMTIMEOUTS %allot drop

0 Value term-fd
0 Value term

: open-port ( addr u -- )
   tuck pad swap move 0 swap pad + c!
   pad GENERIC_READ GENERIC_WRITE or 0 0 OPEN_EXISTING 0 0 CreateFile
   dup -1 = abort" serial port not available"
   to term-fd ;

: set-baud ( baud fd -- )  >r
   r@ tout_buf GetCommTimeouts drop

   $FFFFFFFF tout_buf ReadIntervalTimeout !
   0 tout_buf ReadTotalTimeoutMultiplier !
   0 tout_buf ReadTotalTimeoutConstant !
   0 tout_buf WriteTotalTimeoutMultiplier !
   0 tout_buf WriteTotalTimeoutConstant !
   r@ tout_buf SetCommTimeouts drop

   t_buf DCB %size erase
   DCB %size t_buf DCBlength !
   $1011 t_buf flags !          \
   t_buf BaudRate !             \ baud baudrate
   8 t_buf ByteSize c!
   \ 0 t_buf StopBits c!        \ 1 stop bit
   \ 0 t_buf Parity c!          \ no parity

   r> t_buf SetCommState drop ;

: reset-baud ( fd -- )  drop ;

Create emit-buf  0 c,
Variable term-len

: term-read ( -- addr u )
   term-fd pad &64 term-len 0 ReadFile drop
   pad term-len @ ;

Create read-buf  0 c,
Variable read-len
            
: term-key? ( -- flag )
   read-len @ IF  true  EXIT THEN
   term-fd read-buf 1 read-len  0 ReadFile drop
   read-len @ 0<> ;
            
: term-key ( -- char )
   BEGIN
\      key? IF key $1B = Abort" Break!" THEN
      term-key?
   UNTIL
   read-buf c@  0 read-len ! ;
                 
: (term-type) ( addr u -- )
   term-fd -rot term-len 0 WriteFile drop ;

: term-emit ( char -- )
   emit-buf c!  emit-buf 1 (term-type) ;
   
: term-flush ( -- ) ;

: close-port ( -- )  term-fd CloseHandle 0= abort" can not close serial port" ;

: COM_init  ( string -- )   open-port  &115200 term-fd set-baud ;

: Umbilical: ( <name> -- )   name COM_init ;

\ Umbilical: COM2