Category : Pascal Source Code
Archive   : USNGTP.ZIP
Filename : PLS-UTIL.INC

{ PLS-UTIL.INC Miscelaneous global subprograms }

{ Forward declaration of error handling routines which use some of the
routines in the STD-UTIL.INC file and are also used by some of these
routines. The formal definition of these forward declared procedures
is in the PLS-DISP.INC Include file, which must be included at some
point following PLS-UTIL.INC. }

procedure Disp_IO_Error(device_name: File_ID);

forward;

procedure Disp_Error_Msg(err_msg: Str_80);

forward;

procedure Beep;
begin
begin
Sound(440); Delay(250); NoSound;
end;
end; { Beep }

function Fgnd(attr: Byte): Integer;

{ Converts attribute byte to numeric value for use with Turbo
TextColor procedure. }

begin
Fgnd := (attr and $0F) + ((attr and $80) div 8);
end { Fgnd };

function Bgnd(attr: Byte): Integer;

{ Converts attribute byte to numeric value for use with Turbo
TextBackground procedure. }

begin
Bgnd := (attr and $70) div $10;
end { Bgnd };

procedure Usr_Out_Driver(out_chr: Char);
var vid_char : PC_Char;

{ Direct video ouput driver used to replace the standard Usr driver. }

begin
vid_char.attribute := vid_attr; vid_char.character := out_chr;
vid_chr[cur_pos] := vid_char;
cur_pos := Succ(cur_pos);
end; { Usr_Out_Driver }

procedure GoTo_XY(col, row: Integer); { Used to position }

{ Set the value of curpos for use by the direct video output driver. }

begin
GoToXY(col,row);
col := Pred(col) mod MAX_COL;
row := Pred(row) mod MAX_ROW;
cur_pos := (row * MAX_COL + col + 1); { Calculate cur_pos as }
end; { GoTo_XY } { offset into video RAM }

procedure Repeat_Char(character : Char; { Character to be output. }
count : Integer); { Number of times to output. }
var i : Integer;

begin
for i := 1 to count do
Write(character);
end; { Repeat_Char }

procedure Repeat_Usr_Char(character : Char;
count : Integer);
var i : Integer;

begin
for i := 1 to count do
Write(Usr,character);
end; { Repeat_Char }

procedure Write_Usr_Str(out_str: Str_255);
var i : Integer;
begin
for i := 1 to Length(out_str) do { Outputs out_str via the }
Write(Usr,out_str[i]); { Usr output device }
end; { Write_Usr_Str }

procedure Strip_Trailing(len : Byte);

begin
inp_str[0] := Chr(0); { Set inp_str length to ZERO }
while (inp_str[len] in [#0..SPACE,FILL_CHAR]) and (len > ZERO) do
len := Pred(len);
inp_str[0] := Chr(len); { Set inp_str length to len }
end; { Strip_Trailing }

procedure Strip_Leading(len : Byte);

var i : Byte;

begin
i := 1;
While (inp_str[i] in [#0..SPACE,FILL_CHAR]) and (i <= len) do
i := Succ(i);
inp_str := Copy(inp_str,i,len);
end; { Strip_Leading }

procedure Strip_Inp_Str(len : Byte);

begin
Strip_Trailing(len);
Strip_Leading(len);
end; { Strip_Inp_Str }

function Upper_Case(str: Str_80): Str_80;
var i : Byte;
begin
for i := 1 to length(str) do
str[i] := UpCase(str[i]);
Upper_Case := str;
end { Upper_Case };

function Exist(file_name: File_ID): Boolean;
var chk_file : File;

begin
Assign(chk_file,file_name);
{$I-} Reset(chk_file); {$I+}
Exist := (IOresult = ZERO);
Close(chk_file);
end; { Exist }

procedure Clr_Kbd_Buf;

{ Clears keyboard tpye-ahead buffer. }

var kbd_buf : Byte absolute $0000:$041A;
var kbd_clr : Byte absolute $0000:$041C;
begin
kbd_buf := kbd_clr;
end { Clr_Kbd_Buf };

procedure Get_System_Date;
var ms_reg : record
ax,bx,cx,dx,bp,si,di,ds,es,flags : Integer;
end;
num_str : Str_5;

{ Initialize global var sys_date to formatted mm/dd/yyyy system date. }

begin
with ms_reg do
begin
ax := $2A00;
Intr($21,ms_reg);
Str(Hi(dx):2,num_str);
sys_date := num_str + '/';
Str(Lo(dx):2,num_str);
sys_date := sys_date + num_str + '/';
Str(cx:4,num_str);
sys_date := sys_date + num_str;
for i := 1 to 4 do
if (sys_date[i] = SPACE) then
sys_date[i] := '0';
end; {with}
end; { Get_System_Date }

procedure Chain_To(file_name: File_ID);
var chain_file : File;

begin
if Exist(file_name) then
begin
Assign(chain_file,file_name);
chain(chain_file);
end
else
begin
io_status := $22;
Disp_IO_Error(file_name);
end;
end; { Chain_To }