|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8192 (0x2000)
Types: TextFile
Names: »REGN.PAS«
└─⟦5c8344fa1⟧ Bits:30004223 REGN version 2.1 til ICL Comet
└─ ⟦this⟧ »REGN.PAS«
(* REGN.PAS *)
æ Dette program er en videreudvikling af programmet MICROCALC fra å
æ TURBO PASCAL (Borland Corp.) å
æ Programmet er opstaaet som et programudviklingsprojekt under å
æ Landcentralen for Undervisningsmidler. å
æ Da der er tale om en videreudvikling af et eksisterende program, å
æ vil der findes ting i programmet, som vi nok ville have foretruk- å
æ ket lavet paa en anden maade. Men med de resourcer, vi har haft å
æ raadighed, er dette resultatet. TAKE IT - OR LEAVE IT!!!! å
æ The rest of the comments in this source text are in english to å
æ avoid some danish characters, which have special meaning for the å
æ compiler. å
æ This version can with very few changes be compiled to a running å
æ program on other 8-bit machines using a POLY-PASCAL compiler å
æ If you should be interested in the compability problem, here is a å
æ lot of hints on how to make a program movable from one machine to å
æ another. å
æ The source consists of 8 seperate files: å
æ REGNDEF.PAS REGN.PAS REGN1.PAS REGN2.PAS REGN3.PAS REGN4.PAS å
æ REGN5.PAS and REGN6.PAS å
æ REGN.PAS, REGN2.PAS, REGN3.PAS, REGN4.PAS, REGN5.PAS and REGN6.PAS å
æ are made to be as nearly machine independent as possible. å
æ REGNDEF.PAS consists of definitions regarding special keys and å
æ strings to be sent to the terminal. å
æ REGN1.PAS has a procedure in which function keys can be set å
æ up to send the desired strings. Special characters can be made å
æ here as well. å
æ If you should be in need of more free memory the procedures in å
æ REGN5.PAS are all suitable as overlayes å
æ The group, which have made this particular version of REGN, does å
æ not want to have any responsibility for other versions of the å
æ program, which should be made by using this particular source text.å
æ We kindly request, that you use another name for your own version! å
æ This program is donated to the public domain for å
æ non commercial use only. Donated by TURBO PASCAL (Borland Corp.) å
PROGRAM REGN; (*$R-,U-,A+,C-*)
const
maxtegn = 77; æ maximum length of string å
tom:stringÆmaxtegnÅ=' ';
fxmax: char = 'G'; æ maximum number of columns in spread sheet å
fymax = 21; æ maximum number of lines in spread sheet å
normwidth = 10; æ default width of coloumn å
(*$I REGNDEF.PAS*) æ machine- and system dependend procedures å
æ see also Include file REGN1.PAS å
type
str3 = stringÆ3Å;
str11 = stringÆ11Å;
str14 = stringÆ14Å;
str30 = stringÆ30Å;
str33 = stringÆ33Å;
anystring = stringÆmaxtegnÅ;
str128 = stringÆ128Å;
sheetindex = 'A'..'G';
attributes = (constant,formula,txt,overwritten,locked,calculated,onscreen);
æ the spreadsheet is made out of cells - every cell is defined as å
æ the following record: å
cellrec = record
cellstatus: set of attributes; æ status of cell (see type def.) å
contents: stringÆmaxtegnÅ; æ contains a formula or some text å
value: real; æ last calculated cell value å
dec,fw: 0..maxtegn; æ decimals and cell whith å
end;
cells = arrayÆsheetindex,1..fymaxÅ of cellrec;
const
xpos: arrayÆsheetindexÅ of integer = (2,13,24,35,46,57,68);
æ NOTE this is for PASCAL with upper left corner in position (0,0)å
æ the numbers are related to normwidth å
points:str33='.................................';
æ Line to be written, when calculation is impossible å
stars:str33='*********************************';
æ Line to be written, when cell width is too small å
var
sheet: cells; æ definition of the spread sheet å
fx: sheetindex; æ column of current cell å
fy: integer; æ line of current cell å
forladt: sheetindex; æ last column å
upfx: sheetindex; æ column under update å
upfy: integer; æ line under update å
ch: char; æ last read character å
mcfile: file of cellrec; æ file to store sheets in å
tekstfil: text; æ file for writing sheets å
autocalc: boolean; æ recalculate after each entry? å
slut: boolean; æ control for end of program å
retning: byte; æ default cursor movement direct.å
indicator: char; æ arrows to point the direction å
errmessage: arrayÆ1..15Å of str30; æ errormessages å
beregnet: boolean; æ to test for emty cells å
repeteret: boolean; æ to test for repetition å
eline: anystring; æ temporary string å
filename: str14; æ filename string å
ro: boolean; æ returns true if READ ONLY file å
default: byte; æ default drive å
ramdisk: boolean; æ true if ramdisk å
formelbuffer: cellrec; æ record for copying formulas å
kopierfra: str3; æ name of cell to be copied å
multi: boolean; æ COMET ONLY - true if multiuser å
(*$I REGN1.PAS*) æ machine- and system dependend procedures å
æ see also REGNDEF.PAS å
(*$I REGN2.PAS*)
(*$I REGN3.PAS*)
(*$I REGN4.PAS*)
(*$I REGN5.PAS*)
(*$I REGN6.PAS*)
æ*********************************************************************å
æ* this is where the program starts executing *å
æ*********************************************************************å
begin
TASTER;
(* The following are only for COMET *)
if ramdisk then ramdisk:=RAMDREVTEST; æ Special function in REGN5.PAS å
if ramdisk then ovdrive(4); (* Get overlays from drive D *)
(* *)
CURSOR(false);
INIT;
BUFFERNULL;
WELLCOME;
MENU;
if not slut then begin
GOTOCELL(fx,fy);
ch:=@0;
repeat
if ch<>return then ch:=KEY;
case ch of
op: MOVEUP;
ned: MOVEDOWN;
hoejre: MOVERIGHT;
venstre: MOVELEFT;
omregn:begin
RECALCULATE(true);
gotoxy(0,23);write(clreol);
GOTOCELL(fx,fy);
end;
return:begin
case retning of
0:begin
retning:=0;
indicator:='*';
gotoxy(0,0);write(indicator);
GOTOCELL(fx,fy);
end;
1:MOVERIGHT;
2:MOVEDOWN;
end;
ch:=@0;
end;
'/':begin
COMMANDS;
ch:=@0;
end;
esc: GETCELL(fx,fy);
otherwise
if ch in Æ' '..'ü'Å then GETCELL(fx,fy);
end;
if slut then begin
gotoxy(0,23);
write(clreol,bell,'Skal programmet afbrydes nu? J/N ');
repeat
ch:=UPCASE(KEY);
until ch in Æ'J','N'Å;
write(ch);
if ch='N' then begin
slut:=false;
FLASH(37,' Tast / for kommando ',false);
gotoxy(0,23);write(clreol);
GOTOCELL(fx,fy);
end;
end;
until slut;
end;
CURSOR(true);
AFSLUT;
end.
«eof»