Unit Modempro ;
(* ================================================================= *)
(*  MODEM - Routines and Global variables for IBMPC compatiables.    *)
(* ================================================================= *)
Interface
  Uses Dos,Crt,       (* Standard Turbo Pascal Units *)
       KGlobals ;     (* Kermit Globals - Execution control Flags *)
  Type
      ParityType = (OddP,EvenP,MarkP,NoneP) ;
  Const
      DefaultBaud = 9600 ;
  Var
      PrimaryPort : Boolean ;
      Baudrate    : Integer ;
      Parity      : ParityType ;
  Procedure Initmodem ;
  Procedure ResetModem;
  Procedure SetModem ;
  Procedure AnswerModem ;
  Procedure DialModem ;
  Function RecvChar (var mchar : byte) : boolean ;
  Function CharsInBuffer : integer ;
  Procedure EmptyBuffer ;
  Procedure SendChar (char : byte ) ;
  Procedure SendBreak ;

(* ================================================================= *)
Implementation
CONST
    (* Modem Registers *)
    LowOrderDiv      = 0 ;
    HiOrderDiv       = 1 ;  InterruptEnable = 1 ;
    InterruptIdReg   = 2 ;
    LineControlReg   = 3 ;
    ModemControlReg  = 4 ;
    LineStatusReg    = 5 ;
    ModemStatusReg   = 6 ;
    ClockRate        = 18430 ;  (* CentiHertz. - use 17895 for PCjr *)
    (* 8259 Interrupt Controller addresses *)
    (* IC8259Reg1 = $20 ;   IC8259Reg2 = $21 ; *)
    MaxBuffsize = 32760 ;

VAR
    Modem     : Integer ;
    IntNumber,
    EnableMask,ResetMask,SaveMask : byte ;
    DSRcheck : boolean ;
    OldVector  : pointer ;
    Iout,Iin : integer ;
    Buffer : Packed array [1..MaxBuffsize] of byte ;

(* ------------------------------------------------------------------ *)
(* IntHandler - Interrupt handler                                     *)
(*            This procedure handles the modem interrupts ,           *)
(*            which occur for incomming data only.                    *)
(* ------------------------------------------------------------------ *)
Procedure IntHandler  ;
    Interrupt ;
    Begin (* IntHandler *)
    Inline($FB) ;                       (* STI  set interrupt enable *)
    While (Port[Modem+LineStatusReg] and $01) = $01 do
         begin (* put char in buffer *)
         buffer[Iin] := Port[Modem];
         Iin := Iin + 1 ;
         if Iin = MaxBuffsize then Iin := 1 ;
         end ; (* put char in buffer *)
    Port[$20] := ResetMask ;
    End ;  (* IntHandler *)

(* ------------------------------------------------------------------ *)
(* InitModem - Initialize the modem and setup interrupt procedure.    *)
(* ------------------------------------------------------------------ *)
    Procedure Initmodem ;
    Var rate : integer ;
    Begin (* Init modem *)
    If PrimaryPort then
         Begin (* Primary port *)
         Modem := $3F8 ;
         EnableMask := $EF ;
         ResetMask := $64 ;    (* end of interrupt for IRQ4 *)
         IntNumber := 12 ;
         End  (* Primary Port *)
                  else
        Begin (* Secondary Port *)
        Modem := $2F8 ;
        EnableMask := $F7 ;
        ResetMask := $63 ;   (* end of interrupt for IRQ3 *)
        IntNumber := 11 ;
        End ; (* Secondary Port *)
    Iin := 1 ; Iout := 1 ;

    (* Initialize the Serial port Interrupt Procedure *)
    GetIntVec(IntNumber,Oldvector) ;     (* save the Old interrupt handler *)
    SetIntVec (IntNumber,@IntHandler) ;  (* Use our own interrupt handler *)
    SaveMask  := Port[$21] ;             (* save setting *)
    Port[$21] := Port[$21] and EnableMask ;  (* Enable serial port interrupt *)
    Port[$20] := ResetMask ;

    (* Initialize baud rates and bits and parity *)
    Rate := round( (Clockrate/16) / (Baudrate/100)) ;
    Port[Modem+LineControlReg] := $80 ;     (* Enable baud rate setting *)
    Port[Modem+LowOrderDiv]    := (rate and $00FF) ;
    Port[Modem+HiOrderDiv]     := rate div $100 ;
    Port[Modem+LineControlReg] := (ord(Parity) shl 4) OR $0A ;
                                  (* parity, 7 bits,1 stop *)
    Port[Modem+ModemControlReg] := $0B ;   (* set OUT2, DTR ,RTS *)
    Port[Modem+InterruptEnable] := $01 ;   (* Data Avail. Interrupt set *)
    End ; (* Init modem *)

(* ------------------------------------------------------------------ *)
(*  ResetModem - Reset the Interrupt back to the original.            *)
(*       Global variables - Saveoffset,SaveSeq                        *)
(* ------------------------------------------------------------------ *)
    Procedure ResetModem;
    Begin (* Reset Modem Interrupt *)
    SetIntVec(IntNumber,Oldvector) ;   (* restore the Old interrupt handler *)
    Port[$21] := SaveMask ;
    Port[Modem+InterruptEnable] := $00 ;   (* Data Avail. Interrupt reset *)
    End; (* Reset Modem Interrupt *)

(* ------------------------------------------------------------------ *)
(*  SetModem -  Set the baud rate and parity for modem.               *)
(*       Global variables - Modem,Clockrate,Baudrate,Parity           *)
(* ------------------------------------------------------------------ *)
    Procedure SetModem ;
    Var rate : integer ;
    Begin (* SetModem *)
    If PrimaryPort then
         Begin (* Primary port *)
         Modem := $3F8 ;
         EnableMask := $EF ;
         ResetMask := $64 ;    (* end of interrupt for IRQ4 *)
         End  (* Primary Port *)
                  else
        Begin (* Secondary Port *)
        Modem := $2F8 ;
        EnableMask := $F7 ;
        ResetMask := $63 ;   (* end of interrupt for IRQ3 *)
        End ; (* Secondary Port *)
    Rate := round( (Clockrate/16) / (Baudrate/100)) ;
    Port[Modem+LineControlReg] := $80 ;     (* Enable baud rate setting *)
    Port[Modem+LowOrderDiv]    := (rate and $00FF) ;
    Port[Modem+HiOrderDiv]     := rate div $100 ;
    Port[Modem+LineControlReg] := (ord(Parity) shl 4) OR $0A ;
                                  (* parity, 7 bits,1 stop *)
    End ; (* SetModem *)

(* ------------------------------------------------------------------ *)
(*  DialModem - Check and waits for modem to be connected.            *)
(*              It waits for DSR  signals  be detected.               *)
(*  Side Effect - global variable 'connected' is set true.            *)
(* ------------------------------------------------------------------ *)
   Procedure DialModem ;
   var i : integer ;
   Begin (* Dial Modem *)
   While ((Port[Modem+ModemStatusReg] and $20) <> $20) and DSRcheck Do
         Begin (* Connect modem please *)
    (*   writeln('modem status =',Port[Modem+ModemStatusReg]); *)
         writeln('  Please connect your modem ');
         delay (1000);
         If KeyPressed then  (* Bypass DSRcheck by hitting the space bar *)
              DSRcheck := readkey <> ' ' ;
         End ; (* Connect modem please *)
   Port[Modem+ModemControlReg] := $0B ;   (* set OUT2, DTR ,RTS  *)
   connected := true ;
   If audioflag then
         for i:=1 to 50 do begin sound(100*i); delay(5); end ; nosound;
   Writeln('  Connection completed ');
   End ; (* Dial Modem *)

(* ------------------------------------------------------------------ *)
(*  AnswerModem - Check and waits for modem to be connected.          *)
(*              If DCD is off set RTS off.  Wait for DCD to get set   *)
(*              then set RTS.   (  similar to DIALMODEM  )            *)
(*  Side Effect - global variable 'connected' is set true.            *)
(* ------------------------------------------------------------------ *)
   Procedure AnswerModem ;
   var count : integer ;
   Begin (* Answer Modem *)
   count := 0 ;
   If (Port[Modem+ModemStatusReg] and $80) <> $80 then
       Port[Modem+ModemControlReg] := $09 ;   (* set OUT2,DTR reset RTS  *)
   clrscr ; GotoXY(10,10);
   write(' Waiting for someone to connect  ');
   While ((Port[Modem+ModemStatusReg] and $80) <> $80)  Do
         Begin (* Connect modem please *)
         Gotoxy( 44,10) ;  write(count);
         delay (1000);  count := count + 1 ;
         End ; (* Connect modem please *)
   Port[Modem+ModemControlReg] := $0B ;   (* set OUT2, DTR ,RTS  *)
   Writeln('  Answer completed ');
   End ; (* Answer Modem *)

(* ------------------------------------------------------------------ *)
(* RecvChar - Receive a Character from the modem port.                *)
(*            TRUE - if there is a character from the modem and       *)
(*                   the character is returned in the parmeter.       *)
(*            FALSE - if no character found .                         *)
(*                                                                    *)
(* ------------------------------------------------------------------ *)
    Function RecvChar (var mchar : byte) : boolean ;
    Begin (* RecvChar *)
    if Iin <> Iout then
         begin (* get char from buffer *)
         If Parity = NoneP then mchar := buffer[Iout]
                           else mchar := buffer[Iout] and $7F ;
         Iout := Iout + 1 ;
         If Iout = MaxBuffsize then Iout := 1 ;
         RecvChar := true ;
         if logging then
                     Begin {$I-}
                     write(Logfile,chr(mchar));
                     If IOresult <> 0 then
                        Begin (* IO error *)
                        Writeln(' Disk is Full - logging teminated');
                        logging := false  ;
                        Close(Logfile);
                        End ; (* IO error *)
                     End ; {$I+}
         end   (* get char from buffer *)
                   else
         RecvChar := false ;
    End ; (* RecvChar *)

(* ------------------------------------------------------------------ *)
(* SendChar - Send a character thru the modem port.                   *)
(*           It waits for the previous character to be sent before    *)
(*           sending the current character.                           *)
(* ------------------------------------------------------------------ *)
    Procedure SendChar(char : byte ) ;
    Begin (* Send Char *)
    While  (Port[Modem+LineStatusReg] and $20) <> $20 do delay(1);
         Port[modem] := char ;
    End ;  (* Send Char *)

(* ------------------------------------------------------------------ *)
(* CharsInBuffer - Returns the number of unprocessed characters in    *)
(*                 the Buffer.                                        *)
(* ------------------------------------------------------------------ *)
    Function CharsInBuffer : integer ;
    Begin (* Chars In Buffer *)
    If Iin >= Iout then CharsInBuffer := Iin - Iout
                   else CharsInBuffer := MaxBuffSize - Iout + Iin ;
    End ; (* Chars In Buffer *)

(* ------------------------------------------------------------------ *)
(* EmptyBuffer - Mark the buffer as being empty.                      *)
(* ------------------------------------------------------------------ *)
    Procedure EmptyBuffer ;
    Begin (* Empty Buffer *)
    Iout := Iin ;
    End ; (* Empty Buffer *)

(* ------------------------------------------------------------------ *)
(* SendBreak- Send a break via the modem port .                       *)
(* ------------------------------------------------------------------ *)
    Procedure SendBreak ;
    Var Tbyte,dummy : byte ;
    Begin (* Send Break *)
    Tbyte := Port[Modem+LineControlReg] ;  (* save setting *)
    Port[Modem+InterruptEnable] := $00 ;   (* Data Avail. Interrupt reset *)
    Port[Modem+LineControlReg] := $40 ;    (* break for 200 millsec *)
    GoToXy(1,24); Write(' *** BREAK *** ',chr(07));
    Delay(200) ;
    Port[Modem+LineControlReg] := Tbyte ;    (* restore setting *)
    Delay(100) ;
    dummy := Port[Modem] ;                  (* clear out incoming char *)
    Port[Modem+InterruptEnable] := $01 ;   (* Data Avail. Interrupt set *)
    End ;  (* Send Break *)

(* ================================================================= *)
(*    End of MODEM routines for IBMPC compatiables.                  *)
(* ================================================================= *)
Begin
Baudrate    := DefaultBaud ;
PrimaryPort := True ;
Parity      := EvenP ;
InitModem ;
DSRcheck    := True ;
End. (* Modempro *)