{ ROSMAC.INC - Remote Operating System Machine Dependent Routines }
{ Modified for Kaypro and SPEEDPRO-5RTC by Terry Carlisle  3 May 85}

const
{ Machine specific constants }

  DataPort   = $04;          { Data port }
  StatusPort = $06;          { Status port }
  RatePort   = $00;          { Data rate (bps) port }

{ SPEEDPRO specific constants }

  adata = 156;               { port A data }
  actl  = 157;               { port A control }
  bdata = 158;               { port B data }
  bctl  = 159;               { port B control }
  ncs   = 1;                 { deselect clk chip }
  rd    = 2;                 { read }
  wr    = 4;                 { write }
  adwr  = 8;                 { address write }
  stp   = 16;                { stop }
  mode3 = $0CF;              { bit i/o mode for pio }

Type
  bite = byte;
  cstring = string[13];      { clock string }
  number = integer;

const
{ StatusPort commands }

  RESCHN     = $18;          { reset channel }
  RESSTA     = $10;          { reset ext/status }
  WRREG1     = $00;          { value to write to register 1 }
  WRREG3     = $C1;          { 8 bits/char, rx enable }
  WRREG4     = $44;          { 16x, 1 stop bit, no parity }
  DTROFF     = $68;          { dtr off, rts off }
  DTRON      = $EA;          { dtr on, 8 bits/char, tx enable, rts on }
  ONINS      = $30;          { error reset }

{ StatusPort status masks }

  DAV        = $01;          { data available }
  TRDY       = $04;          { transmit buffer empty }
  DCD        = $08;          { data carrier detect }
  PE         = $10;          { parity error }
  OE         = $20;          { overrun error }
  FE         = $40;          { framing error }
  ERR        = $60;          { parity, overrun and framing error }

{ Smartmodem result codes }

  OKAY        = '0';        { Command executed with no errors }
  CONNECT300  = '1';   { Carrier detect at 300 bps }
  RING        = '2';      { Ring signal detected }
  NOCARRIER   = '3'; { Carrier lost or never heard }
  ERROR       = '4';     { Error in command execution }
  CONNECT1200 = '5';         { Carrier detect at 1200 bps }

{ Rate setting commands }

  BD300      = 5;            { 300 bps }
  BD1200     = 7;            { 1200 bps }

function mdcarck: boolean;
{ Check to see if carrier is present }
begin
  port[StatusPort] := RESSTA;
  mdcarck := ((DCD and port[StatusPort]) <> 0)
end;

function mdinprdy: boolean;
{ Check for ready to input from modem }
var
  bt: byte;
begin
  if (DAV and port[StatusPort]) <> 0
    then
      begin
        port[StatusPort] := 1;
        if (ERR and port[StatusPort]) <> 0
          then
            begin
              port[StatusPort] := ONINS;
              bt := port[DataPort];
              mdinprdy := FALSE
            end
          else mdinprdy := TRUE
      end
    else mdinprdy := FALSE
end;

function mdinp: byte;
{ Input a byte from modem - no wait - assumed ready }
begin
  mdinp := port[DataPort]
end;

procedure mdout(b: byte);
{ Output a byte to modem - wait until ready }
begin
  repeat
  until (TRDY and port[StatusPort]) <> 0;
  port[DataPort] := b
end;

procedure mdinit;
{ Initialize the sio channel and the Hayes Smartmodem 1200 }
const
  sio_init: array[1..9] of byte = (RESCHN, 4, WRREG4, 1, WRREG1, 3, WRREG3, 5, DTROFF);
var
  i: integer;
  mdm_attn : string[2];
  mdm_init : string[41];
  bt       : byte;
begin
  for i := 1 to 9 do
    port[StatusPort] := sio_init[i];        { initialize the SIO channel }
  port[StatusPort] := 5;                    { pull DTR high }
  port[StatusPort] := DTRON;
  mdm_attn := 'AT';
  mdm_init := 'ATE0Q0V0M0X1 S0=0 S2=3 S4=255 S5=255';
  port[RatePort] := BD1200;                 {set the 8116 to 1200 baud}
  delay (500);                              {let the modem settle for a bit}
  for i := 1 to 2 do
    begin
      bt := ord(mdm_attn[i]);               {force the modem to 1200 baud}
      mdout(bt)
    end;
  bt := ord(CR);
  mdout(bt);
  delay (2000);                             {wait a sec...}
  for i := 1 to 41 do
    begin
      bt := ord(mdm_init[i]);               {initialize the modem}
      mdout(bt)
    end;
  bt := ord(CR);
  mdout(bt);
  bt := mdinp;                              { clear any previous rings }
  bt := mdinp
end;

function mdring: boolean;
{ Determine if the phone is ringing }
begin
  if mdinprdy
    then mdring := (RING = chr(mdinp))
    else mdring := FALSE
end;

procedure mdhangup;
{ Hangup modem }
var
  i        : integer;
  mdm_hang : string[4];
  bt       : byte;
begin
  repeat
    port[StatusPort] := 5;             { setup to write register 5 }
    port[StatusPort] := DTROFF;        { clear DTR, causing hangup }
    delay(2000);
    port[StatusPort] := 5;
    port[StatusPort] := DTRON;
    if mdcarck
      then
        begin
          mdm_hang := 'ATH0';
          for i := 1 to 3 do
            begin
              bt := ord(ETX);
              mdout(bt)
            end;
          delay(1500);
          for i := 1 to 4 do
            begin
              bt := ord(mdm_hang[i]);
              mdout(bt)
            end;
          bt := ord(CR);
          mdout(bt)
        end;
  until not(mdcarck)
end;

procedure mdans;
{ Detect and set system to rate at which modem answered phone }
var
  mdm_answ : string[3];
  code     : char;
  i        : integer;
  bt       : byte;
begin
  repeat
  until mdinprdy;
  bt := mdinp;
  mdm_answ := 'ATA';
  for i := 1 to 3 do
    begin
      bt := ord(mdm_answ[i]);
      mdout(bt)
    end;
  bt := ord(CR);
  mdout(bt);
  repeat
  until mdinprdy;
  code := chr(mdinp);
  if code = CONNECT1200
    then
      begin
        port[RatePort] := BD1200;
        rate := 0.02075;
        delay(500);
        bt := mdinp;
        bt := mdinp
      end;
  if code = CONNECT300
    then
      begin
        port[RatePort] := BD300;
        rate := 0.083;
        delay(500);
        bt := mdinp;
        bt := mdinp
      end;
  if code = NOCARRIER
    then mdhangup
end;

procedure mdbusy;
{ Take modem off hook to present a busy signal to incoming callers }
  begin
    mdhangup
  end;

procedure putstat(st: StrStd);
{ Put 'st' on status line and return to normal display }
  const
    status_line    =   1;              { Line used for system status }
    last_line      =  24;              { Last line on screen }
  begin
    GotoXY(1, status_line);
    ClrEol;
    write(st);
    GotoXY(1, last_line)
  end;

{ SPEEDPRO calls this once per program to set up the Z80 PIO }

procedure system_init;
begin
  port[actl] := 0;
  port[actl] := mode3;
  port[actl] := 0;
  port[actl] := 7;
  port[actl] := 3;
  port[adata] := 0;
  port[bctl] := mode3;
  port[bctl] := 0;
  port[bctl] := 7;
  port[bctl] := 3;
  port[bdata] := 0;
  port[bdata] := ncs;
end; {system_init}

Function Read_clock(chnl: bite): bite;
{ Read one register of the clock chip }

  Const
    mask12: integer = 7;               { mask 12/24 hourbit in reg 5 }
    lpmask: integer = 3;               { mask leap year bit in reg 8 }

  Var
    rtnval : integer;

  begin
    rtnval := 0;

    port[actl] := mode3;                 { set PIO to bit ctrl mode }
    port[actl] := 0;                     { for output }
    port[actl] := 7;                     { int control }
    port[actl] := 3;                     { int enable flag }
    port[adata] := 0;                    { output }
    port[adata] := chnl;                 { channel to read }
    port[bdata] := stp;                  { select chip & stp }
    port[bdata] := stp or adwr;          { pulse adwr line high }
    port[bdata] := stp;                  { then back low }

    {read the data }
    port[actl] := mode3;                 { set PIO to bit I/O }
    port[actl] := $0FF;                  { for input }
    port[actl] := 7;                     { int control }
    port[actl] := 3;                     { int enable flag }
    port[bdata] := stp or rd;            { raise read flag }
    rtnval := port[adata];               { get data into buffer }
    port[bdata] := stp;                  { lower the read bit }
    port[bdata] := ncs;                  { deselect chip }

      { Mask off 12/24 hour bit in tens of hours register 5 }
      if chnl = 5 then
        rtnval := rtnval and mask12;

      { Mask leap year bits from register 8 }
      if chnl = 8 then
        rtnval := rtnval and lpmask;

    Read_clock := rtnval;

End; { Read_clock }

Function Time: cstring;

  Var
    time_str: string[13];
    year10, year1, mon10, mon1, day10, day1,
    day_of_week, hours10, hours1, min10, min1,
    sec10, sec1 : byte;

  begin
    year10 := Read_clock(12);
    year1 := Read_clock(11);
    mon10 := Read_clock(10);
    mon1 := Read_clock(9);
    day10 := Read_clock(8);
    day1 := Read_clock(7);
    day_of_week := Read_clock(6);
    hours10 := Read_clock(5);
    hours1 := Read_clock(4);
    min10 := Read_clock(3);
    min1 := Read_clock(2);
    sec10 := Read_clock(1);
    sec1 := Read_clock(0);

  if hours10 + hours1 = 0 then
  begin  { Military Time }
    hours10 := 1;
    hours1 := 2;
  end;

  Time := chr(hours10 + 48) +
          chr(hours1 + 48) +
          chr(min10 + 48) +
          chr(min1 + 48) +
          chr(sec10 + 48) +
          chr(sec1 + 48) +
          chr(mon10 + 48) +
          chr(mon1 + 48) +
          chr(day10 + 48) +
          chr(day1 + 48) +
          chr(year10 + 48) +
          chr(year1 + 48) +
          chr(day_of_week + 48);

End; { Time }

procedure GetTAD(var t: tad_array);
{ Returns a six element integer array of the current system time in
  seconds, minutes, hours, day, month, and year. }

  var
    temp1,temp2,temp3,temp4,temp5,temp6,result : integer;
    c_str: cstring;

  begin
    c_str := Time;
    val((c_str[5] + c_str[6]),temp1,result);
    val((c_str[3] + c_str[4]),temp2,result);
    val((c_str[1] + c_str[2]),temp3,result);
    val((c_str[9] + c_str[10]),temp4,result);
    val((c_str[7] + c_str[8]),temp5,result);
    val((c_str[11] + c_str[12]),temp6,result);

    t[0] := temp1;
    t[1] := temp2;
    t[2] := temp3;
    t[3] := temp4;
    t[4] := temp5;
    t[5] := temp6;

  end;

procedure SetTAD(var t: tad_array);
{ Set the system time using  a 6 element integer array which contains
  seconds, minutes, hours, day, month, and year. }

  begin
    mem[$FF7C] := t[0];
    mem[$FF7D] := t[1];
    mem[$FF7E] := t[2];
    mem[$FF7F] := t[3];
    mem[$FF80] := t[4];
    mem[$ff81] := t[5];
  end;