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/ |