|
|
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 - metrics - download
Length: 7040 (0x1b80)
Types: TextFile
Names: »USINSTAL.PAS«
└─⟦29e35ddf2⟧ Bits:30003931/CCPM_Tegn.imd Disketter indleveret af Steffen Jensen (Piccolo/Piccoline)
└─⟦this⟧ »USINSTAL.PAS«
(* Dette program laver usinstal.cmd som startegn chainer til, hvis det er
første gang programmet bruges.
Programmet kompileres på følgende måde : p a:usinstal,,,0b56,05c0 *)
type
streng20=string(.20.);
streng80=string(.80.);
reg_type=record
ax,bx,cx,dx,bp,si,di,ds,es,flags:integer
end;
var
reg:reg_type;
filnavn:file of integer;
fil : file;
streng: streng80;
tjeksum,tal,iofejl,lengde,sum,i: integer;
diskdrev:char;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure drv_get(var diskdrev : char);
var
d_no :integer;
begin
reg.cx := $19;
swint(224,reg);
d_no := reg.ax;
diskdrev:=chr(65+d_no);
end;
procedure TaendCursor;
begin
write(@27'e');
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure SlukCursor;
begin
write(@27'f');
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure Ramme(x1,y1,x2,y2: integer);
var
x,y: integer;
begin
gotoxy(x1,y2); write('▶8b◀');
for x:=(x1+1) to (x2-1) do write('▶88◀'); write('▶8c◀');
for y:=(y2+1) to (y1-1) do begin
gotoxy(x1,y); write('▶89◀');
gotoxy(x2,y); write('▶89◀');
end;
gotoxy(x1,y1); write('▶8d◀');
for x:=(x1+1) to (x2-1) do write('▶88◀'); write('▶8e◀');
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure SetFunkTast(ascii: byte; streng: streng20);
begin
write(@27':'+chr(ascii)+streng+@0);
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure SetFunkTaster;
begin
SetFunkTast(75,@9); (* pil til venstre *)
SetFunkTast(77,@24); (* pil til højre *)
SetFunkTast(72,@26); (* pil op *)
SetFunkTast(80,@10); (* pil ned *)
SetFunkTast(71,@29); (* pil home *)
SetFunkTast(82,@4); (* tegn ind *)
SetFunkTast(83,@5); (* slet tegn *)
SetFunkTast(73,@21); (* A1 *)
SetFunkTast(74,@22); (* A2 *)
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
procedure InputStreng(kolonne,linie,max_laengde:integer;
tegn_stoerrelse: integer;
fjern_mellemrum,tegn_ramme: boolean;
VAR streng:streng80);
const
PIL_HOEJRE=@24;
PIL_VENSTRE=@9;
PIL_HOME=@29;
TEGN_IND=@4;
BACK_SPACE=@8;
SLET_TEGN=@5;
SLET_REST_LINIE=@21; (* A1-tast *)
SLET_HEL_LINIE=@22; (* A2-tast *)
RETURN_TAST=@13;
ESC_TAST=@27;
SLUK_CURSOR=@27'f';
TAEND_CURSOR=@27'e';
tegnsaet:set of char=(.' '..'ü'.);
var
tegn: char;
streng_tegn: array(.1..80.) of char;
temp_streng: streng80;
i,xpos: integer;
begin
if (tegn_ramme=true) then
Ramme((kolonne-2),(linie+1),(kolonne+max_laengde+1),(linie-1));
streng:='';
for i:=1 to max_laengde do streng_tegn(.i.):=' ';
xpos:=1;tegn:=chr(0);
repeat
gotoxy(kolonne-1+xpos,linie);
TaendCursor;
read(KBD,tegn);
SlukCursor;
if (tegn in tegnsaet) and (xpos<=max_laengde) then begin
streng_tegn(.xpos.):=tegn;
xpos:=xpos+1;
write(tegn);
end else begin
if (tegn=PIL_VENSTRE) and (xpos>=2) then begin
xpos:=xpos-1;
end else begin
if (tegn=PIL_HOEJRE) and (xpos<=(max_laengde-1)) then begin
xpos:=xpos+1;
end else begin
if (tegn=SLET_REST_LINIE) then begin
for i:=xpos to max_laengde do begin
streng_tegn(.i.):=' ';
write(' ');
end;
end else begin
if (tegn=SLET_HEL_LINIE) then begin
gotoxy(kolonne,linie);
for i:=kolonne to (max_laengde+kolonne) do write(' ');
for i:=1 to max_laengde do streng_tegn(.i.):=' ';
xpos:=1;
end else begin
if (tegn=PIL_HOME) then begin
xpos:=1;
end else begin
if (tegn=TEGN_IND) then begin
for i:=max_laengde downto (xpos+1) do begin
streng_tegn(.i.):=streng_tegn(.i-1.);
end;
streng_tegn(.xpos.):=' ';
for i:=xpos to max_laengde do write(streng_tegn(.i.));
end else begin
if ((tegn=BACK_SPACE) and (xpos>1)) then begin
for i:=xpos to max_laengde do begin
streng_tegn(.(i-1).):=streng_tegn(.i.);
end;
streng_tegn(.max_laengde.):=' ';
xpos:=(xpos-1);
gotoxy(kolonne,linie);
for i:=1 to max_laengde do write(streng_tegn(.i.));
end else begin
if (tegn=SLET_TEGN) then begin
for i:=xpos to (max_laengde-1) do begin
streng_tegn(.i.):=streng_tegn(.i+1.);
write(streng_tegn(.i.));
end;
streng_tegn(.max_laengde.):=' ';
write(' ');
end else begin
end;end;end;end;end;end;end;end;end;
until ((tegn=RETURN_TAST) or (tegn=ESC_TAST));
if (tegn=RETURN_TAST) then begin
for i:=1 to max_laengde do streng:=streng+streng_tegn(.i.);
i:=max_laengde;
repeat
if streng_tegn(.i.)=' ' then delete(streng,i,1);
i:=i-1;
until (streng_tegn(.i.)<>' ') or (i=1);
if (tegn_stoerrelse=1) then begin
for i:=1 to len(streng) do begin
if (streng(.i.) in (.'A'..'^'.)) then begin
streng(.i.):=chr(ord(streng(.i.))+32);
end;
end;
end;
if (tegn_stoerrelse=2) then begin
for i:=1 to len(streng) do begin
if (streng(.i.) in (.'a'..'ü'.)) then begin
streng(.i.):=chr(ord(streng(.i.))-32);
end;
end;
end;
if fjern_mellemrum then begin
temp_streng:=streng; streng:='';
for i:=1 to len(temp_streng) do begin
if (temp_streng(.i.)<>' ') then begin
streng:=streng+temp_streng(.i.);
end;
end;
end;
if (fjern_mellemrum) or
(tegn_stoerrelse=1) or (tegn_stoerrelse=2) then begin
gotoxy(kolonne,linie);
for i:=1 to max_laengde do write(' ');
gotoxy(kolonne,linie);
write(streng);
end;
end;
if (tegn=ESC_TAST) then streng:=@27;
end;
(* ▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀▶ac◀ *)
begin
write(clrhom);
drv_get(diskdrev);
assign(fil,'B:USINSTAL.CMD');
erase(fil);
SetFunkTaster;
gotoxy(26,1);write(rvson,' INSTALLERING AF BRUGERNAVN ',RVSOFF);
gotoxy(35,3);write('Bemærk !');
gotoxy(15,6);write('Da det er første gang programmet startes, skal det');
gotoxy(15,7);write('forsynes med navnet på den bruger, der har ret til');
gotoxy(15,8);write('anvende det. I rammen herunder skal denne identifi-');
gotoxy(15,9);write('kation indtastes. Der kan editeres indtil der tas-');
gotoxy(15,10);write('tes retur ( <▶83◀ ).');
repeat
inputstreng(25,15,30,0,false,true,streng);
until len(streng)>5;
TaendCursor;
sum:=0;lengde:=len(streng);
for i:=1 to len(streng) do begin
streng(.i.):=chr(255-ord(streng(.i.)));
sum:=sum+ord(streng(.i.));
end;
sum:=sum-1001;
(*gem*);
assign(filnavn,'B:BRUGER.FIL');
(*$I-*) rewrite(filnavn) (*$I+*);
iofejl:=iores;
if iofejl<>0 then write('Fejl i brugerfil !');
write(filnavn,lengde);(*Strengens længde *);
write(filnavn,sum);(* sum-1001 *)
for i:=1 to lengde do begin
tal:=ord(streng(.i.));
write(filnavn,tal);
end;
close(filnavn);
end.
«eof»