|
Updated on Monday, July 07, 2008, Saturday, July 17, 2010
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
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.
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 .
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 }
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.
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.
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/ |