               ґ               BOX     PAS 	 К               CPY     PASb $ <м               NZ-TOOL BOX L Ѕ1               PD      PAS  Јс               RAD     PAS†  {^              я                               я                               Program PD;
{ Author:  Joe Wright
  Date:    22 Sep 89
  Version: 0.1

  Poorman's version of PWD.COM to demonstrate NZ-TOOL.BOX and
  access to the Z3NDIR structure.
}

{$I nz-tool.box}

Var NDIR : ndrptr;
    X, Y : Integer;

Begin
ndir := Ptr(getndr);
name := namstr(z3eadr^.extfcb^.name);
y := 7;
x := 25;

ClrScr;
WriteLn('Print Working Directories');
if fcb1.name[1] = '/' then
  Begin
    WriteLn('    Syntax:  ',name,' [P]');
    WriteLn('  The P option will show Passwords if Wheel is ON');
  End
else
  Begin
    Write(' Z3 Wheel is O');
    if getwhl then WriteLn('N') else WriteLn('FF');
    if ndir^.du <> 0 then
      Repeat
        if x > 20 then x := 1 else x := 35;
        y := y+1;
        GoToXY(x,y div 2);
        if getduok then pdu(Swap(ndir^.du));
        name := namstr(ndir^.name);
        pass := namstr(ndir^.pass);
        x := x+5;
        GoToXY(x,y div 2);
        Write(name);
        if (fcb1.name[1]='P') and getwhl then
          Begin
            x := x+9;
            GoToXY(x,y div 2);
            LowVideo;
            Write(' Pass: ',pass);
            NormVideo;
          End;
        WriteLn;
        ndir := Ptr(Ord(ndir)+SizeOf(ndrrec));
      Until Lo(ndir^.du) = 0
  End;
End.
Program BOX;

var i : integer;
    x : integer;
    y : integer;
    c : boolean;
    v : boolean;

procedure draw(x1,y1,x2,y2:integer);
var i : integer;
begin
  gotoxy(x1,y1);
  if v then lowvideo else normvideo;
  for i := x1 to x2 do write('-');
  normvideo;
  for i := y1+1 to y2 do
  begin
    if v then lowvideo else normvideo;
    gotoxy(x1,i); write('|');
    normvideo;
    if c then clreol;
    if v then lowvideo else normvideo;
    gotoxy(x2,i); write('|');
    normvideo;
  end;
  gotoxy(x1,y2);
  if v then lowvideo else normvideo;
  for i := x1 to x2 do write('-');
  normvideo;
  v := not v;
end;

BEGIN
  clrscr;
  c := true;
  v := false;
  for i := 1 to 5 do draw(i*4,i*2,12*i,4*i);
  c := false;
  x := 27;
  y := 13;
  gotoxy(x,y); Write('Alpha Systems Corporation'); y := y+1;
  gotoxy(x,y); Write('  711 Chatsworth Place'); y := y+1;
  gotoxy(x,y); Write('   San Jose, CA 95128'); y := y+1;
  gotoxy(x,y); Write('     (408) 297-5594');
  draw(1,1,79,23);
  normvideo
END.
(* NZ-TOOL.BOX 1.0 for Turbo Pascal 3.0
   Copyright (C) 1989 Alpha Systems

   Author:  Joe Wright
   Date:    20 Sept 89
   Version: 1.0

   Invoke TURBO.COM with a Z-System alias, TP.COM, as follows..

     1 --> GET 100 TURBO.COM;
     2 --> POKE 103 5A 33 45 4E 56 01 00 00;
     3 --> GO

   This puts a Z3ENV Type 1 header at the beginning of TURBO.COM
   so that GO will 'install' the Environment address at 109H.
   COM files created by TURBO.COM will also contain this header
   and therefore be Z3 utilities.

   This version of the TOOL.BOX describes the entire Z-System in
   terms of Turbo Pascal Records.  The Record structure and Turbo
   Pascal Pointers will allow the veteran Pascal programmer complete
   access to the Z-System Environment and by implication, a description
   of its entire structure.

   The Z-System assembly language programmer is presented with Pascal
   functions and procedures with familiar SYSLIB and Z3LIB names so
   that he can 'call' his favorite subroutines within Turbo Pascal
   without re-inventing the wheel.

   Programming style seems to vary according to the square of
   of programmers (or square programmers?) and no one should feel
   limited by the examples in this TOOL.BOX.  Think of it as a
   demonstration.  In the end, do it your way.

   Load the Tool Box into you program with the Turbo Pascal
   {$I NZ-TOOL.BOX} insertion directive.

   Turbo Pascal is not upper/lower case sensitive.  We tend to use
   mixed case for readability.  In order to distinguish among Turbo
   Pascal Standard declarations and our own, I try to follow the
   convention that..

     GoToBed   is a Turbo Pascal defined Word or Identifier
     GOTOBED   is the User Definition
     gotobed   is the User Declaration

   Mixed case is Pascal, UPPERCASE is our own definition and
   lowercase declares our definitions.

*)

{ User-Defined Global Types }

Type
  STR8    = String[8];              { Dir Name or Password         }
  STR21   = String[21];             { NDIRNAME:FILENAME.TYP        }

  ARR8    = Array[1..8] of Char;    { Name or Password array       }
  ARR3    = Array[1..3] of Char;    { File type array              }
  ARR5    = Array[1..5] of Char;    { Five-char ID like Z3ENV      }

  SECTOR  = Array[0..127] of Byte;  { Standard CP/M Unit Record    }

  FCBPTR  = ^FCBREC;
  FCBREC  =
    Record
      DRIV  : Byte;
      NAME  : arr8;
      TYP   : arr3;
      EXT   : Byte;
      S1    : Byte;
      S2    : Byte;
      RC    : Byte;
      ALLOC : Array[0..15] of Byte;
      CR    : Byte;
      RREC  : Integer;
      RERR  : Byte
    End;

{ This describes the Z3MSG structure. }

  MSGPTR = ^MSGREC;
  MSGREC =
    Record
      ERFLG   : Byte;
      IFLEV   : Byte;
      IFSTS   : Byte;
      CMDST   : Byte;
      ERADR   : Integer;
      PRGER   : Byte;
      ZEXMSG  : Byte;
      ZEXRUN  : Byte;
      ZEXNXT  : Integer;
      ZEX1ST  : Integer;
      SHCTL   : Byte;
      SCRAT   : Integer;
      ERCMD   : Array[1..32] of Char;
      REGIS   : Array[0..31] of Byte;
    End;

{ This describes the Z3CL structure for 'standard' Z-Systems. }

  MCLPTR = ^MCLREC;
  MCLREC =
    Record
      NXTCHR  : Integer;
      MCLMAX  : Byte;
      MCL     : String[203];
    End;

  MEMORY = Array[0..$7FFE] of Integer;

  PATPTR = ^PATREC;
  PATREC =
    Record
      PATH : memory;
    End;

  NDRPTR = ^NDRREC;
  NDRREC =
    Record
      DU : Integer;
      NAME : arr8;
      PASS : arr8;
    End;

{ The following Record Structures define the Z3 Environment of
  any NZ-System.  }

  ENVPTR = ^ENVREC;
  ENVREC =
    Record
      ENV     : Byte;
      CBIOS   : Integer;
      Z3ID    : Array[1..5] of Char;
      ENVTYP  : Byte;
      EXPATH  : patptr;
      EXPATHS : Byte;
      RCP     : Integer;
      RCPS    : Byte;
      IOP     : Integer;
      IOPS    : Byte;
      FCP     : Integer;
      FCPS    : Byte;
      Z3NDIR  : ndrptr;
      Z3NDIRS : Byte;
      Z3CL    : mclptr;
      Z3CLS   : Byte;
      Z3ENV   : Integer;
      Z3ENVS  : Byte;
      SHSTK   : Integer;
      SHSTKS  : Byte;
      SHSIZE  : Byte;
      Z3MSG   : msgptr;
      EXTFCB  : fcbptr;
      EXTSTK  : Integer;
      QUIET   : Byte;
      Z3WHL   : ^Byte;
      SPEED   : Byte;
      MAXDSK  : Byte;
      MAXUSR  : Byte;
      DUOK    : Byte;
      CRT     : Byte;
      PRT     : Byte;
      COLS    : Byte;
      ROWS    : Byte;
      LINS    : Byte;
      DRVEC   : Integer;
      SPAR1   : Byte;
      PCOL    : Byte;
      PROW    : Byte;
      PLIN    : Byte;
      FORM    : Byte;
      SPAR2   : Byte;
      SPAR3   : Byte;
      SPAR4   : Byte;
      SPAR5   : Byte;
      CCP     : Integer;
      CCPS    : Byte;
      DOS     : Integer;
      DOSS    : Byte;
      BIO     : Integer;
      SHVAR   : Array[1..11] of Char;
      FILE1   : Array[1..11] of Char;
      FILE2   : Array[1..11] of Char;
      FILE3   : Array[1..11] of Char;
      FILE4   : Array[1..11] of Char;
      PUBLIC  : Integer;
    End;

{ Global Variables }

{ These are the Absolute (External) variable assignments which
  give the Turbo Pascal program access to everything we know. }

Var
  WBOOTV  : Integer     Absolute $0001;
  IOBYTE  : Byte        Absolute $0003;
  CDISK   : Byte        Absolute $0004;
  BDOSV   : Integer     Absolute $0006;
  FCB1    : fcbrec      Absolute $005C;
  FCB2    : fcbrec      Absolute $006C;
  TBUFF   : String[126] Absolute $0080;
  DBUFF   : sector      Absolute $0080;
  Z3EADR  : envptr      Absolute $0109;

{ These Global Variables are used by the new Functions and Procedures
  and the Main program to pass parameters among themselves. }

  SPEC1   : str21;      {For DIRECTRY:FILENAME.TYP}
  SPEC2   : str21;      {For DIRECTRY:FILENAME.TYP}
  DIRS    : str8;       {For D:, U:, DU: or DIR:}
  NAME    : str8;       {Directory Name}
  PASS    : str8;       {Directory Password}

  SOURCE  : File;       {File being Read}
  DESTIN  : File;       {File being Written}
  CURDU   : Integer;    {Current (default) Drive/User}
  SRCDU   : Integer;    {Source D/U}
  DSTDU   : Integer;    {Destination D/U}


{ From here on, we will collect various User-Defined functions
  and procedures which emulate SYSLIB and Z3LIB subroutines of
  the Z-System.  To the extent that they may 'call' each other,
  they are arranged here such they are Declared before they are
  called, SYSLIB, Z3LIB, VLIB, in that order.  Turbo Pascal is
  itself rich enough to provide most of the functions we need. }

Procedure CAPSTR(Var S:str21);
Var I : Integer;
Begin
  for i := 1 to Length(s) do s[i] := UpCase(s[i])
End;

Function PHEX(N,B:Integer):str8;
Var H : str8; I, C : Byte;
Begin
  h[0] := #0; { Clear the string }
  For i := b Downto 1 Do
  Begin
    c := n and 15; n := n shr 4;
    If c < 10 Then c := c+48 Else c := c+55;
    Insert(Chr(c),h,1)
  End;
  phex := h
End;

Function RETUD:Integer;
Begin
  retud := 256 * (Bdos(25)+1) + Bdos(32,$FF)
End;

Procedure LOGUD(DU:Integer);
Begin
  Bdos(14,Hi(DU)-1); Bdos(32,Lo(DU))
End;

Procedure PDU(du:Integer);
Begin
  Write(Chr(Hi(du)+64),Lo(du),':')
End;

Function GETNDR:Integer;
Begin
  getndr := Ord(z3eadr^.z3ndir)
End;

Function DIRSCAN(S:str8):Integer;
Var NDIR : ndrptr;
    D, I : Integer;
Begin
  d := 0;
  ndir := Ptr(getndr);
  if ndir^.du <> 0 then
    Repeat
      name[0] := #8;
      for i := 1 to 8 do name[i] := ndir^.name[i];
      i := Pos(' ',name);
      if i <> 0 then name[0] := Chr(i-1);
      if s = name then d := Swap(ndir^.du) else d := 0;
      ndir := Ptr(Ord(ndir)+SizeOf(ndrrec));
    Until (d <> 0) or (Lo(ndir^.du) = 0);
  dirscan := d;
End;

Function DUSCAN(S:str8):Integer;
Const d = 'ABCDEFGHIJKLMNOP';
Var du, usr, cod : Integer;
Begin
  du := curdu;
  if Length(s) <> 0 then
    begin
      if Pos(s[1],d) <> 0 then
        begin
          du := Pos(s[1],d)*256 + (du and 255);
          Delete(s,1,1)
        end;
      if Length(s) <> 0 then
        begin
          Val(s,usr,cod);
          if cod <> 0 then du := 0 else du := (du and -256) + usr
        end;
    end;
  duscan := du;
End;

Function DNSCAN:Integer;
Var du : Integer;
Begin
  du := dirscan(dirs);
  if du = 0 then du := duscan(dirs);
  dnscan := du
End;

Function NAMSTR(Nam:arr8):str8;
Var I : Integer; Str : str8;
Begin
  str[0] := #8;
  for i := 1 to 8 do str[i] := nam[i];
  i := Pos(' ',str);
  if i <> 0 then
    str[0] := Chr(i-1);
  namstr := str
End;

Function DUTDIR(du:Integer):Boolean;
Var ndir : ndrptr;
    i    : Integer;
Begin
  name[0] := #0;
  pass[0] := #0;
  ndir    := Ptr(getndr);
  Repeat
    if du = Swap(ndir^.du) then
      begin
        name := namstr(ndir^.name);
        pass := namstr(ndir^.pass);
      end;
    ndir := Ptr(Ord(ndir)+SizeOf(ndrrec));
  Until (Length(name) <> 0) or (Lo(ndir^.du) = 0);
  dutdir := Length(name) <> 0
End;

Function GETWHL:Boolean;
Begin
  if z3eadr^.z3whl^ = 0 then
    getwhl := false
  else
    getwhl := true
End;

Procedure SETWHL(B:Byte);
Begin
  z3eadr^.z3whl^ := b
End;

Function GETDUOK:Boolean;
Begin
  if z3eadr^.duok = 0 then
    getduok := false
  else
    getduok := true
End;

Procedure PARSE(Var S:str21);
Var P : Integer;
Begin
  dirs[0] := #0;  { Clear the string }
  p := Pos(':',s);
  if p <> 0 then
    begin
      dirs := Copy(s,1,p-1);
      Delete(s,1,p)
    end;
End;

{ End of NZ-TOOL.BOX 1.0 }
{ Program:  CPY.PAS
  Author:   Joe Wright
  Date:     10 Sept 89
  Version:  0.1

  This single-file copy program uses the NZ-TOOL.BOX to add
  many Z3LIB functions to Turbo Pascal programs.

  Version 0.2 is modified for the changes in NZ-TOOL.BOX

}

Program CPY;
{$I nz-tool.box}
{ Constants are used very much like EQUates. }
Const
  ver  = 0.2;    { Version Number }
  cr   = ^M;
  lf   = ^J;
  bel  = ^G;
  recs = 128;    { Sector size }
  bufs = 128;    { 128 of them for 16k (Max) }
Var
  inpbuf : Array[1..bufs,1..recs] of Byte;
  count  : Integer;
  i      : Integer;
  cks    : Integer;  { Checksum variable }
  ch     : Char;     { Keyboard response }
  o      : Boolean;  { Overwrite option  }
  n      : Boolean;  { No verify option  }

BEGIN {ning of CPY.PAS}
  name := namstr(z3eadr^.extfcb^.name);
  if fcb1.name[1] < '0' then {Help}
    Write(
      name,' Ver ',ver:1:1,' Single-File Copy Program',cr,lf,
      '  Syntax:  ',name,' [dir:]source [[dir:]destination] [/oo]',cr,lf,
      '    where ''/oo'' is [O]verwrite and/or [N]o Verify options.'
      )
  else
    begin {source}
      o := false;
      n := false;
      curdu := retud;       { retud from nz-tool.box }
      dstdu := curdu;
      i := Pos('/',tbuff);  { check for '/' on command line }
      if i <> 0 then
        Repeat
          i := i+1;
          if tbuff[i] = 'O' then o := true;
          if tbuff[i] = 'N' then n := true;
        Until tbuff[i] = #0;
      spec1 := ParamStr(1);
      parse(spec1);         { parse dir: part to dirs }
      srcdu := dnscan;      { dnscan resolves d:, u:, du: and dir: }
      logud(srcdu);         { log it in }
      Assign(source,spec1);
      {$I-}
      Reset(source);        { open the input file }
      {$I+}
      if IOresult <> 0 then
        Write('Can''t find ',spec1)
      else
        begin {destin}
          spec2 := spec1;
          spec1 := ParamStr(2);
          parse(spec1);
          if (Length(spec1) = 0) or (spec1[1] = '/') then
            spec1 := spec2;
          dstdu := dnscan;
          if (dstdu = srcdu) and (spec1 = spec2) then
            Write(bel,'Don''t be silly..') { source=destination }
          else
            begin {copy}
              logud(dstdu);  { Log into destination area }
              Assign(destin,spec1);
              if not o then
                begin
                  {$I-}
                  Reset(destin);
                  {$I+}
                  If IOresult = 0 then
                    begin
                      pdu(dstdu);
                      if dutdir(dstdu) then Write(name,' ');
                      Write(spec1,' Exists.  Overwrite? (Y or N) ');
                      Read(Kbd,ch); WriteLn(ch);
                      if UpCase(ch) <> 'Y' then Halt;
                    end;
                end;
              ReWrite(destin);  { erases any existing file }
              { Tell the user we're up to something }
              Write(' Copying ');
              pdu(srcdu);
              if dutdir(srcdu) then Write(name,' ');
              Write(spec2,' to ');
              pdu(dstdu);
              if dutdir(dstdu) then Write(name,' ');
              WriteLn(spec1);
              cks := 0;  { clear the checksum word }

              Repeat
                Write('.');
                logud(srcdu);
                BlockRead(source,inpbuf,bufs,count);
                if not n then
                  for i := 0 to (count*recs)-1 do
                    cks := cks + Mem[Addr(inpbuf)+i];
                logud(dstdu);
                BlockWrite(destin,inpbuf,count);
              Until count = 0;

              Close(destin);
              if not n then
                begin {verify}
                  Reset(destin);   { Prepare to read it }
                  Write(cr,lf,' Verifying ');
                  pdu(dstdu);
                  if dutdir(dstdu) then Write(name,' ');
                  WriteLn(spec1);

                  Repeat
                    Write('.');
                    BlockRead(destin,inpbuf,bufs,count);
                    for i := 0 to (count*recs)-1 do
                      cks := cks - Mem[Addr(inpbuf)+i];
                  Until count = 0;

                  if cks <> 0 then Write(bel,cr,lf,'  Failed!')
                end; {verify}
            end; {copy}
        end; {destin}
    end; {source}
END. {of CPY.PAS}
Program RAD;

{$I nz-tool.box}

Function EVAL(RAD:Integer; NUM:str21):Real;
{ Evaluate a String variable of a given radix 2..16 to decimal Real.}
Const T = '0123456789ABCDEF';
Var   N : Real;
Begin
  n := 0;
  if (1 < rad) and (rad < 17) then
  While Length(num) <> 0 do
    Begin
      n := n * rad + Pos(num[1],t)-1;
      Delete(num,1,1)
    End;
  eval := n;
End;

Function CNVRT(R:Integer; V:Real):str21;
{ Convert a decimal Real number to a string of radix 2..16 }
Const  D = '0123456789ABCDEF';
Var S : str21;
Begin
s := '0';
if (v>0) and (1<r) and (r<17) then
  Begin
    s[0] := #0;  { Clear the string }
    Repeat
      v := v / r;
      s := Copy(d,Round(Frac(v)*r+1),1) + s;
      v := v - Frac(v);
    Until v = 0;
  End;
cnvrt := S;
End;

Function RAD(S:str21):Integer;
Var r, c : Integer;
Begin
  Case s[1] of
    'B','b'  : r := 2;
    'O','o'  : r := 8;
    'D','d'  : r := 10;
    'H','h'  : r := 16;
  else
    Val(s,r,c)
  end;
rad := r;
End;

Var r1, r2 : Integer;
    value  : Real;
Begin
if fcb1.name[1] < '0' then
  Begin
    name := namstr(z3eadr^.extfcb^.name);
    WriteLn(name,' Number conversion program');
    WriteLn('  Syntax:  ',name,' nnnn [r1] [r2]');
    WriteLn('    where r1 is the input radix, r2 the output');
    WriteLn('    radix, any of 2..16, H, D, O or B')
  End
else
  Begin
    r1 := 16;
    r2 := 10;
    if Length(ParamStr(3)) <> 0 then r2 := rad(ParamStr(3));
    if Length(ParamStr(2)) <> 0 then r1 := rad(ParamStr(2));
    value := eval(r1,ParamStr(1));
    Write('Base ',r1,':',r2,'  ',cnvrt(r2,value))
  End
End.

