
{   15-Nov-2006
    Joe Viola
    jov@mountain.net

This applet handles all IR data transfer to/from the palm running OS5.
Call the applet from izibasic using the format:  R$=CALLPP(100,S$).

    To open the ir port for raw data transfer:
        S$="open,raw,baudrate"  R$ returns a 2 digit error code.
    To open the ir port for ircomm protocol transfers:
        S$="open,ircomm,baudrate"   R$ returns a 2 digit error code.

    To close the ir port:
        S$="close"  R$ returns a 2 digit error code.

    To write to the ir port:
        S$="write,stringtosend,timeoutinticks" R$ returns a 2 digit error code.
        Timeoutinticks need only be sent once. Subsequent writes will default
        to that value.

    To read the ir port:
        S$="read,numchars,timeoutinticks"   R$ returns the chars received.

    To read the last port error code:
        S$="error"  R$ returns the last 2 digit error code. This is used after
        a read op since read does not return an error code.
        
    Error code values are those returned by the palm serial manager api with the
    addition of code=-1 indicating illegal op request. See Palm OS Reference.}

{$code appl,JVxx,code,100}      //required by izibasic
program irtransfer;

{$i PalmAPI.pas}
type 
    iBasFunType=function(S:string):string;  //required by izibasic

// Global variables
var 
    iBasCallPP:iBasFunType; //required by izibasic
    port,baud:uint32;
    portid,irerror:uint16;

//Other required api calls.
function SrmOpen(port:uint32;baud:uint32;var id:uint16):err;inline($7400+1,SYSTRAP,$A367);
function SrmClose (Id:uint16):err;inline($7400+3,SYSTRAP,$A367);
function SrmSend(Id:uint16;const s:string;c:uint32;var e:err):uint32;inline($7400+11,SYSTRAP,$A367);
function SrmControl (id:UInt16;op:UInt16;var v:int32;var vlen:uint16):err;inline($7400+10,SYSTRAP,$A367);
function SrmReceiveFlush(id:uint16;t:uint32):err;inline($7400+18,SYSTRAP,$A367);
function SrmSendFlush(id:uint16):err;inline($7400+14,SYSTRAP,$A367);
function SrmReceive(id:UInt16;var s:string;c:uint32;t:uint32;var e:err):uint32;inline($7400+15,SYSTRAP,$A367);
function SrmSendWait(Id:uint16):err;inline($7400+12,SYSTRAP,$A367);
function SrmSendCheck(id:uint16;var n:uint32):err;inline($7400+13,SYSTRAP,$A367);

function StrLen(const str:string):uint16;inline(SYSTRAP,$A0C7);

function CallPP(S:string):string;
type
    typeparm=array[1..4] of string;
    typeop=(open,read,write,close,error,invalidop);
    typeirtransfer=(raw,ircomm,invalidtransfer);
var
    len,index,parmindex:uint16;
    pstr:typeparm;
    s1,s2,s3:string;
    irop:typeop;
    irtransfertype:typeirtransfer;
    varsize:uint16;
    irtimeout,numbytes,n:int32;
    i:uint32;
    
begin

{Search thru s to get string parameters passed to applet. The parms are 
delimited with commas and then stored in string array pstr[1..4]. A maximum of 
4 parms are allowed. Extras are ignored.}
    s1:='';
    pstr[1]:='';pstr[2]:='';pstr[3]:='';pstr[4]:='';
    parmindex:=1;index:=1;
    len:=strlen(s);
    while index<=len do 
        begin
            if (s[index]=',')
            then 
                begin
                pstr[parmindex]:=s1;    //save parm if comma found
                parmindex:=parmindex+1;
                s1:=''
                end
            else 
                begin
                s1:=s1+s[index];        //else, keep building new parm string
                if index=len
                then
                    begin
                    pstr[parmindex]:=s1;    //also, save parm if last char
                    parmindex:=parmindex+1
                    end;           
            end;
        if parmindex>4 then index:=len;     //quit if 4 parms are received        
        index:=index+1    
        end;

{Convert requested operation in pstr[1] to ordinal for the following case 
statement. Request is NOT case sensitive.}
    irop:=invalidop;  //invalid request if pstr[1] = none of the below
    if strcaselesscompare(pstr[1],'open')=0 then irop:=open;
    if strcaselesscompare(pstr[1],'read')=0 then irop:=read;
    if strcaselesscompare(pstr[1],'write')=0 then irop:=write;
    if strcaselesscompare(pstr[1],'close')=0 then irop:=close;
    if strcaselesscompare(pstr[1],'error')=0 then irop:=error;

{Initialize port to raw ir or ircomm, depending on pstr[2].} 
    if strcaselesscompare(pstr[2],'raw')=0 then port:=$8001;
    if strcaselesscompare(pstr[2],'ircomm')=0 then port:=$6972636d; //'ircm'

{Ready to execute the requested ir operation.}
    case irop of

{Open the ir port. pstr[2] determines if it is either a raw data port or an 
ircomm port. Returns a 2 digit error code}
    open: 
        begin
        if strcaselesscompare(pstr[2],'raw')=0 then port:=$8001;
        if strcaselesscompare(pstr[2],'ircomm')=0 then port:=$6972636d; //'ircm'
        baud:=stratoi(pstr[3]);
        irerror:=srmopen(port,baud,index);
        if irerror=0 then portid:=index;    //valid portid if no open error
        if (irerror=0) and (port=$8001)     // if raw port, must turn on ir
        then
            begin
            irerror:=srmcontrol(portid,11,n,varsize); //enable ir
            if irerror=0 then irerror:=srmcontrol(portid,13,n,varsize)
            end;
        if irerror=0    //proceed to flush send port if no pending error
        then
            begin
            irerror:=srmsendflush(portid)
            end;        
        if irerror=0    //proceed to flush receive port if no pending error
        then
            begin
            irerror:=srmreceiveflush(portid,100)
            end;
        stritoa(s1,irerror and $ff);
        callpp:=s1    
        end;   

{Reads the ir port. Returns the characters read. Must call error op to check 
receive error}    
    read:
        begin
        numbytes:=stratoi(pstr[2]);
        irtimeout:=stratoi(pstr[3]);
        n:=srmreceive(portid,s1,numbytes,irtimeout,irerror);
        s1[n+1]:=chr(0);    //terminate string
        callpp:=s1    
        end;
        
{Sends the string pstr[2] to the ir port. Returns a 2 digit error code.}
    write:
        begin           //check for ircomm timeout string
        if (port=$6972636d) and (strlen(pstr[3])<>0) 
        then
            begin                           //set timeout if necessary
            n:=stratoi(pstr[3]);
            varsize:=4;
            irerror:=srmcontrol(portid,5,n,varsize)
            end;               
        irerror:=srmsendcheck(portid,i);
        if (i<>0) and (irerror=0) then      //if data still in buffer... 
            irerror:=srmsendwait(portid);   //...wait for line to clear
        if irerror=0 
        then
            begin
            numbytes:=strlen(pstr[2]);
            srmsend(portid,pstr[2],numbytes,irerror)
            end;
        stritoa(s1,irerror and $ff);
        callpp:=s1
        end;

{Close the ir port. Returns a 2 digit error code.}
    close: 
        begin
        irerror:=srmclose(portid);
        if irerror=0 then port:=0;  //indicate no port open
        stritoa(s1,irerror and $ff);
        callpp:=s1            
        end;

{Return read error or last error.}        
    error:
        begin
        if irerror=65535 then s1:='-1'
        else stritoa(s1,irerror and $ff);
        callpp:=s1            
        end;

{Handle invalid op requests here. Indicate with error=-1}
    else    
        begin
        irerror:=65535;
        callpp:='-1'
        end;
    end;   

end;


// Main. Required by izibasic
begin
 iBasCallPP:=CallPP;

end.
 
