|
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: 17408 (0x4400)
Types: TextFile
Names: »TELEFON.PAS«
└─⟦6032ef8bc⟧ Bits:30003298 Turbo Pascal 3.01A og diverse programmer til RC700
└─ ⟦this⟧ »TELEFON.PAS«
PROGRAM TELEFON; (*$A+,R-,C-*)
(* Rc702,703 piccolo *)
CONST
version = 'Telefon-register,Main v.87.11.09 (C) JFP.';
max = 255; (* 255 Fil-poster, (252 DATA-Poster). *)
px = 32; ypos = 11; (* Cur. XYpos, v.inddata, svar *)
offset = 2; (* Fil-offset=2, post1 i UDSKRIFT= DataPost.3 *)
level = 4; (* 1..9, Level= Max. File-No uden Password. *)
maxpas = 4; (* Password-Lengde, max 12 tegn. (Fil-acces). *)
maxpen = 3; (* Password-Lengde, max 12 tegn. (Skrivning). *)
TYPE
str3 = STRING Æ3Å;
str12 = STRING Æ12Å;
str16 = STRING Æ16Å;
str21 = STRING Æ21Å;
str24 = STRING Æ24Å;
str26 = STRING Æ26Å;
filpost = RECORD
flag,frik: CHAR;
grup: CHAR; (* Gruppe-Kode 0..9 *)
telf,idnt: str12; byno: str21;
navn,addr: str24; stil: str26;
END;
VAR
prn: TEXT;
modul,ch,svar,p_num,disp,UP,olpok: CHAR;
nr: CHAR; (* Index-Nr ved udskrift *)
pass,password: STRING ÆmaxpasÅ;
penn,pennword: STRING ÆmaxpenÅ;
listdev,udlist,filnavn,intxt,lede: str16;
grup_kode: ARRAY Æ0..9Å OF str21;
files: ARRAY Æ1..9Å OF str12;
txt,sbuf,fyld,txtcopy,sp: str26;
ok,indset,cont,clr,clear,fundet,dato_ok,nohead: BOOLEAN;
olp,lp_on,started,modul2,modul3,pass_ok,oprette: BOOLEAN;
term, dato,fil_dato: str12;
no,post: INTEGER; (* Fil-pointere, nix pille! *)
nul,startpost,nummer,line,tal,i,j,n: INTEGER;
form,komp,norm,lintop,linfed: INTEGER;
inryk,nlqon,nlqoff,labfed: INTEGER; (* label-setup *)
sp1,sp2,sp3: INTEGER; (* Special Print-Comm. *)
setolp,setlab: str21;
py,gempy,plx,skrift,nyside,side,filnum: BYTE;
cmd_str: str12 AT $0080;
fv: FILE OF filpost;
fpo: filpost;
PROCEDURE write_olp_string;
VAR
k: CHAR;
c1,c2,c3,c4,c5: str3;
BEGIN
STR(form,c1); STR(komp,c2); STR(norm,c3);
k:=','; STR(lintop,c4); STR(linfed,c5);
setolp:=c1+k+c2+k+c3+k+c4+k+c5+'.';
STR(inryk,c1); STR(nlqon,c2);
STR(nlqoff,c3); STR(labfed,c4);
setlab:=c1+k+c2+k+c3+k+c4+'.';
END;
PROCEDURE opstart;
BEGIN
UP:=CHR(26); (* Rc700-Cursor UP *)
form:=12; komp:=15; norm:=18; lintop:=60; linfed:=12;
inryk:=3; nlqon:=69; nlqoff:=70; labfed:=2; (* LP-Setup *)
FOR i:=0 TO 8 DO grup_kodeÆiÅ:='-ikke oprettet- ';
grup_kodeÆ9Å:='Diverse.'; nul:=3158; ch:=' ';
fpo.frik:='F'; (* Reserved Future use *)
fyld:=' '; (* 26 spacer *)
started:=FALSE; clr:=FALSE; clear:=FALSE;
pass_ok:=FALSE; olp:=FALSE; cont:=FALSE;
dato_ok:=TRUE; dato:='o'; fil_dato:='dato';
skrift:=1; nul:=5+nul+nul; nr:='#'; no:=0;
listdev:=' '; lede:=' '; udlist:=' /1';
filnavn:=' *'; filnum:=0; modul:='5';
sp1:=0; sp2:=67; sp3:=36; (* Print-Comm.*)
modul2:=FALSE; modul3:=FALSE; (* G-Koder *)
ASSIGN(prn,'CON:'); REWRITE(prn);
filesÆ1Å:='NAVNEREG'; filesÆ2Å:='FIRMAREG';
filesÆ3Å:='DATABASE'; filesÆ4Å:='FORENING';
filesÆ5Å:='ARKIVREG'; filesÆ6Å:='SKOLEREG';
filesÆ7Å:='KUNDEREG'; filesÆ8Å:='BUISNESS';
filesÆ9Å:='UDLANDET';
write_olp_string;
END;
PROCEDURE cleol;
BEGIN
CASE disp of
'1': WRITE(CLREOL); (* Rc700 *)
'2': BEGIN
WRITE(CHR(27)); WRITE(CHR(84)); (* McTerm *)
END;
'3': WRITE(CHR(30)); (* Rc822 *)
END;
END;
PROCEDURE cursor(dx,dy: INTEGER);
VAR w,xof: INTEGER;
BEGIN
CASE disp OF
'1': GOTOXY(dx,dy); (* Rc700 *)
'2': BEGIN
WRITE(CHR(27),CHR(61)); (* ESC=Y,X YX-Adr for *)
WRITE(CHR(dy+32)); WRITE(CHR(dx+32)); (* McTerm *)
END;
'3': BEGIN
xof:=32; (* for dx in 32..63 *)
IF dx<32 THEN xof:=96;
IF dx>63 THEN xof:=(-32);
WRITE(@6); (* XY-Adr, Rc822 *)
WRITE(CHR(dx+xof)); WRITE(CHR(dy+96));
FOR w:=1 TO 100 DO (* wait 3 msec *);
END;
END;
END;
PROCEDURE getcmd;
BEGIN
disp:='1'; (* Rc700 *)
i:=1; term:='';
j:=LEN(cmd_str);
IF j>1 THEN
BEGIN
WHILE cmd_strÆiÅ=' ' DO i:=i+1;
term:=COPY(cmd_str,i,j+1-i);
IF POS(term,'RC700')>0 THEN disp:='1';
IF POS(term,'MCTERM')>0 THEN disp:='2';
IF POS(term,'RC822')>0 THEN disp:='3';
CASE disp OF
'1': term:='Rc700'; (* 'Home', 0,0: x,y= 0,0 *)
'2': term:='McTerm'; (* 'Home', 0,0: y,x(!)= 32,32 *)
'3': term:='Rc822'; (* 'Home', 0,0: x,y= 96,96 *)
END;
END;
(* Rc822 x0=96 x31=127 x32=64 x63=94 x64=32 x79=47 y0=96 y23=119 *)
END;
PROCEDURE make_olp_setup;
VAR k: CHAR; c1: str3; x,y: INTEGER;
BEGIN
x:=1; y:=1;
WHILE setolpÆyÅ>='0' DO y:=y+1; c1:=COPY(setolp,x,y-x);
VAL(c1,form,n); y:=y+1; x:=y;
WHILE setolpÆyÅ>='0' DO y:=y+1; c1:=COPY(setolp,x,y-x);
VAL(c1,komp,n); y:=y+1; x:=y;
WHILE setolpÆyÅ>='0' DO y:=y+1; c1:=COPY(setolp,x,y-x);
VAL(c1,norm,n); y:=y+1; x:=y;
WHILE setolpÆyÅ>='0' DO y:=y+1; c1:=COPY(setolp,x,y-x);
VAL(c1,lintop,n); y:=y+1; x:=y;
WHILE setolpÆyÅ>='0' DO y:=y+1; c1:=COPY(setolp,x,y-x);
VAL(c1,linfed,n);
x:=1; y:=1;
WHILE setlabÆyÅ>='0' DO y:=y+1; c1:=COPY(setlab,x,y-x);
VAL(c1,inryk,n); y:=y+1; x:=y;
WHILE setlabÆyÅ>='0' DO y:=y+1; c1:=COPY(setlab,x,y-x);
VAL(c1,nlqon,n); y:=y+1; x:=y;
WHILE setlabÆyÅ>='0' DO y:=y+1; c1:=COPY(setlab,x,y-x);
VAL(c1,nlqoff,n); y:=y+1; x:=y;
WHILE setlabÆyÅ>='0' DO y:=y+1; c1:=COPY(setlab,x,y-x);
VAL(c1,labfed,n);
END;
PROCEDURE menu;
BEGIN
WRITE(CLRHOM,no-1);
cursor(68,0); WRITELN(fil_dato);
cursor(12,1);
IF modul='5' THEN WRITELN(version,' <',term,'>');
cursor(25,3);
WRITELN('Arkiv',filnum,' ',filnavn);
WRITELN('===================':44);
IF MODUL='0' THEN WRITELN('HOVED MENU (0)':41);
IF MODUL='1' THEN WRITELN('NYOPRETTELSER':40);
IF MODUL='2' THEN WRITELN('VEDLIGEHOLDELSE':41);
IF MODUL='3' THEN WRITELN('SØGNINGER (3)':40);
IF MODUL='5' THEN WRITELN('ARKIV-VALG (5)':41);
IF MODUL='7' THEN WRITELN('GRUPPEKODER':39);
WRITELN('-------------------':44);
END;
PROCEDURE get_write_acces;
BEGIN
menu;
penn:=''; WRITELN(@10);
WRITE('Password, tak. '); READ(KBD,penn);
IF penn=pennword THEN
BEGIN
IF dato<>fil_dato THEN
BEGIN
WRITELN(@13,'Dato for indeværende Fil = ',fil_dato);
WRITE(' >>>');
WRITE(@13,'Ny dato, (max.12 tegn): <<<');
READLN(intxt); IF LEN(intxt)>1 THEN
BEGIN
WHILE LEN(intxt)<12 DO intxt:=intxt+' ';
fil_dato:=intxt; dato:=intxt;
dato_ok:=FALSE;
END ELSE dato:=fil_dato;
END;
END ELSE modul:='?';
END;
PROCEDURE tilladelse;
BEGIN
pass:='';
WRITE('Password, tak. '); READ(KBD,pass);
IF pass<>password THEN
BEGIN
pass_ok:=FALSE; filnum:=0; filnavn:='?!';
END;
END;
PROCEDURE test_svar;
BEGIN
IF svar='C' THEN
BEGIN
cont:=NOT cont;
cursor(3,ypos+8);
IF cont THEN WRITE('C-on ') ELSE WRITE('C-off');
cursor(px-2,ypos+9);
END;
IF clr AND (svar='S') THEN
BEGIN
clear:=TRUE; (* sletmerkning af post *)
svar:='J';
END;
END;
PROCEDURE janej;
BEGIN
REPEAT
READ(KBD,svar);
IF svar>='a' THEN svar:=CHR(ORD(svar)-32);
IF modul2 THEN test_svar;
IF svar='R' THEN svar:='N';
UNTIL svar IN Æ'J','N'Å;
WRITELN(svar);
END; (* janej *)
(*$I TELEPROC.PAS *)
PROCEDURE set_gruppe;
BEGIN
(* Gruppekode-tekst-Nr. i fil-post 0..2 *)
menu;
viskode(7,0,18);
IF olp THEN print_gruppekoder;
WRITE('Opret nye Gruppe-koder, j/n ? ');
janej;
IF svar='J' THEN get_write_acces ELSE modul:='?';
IF modul='7' THEN
BEGIN
opret_gruppekoder;
write_gruppekoder;
IF txt>'' THEN
BEGIN
menu; WRITELN;
WRITELN(' ':19,'Følgende Filnavne kan anvendes:',@10);
FOR j:=1 TO 9 DO WRITELN(j:27,'.) ',filesÆjÅ,'.TLF');
WRITE(' ':35,'return'); READ(KBD,ch);
END;
END;
END;
PROCEDURE startadr;
BEGIN
REPEAT
cursor(25,18);
WRITE('Udlæsning fra post no: '); cleol;
(*$I-*) READLN(startpost); (*$I+*)
UNTIL (IORES=0) AND (startpost>0);
IF (startpost=nul) AND (nul>$4AF) THEN
startpost:=offset-(offset+offset);
startpost:=startpost+offset;
IF (startpost>=0) AND (startpost<no) THEN
modul:='4'
ELSE BEGIN
startpost:=1+offset;
WRITE(UP); cleol; cursor(48,17);
END;
END;
PROCEDURE hent(VAR iotal: INTEGER; yy: INTEGER);
BEGIN
REPEAT
tal:=-1;
cursor(47,yy);
WRITE(' '); cleol;
(*$I-*) READLN(tal) (*$I+*);
UNTIL (IORES=0) AND (tal<=255);
if tal>=0 THEN iotal:=tal;
END;
PROCEDURE printer_setup;
BEGIN
WRITELN(CLRHOM);
WRITELN(' ':9,'PRINTER SET-UP for ',filnavn,'.');
WRITELN(' ':8,'=================================',@10);
WRITELN(' Form-/Line-Feed v.sideskift(12=FF,def= 12)',form:3);
WRITELN(' Værdi for komprimeret udskrift, (def= 15)',komp:3);
WRITELN(' Værdi for normal udskrift, (default= 18)',norm:3);
WRITELN(' Antal linier pr. side i udskrift, (60)',lintop:3);
WRITELN(' Antal line-feed, udskr.-slut, (12=FF),(12)',linfed:3);
WRITELN(' Venstre margin ved print-Labels, (3)',inryk:3);
WRITELN(' NLQ-skrift = ON, (default= ESC E E= 69)',nlqon:3);
WRITELN(' NLQ-skrift = OFF, (default= ESC F F= 70)',nlqoff:3);
WRITELN(' Antal line-feed mellem Labels (2)',labfed:3);
hent(form,4);
hent(komp,5); hent(norm,6); hent(lintop,7); hent(linfed,8);
hent(inryk,9); hent(nlqon,10); hent(nlqoff,11); hent(labfed,12);
WRITELN;
WRITE(' ':14,'Gem ny printer-setup, j/n ? '); janej;
if svar='J' THEN BEGIN
write_olp_string;
write_gruppekoder;
END;
END;
PROCEDURE spec_print;
BEGIN
WRITELN(CLRHOM);
WRITELN(' ':15,'Special Print.');
WRITELN(' ':14,'===============',@10);
WRITELN(' Denne ordre (max 3 char lang) gemmes ikke, men');
WRITELN(' kan sendes direkte til printeren, hvis char1>0.',@10);
WRITELN(' Bruges f.eks til Form-længde (ESC) Char1=',sp1:3);
WRITELN(' Line-spacing-kommando, NLQ, etc. Char2=',sp2:3);
WRITELN(' Eks. 27 67 72, 27 65 24 + 27 50 Char3=',sp3:3);
svar:='*'; hent(sp1,7); hent(sp2,8); hent(sp3,9);
WRITELN;
IF sp1>0 THEN BEGIN
WRITE(' ':14,'Kommando til printer, j/n ? '); janej;
END;
IF svar='J' THEN BEGIN
WRITE(lst,CHR(sp1));
IF sp2>0 THEN WRITE(lst,CHR(sp2));
IF sp3>0 THEN WRITE(lst,CHR(sp3));
END;
END;
PROCEDURE printctrl;
BEGIN
olp:=NOT olp; ch:=' ';
listdev:=''; modul:='?';
IF olp THEN BEGIN
ch:='6'; listdev:='Printer ON.';
END;
cursor(46,12); WRITE(listdev); cleol;
cursor(48,17); WRITE(ch,@8);
END;
PROCEDURE listvalg;
BEGIN
WRITE(modul);
READ(KBD,ch); WRITE(ch);
IF ch='1' THEN udlist:='/1,Quick. ';
IF ch='2' THEN udlist:='/2,Total-Liste';
IF ch='3' THEN udlist:='/3,Adr.Labels ';
IF ch IN Æ'1'..'3'Å THEN skrift:=ORD(ch)-48;
cursor(47,10); WRITE(udlist);
cursor(48,17); cleol;
END;
PROCEDURE new_file;
BEGIN
WRITE(@7,' findes ikke.');
WRITE(' - NY-opret, j/n ? '); janej;
IF svar='J' THEN
BEGIN
WRITELN(filnavn,' Oprettes');
password:='PASSWORD....';
pennword:='PASSWORD....';
fil_dato:='Dato.'; dato:='o';
REWRITE(fv);
write_gruppekoder;
WRITE(filnavn);
END ELSE started:=FALSE;
END;
PROCEDURE filswap;
VAR fv: FILE;
BEGIN
WRITELN('TELE.COM');
ASSIGN(fv,'TELE.COM');
WRITELN('hentes.');
(*$I-*) EXECUTE(fv); (*$I+*)
IF IORES>0 THEN WRITELN(UP,'findes ikke');
END;
PROCEDURE filename;
BEGIN
menu;
FOR j:=1 TO level DO WRITELN(j:27,'.) ',filesÆjÅ,'.TLF');
WRITE(@10,'/ ':26,'Indtast Nummer: ');
REPEAT
READ(KBD,ch)
UNTIL ch IN Æ'/','1'..'9'Å;
WRITELN(ch,@10);
IF ch>'/' THEN
BEGIN
filnum:=ORD(ch)-48;
filnavn:=filesÆfilnumÅ+'.TLF';
IF started THEN CLOSE(fv);
WRITE(filnavn);
ASSIGN(fv,filnavn);
started:=TRUE; no:=0;
(*$I-*) RESET(fv) (*$I+*);
IF IORES>0 THEN new_file;
IF started THEN
read_gruppekoder
ELSE filnavn:=' ?';
END;
END;
PROCEDURE modultekst;
BEGIN
menu;
WRITELN('1.) NYOPRETTELSER':42);
WRITELN('2.) VEDLIGEHOLDELSE':44);
WRITELN('3.) SØGNINGER':38);
WRITELN('4.) UDSKRIVNING#/123':45,' ',udlist);
WRITELN('5.) NYT ARKIV-NAVN':43);
WRITE ('6.) PRINTER ON/OFF':43,' ',listdev);
cleol; WRITELN;
WRITELN('7.) GRUPPE-KODER':41);
WRITELN('8;) PRINTER SET-UP':43);
WRITELN('9:) SLUT.':34,@10);
WRITE('HVILKET MODUL ØNSKES ? ':48);
REPEAT
READ(KBD,modul);
IF modul='6' THEN printctrl;
IF started AND (modul='#') THEN startadr;
IF modul='/' THEN listvalg;
UNTIL modul IN Æ'1'..';'Å;
WRITELN(modul);
END;
BEGIN
opstart; getcmd;
filename;
REPEAT
modul:='0'; svar:='*'; gempy:=0;
startpost:=1+offset; indset:=FALSE;
modultekst;
IF started AND pass_ok THEN
BEGIN
IF modul IN Æ'1','2'Å THEN get_write_acces;
IF NOT dato_ok THEN write_gruppekoder;
IF modul='1' THEN nyopret;
IF modul='2' THEN rettelse;
IF modul='4' THEN readout(startpost);
IF modul='3' THEN kig_efter;
IF modul='7' THEN set_gruppe;
IF modul='8' THEN printer_setup;
END ELSE
IF modul IN Æ'1'..'4','7','8'Å THEN WRITE(@7);
IF modul='5' THEN filename;
IF modul=';' THEN spec_print;
UNTIL modul IN Æ'9',':'Å;
CLOSE(prn);
IF started THEN CLOSE(fv);
IF modul=':' THEN filswap;
END. (* TELEFON.PAS, 851115. Rev.9/11-1987. (C) JFP *)
«eof»