Power-Programmierung/CD1.mdf/pascal/library/dos/wct/misc.pas

Pascal/Delphi Source File | 1992-02-25 | 4.4 KB | 205 lines

unit misc;

{ Written by William C. Thompson }

{ This unit does a few miscellaneous things }

interface

uses
  dos,crt,xcrt,keydef;

var
  startingtime, endingtime: real;

procedure getcommandline(var s:string);
function searchpath(fn:string):dirstr;
function inttostr(i:longint):string;
function realtostr(r:real; width,prec:byte):string;
function fileexists(fn:string; attr:word) : boolean;
function isdigit(c:char):boolean;
function datetoday(m,d,y:word):byte;
function printerstatus:byte;
function printerokay:boolean;
procedure starttimer;
function elapsedtime:real;
procedure unpackseconds(t:real; var hour,min,sec,sec100:word);
procedure debug(s:string);

implementation

procedure getcommandline(var s:string);
{ Retrieves entire command line into string s }
var
  p:^string;
begin
  p:=ptr(prefixseg,$80);
  s:=p^
end;

function searchpath(fn:string):dirstr;
{ Searches path for file Fn and return path to it if found, and '' o/w }
var
  s: pathstr;
  e: extstr;
  d: dirstr;
  n: namestr;
begin
  s:=fsearch(fn,getenv('PATH'));
  if s='' then searchpath:=''
  else begin
    fsplit(fexpand(s),d,n,e);
    searchpath:=d
    end
end;

function inttostr(i:longint):string;
var s: string;
begin
  str(i,s);
  inttostr:=s
end;

function realtostr(r:real;width,prec:byte):string;
var s: string;
begin
  str(r:width:prec,s);
  realtostr:=s
end;

function fileexists(fn:string; attr:word):boolean;
{ attr=archive ($20) / directory ($10) }
var
  sr : searchrec;
begin
  findfirst(fn,attr,sr);
  fileexists := doserror = 0;
end;

function fptr(var f:text):char;
{ Returns next char in file, with out a read - [e-mail] }
var
  fb:textrec absolute f;
begin
  with fb do fptr:=buffer[bufpos]
end;

function isdigit(c:char):boolean;
{ returns TRUE if c is a digit }
begin
  isdigit:=c in ['0'..'9']
end;

function datetoday(m,d,y: word):byte;
{ returns day of week for the appropriate month, day, and year
  0 = Sunday
  1 = Monday
  ...
  6 = Saturday }
var
  z: byte;
begin
  z:=y-ord(m<3);
  datetoday:=(23*m div 9+d+4+y+(z div 4)-(z div 100)+
     (z div 400)-2*ord(m>=3)) mod 7
end;

function printerstatus:byte;
{ Returns the actual status of the printer
  Definition of status byte bits: (1 & 2 are not used)
  Bit -- 7 ---  ---- 6 ----  -- 5 ---  -- 4 ---  -- 3 --  --- 0 ---
      Not Busy  Acknowledge  No Paper  Selected  I/O Err. Timed-out }
var
  regs : registers;
begin
  with regs do begin
    ah:=2;
    dx:=0;
    intr($17,regs);
    printerstatus:=ah;
    end;
end;

function printerokay:boolean;
{ Returns TRUE if the printer is selected, then printer has paper and no
  I/O or time out error has occurred. }
var
  n: byte;
begin
  n:=printerstatus;
  if ((n and $10)<>0) and ((n and $29)=0) then printerokay:=true
     { selected set & no paper, i/o error, timed-out not set }
  else printerokay := false;
end;

procedure starttimer;
{ This procedure sets the starting time (in seconds) }
var
  h,m,s,s100: word;
begin
  gettime(h,m,s,s100);
  startingtime:=h*3600.0+m*60.0+s+s100/100;
end;

function elapsedtime:real;
{ This function returns the elapsed time since the timer was started.
  It also sets ending time to the current time (in seconds) }
var
  h,m,s,s100: word;
begin
  gettime(h,m,s,s100);
  endingtime:=h*3600.0+m*60.0+s+s100/100;
  if endingtime>startingtime then elapsedtime:=endingtime-startingtime
  else elapsedtime:=86400.0-startingtime+endingtime
end;

procedure unpackseconds(t: real; var hour,min,sec,sec100: word);
{ This procedure converts a time in seconds to something more
  meaningful. }
begin
  sec100:=trunc(frac(t)*100);
  sec:=trunc(t) mod 60;
  hour:=trunc(t) div 60;
  min:=hour mod 60;
  hour:=hour div 60
end;

procedure debug(s:string);
var
  w: block;
  ch: char;
  row: byte;
  i,j: byte;

  procedure draw;
  begin
    savewindow(1,row,80,row,w);
    attrblock(1,row,80,row,redbg+white);
    writexy(1,row,s);
  end;

begin
  if maxavail<240 then exit;
  i:=length(s);
  if i>80 then i:=80;
  s[0]:=#80;
  for j:=i+1 to 80 do s[j]:=' ';
  row:=1;
  draw;
  repeat
    ch:=getoneof(enter+esc+uparrow+downarrow);
    recallwindow(1,row,w);
    killwindow(w);
    if ch=uparrow then begin
      if row>1 then row:=row-1;
      draw
      end
    else if ch=downarrow then begin
      if row<25 then row:=row+1;
      draw
      end
  until (ch=esc) or (ch=enter)
end;

end.