require'dll convert'

NB. --- Serial port I/O API cover functions. Works in Win 95 only.
NB. --- for questions or comments, e-mail to Infodev@compuserve.com

NB. ---------------------------------------------------------
NB. --- 32 bit scalar integers.
NB. ---------------------------------------------------------

Scalar=: ''&$

Type=: 3!:0

FALSE=: NULL=: ZERO=: 0+0 NB. --- generates 32 bit integer results.
NB. ---------------------------------------------------------
NB. --- High performance for millisecond timings and waits.
NB. --- Used when controlling timing sensitive external equipment.
NB. --- Not used in normal telecommunications.
NB. ---------------------------------------------------------

QueryPerformanceCounter=: 3 : 0
NB. --- the system's highest resolution clock.
(2^32)#.|.>1{'kernel32 QueryPerformanceCounter i *i' cd <2#ZERO
)

QueryPerformanceFrequency=: 3 : 0
NB. --- how many tics per second?
(2^32)#.|.>1{'kernel32 QueryPerformanceFrequency i *i' cd <2#ZERO
)

Waitm=: 3 : 0
NB. --- Waitm some
NB. --- Waits some milliseconds. Ctrl-Break will interrupt.
TicsNow=. QueryPerformanceCounter''
TicsThen=. TicsNow+y.*<.0.001*QueryPerformanceFrequency''
while. TicsThen>QueryPerformanceCounter'' do. 1 end.
empty''
)



NB. ---------------------------------------------------------
NB. --- Opening and Closing
NB. ---------------------------------------------------------

9!:11 ] 16 NB. --- maximum display digits to clearly see some arguments and results.


Bits=: 4 : 0
y.-(2^x.)*y.>:2^<:x.
)

GENERIC_READ=: <. 32 Bits dfh'80000000'

GENERIC_WRITE=: <. dfh'40000000'

OPEN_EXISTING=: 3


LogState=: 0 NB. --- used to turn on and off optional logging of telecom I/O

OpenComm=: 3 : 0
NB. --- OpenComm 'COM1' returns and creates handle of Comm port hComm.
NB. --- optional left arg is inbuf size, outbuf size.
32768 4096 OpenComm y.
:

b=. y.;(GENERIC_READ+GENERIC_WRITE);ZERO;NULL;OPEN_EXISTING;ZERO;NULL
hComm=. >0{'kernel32 CreateFileA i *c i i i i i i' cd b
if. _1=hComm do. _1 return. end. NB. --- exit now if it didn't work.
hComm=. >1{'kernel32 SetupComm i i i i' cd hComm;<"0 ]2$x. NB. --- set up buffers.
if. LogState do. LogFile=: LogDir,PATHSEP_j_,LogDir NewName (UniqueFileName 0),'.log' end.
hComm
)

CloseComm=: 3 : 0
NB. --- returns success/failure as 0 or 1
CloseHandle y.
)



CloseHandle=: 3 : 0
>0{'kernel32 CloseHandle i i' cd <Scalar y.
)

UniqueFileName=: 3 : 0
NB. --- UniqueFileName LoggerNumber returns possible unique file name in Directory.
NB. --- Make your own formula for file names here.
Time=. (6!:0)''
x=. ":100#.10 100|0 2{Time
y=. (1{Time){'0123456789ABC'
z=. 0 2 4{,":10 10 10#:y.
({.x),y,(1 2{x),z,'0'
)

NewName=: 4 : 0
NB. --- Directory NewName FileName
NB. --- tests FileName's (8.3 format obligatory) existence in Directory
NB. --- changes last character if exists until found new file name.
NB. --- returns a valid new file name.

NewTrial=. LastTrial=. y.
i=. 0
while. 1 do.
  try. (1!:4) <x.,PATHSEP_j_,NewTrial catch. NewTrial return. end.
  LastTrial=. NewTrial
  NewTrial=. (7{.NewTrial),(":i=. >:i),_4{.NewTrial
end.
LastTrial
)



NB. ---------------------------------------------------------
NB. --- Setting Speed and Parity
NB. ---------------------------------------------------------

NB. --- build your own wrapper on the following.
NB. --- the full API statement would be:
NB. --- hComm SetCommState 'baud=9600 parity=n data=8 stop=1' BuildCommDCB GetCommState OpenComm 'Com2'

BuildComm=: 4 : 0
NB. --- '9600,n,8,1' BuildComm hComm
y. SetCommState x. BuildCommDCB GetCommState y.
)


GetCommState=: 3 : 0
NB. ... GetCommState OpenComm 'com1:'
>2{'kernel32 GetCommState i i *i' cd (Scalar y.);7#ZERO
)

BuildCommDCB=: 4 : 0
NB. ... 'baud=9600 parity=n data=8 stop=1' BuildCommDCB GetCommState OpenComm 'Com2'
>2{'kernel32 BuildCommDCBA i *c *i' cd x.;y.
)


SetCommState=: 4 : 0
NB. ... hComm SetCommState '9600,N,8,1'BuildCommDCB ...
>0{'kernel32 SetCommState i i *i' cd (Scalar x.);y.
)



NB. ---------------------------------------------------------
NB. --- Sensing and Purging I/O Buffers
NB. ---------------------------------------------------------

NB. --- refer to an API book for details of return codes.

cbInQue=: 3 : '(1;1){::ClearCommError y.' NB. --- number of characters unread in input buffer.

cbOutQue=: 3 : '(1;2){::ClearCommError y.' NB. --- number of characters unwritten from output buffer.

ClearCommError=: 3 : 0
NB. ... ClearCommError hComm
NB. ... returns (most recent error code) ; (status structure)

2 3{'kernel32 ClearCommError i i *i *i' cd (Scalar y.);(,ZERO);3#ZERO
)

PURGE_TXABORT=: 1  NB. Kill the pending/current writes to the comm port.
PURGE_RXABORT=: 2  NB. Kill the pending/current reads to the comm port.
PURGE_TXCLEAR=: 4  NB. Kill the transmit queue if there.
PURGE_RXCLEAR=: 8  NB. Kill the typeahead buffer if there.

PurgeComm=: 3 : 0
(PURGE_TXABORT+PURGE_RXABORT+PURGE_TXCLEAR+PURGE_RXCLEAR) PurgeComm y.
:
>0{'kernel32 PurgeComm i i i' cd (Scalar y.) ; Scalar x.
)

NB. ---------------------------------------------------------
NB. --- Writing and Reading
NB. ---------------------------------------------------------

WriteComm=: 4 : 0
NB. ... hComm WriteComm text
if. LogState do. y. (1!:3)<LogFile end.
>0{'kernel32 WriteFile i i *c i *i i' cd (Scalar x.) ;(,y.) ;(''$#,y.) ;(,ZERO) ;0
)

WriteCommCRLF=: 4 : 0
x. WriteComm y.,CRLF
)



ReadComm=: 4 : 0
NB. ...  max_length ReadComm hComm
NB. ...  returns buffer contents
NB. --- we suppose that 0<cbInQue y.
opt=. x.<.cbInQue y.
a=. 'kernel32 ReadFile i i *c i *i i' cd (Scalar y.) ;(opt$0{a.);(''$opt+0);(,ZERO);0
a=. (>4{a)$>2{a
if. LogState do. a (1!:3)<LogFile end.
a
)


NB. ---------------------------------------------------------
NB. --- a few utilities for testing port operation
NB. ---------------------------------------------------------

WriteAndRead=: 4 : 0
(0{x.) WriteCommCRLF y.
a=. SplitLines ReadCommTimeout x.
)

SplitLines=: 3 : 0
NB. ... create enclosed lines from a telecom response.
y=. (y.~:LF)#y.
y=. y,(CR~:({: :: (' '&,))y)#CR
<;._2 y
)


ReadCommTimeout=: 3 : 0
NB. --- read from port until nothing received for a certain time.
NB. --- ReadCommTimeout port,timeout_seconds
a=. '' [ m=. n=. 0

while. 1 do.
  whilst. *$b do. a=. a,b=. (<.0.5*InBufferLength) ReadComm {.y. end.
  if. ((m=$a)*.n=1) do. a return. end.
  d=. (6!:3) (n=. 1){y.
  m=. $a
end.
)

NB. ---------------------------------------------------------
NB. --- Higher level verbs
NB. ---------------------------------------------------------

NB. --- The following look a little complicated because WriteAndTest needs to test
NB. --- in two different situations. The device might respond with lines
NB. --- completed by CRLF or it might respond with a prompt ending with nothing.
NB. --- delay is in seconds, port is a handle.
NB. --- When starting this, initialise AcquiredBuffer=:''

WriteAndTest=: 4 : 0
NB.--- (delay [port]) WriteAndTest 'text to send';'what to look for'
NB.--- what to look for can be <'first string';'second';....
opt=. 2{.x.,hComm
'Delay Port'=. opt
Port WriteCommCRLF >0{y.
ExpectedPrompts=. >1{y.
Pulled=. ''

whilst. flag=1 do.
  flag=. >0{a=. opt Pull (CRLF ;<ExpectedPrompts)
  Pulled=. Pulled,<a=. CRLF-.~>1{a
  if. LogState do. AppendLog a end.
  b=. a Test ExpectedPrompts
  if. _1<b do. (b;Pulled) return. end.
end.
b;Pulled
)

Test=: 4 : 0
y=. boxopen y.
i=. 0
while. i<#y do.
  if. 1 e.(>i{y)E. opt do. i return. end.
  i=. >:i
end.
_1
)

Pull=: 4 : 0
NB. --- (Delay,Port) Pull (CRLF;ExpectedPrompts) get a line terminated by CRLF
NB. --- or test with ExpectedPrompts if nothing coming in. Max Delay to assure no further response.
Port=. >1{x.
'EndLine ExpectedPrompts'=. y.

label_try.

if. 0<#AcquiredBuffer do.
  if. 1 e. a=. EndLine E. AcquiredBuffer do.
    a=. (a i. 1){.AcquiredBuffer
    AcquiredBuffer=: (#a,EndLine)}.AcquiredBuffer
    1;a
    return.
  end.
end.

if. 0<L=. cbInQue hComm do.
  AcquiredBuffer=: AcquiredBuffer,L ReadComm Port
  goto_try.
end.

if. _1<AcquiredBuffer Test ExpectedPrompts do.
  a=. AcquiredBuffer
  AcquiredBuffer=: ''
  1;a
  return.
end.

Delay=. >0{x.
while. 0<Delay do.
  if. 0=L=. cbInQue hComm do.
    6!:3]1
    Delay=. <:Delay
  else.
    AcquiredBuffer=: AcquiredBuffer,L ReadComm Port
    goto_try.
  end.
end.
a=. AcquiredBuffer
AcquiredBuffer=: ''
0;a
)
