{*******************************************************}
{                                                       }
{       Turbo Pascal Version 7.0                        }
{       FOSSIL Support Unit                             }
{                                                       }
{       Copyright (c) 1994,95 by Solar Designer         }
{                                                       }
{*******************************************************}

unit Fossil;
{$G+}
interface
   uses
      Objects;

   type
      TBaudRate=
      (br19200, br38400, br300, br600, br1200, br2400, br4800, br9600);
      TWordLen=    5..8;
      TStopBits=   1..2;
      TParity=     (pcNone, pcOdd, pcEven);

      PFossilPort= ^TFossilPort;
      TFossilPort=
      object(TObject)

         PortNum             :Word;
         Initialized         :Boolean;

         constructor Init(APortNum               :Word);

         destructor  Done; virtual;

         procedure SetParams(Rate                :TBaudRate;
                             WordLen             :TWordLen;
                             StopBits            :TStopBits;
                             Parity              :TParity);

         procedure SendChar(c                    :Char);

         function  ReceiveChar                   :Char;

         function  PreviewChar                   :Char;

         function  GetStatus                     :Word;

         function  CharAvail                     :Boolean;

         function  CarrierDetect                 :Boolean;

         procedure SendString(const s            :String);

         procedure SendCommand(const Cmd         :String);

      end;

implementation

   constructor TFossilPort.Init;
   begin
      Inherited Init;
      asm
         les  di,Self
         mov  dx,APortNum
         mov  es:[di].PortNum,dx
         xor  bx,bx
         mov  ah,04h
         int  14h
         cmp  ax,1954h
         jne  @@1
         mov  es:[di].Initialized,1
@@1:
      end;
   end;

   destructor  TFossilPort.Done;
   var
      Timer        :Word absolute 0:$46C;
      LTimer       :Word;
   begin
      LTimer:=Timer;
      while CarrierDetect and (Timer>=LTimer) and (Timer-LTimer<4) do;

      asm
         les  di,Self
         mov  dx,es:[di].PortNum
         mov  ah,05h
         int  14h
         mov  es:[di].Initialized,0
      end;
      Inherited Done;
   end;

   procedure TFossilPort.SetParams;
   assembler;
   asm
      mov  al,Rate
      shl  al,5
      mov  cl,Parity
      cmp  cl,2
      jne  @@1
      inc  cx
@@1:
      shl  cl,3
      mov  bl,StopBits
      dec  bx
      shl  bl,2
      mov  dl,WordLen
      sub  dl,5

      or   al,cl
      or   al,bl
      or   al,dl

      les  di,Self
      mov  dx,es:[di].PortNum
      xor  ax,ax
      int  14h
   end;

   procedure TFossilPort.SendChar;
   assembler;
   asm
      les  di,Self
      mov  dx,es:[di].PortNum
      mov  al,c
      mov  ah,01h
      int  14h
   end;

   function  TFossilPort.ReceiveChar;
   assembler;
   asm
      les  di,Self
      mov  dx,es:[di].PortNum
      mov  ah,02h
      int  14h
   end;

   function  TFossilPort.PreviewChar;
   assembler;
   asm
      les  di,Self
      mov  dx,es:[di].PortNum
      mov  ah,0Ch
      int  14h
   end;

   function  TFossilPort.GetStatus;
   assembler;
   asm
      les  di,Self
      mov  dx,es:[di].PortNum
      mov  ah,03h
      int  14h
   end;

   function  TFossilPort.CharAvail;
   assembler;
   asm
      les  di,Self
      push es
      push di
      call GetStatus
      xchg al,ah
      and  al,1
   end;

   function  TFossilPort.CarrierDetect;
   assembler;
   asm
      les  di,Self
      push es
      push di
      call GetStatus
      and  al,80h
   end;

   procedure TFossilPort.SendString;
   var
      i            :Integer;
   begin
      for i:=1 to Length(s) do SendChar(s[i]);
   end;

   procedure TFossilPort.SendCommand;
   var
      i            :Integer;
   begin
      for i:=1 to Length(Cmd) do
      if Cmd[i]='|' then SendChar(#13) else SendChar(Cmd[i]);
   end;

end.