An OCR / scanning / proofreading project by Kim Sparre and Lee Bradley

Updated on Monday, July 07, 2008, Saturday, July 17, 2010

cover-page.jpg

http://primepuzzle.com/tp2/turbo-pascal-2.0.zip

http://primepuzzle.com/tp2/turbo-pascal-2.0-manual-fixed.pdf

http://primepuzzle.com/tp2/turbo-pascal-2.0-manual-fixed.zip

http://primepuzzle.com/tp2/supplemental-notes.html

http://primepuzzle.com/tp2/addendum.pdf


The archive http://primepuzzle.com/mouse/maxz80.zip contains the example programs below (and a lot more).

This example illustrates how you can hook your application into a Z-System environment.

Program PD;
{
  Author: Joe Wright
  Date: 22 Sep 89
  Poorman's version of PWD.COM to demonstrate NZ-TOOL.BOX and
  access to the Z3NDIR structure.
  Updated: Lee Bradley
  Date: 12 May 08, 25 Sep 08
  Compile with End Address of 3000 hex.
}
{$I nz-tool.def}
{$I nz-tool.box}
label
  100;
var
  ndir : ndrptr;
  x, y : Integer;
const
  ver = '0.4';
Begin
  if not z3exist Then Begin
    WriteLn('Z3 not found.'); goto 100;
  End;
  ndir := Ptr(getndr);
  if Ord(ndir)=0 Then Begin
    WriteLn('Named Directory not found.');goto 100;
  End;
  if Ord(z3eadr^.extfcb)=0 Then Begin
    WriteLn('External FCB not found.');goto 100;
  End;
  name := namstr(z3eadr^.extfcb^.name);
  y := 13; x := 25;
  ClrScr;
  WriteLn; WriteLn('Print Working Directories, Version ',ver);
  WriteLn('    Syntax:  ',name,' [P]');
  WriteLn('  The P option will show Passwords if Wheel is ON');
  Write(' Z3 Wheel is O');
  if getwhl then WriteLn('N') else WriteLn('FF');
  WriteLn; WriteLn;
  While Lo(ndir^.du) <> 0 do
  Begin
    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); Write(' Pass: ',pass); End;
    WriteLn;
    ndir := Ptr(Ord(ndir)+SizeOf(ndrrec));
  End;
100:
End.
pd.jpg

The next two examples show how to use CP/M bdos calls in a high level language application. They both display file directories. The first of the two illustrates sorting, linked lists, heap management, file size calculation etc. The second is shorter and has fewer features.

{

CP/M-80 directory program written in Turbo Pascal 2.0.
Based loosely on wildcard.pas, author and compiler unknown.
Accepts ambiguous file names and displays sorted directory.
File sizes rounded to next 1k increment.
Steve Fox - Albuquerque RCP/M (505)299-5974
Version 1.0 29 Mar 1985

Revised 23 Apr 85 by : William L. Mabee, CRNA.

Changed code to allow automatic display of logged DU directory. Code can 
be included in a Turbo Pascal program or chained to from a main Turbo 
routine. Added code to display total amount of disk space used. Added 
header.

21 June 08 - removed unused functions, added command tail processing,
changed file size calculation to reflect 4K allocation block size, added
pause when more than 80 files are found, added S option (include System
files), added Usage text - Lee Bradley

}

program dir;
const
  columns   = 4;
  fence     = ' | ';
  h1        = 'File     Ext Size   ';
type
  CharSet   = set of char;
  FileName  = string[14];     { d:filename.ext }
  Str80     = string[80];
  StrStd    = string[127];
  FilePtr   = ^FileDescr;
  FileDescr =
    record
      fname: FileName;  { Name of a matching file }
      fsize: integer;   { Size of file }
      Next: FilePtr;    { Points to next name on linked list }
    end;
  FileBlock =
    record
      case boolean of
        true:
          (drive: byte;                     { Byte code }
           fname: array[1..11] of char;     { File name }
           extent,                          { Current extent }
           s1, s2, reccount: byte;          { Used to compute file size }
           dn: array[16..31] of byte);
        false:
          (init: array[1..32] of byte);
    end;
var
  entries: integer;                         { Count of directory entries }
  prototype: FileName;                      { Directory mask }
  first: FilePtr;                           { Start of linked list }
  searchblk: FileBlock;                     { Block for search }

{$I paramstb.inc}

procedure GetMask(var prototype: FileName);
  { Get ambiguous file name and expand into directory mask (prototype) }
    label label1;
    var
      i,j: integer;
      line: StrStd;

    function pad(line: StrStd; i: integer): StrStd;
    { Pad line with spaces to length of i }
      begin
        while length(line) < i do
          line := line + ' ';
        pad := line
      end;

    begin
      line := paramstr(1);
      if Pos('/',line) <> 0 then goto label1;
      if line = '' then line := '*.*';
      line := pad(line, 14);
      prototype := copy(line, 1, 14);
      FillChar(searchblk.init, 32, 0);
      with searchblk do
        begin
          if prototype[2] = ':'
            then
              begin
                drive := succ(ord(prototype[1]) - ord('A'));
                i := 3
              end
            else
              begin
                drive := 0;
                i := 1
              end;
          fname := '           ';
          j := 1;
          repeat
            begin
              if prototype[i] = '*'
                then while j <= 8 do
                  begin
                    fname[j] := '?';
                    j := succ(j)
                  end
                else
                  begin
                    fname[j] := prototype[i];
                    j := succ(j)
                  end
            end;
            i := succ(i)
          until (j > 8) or (prototype[i] = '.');

          while (prototype[i] <> '.') and (prototype[i] <> ' ') do
            i := succ(i);

          i := succ(i);
          j := 9;
          repeat
            begin
              if prototype[i] = '*'
                then while j <= 11 do
                  begin
                    fname[j] := '?';
                    j := succ(j)
                  end
                else
                  begin
                    fname[j] := prototype[i];
                    j := succ(j)
                  end
            end;
            i := succ(i)
          until (j > 11) or (prototype[i] = '.');
          extent := ord('?');
          s1     := ord('?');
          s2     := ord('?')
        end;
        label1:
    end;

procedure ReadDir(
  prototype: filename; var entries: integer; var first: FilePtr);
  { Create an alphabetized list of files which match the prototype }
    const
      findfirst = 17;   { search for first file }
      findnext  = 18;   { search for next file }
      setdma    = 26;   { set dma buffer address }
      fcb       = $80;  { Default dma buffer address }
    type
      dirblock  = array [0..3] of FileBlock;
    var
      off: integer;         { dir entry offset or end flag }
      fn: FileName;
      answerblk: dirblock;  { block to receive file name }

    procedure InsertFile(
      fn: FileName; fs: integer; var entries: integer; var first: FilePtr);
    { Insert a new file name in the alphabetic list }
      var
        f,this,previous: FilePtr;    { created, inserted }
      begin
        previous := nil;
        this := first;
        while (this <> nil) and (this^.fname < fn) do
          begin
            previous := this;
            this := this^.next
          end;
        if this^.fname <> fn then
          begin
            entries := succ(entries);
            new(f);
            f^.fname := fn;
            f^.fsize := fs;
            f^.next  := this;
            if previous = nil then first := f
            else previous^.next := f
          end
        else if this^.fsize < fs then this^.fsize := fs
      end;

    begin { ReadDir }
      entries := 0;
      first := nil;
      BDOS(setdma, addr(answerblk));
      off := BDOS(findfirst, addr(searchblk));
      while off <> 255 do
        begin
          with answerblk[off] do
            if (((ord(fname[10]) and $80) = 0) or
             (Pos('S',paramstr(2)) <> 0)) then
             { Non-system? or include System }
                begin
                  drive := 11;              { File name length }
                  move(drive, fn, 12);      { File name }
                  insert('.', fn, 9);
                  InsertFile(
                  fn, reccount + (extent + (s2 shl 5)) shl 7, entries, first);
                end;
          off := BDOS(findnext, addr(searchblk));
        end;
      BDOS(setdma, fcb)    { Restore DMA buffer }
    end;

procedure DispDir(entries: integer; first: FilePtr);
  { Display directory list }
    var
      i,j,size,totsize: integer;
      OldName: FilePtr;
      Ch: Char;
    begin
      i := 0;j := 0;
      totsize := 0;
      WriteLn;WriteLn(h1+h1+h1+h1);
      while first <> nil do
        begin                               { Scan the whole list }
          size := first^.fsize shr 3;
          if 0 <> (first^.fsize mod 8) then size := succ(size);
          if size mod 4 <> 0 then size := size + 4 - size mod 4;
          totsize := totsize + size;
          Write(first^.fname, size:4, 'K');
          i := succ(i);
          Oldname := first;
          first := first^.Next;             { Go to next on chain }
          dispose(Oldname);                 { Reclaim space }
          if i < columns then Write(fence)
          else begin WriteLn;i := 0;j := succ(j) end;
          if j=20 then begin
            j := 0;Write('Strike Any Key ... ');Read(Kbd,Ch);WriteLn
          end;
        end;
        WriteLn;WriteLn;Write('Total number of Files : ',entries);
        WriteLn('              Using a total of : ',totsize,'K');
    end;

  begin
    GetMask(prototype);                     { Read mask }
    if Pos('/',paramstr(1)) <> 0 then
      WriteLn(^J^M'Usage: TDIR [[d:]afn.aft [S]]')
    else begin
      ReadDir(prototype, entries, first);     { Read directory }
      DispDir(entries, first);                { Display directory }
    end;
  end .

tdir.jpg

PROGRAM CPM80Dir;

  { This program gives a directory of the logged drive/user area. }
  { Update log. Lee Bradley
    6/24/86, Fixed treatment of drive byte and added user number
             display.
    6/27/86, Removed redundant code.
    6/29/86, Made more efficient.  Capitalized key words.  Adding
             formatting logic. }

CONST
  Search_First         : integer = $11;
  Search_Next          : integer = $12;
  Set_DMA              : integer = $1A;
  Return_Cur_Disk      : integer = $19;
  Get_Cur_User         : integer = $20;

VAR
  Error, Loop, Start   : integer;
  FCB                  : ARRAY[0..25] OF byte ABSOLUTE $005C;
  DMA                  : ARRAY[0..255] OF byte;
  first_time           : boolean;
  d,u                  : STRING[1];
  i                    : integer;

BEGIN
  first_time := true;
  i := 0;
  Error := BDos(Set_DMA,Addr(DMA));
  FCB[0] := 0;
  FOR Loop := 1 TO 11 DO
    FCB[Loop] := ord('?');
  d := Chr(BDos(Return_Cur_Disk)+65);
  u := Chr(BDos(Get_Cur_User,$ff)+48);
  Writeln;
  Writeln('CPMDIR.PAS, Version 1.1, 6/29/86');
  Writeln;
  REPEAT
    IF NOT first_time THEN Error := BDos(Search_Next)
    ELSE
      BEGIN
        Error := BDos(Search_First,Addr(FCB));
        first_time := false;
      END;
    Start := Error * 32;
    IF Error <> 255 THEN
      BEGIN
        IF i = 4 THEN BEGIN Writeln; i := 0; END;
        IF i <> 0 THEN Write(' | ');
        Write(d,u,': ');
        FOR Loop:= Start+1 TO Start+8 do
          Write(Chr(Mem[Addr(DMA)+Loop]));
        Write('.');
        FOR Loop:= Start+9 TO Start+11 DO
          Write(Chr(Mem[Addr(DMA)+Loop]));
        i := i + 1
      END
  UNTIL Error=255;
  Writeln
END. { CPM80Dir }
cpmdir.jpg

The next example illustrates file input, the builtin Delay function etc.

PROGRAM bambi;

(*

   Update Log: Lee Bradley, Sysop, Z-Node #12
   Modem: (203) 665-1100
   Date: 09/30/90

   Compile End address = 3000.
   Added frame procedure, reducing code size.
   Made DELA, DELA1 constants.
   Using mixed case in title.
   Renumbered frame index.
   Added Xerox/Royal cursor on/off code. You may uncomment/comment
   and/or change for your terminal and recompile.

   Change delay logic - user can control the speed now
   Uses MyZ80 cursoron and cursoroff commands - 7/3/2010 - lrb

*)

VAR
  bambi,godzilla : TEXT;
  deer : ARRAY[1..10] OF STRING[40];
  foot : ARRAY[1..22] OF STRING[60];
  i,j : BYTE;
  idelay : INTEGER;

PROCEDURE cursoroff;
BEGIN
(* write(^[^R); *)   (* Royal alphaTronic specific *)
(* write(^E' ');     (* Xerox specific *)
  write(^['"6');     (* MyZ80 *)
END;

PROCEDURE cursoron;
BEGIN
(*  write(^[^S); *)  (* Royal alphaTronic specific *)
(*  write(^E^B);     (* Xerox specific *)
  write(^['"3');     (* MyZ80 *)
END;

PROCEDURE frame;
BEGIN
  FOR i:=1 TO 10 DO
    READLN(bambi,deer[i]);
  GotoXY(1,11);
  FOR i:=1 TO 10 DO BEGIN
    WRITE(Deer[i]);
    ClrEol;
    WRITELN;
    END;
END;

BEGIN

  writeln;
  repeat
    write('Speed level (1-fast, 30-slow): ');
    readln(idelay);
  until idelay in [1..30];
  idelay:=idelay*1000;

  ASSIGN(bambi,'BAMBI.DAT');
  RESET(bambi);
  ClrScr;
  cursoroff;
  ASSIGN(godzilla,'GODZILLA.DAT');
  RESET(godzilla);
  FOR i := 1 TO 22 DO
    READLN(godzilla,foot[i]);
  CLOSE(godzilla);
  GotoXY(1,8);
  WRITELN('  B a m b i   M e e t s   G o d z i l l a');
  WRITELN;
  Delay(idelay);
  frame; Delay(idelay);         (* #1 *)
  FOR j := 2 TO 3 DO frame;
  Delay(idelay);
  frame; Delay(idelay);         (* #4 *)
  frame; Delay(idelay);         (* #5 *)
  FOR j := 6 TO 14 DO BEGIN
    frame;
    IF j>10 THEN Delay(idelay);
    END;
  Delay(idelay);
  FOR j := 15 TO 34 DO frame;
  Delay(idelay);
  frame; Delay(idelay);         (* #35 *)
  frame; Delay(idelay);         (* #36 *)
  frame; Delay(idelay);         (* #37 *)
  FOR j := 1 TO 9 DO BEGIN
    Delay(idelay);
    GotoXY(1,1);
    FOR i := 21-j TO 20 DO BEGIN
      WRITE(Foot[i]);
      ClrEol;
      WRITELN;
      END;
    END;
  frame;                        (* #38 *)
  FOR j := 10 TO 20 DO BEGIN
    Delay(idelay);
    GotoXY(1,1);
    FOR i := 21-j TO 20 DO BEGIN
      WRITE(Foot[i]);
      ClrEol;
      WRITELN;
      END;
    END;
  GotoXY(1,1);
  FOR i := 1 TO 22 DO BEGIN
    WRITE(Foot[i]);
    ClrEol;
    WRITELN;
    END;
    cursoron;
END.

Click the link below to see the movie clip.

http://primepuzzle.com/mouse/bambi.avi

bambi.jpg

The next example generates n-point stars. INClude files that support graphing routines and command tail parsing are used.

{
STARPS.PAS - lrb - 1/25/2008
Operating system: CP/M or Z-System
Compiler: Turbo Pascal 2.0

This program generates PLOT-compatible .VEC files of "star graphs."

Use PLOT33 or ZPLOT to generate .PLT files from the .VEC files.

An Epson-compatible dot matrix printer with graphics capability is needed
to print the .PLT files. Alternatively, you may export the .PLT file to the
DOS environment and use DOSPrinter.EXE, an Epson emulator.

Usage: STARPS p s r

where p is the number of points on the star, s is a "skip" number, r is an
optional radius.
}

PROGRAM main;
LABEL
    foo,bar;
TYPE
    PRIMES = set of 7..101;
    Str80 = string[80];
VAR
    x,y: ARRAY [1..101] of REAL;
    a: REAL;
    i,n: INTEGER;
    ip,jp: INTEGER;
    step,skip: INTEGER;
    radius: REAL;
    points,skips: string[3];
    radiuss: string[4];
    works: string[80];
    code: INTEGER;
    prime: PRIMES;
    work: INTEGER;
    good: BOOLEAN;
{$I GRAF1.PAS}
{$I GRAF2.PAS}
{$I PARAMSTB.INC}
BEGIN
    Writeln(^J'STARPS - 1/25/2008 - lrb');
    prime := [7,11,13,17,19,23,29,31,37,41,43,47];
    prime := prime+[53,59,61,67,71,73,79,83,89,97,101];
    good := True;
    work := length(ParamStr(1));
    work := work*length(ParamStr(2));
    If work <> 0 THEN BEGIN
      points := ParamStr(1);
      Val(points,n,code);
      skips := ParamStr(2);
      Val(skips,skip,code);
      step := skip+1;
      IF NOT (n in prime) THEN good := False;
      IF (skip > (n-3)/2) or (skip < 1) THEN good := False;
    END
    ELSE good := False;
bar:
    IF NOT good THEN BEGIN
      Writeln(^J'Usage : STARPS points skip radius');
      Writeln(^J'points is a prime number in 7..101');
      Writeln('skip is <= (points-3)/2');
      Writeln('radius (optional) is radius of circle');
      Writeln('radius must be <= 0.5 (default = 0.5)');
      GOTO foo;
      END;
    grinit ('ST'+points+'S'+skips+'.VEC');
    radius := 0.5;
    radiuss := ParamStr(3);
    if length(radiuss) <> 0 then Val(radiuss,radius,code);
    if (radius < 0) or (radius > 0.5) then BEGIN
       good := False;
       GOTO bar;
       END;
    FOR i := 1 to n DO BEGIN
      a := 6.28318 * i / n;
      x[i] := cos(a)*radius + radius;
      y[i] := sin(a)*radius + radius;
    END;
    Str(radius:4:2,radiuss);
    works := points+'-point skip-'+skips;
    works := works+' radius '+radiuss+' star';
    Writeln(CON,'Plotting '+works);
    segmnt(x[1],y[1],x[1+step],y[1+step]);
    FOR i := 2 to n DO
    BEGIN
      ip := (step*i - (step - 1)) mod n;
      if ip = 0 then ip := n;
      jp := (ip + step) mod n;
      if jp = 0 then jp := n;
      vector( x[jp],y[jp] );
    END;
    if radius <= 0.45 then gstrng(radius,0.950,works);
    gprint;
    color(0);
    erase;
    color(127);
    Writeln(CON, ^J'Finished plotting!'^G^G);
    Writeln(CON,'ST'+points+'S'+skips+'.VEC ready for ZPLOT (or PLOT33)!');
    grfini;
foo:
END.

200px-Blaise_pascal.jpg


From Wikipedia, the free encyclopedia
Blaise Pascal
Birth 	June 19, 1623(1623-06-19)
Death 	August 19, 1662 (aged 39)
School/tradition 	Continental Philosophy, precursor to existentialism
Main interests 	Theology, Mathematics
Notable ideas 	Pascal's Wager
Influenced by 	Michel de Montaigne

Blaise Pascal (pronounced [bl?z paskal]), (June 19, 1623 - August 19,
1662) was a French mathematician, physicist, and religious philosopher.
He was a child prodigy who was educated by his father. Pascal's earliest
work was in the natural and applied sciences where he made important
contributions to the construction of mechanical calculators, the study
of fluids, and clarified the concepts of pressure and vacuum by
generalizing the work of Evangelista Torricelli. Pascal also wrote in
defense of the scientific method.

Pascal was a mathematician of the first order. He helped create two
major new areas of research. He wrote a significant treatise on the
subject of projective geometry at the age of sixteen, and later
corresponded with Pierre de Fermat on probability theory, strongly
influencing the development of modern economics and social science.

Following a mystical experience in late 1654, he abandoned his
scientific work and devoted himself to philosophy and theology. His two
most famous works date from this period: the Lettres provinciales and
the Pensées. Pascal suffered from ill health throughout his life and
died two months after his 39th birthday.
http://primepuzzle.com/tp2/