DataMuseum.dk

top - metrics - download

    Length: 4480 (0x1180)
    Types: TextFile
    Names: »INSTALL.PAS«

└─⟦e3723fcdd⟧ Bits:30004778 WordStar 3.3 og PolyPascal 3.10
    └─⟦this⟧ »INSTALL.PAS« 

TextFile

PROGRAM install; 
æ$C-å
æ$A+,R-å

CONST
  maxterm = 40;

TYPE
  str2     = STRINGÆ2Å;
  str3     = STRINGÆ3Å;
  str4     = STRINGÆ4Å;
  str5     = STRINGÆ5Å;
  str8     = STRINGÆ8Å;
  str12    = STRINGÆ12Å;
  str14    = STRINGÆ14Å;
  str24    = STRINGÆ24Å;
  str31    = STRINGÆ31Å;
  str36    = STRINGÆ36Å;
  str48    = STRINGÆ48Å;
  charset  = SET OF char;
  filename = RECORD
               drv: byte;
               nam: ARRAYÆ1..8Å OF char;
               ext: ARRAYÆ1..3Å OF char;
             END;
  extstr   = ARRAYÆ1..3Å OF char;
  datarec  = RECORD
               f1: byte;
               edofs,pstwd: integer;
               f2: ARRAYÆ1..27Å OF byte;
               termname: str31;
               width,height: byte;
               gxyls: str8;
               gxyss,gxyts: str4;
               colblin,coorofs,coorfmt: byte;
               clhs,cess,cels,ilns,dlns,rons,rofs,
               ions,iofs,uons,uofs,bons,bofs,aofs: str8;
               f3: ARRAYÆ1..150Å OF byte;
               rdelay: integer;
               altkey: ARRAYÆ0..255Å OF byte;
               xstep,backf,insmf,autof,tabsf,errmod: byte;
               hlpstr,ermstr,wrkstr: filename;
               pasext,bakext,comext,chnext: extstr;
             END;
  pdatrec  = ARRAYÆ1..590Å OF byte;

VAR
  cf,hf: FILE;
  tf: FILE OF str31;
  df: FILE OF pdatrec;
  cfn: str14;
  data: datarec;
  tnam: ARRAYÆ1..maxtermÅ OF str31;
  b1: ARRAYÆ0..1023Å OF byte;
  b2: ARRAYÆ0..511Å OF byte;
  b2sec,b2ofs,i: integer;
  insfile: boolean;
  ch: char;

PROCEDURE errhand(errno,errofs: integer);
BEGIN
  IF errno=1 THEN
  BEGIN
    writeln('^C'); halt;
  END;
END;

FUNCTION upcase(s: str24): str24;
VAR
  i: integer;
  u: str24;
BEGIN
  u:='';
  FOR i:=1 TO len(s) DO
  IF (sÆiÅ>='a') AND (sÆiÅ<='z') THEN
  u:=u+chr(ord(sÆiÅ)-32) ELSE u:=u+sÆiÅ;
  upcase:=u;
END;

FUNCTION hex(number,digits: integer): str4;
CONST
  hexdigits: ARRAYÆ0..15Å OF char = '0123456789ABCDEF';
VAR
  d: integer;
  h: str4;
BEGIN
  hÆ0Å:=chr(digits);
  FOR d:=digits DOWNTO 1 DO
  BEGIN
    hÆdÅ:=hexdigitsÆnumber AND 15Å;
    number:=number SHR 4;
  END;
  hex:=h;
END;

FUNCTION hexseq(seq: str8): str24;
VAR
  i: integer;
  s: str24;
BEGIN
  IF seq='' THEN hexseq:='Unconfigured' ELSE
  BEGIN
    s:='';
    FOR i:=1 TO len(seq) DO s:=s+hex(ord(seqÆiÅ),2)+' ';
    hexseq:=copy(s,1,len(s)-1);
  END;
END;

FUNCTION yesno(flag: integer): str4;
BEGIN
  IF flag<>0 THEN yesno:='YES' ELSE yesno:='NO';
END;

PROCEDURE backsp(n: integer);
VAR
  i: integer;
BEGIN
  FOR i:=1 TO n DO write(^H' '^H);
END;

FUNCTION readnum(min,max: integer): integer;
VAR
  n,p: integer;
  ok: boolean;
  s: str5;
BEGIN
  REPEAT
    buflen:=5; read(s);
    IF s='' THEN ok:=false ELSE
    BEGIN
      val(s,n,p);
      ok:=(p=0) AND (n>=min) AND (n<=max);
    END;
    IF NOT ok THEN backsp(len(s));
  UNTIL ok;
  writeln; readnum:=n;
END;

FUNCTION readseq(maxlen: integer): str8;
CONST
  hexdigits: SET OF '0'..'f' = Æ'0'..'9','A'..'F','a'..'f'Å;
VAR
  h,i,n,p: integer;
  error: boolean;
  seq: str8;
  s: str24;
BEGIN
  REPEAT
    buflen:=maxlen*3-1; read(s); s:=s+^M;
    error:=false; p:=1; n:=0;
    REPEAT
      WHILE sÆpÅ=' ' DO p:=succ(p);
      IF sÆpÅ=^M THEN i:=0 ELSE
      BEGIN
        i:=p; WHILE NOT(sÆpÅ IN Æ' ',^MÅ) DO p:=succ(p);
        val('$'+copy(s,i,p-i),h,i);
        n:=succ(n); seqÆnÅ:=chr(h);
      END;
    UNTIL (sÆpÅ=^M) OR (i<>0);
    IF i<>0 THEN backsp(len(s)-1);
  UNTIL i=0;
  seqÆ0Å:=chr(n); writeln;
  readseq:=seq;
END;

FUNCTION readyn: integer;
VAR
  s: str4;
BEGIN
  REPEAT
    buflen:=3; read(s); s:=upcase(s);
    IF (s<>'YES') AND (s<>'NO') THEN backsp(len(s));
  UNTIL (s='YES') OR (s='NO');
  IF s='YES' THEN readyn:=255 ELSE readyn:=0;
  writeln;
END;

FUNCTION select(prompt: str48; okch: charset): char;
VAR
  ch: char;
BEGIN
  write(prompt,': ');
  REPEAT
    read(kbd,ch);
    IF (ch>='a') AND (ch<='z') THEN ch:=chr(ord(ch)-32);
  UNTIL ch IN okch;
  IF ch=^M THEN backsp(len(prompt)+2) ELSE
  BEGIN
    writeln(ch); writeln;
  END;
  select:=ch;
END;

PROCEDURE pressreturn;
VAR
  ch: char;
BEGIN
  write('Press RETURN...');
  REPEAT read(kbd,ch) UNTIL ch=^M;
  backsp(15);
END;

PROCEDURE resetdisks;
BEGIN
  bdos(37,-1);
END;

PROCEDURE clear1;
BEGIN
  fill(data.termname,332,0);
  WI