Category : Pascal Source Code
Archive   : TBBS.ZIP
Filename : MACHDEP.INC

(* --------------------MACHDEP.INC------------------------------------ *)
{This is a minimal overlay file for IBM machines and compatibles
using the addresses corresponding to COM1:. It works on a Compaq
using a Hayes Internal Modem (for sure!). The modem initialization
is for a Hayes Smartmodem. - RHM}

const
iodata = $3f8;

procedure lineout(message: line); forward;
{lineout is in IO.INC - don't change this declaration!}
procedure lineout_withpause(message: line); forward;
{lineout_withpause is in IO.INC - don't change this declaration!}


function outready: boolean;

{Returns true if serial output port is
ready to transmit a new character}

begin
outready := ((port[$3fd] and 32) > 0);
end;

procedure xmitchar(ch: char);

{Transmits ch when serial output port is ready,
unless we're in the local mode.}

begin
if not local then begin
repeat until outready;
port[iodata] := ord(ch);
end;
end;

function cts: boolean;

{This function returns true if a carrier tone is present on the modem
and is frequently checked to see if the caller is still present.
It always returns "true" in the local mode.}

begin
cts := ((port[$3fe] and 128) = 128) or local;
end;

function inready: boolean;

{Returns true if we've got a character received
from the serial port or keyboard.}

begin
inready := keypressed or ((port[$3fd] and 1) > 0);
end;

function recvchar: char;

{Returns character from serial input port,
REGARDLESS of the status of inready.}

begin
recvchar := chr(port[iodata]);
end;

procedure setbaud(speed: rate);

{For changing the hardware baud rate setting}

begin
port[$3fb] := 131;
case speed of
slow: begin
port[$3f8] := $80;
port[$3f9] := 1;
end;
fast: begin
port[$3f8] := $60;
port[$3f9] := $0;
end;
end;
port[$3fb] := 3;
baud := speed;
end;

procedure clearSIO;

{ Initializes serial I/O chip:
sets up for 8 bits, no parity and one stop bit on both
transmit and receive, and allows character transmission
with CTS low. Also sets RTS line high. }

begin
port[$3fb] := 3;
port[$3f9] := 0;
port[$3fc] := 11;
end;

procedure clearmodem; (* Modem Dependent *)

{Sets modem for auto-answer, CTS line as carrier detect, no command echo}

var buffer: line;
loop : byte;
ch : char;

begin
buffer := 'ATS0=1 V0 Q1 M0';
for loop := 1 to length(buffer) do begin
ch := buffer[loop];
xmitchar(ch);
delay(50);
end;
xmitchar(#13);
writeln;
write('Delaying...');
delay(1000); {Delays while modem digests initialization codes}
writeln;
end;

procedure setup;

{Hardware initializion for system to start BBS program}

begin
clearSIO;
setbaud(fast);
clearmodem;
end;

(*
function badframe: boolean;
{Indicates Framing Error on serial I/O chip - return false if not available.}
begin
badframe := (port[$3FD] and 8) = 8;
end;
*)

procedure dropRTS;

{ Lowers RS-232 RTS line - used to inhibit auto-answer
and to cause modem to hang up }

begin
port[$3fc] := 8;
end;

procedure raiseRTS;

(* Raises RTS line to enable auto-answer *)

begin
port[$3fc] := 11;
end;

procedure setlocal;
begin
dropRTS; {Inhibits Rixon auto-answer}
local := true;
end;

procedure clearlocal;
{Clears local flag and allows modem auto-answer}
begin
raiseRTS; {Enables Rixon Auto-answer}
local := false;
end;

PROCEDURE dispinfo;

var
col, row, junk : integer;
hh, mm, ss : string[2];
tstr : string[8];

begin
if not screenon then port[$3d8] := $21 else begin
port[$3d8] := $29;
col := WhereX;
row := WhereY;
if row = 25 then row := 1;
window(1,25,80,25);
gotoxy(1,25);
if sysopin then write('Avail ') else write('NoAvail');
if printon then write(' Print ') else write(' NoPrint ');
junk := access;
write(junk,' ');
str(usehour:2,hh);
str(usemin:2,mm);
str(usesec:2,ss);
tstr := hh + ':' + mm + ':' + ss;
for junk := 1 to 8 DO
if tstr[junk] = ' ' THEN tstr[junk] := '0';
write(tstr,' ');
write(caller);
ClrEol;
window(1,1,80,24);
gotoXY(col,row);
if (caller = 'System Available') then begin
gotoXY(1,5);
writeln(' 1 - Enter sysop maintenance mode');
writeln('F2 - Printer toggle');
writeln('F3 - Sysop available toggle');
writeln('F4 - Sceen toggle');
writeln('F5 - Force off user');
writeln('F9 - Exit to remote DOS');
writeln('F10 - Halt BBS');
end;
end;
end;

PROCEDURE Play(Octave,Note,Duration: integer);
{ from turbo pascal disk version 3.0 sound.pas
Play Note in Octave Duration milliseconds
Frequency computed by first computing C in
Octave then increasing frequency by Note-1
times the twelfth root of 2. (1.059463994) }
var
Frequency : real;
I : integer;
begin
Frequency := 32.625;
for I := 1 to Octave do { Compute C in Octave }
Frequency := Frequency * 2;
for I := 1 to Note - 1 do { Increase frequency Note-1 times }
Frequency := Frequency * 1.059463094;
if Duration <> 0 then
begin
Sound(Round(Frequency));
Delay(Duration);
NoSound;
end
else Sound(Round(Frequency));
end;

PROCEDURE SoftAlarm;
{ Play the notes G and D in octave three 7 times
each with a duration of 70 milliseconds. }
var
I: integer;
begin
for I := 1 to 7 do
begin
Play(4,8,80);
Play(4,3,80);
end;
end;

procedure hangup;
{Signals modem to hang up - in this case by lowering RTS line for 500 msec.}

begin
if cts then lineout('--- Disconnected ---' + cr + lf);
dropRTS;
if local then clearlocal else repeat until not cts;
raiseRTS;
end;

procedure flush;

var junk: char;

begin
junk := recvchar;
end;

{Real-time clock support begins here - this routine is called
even if there is NO clock, so leave it and set clockin accordingly}

procedure clock(var month,date,hour,min,sec: byte);

{Returns with month in range 1(Jan)..12(Dec),
date in 1..length of month, hour in 0..23 (24-hr clock),
minute and second in 0..59}

var
temp: integer;
tempint: integer;
temp1: byte;

const monthmask = $000F;
daymask = $001F;
minutemask = $003F;
secondmask = $001F;
type dtstr = string[8];
Register = Record
AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
End;
var tstr : dtstr;

function getdate : dtstr;

var
allregs : register;
month, day,
year : string[2];
i : integer;
tstr : dtstr;

begin
allregs.ax := $2A * 256;
MsDos(allregs);
str((allregs.dx div 256):2,month);
str((allregs.dx mod 256):2,day);
str((allregs.cx - 1900):2,year);
tstr := month + '/' + day + '/' + year;
for i := 1 to 8 do
if tstr[i] = ' ' then
tstr[i] := '0';
getdate := tstr;
end; {getdate}

function gettime : dtstr;

var
allregs : register;
hour, minute,
second : string[2];
i : integer;
tstr : dtstr;

begin
allregs.ax := $2C * 256;
MsDos(allregs);
str((allregs.cx div 256):2,hour);
str((allregs.cx mod 256):2,minute);
str((allregs.dx div 256):2,second);
tstr := hour + ':' + minute + ':' + second;
for i := 1 to 8 do
if tstr[i] = ' ' then
tstr[i] := '0';
gettime := tstr;
end; {gettime}

begin
val(copy(getdate,1,2),tempint,temp);
month := lo(tempint);
val(copy(getdate,4,2),tempint,temp);
date := lo(tempint);
val(copy(gettime,1,2),tempint,temp);
hour := lo(tempint);

val(copy(gettime,4,2),tempint,temp);
min := lo(tempint);
val(copy(gettime,7,2),tempint,temp);
sec := lo(tempint);
end;