Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/DOORPROC.ZIP/DOORPROC.PAS

Pascal/Delphi Source File | 1986-11-07 | 5.8 KB | 204 lines

type
  CPUregs = record
              AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
            end;
  MaxString = string [80];



procedure Print (output:MaxString); forward;
procedure Println (output:MaxString); forward;
procedure Exit; forward;


function Carrier : boolean;  {This function looks for a carrier and returns
                              TRUE if one exists, FALSE if one doesn't}
var
  regs : CPUregs;

begin
  regs.AX:=$0300;
  regs.DX:=$0000;           {Change to regs.DX:=$0001; for COM2:)
  Intr ($14,regs);
  if (Lo(regs.AX)>=128) then Carrier:=true else Carrier:=false;
end;




function SerialChar : boolean;  {This function checks to see if a character
                                 is available from the COM1: port.  TRUE if
                                 one is, FALSE if one isn't}
var
  regs : CPUregs;

begin
  regs.AX:=$0300;
  regs.DX:=$0000;               {Change to regs.DX:=$0001; for COM2:)
  Intr ($14,regs);
  if (Odd(Hi(regs.AX)) and (OrgCarr=true)) then SerialChar:=true
    else SerialChar:=false;
end;

function KeyChar : boolean;    {This function checks to see if a character is
                                available from the keyboard.  TRUE if one is,
                                FALSE if one isn't.}
var
  regs : CPUregs;

begin
  regs.AX:=$0B00;
  MsDos(regs);
  if (Lo(regs.AX)=0) then KeyChar:=false
    else KeyChar:=true;
end;

Function Inkey:char;            {This functions like the BASIC INKEY$, only
                                 it returns the first character from the
                                 keyboard OR the modem.  All input is done
                                 through this function}
var
 tc : char;
 AL :  Integer;
 finished : boolean;

Begin
  finished:=false;
  tc:='Q';
  if ((OrgCarr=true) and (Carrier=false)) then Exit;
  repeat
    if SerialChar then
    begin
      param.AX:=$0200;
      param.DX:=$0000;
      Intr($14,param);
      AL:=Lo(param.AX);
      tc:=chr(AL);
      finished:=true;
    end else
    if KeyChar then
    begin
      param.AX:=$0700;
      MsDos(param);
      AL:=Lo(param.AX);
      tc:=chr(AL);
      finished:=true;
    end
  until Finished;
  InKey:=tc;
End;


function Input(num:integer):MaxString;      {This function returns a string
                                             of length num.  It uses the Inkey
                                             function, and will not allow the
                                             user to enter more than num
                                             characters.}
var
  ts : MaxString;
  tc : char;

begin
  cnt:=0;
  ts:='';
  repeat
    tc:=Inkey;
    if (tc=chr(8)) then
    begin
      if (cnt>0) then
      begin
        ts:=Copy (ts,1,(Length(ts)-1));
        Print (tc+' '+tc);
        cnt:=cnt-1;
      end;
    end else
     if (tc<>chr(13)) and (cnt<num) then
     begin
       ts:=ts+tc;
       Print (tc);
       cnt:=cnt+1;
     end;
  until (tc=chr(13));
  Println ('');
  Input:=ts;
end;



procedure Println;                          {This procedure mimics Writeln,
                                             only it also sends to the modem
                                             if there is a carrier, and to the
                                             printer if the boolean variable
                                             printer is TRUE}
begin
  Writeln (output);
  if Carrier then Writeln (aux,output);
  if Printer then Writeln (lst,output);
end;

procedure Print;                           {Same as above, only without a
                                            CR/LF at the end, to enable you
                                            to continue writing on the same
                                            line}
begin
  Write (output);
  if Carrier then Write (aux,output);
  if Printer then Write (lst,output);
end;

procedure cls;                            {Clears both the local screen and
                                           the screen of the modem user}
begin
  print (chr(12));
  ClrScr;
end;

procedure Exit;                           {Sends the user back to RBBS.  I
                                           exit this "non-standard" way in
                                           to enable a return to RBBS if the
                                           Carrier is lost (i.e. User hangs
                                           up on the program)}
begin
  Println ('Now returning to RBBS.  Please stand by...');
  Port[$3FC]:=Port[$3FC] Or 1;
  if ((OrgCarr=true) and (Carrier=false)) then Intr ($20,param);
end;



procedure Init;                       {This is used to initialize the modem
                                       and generally set everything up.  Call
                                       this procedure before you do any screen
                                       I/O, or even call cls.  If you don't,
                                       the PC refuses to recognize input from
                                       the modem.}
var
  messages : file of string[128];
  r : string [128];
  bps : integer;
  Code : integer;

begin
  Printer:=false;
  OrgCarr:=Carrier;
  if OrgCarr then
  begin
    Assign (messages,'B:MESSAGES');   {Sysops, make sure this is the drive
                                       that your MESSAGES file is on!}
    Reset (messages);
    Seek (messages,2);
    Read (messages,r);
    Val((Copy(r,44,2)),bps,Code);
    if (bps=-3) then param.AX:=$0043
      else param.AX:=$0083;
    Intr($14,param);
    Close (messages);
  end;
end;

{Well, that's about it.  I hope these procedures help all you aspiring Doors
programmers out, and I really hope we see a whole lot more useful Doors for
RBBS out there.  Good Luck!
     -JV-
}