/* * $Id$ */ /* * Harbour Project source code: * Telepathy emulation library * * Copyright 2000, 2001 Dan Levitt * Copyright 2004, 2005 Maurilio Longo * Copyright 2010 Viktor Szakats (harbour syenar.net) * www - http://harbour-project.org * * This program 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 2, 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 software; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). * * As a special exception, the Harbour Project gives permission for * additional uses of the text contained in its release of Harbour. * * The exception is that, if you link the Harbour libraries with other * files to produce an executable, this does not by itself cause the * resulting executable to be covered by the GNU General Public License. * Your use of that executable is in no way restricted on account of * linking the Harbour library code into it. * * This exception does not however invalidate any other reasons why * the executable file might be covered by the GNU General Public License. * * This exception applies only to the code released by the Harbour * Project under the name Harbour. If you copy code from other * Harbour Project or Free Software Foundation releases into a copy of * Harbour, as the General Public License permits, the exception does * not apply to the code that you add in this way. To avoid misleading * anyone as to the status of such modified files, you must delete * this exception notice from them. * * If you write modifications of your own for Harbour, it is your choice * whether to permit this exception to apply to your modifications. * If you do not wish that, delete this exception notice. * */ /* This is based upon a library originally made by Dan Levitt (see README and ChangeLog). The original files have been committed as v1.0, so you can always retrieve them (see CVS docs on how to) */ #include "telepath.ch" #include "hbcom.ch" #define TPFP_NAME 1 /* Structure of ports array */ #define TPFP_HANDLE 2 #define TPFP_BAUD 3 #define TPFP_DBITS 4 #define TPFP_PARITY 5 #define TPFP_SBITS 6 #define TPFP_OC 7 /* Open/Close Flag */ #define TPFP_INBUF 8 #define TPFP_INBUF_SIZE 9 /* Size of input buffer */ THREAD STATIC t_aPorts // Array with port info THREAD STATIC t_nErrorCode := 0 // Error code from last operation, 0 if no error FUNCTION tp_baud( nPort, nNewBaud ) hb_default( @nNewBaud, 0 ) IF ! isport( nPort ) .OR. Empty( t_aPorts[ nPort, TPFP_NAME ] ) RETURN TE_NOPORT ENDIF IF ! isopenport( nPort ) RETURN 0 ENDIF IF nNewBaud > 0 IF hb_comInit( t_aPorts[ nPort, TPFP_HANDLE ], nNewBaud, t_aPorts[ nPort, TPFP_PARITY ], t_aPorts[ nPort, TPFP_DBITS ], t_aPorts[ nPort, TPFP_SBITS ] ) t_aPorts[ nPort, TPFP_BAUD ] := nNewBaud ELSE // set error code ENDIF ENDIF RETURN t_aPorts[ nPort, TPFP_BAUD ] FUNCTION tp_inkey( ... ) RETURN inkey( ... ) FUNCTION tp_idle( lNewval ) IF lNewval == .T. RETURN .T. ENDIF RETURN .F. PROCEDURE tp_delay( nTime ) hb_default( @nTime, 0 ) IF nTime < 0 RETURN ELSEIF nTime > 1800 nTime := 1800 ENDIF hb_idleSleep( nTime ) RETURN FUNCTION tp_close( nPort, nTimeout ) hb_default( @nTimeout, 0 ) /* Clipper returns 0 even if a port is not open */ IF ! isopenport( nPort ) RETURN 0 ENDIF IF nTimeout > 0 tp_flush( nPort, nTimeout ) ENDIF IF t_aPorts[ nPort, TPFP_HANDLE ] >= 0 hb_comClose( t_aPorts[ nPort, TPFP_HANDLE ] ) /* Port parameters should stay the same for the case the port gets reopened */ t_aPorts[ nPort, TPFP_OC ] := .F. t_aPorts[ nPort, TPFP_INBUF ] := "" t_aPorts[ nPort, TPFP_HANDLE ] := -1 ENDIF RETURN 0 FUNCTION tp_reopen( nPort, nInSize, nOutSize ) LOCAL nBaud, nData, cParity, nStop, cPortName IF ! isport( nPort ) .OR. Empty( t_aPorts[ nPort, TPFP_NAME ] ) RETURN TE_NOPORT ENDIF cPortname := t_aPorts[ nPort, TPFP_NAME ] nBaud := t_aPorts[ nPort, TPFP_BAUD ] nData := t_aPorts[ nPort, TPFP_DBITS ] cParity := t_aPorts[ nPort, TPFP_PARITY ] nStop := t_aPorts[ nPort, TPFP_SBITS ] RETURN tp_open( nPort, nInSize, nOutSize, nBaud, nData, cParity, nStop, cPortName ) FUNCTION tp_open( nPort, nInSize, nOutSize, nBaud, nData, cParity, nStop, cPortname ) IF ! isport( nPort ) RETURN TE_NOPORT ENDIF hb_default( @nInSize, 1536 ) hb_default( @nOutSize, 1536 ) hb_default( @nBaud, 1200 ) hb_default( @nData, 8 ) hb_default( @cParity, "N" ) hb_default( @nStop, 1 ) IF HB_ISSTRING( cPortname ) hb_comSetDevice( nPort, cPortname ) ENDIF t_aPorts[ nPort, TPFP_NAME ] := cPortname t_aPorts[ nPort, TPFP_BAUD ] := nBaud t_aPorts[ nPort, TPFP_DBITS ] := nData t_aPorts[ nPort, TPFP_PARITY ] := cParity t_aPorts[ nPort, TPFP_SBITS ] := nStop t_aPorts[ nPort, TPFP_OC ] := .F. t_aPorts[ nPort, TPFP_INBUF ] := "" t_aPorts[ nPort, TPFP_INBUF_SIZE ] := nInSize t_aPorts[ nPort, TPFP_HANDLE ] := -1 IF hb_comOpen( nPort ) t_aPorts[ nPort, TPFP_HANDLE ] := nPort IF hb_comInit( t_aPorts[ nPort, TPFP_HANDLE ], t_aPorts[ nPort, TPFP_BAUD ], t_aPorts[ nPort, TPFP_PARITY ], t_aPorts[ nPort, TPFP_DBITS ], t_aPorts[ nPort, TPFP_SBITS ] ) t_aPorts[ nPort, TPFP_OC ] := .T. RETURN 0 ELSE tp_Close( t_aPorts[ nPort, TPFP_HANDLE ] ) RETURN TE_PARAM ENDIF ENDIF t_aPorts[ nPort, TPFP_NAME ] := "" t_aPorts[ nPort, TPFP_HANDLE ] := -1 t_aPorts[ nPort, TPFP_BAUD ] := 1200 t_aPorts[ nPort, TPFP_DBITS ] := 8 t_aPorts[ nPort, TPFP_PARITY ] := "N" t_aPorts[ nPort, TPFP_SBITS ] := 1 t_aPorts[ nPort, TPFP_OC ] := .F. t_aPorts[ nPort, TPFP_INBUF ] := "" t_aPorts[ nPort, TPFP_INBUF_SIZE ] := 0 RETURN TE_CONFL /* maybe should return something different? */ FUNCTION tp_recv( nPort, nLength, nTimeout ) LOCAL nDone LOCAL cRet IF ! HB_ISNUMERIC( nLength ) nLength := t_aPorts[ nPort, TPFP_INBUF_SIZE ] ENDIF hb_default( @nTimeout, 0 ) FetchChars( nPort ) nDone := Seconds() + iif( nTimeout >= 0, nTimeout, 0 ) DO WHILE Len( t_aPorts[ nPort, TPFP_INBUF ] ) < nLength .AND.; ( nTimeout < 0 .OR. Seconds() < nDone ) IF ! tp_idle() FetchChars( nPort ) ELSE EXIT ENDIF ENDDO IF nLength > Len( t_aPorts[ nPort, TPFP_INBUF ] ) cRet := t_aPorts[ nPort, TPFP_INBUF ] t_aPorts[ nPort, TPFP_INBUF ] := "" ELSE cRet := SubStr( t_aPorts[ nPort, TPFP_INBUF ], 1, nLength ) t_aPorts[ nPort, TPFP_INBUF ] := SubStr( t_aPorts[ nPort, TPFP_INBUF ], nLength + 1 ) ENDIF RETURN cRet FUNCTION tp_send( nPort, cString, nTimeout ) hb_default( @cString, "" ) hb_default( @nTimeout, 0 ) IF ! isopenport( nPort ) RETURN 0 ENDIF IF Len( cString ) == 0 RETURN 0 ENDIF RETURN hb_comSend( t_aPorts[ nPort, TPFP_HANDLE ], cString,, nTimeout ) FUNCTION tp_sendsub( nPort, cString, nStart, nLength, nTimeout ) hb_default( @nStart, 1 ) IF ! HB_ISNUMERIC( nLength ) nLength := Len( cString ) ENDIF RETURN tp_send( nPort, SubStr( cString, nStart, nLength ), nTimeout ) FUNCTION tp_recvto( nPort, cDelim, nMaxlen, nTimeout ) LOCAL cChar LOCAL nAt LOCAL nStartPos := 1, nFirst := 0 LOCAL nDone, cRet := "" IF ! isopenport( nPort ) RETURN "" ENDIF IF ! HB_ISSTRING( cDelim ) .OR. Len( cDelim ) == 0 RETURN "" ENDIF hb_default( @nMaxLen, 64999 ) /* dos telepathy def. on xharbour could be higher */ hb_default( @nTimeout, 0 ) FetchChars( nPort ) /* Telepathy ng: [...] If nTimeout is omitted or zero, reads until finding the delimiter or the input buffer is empty. */ IF nTimeout == 0 .AND. Len( t_aPorts[ nPort, TPFP_INBUF ] ) == 0 RETURN "" ENDIF nDone := Seconds() + iif( nTimeout >= 0, nTimeout, 0 ) DO WHILE ( nTimeout < 0 .OR. Seconds() < nDone ) IF Len( cDelim ) == 1 nAt := hb_At( cDelim, t_aPorts[ nPort, TPFP_INBUF ], nStartPos ) IF nAt > 0 .AND. iif( nFirst > 0, nAt < nFirst, .T. ) nFirst := nAt ENDIF ELSE FOR EACH cChar IN cDelim nAt := hb_At( cChar, t_aPorts[ nPort, TPFP_INBUF ], nStartPos ) IF nAt > 0 .AND. iif( nFirst > 0, nAt < nFirst, .T. ) nFirst := nAt ENDIF NEXT ENDIF // I've found it IF nFirst > 0 EXIT ELSE // Next loop I don't need to search that part of the input buffer that // I've already just searched for nStartPos := Max( Len( t_aPorts[ nPort, TPFP_INBUF ] ), 1 ) // I've read more characters than I'm allowed to, so I exit IF nStartPos >= nMaxLen EXIT ENDIF IF ! tp_idle() FetchChars( nPort ) ELSE EXIT ENDIF ENDIF ENDDO IF nFirst > 0 cRet := Left( t_aPorts[ nPort, TPFP_INBUF ], nFirst ) t_aPorts[ nPort, TPFP_INBUF ] := SubStr( t_aPorts[ nPort, TPFP_INBUF ], nFirst + 1 ) ENDIF RETURN cRet /* here's an improvement over original TP... you can "lookfor" a string here rather than just a char. yay me. of course, if you're using clipper/tp code and you search for a single char it will work the same. */ FUNCTION tp_lookfor( nPort, cLookfor ) IF ! isopenport( nPort ) RETURN 0 ENDIF FetchChars( nPort ) RETURN At( cLookfor, t_aPorts[ nPort, TPFP_INBUF ] ) FUNCTION tp_inchrs( nPort ) IF ! isopenport( nPort ) RETURN 0 ENDIF FetchChars( nPort ) RETURN Len( t_aPorts[ nPort, TPFP_INBUF ] ) FUNCTION tp_infree( nPort ) IF ! isopenport( nPort ) RETURN 0 ENDIF RETURN __tp_infree( t_aPorts[ nPort, TPFP_HANDLE ] ) FUNCTION tp_outfree( nPort ) IF ! isopenport( nPort ) RETURN 0 ENDIF RETURN __tp_outfree( t_aPorts[ nPort, TPFP_HANDLE ] ) PROCEDURE tp_clearin( nPort ) IF isopenport( nPort ) FetchChars( nPort ) t_aPorts[ nPort, TPFP_INBUF ] := "" ENDIF RETURN PROCEDURE tp_clrkbd() CLEAR TYPEAHEAD RETURN FUNCTION tp_crc16( cString ) RETURN hb_byteSwapW( hb_crcct( cString ) ) /* swap lo and hi bytes */ FUNCTION tp_crc32( cString ) RETURN hb_crc32( cString ) /* nPort, nTimeout, acList|cString..., lIgnorecase */ FUNCTION tp_waitfor( ... ) LOCAL aParam := hb_AParams() LOCAL nPort//, nTimeout, lIgnorecase nPort := aParam[ 1 ] // nTimeout := aParam[ 2 ] // lIgnorecase := aParam[ Len( aParam ) ] IF ! isopenport( nPort ) RETURN 0 ENDIF // hb_default( @nTimeout, -1 ) // hb_default( @lIgnorecase, .F. ) /* IF ntimeout < 0 nDone := _clock() + 999999 ELSEIF ntimeout == 0 nDone := 4 ELSE nDone := _clock() + nTimeout ENDIF DO WHILE ( nDone > _clock() .OR. nFirst == 100000 ) .AND. ! tp_idle() IF nFirst == 100000 nFirst := 99999 ENDIF FetchChars( nPort ) FOR x := 1 TO Len( acList ) IF lIgnorecase nAt := At( Upper( acList[ x ] ), Upper( t_aPorts[ nPort, TPFP_INBUF ] ) ) ELSE nAt := At( acList[ x ] , t_aPorts[ nPort, TPFP_INBUF ] ) ENDIF IF nAt > 0 .AND. nAt < nFirst nFirst := nAt nRet := x ENDIF NEXT IF nFirst < 64000 EXIT ENDIF #if 0 sched_yield() // C level function #endif ENDDO IF nFirst < 64000 tp_recv( nPort, nAt + Len( acList[ nRet ] )) RETURN nRet ENDIF */ RETURN 0 /* We cannot set, well, _I_ think we cannot, CTS without setting RTS flowcontrol, so this function and tp_ctrlrts() do the same thing, that is set/reset CRTSCTS flowcontol */ FUNCTION tp_ctrlcts( nPort, nNewCtrl ) LOCAL nCurValue LOCAL nFlag IF ! isopenport( nPort ) RETURN 0 ENDIF IF hb_comFlowControl( t_aPorts[ nPort, TPFP_HANDLE ], @nCurValue ) nFlag := hb_bitOr( HB_COM_FLOW_IRTSCTS, HB_COM_FLOW_ORTSCTS ) IF HB_ISNUMERIC( nNewCtrl ) IF nNewCtrl == 0 nNewCtrl := hb_bitAnd( nCurValue, hb_bitNot( nFlag ) ) ELSE nNewCtrl := hb_bitOr( nCurValue, nFlag ) ENDIF hb_comFlowControl( t_aPorts[ nPort, TPFP_HANDLE ], NIL, nNewCtrl ) ENDIF nCurValue := iif( hb_bitAnd( nCurValue, nFlag ) != 0, 1, 0 ) ENDIF RETURN nCurValue // Simply calls tp_ctrlcts() FUNCTION tp_ctrlrts( nPort, nNewCtrl ) RETURN tp_ctrlcts( nPort, nNewCtrl ) // telepathy says... // returns old dtr value 0,1,2 // sets to 0 = dtr off, 1 dtr on, 2 = dtr flow control autotoggle // I don't support 2. who uses dtr for flow control anyway... FUNCTION tp_ctrldtr( nPort, nNewCtrl ) LOCAL nCurValue LOCAL nFlag IF ! isopenport( nPort ) RETURN 0 ENDIF IF hb_comFlowControl( t_aPorts[ nPort, TPFP_HANDLE ], @nCurValue ) nFlag := hb_bitOr( HB_COM_FLOW_IDTRDSR, HB_COM_FLOW_ODTRDSR ) IF HB_ISNUMERIC( nNewCtrl ) IF nNewCtrl == 0 nNewCtrl := hb_bitAnd( nCurValue, hb_bitNot( nFlag ) ) ELSE nNewCtrl := hb_bitOr( nCurValue, nFlag ) ENDIF hb_comFlowControl( t_aPorts[ nPort, TPFP_HANDLE ], NIL, nNewCtrl ) ENDIF nCurValue := iif( hb_bitAnd( nCurValue, nFlag ) != 0, 1, 0 ) ENDIF RETURN nCurValue FUNCTION tp_isdcd( nPort ) LOCAL nValue IF ! isopenport( nPort ) RETURN .F. ENDIF hb_comMSR( nPort, @nValue ) RETURN hb_bitAnd( nValue, HB_COM_MSR_DCD ) != 0 FUNCTION tp_isri( nPort ) LOCAL nValue IF ! isopenport( nPort ) RETURN .F. ENDIF hb_comMSR( nPort, @nValue ) RETURN hb_bitAnd( nValue, HB_COM_MSR_RI ) != 0 FUNCTION tp_isdsr( nPort ) LOCAL nValue IF ! isopenport( nPort ) RETURN .F. ENDIF hb_comMSR( nPort, @nValue ) RETURN hb_bitAnd( nValue, HB_COM_MSR_DSR ) != 0 FUNCTION tp_iscts( nPort ) LOCAL nValue IF ! isopenport( nPort ) RETURN .F. ENDIF hb_comMSR( nPort, @nValue ) RETURN hb_bitAnd( nValue, HB_COM_MSR_CTS ) != 0 FUNCTION tp_flush( nPort, nTimeout ) LOCAL nDone hb_default( @nTimeout, -1 ) IF ! isopenport( nPort ) RETURN TE_CLOSED ENDIF IF nTimeout > 1800 nTimeout := 1800 ENDIF nDone := Seconds() + iif( nTimeout >= 0, nTimeout, 0 ) DO WHILE tp_OutFree( nPort ) > 0 .AND. ; ( nTimeout < 0 .OR. Seconds() < nDone ) hb_IdleState() ENDDO RETURN iif( tp_OutFree( nPort ) > 0, TE_TMOUT, 0 ) /* /// sorry, but ctrldsr and ctrlcts will act like isdsr and iscts... if you want /// flow control, talk to the system. FUNCTION tp_ctrldsr( nPort ) RETURN tp_isdsr( nPort ) /// you can't do these things. try rc.serial FUNCTION tp_shared RETURN 0 FUNCTION tp_setport RETURN 0 */ // internal (static) functions --------------------------------------------------- STATIC FUNCTION isopenport( nPort ) IF ! isport( nPort ) RETURN .F. ENDIF RETURN t_aPorts[ nPort, TPFP_OC ] STATIC FUNCTION isport( nPort ) IF ! HB_ISNUMERIC( nPort ) .OR. nPort < 1 .OR. nPort > TP_MAXPORTS RETURN .F. ENDIF RETURN .T. STATIC FUNCTION FetchChars( nPort ) LOCAL cStr IF ! isopenport( nPort ) RETURN 0 ENDIF cStr := Space( hb_comInputCount( t_aPorts[ nPort, TPFP_HANDLE ] ) ) hb_comRecv( t_aPorts[ nPort, TPFP_HANDLE ], @cStr ) t_aPorts[ nPort, TPFP_INBUF ] += cStr RETURN Len( cStr ) INIT PROCEDURE _tpinit() LOCAL x IF t_aPorts == NIL t_aPorts := Array( TP_MAXPORTS ) FOR x := 1 TO Len( t_aPorts ) /// port name, file handle, baud, data bits, parity, stop bits, Open?, input buffer, input buff.size t_aPorts[ x ] := { "", -1, 1200, 8, "N", 1, .F., "", 0 } NEXT ENDIF RETURN /* /// you can uncomment the following section for compatability with TP code... I figured /// you'd probably want them commented so it won't compile so that you would see where /// you have potential incomplete port problems ///FUNCTION tp_mstat /// RETURN "" /// ///FUNCTION tp_szmodem /// RETURN 0 /// ///FUNCTION tp_noteoff /// RETURN 0 /// ///FUNCTION tp_ontime /// RETURN 0 /// ///FUNCTION tp_rzmodem /// RETURN 0 /// ///FUNCTION tp_error /// RETURN 0 /// ///FUNCTION tp_errmsg /// RETURN "" /// ///FUNCTION tp_fifo /// RETURN 0 /// /// ///FUNCTION tp_outchrs /// RETURN 0 /// ///FUNCTION tp_keybd /// RETURN 0 /// /// tp_debug is not a real TP function. I included it so you can define your own debug /// output function. /// the point of the first parameter is a "debug level". I keep a system variable for how /// much debuggning output is wanted and if the tp_debug parameter is a LOWER number than /// the global debug level I print the message. Since I don't have your system globals, /// I will ignore the first parameter and always print it. /// I recommend you modify this function to suit your own debugging needs FUNCTION tp_debug( nDebugLevel, cString ) ? cString RETURN NIL */ PROCEDURE tp_uninstall() /* NOTE: dummy function, solely for compatibility. */ RETURN STATIC FUNCTION __TP_INFREE() RETURN -1 STATIC FUNCTION __TP_OUTFREE() RETURN -1 FUNCTION BIN_AND( ... ) RETURN HB_BITAND( ... ) FUNCTION BIN_OR( ... ) RETURN HB_BITOR( ... ) FUNCTION BIN_XOR( ... ) RETURN HB_BITXOR( ... ) FUNCTION BIN_NOT( ... ) RETURN HB_BITNOT( ... )