DataMuseum.dk

Presents historical artifacts from the history of:

CP/M

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about CP/M

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦40284ce31⟧ TextFile

    Length: 2944 (0xb80)
    Types: TextFile
    Names: »SKRIVERA.PAS«

Derivation

└─⟦a1337913c⟧ Bits:30002679 PGM1 - indeholder forskellige undervisningsprogrammer
    └─ ⟦this⟧ »SKRIVERA.PAS« 

TextFile

PROGRAM skvslet;
TYPE navntype = STRING(.15.);
     katindextype = 'A'..'T';
     
VAR tmp : STRING(.127.) AT DSEG:$0080;
    tmpline : STRING(.127.);
    katfil : FILE OF navntype;
    skvkat : ARRAY(.katindextype.) OF navntype;
    slet   : ARRAY(.katindextype.) OF BOOLEAN;
    sletfil: FILE;
    katindex : katindextype;
    tast : CHAR;
    cpu : RECORD
            ax,bx,cx,dx,bp,si,di,ds,es,flags : INTEGER
          END;
    hex,scan,user : INTEGER;
    drv,userstr : STRING(.2.);
BEGIN
  drv:=''; user:=-1;
  IF LEN(tmp)>0 THEN BEGIN
    tmpline:=tmp;
    WHILE POS(' ',tmpline)>0 DO DELETE(tmpline,POS(' ',tmpline),1);
    IF tmpline(.1.) IN (.'A','B','M'.) THEN drv:=tmpline(.1.)+':';
    scan:=0;
    REPEAT
      scan:=scan+1
    UNTIL (tmpline(.scan.) IN (.'0'..'9'.)) OR (scan=LEN(tmpline));
    IF tmpline(.scan.) IN (.'0'..'9'.) THEN BEGIN
      userstr:=tmpline(.scan.); DELETE(tmpline,1,scan)
    END;
    IF tmpline<>'' THEN
      IF tmpline(.1.) IN (.'0'..'9'.) THEN userstr:=userstr+tmpline(.1.);
    cpu.cx:=$0020;
    VAL(userstr,cpu.dx,hex);
    SWINT(224,cpu)
  END;
  IF drv='' THEN BEGIN
    (* DRV_GET *)
    cpu.cx:=$0019;
    SWINT(224,cpu);
    drv:=CHR(LO(cpu.ax)+65)+':'
  END;
  IF user=-1 THEN BEGIN
    (* F_USERNUM *)
    cpu.cx:=$0020; cpu.dx:=$00FF;
    SWINT(224,cpu);
    user:=cpu.ax
  END;
  WRITELN(CLRHOM,'KATALOG OVER ''SKRIVTEKSTER''');
  WRITELN('DREV ',drv,'   BRUGER : ',LO(user));
  ASSIGN(katfil,drv+'TEXTER.FIL'); (*$I-*)
  RESET(katfil); (*$I+*)
  IF IORES=2 THEN BEGIN
    WRITELN(@7,'KAN IKKE FINDE SKRIVKATALOG ''TEXTER.FIL''');
    HALT
  END;
  FOR katindex:='A' TO 'T' DO READ(katfil,skvkat(.katindex.));
  CLOSE(katfil);
  GOTOXY(0,2);
  FOR katindex:='A' TO 'T' DO
    WRITELN(' ':12,katindex,' : ',RVSON,skvkat(.katindex.),RVSOFF);
  FOR katindex:='A' TO 'T' DO BEGIN
    GOTOXY(0,ORD(katindex)-65+2);
    WRITE('Slet J/N ');
    REPEAT
      READ(KBD,tast)
    UNTIL tast IN (.'J','j','N','n'.);
    WRITE(tast);
    IF tast IN (.'J','j'.) THEN BEGIN
      GOTOXY(16,ORD(katindex)-65+2); WRITE(CLREOL);
      slet(.katindex.):=TRUE
    END ELSE
      slet(.katindex.):=FALSE;
  END;
  WRITELN; WRITELN;
  WRITE('Sletning ok J/N ? ');
  REPEAT
    READ(KBD,tast)
  UNTIL tast IN (.'J','j','N','n'.);
  WRITELN(tast);
  IF tast IN (.'J','j'.) THEN BEGIN
    FOR katindex:='A' TO 'T' DO
      IF slet(.katindex.) THEN BEGIN
        (*$I-*)
        ASSIGN(sletfil,drv+'TEKST'+katindex+'.PCK');
        WRITELN('Sletter tekst ',katindex);
        ERASE(sletfil); (*$I+*)
        IF IORES<>0 THEN WRITE(@7);
        skvkat(.katindex.):='               ';
      END;
    ASSIGN(katfil,drv+'TEXTER.FIL');
    RESET(katfil);
    FOR katindex:='A' TO 'T' DO WRITE(katfil,skvkat(.katindex.));
    CLOSE(katfil)
  END ELSE
    WRITELN('Ingen tekster er slettet !');
END.
«eof»