DataMuseum.dk

top - download

    Length: 3328 (0xd00)
    Types: TextFile
    Names: »POLE.PAS«

└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
    └─ ⟦this⟧ »POLE.PAS« 

TextFile

PROGRAM LPRINTER;    (* O.B.M.  3/4-1985. *)

    (*  PROGRAMMET UDSKRIVER FILER PAA PRINTER SAMT UDSKRIVER SIDE NR. *)
    (* OG HVIS MAN VIL , OGSAA DAG,MAANED,AAR OG KLOKKESLET SAMMEN MED *)
    (* SIDE NR.                                                        *)
    
CONST
     ANTAL= 65;      (* antal linier pr side  *)    
     NAVN = 'Ole';   (* udskrift indifikation *)
      AAR = 1985;
VAR
   SEK,MIN,TIM: STRINGÆ2Å;
   UR,HVAD,R,S,T,U,V,X: CHAR;
   SIDE,LINNO,I,DAG,MON: INTEGER;
   CMDLIN: STRINGÆ80Å AT $80;
   FIL: TEXT;
   FILN: STRINGÆ20Å;
   LINIE: STRINGÆ150Å;
   FOUND,PF: BOOLEAN;
   
PROCEDURE SETTIME;  (* set time *)
  BEGIN
    WRITE('    Skriv tid  6 cifre    ');
    READ(KBD,R);WRITE(R);
    READ(KBD,S);WRITE(S,':');
    READ(KBD,T);WRITE(T);
    READ(KBD,U);WRITE(U,':');
    READ(KBD,V);WRITE(V);
    READ(KBD,X);WRITE(X);
    WRITELN(@27,'c',R,S,T,U,V,X);
  END;
  
PROCEDURE GETTIME;
   BEGIN
    WRITE(@27,'d');
    READ(KBD,R,S,T,U,V,X);
   END;
       
PROCEDURE DISPLAY;
   BEGIN
    WRITE(@27,'x1');      (* enable status line *)
    WRITE(@27,'x:');      (* time display *)
   END; 
      
PROCEDURE DATOTID;   
   BEGIN
     GETTIME; 
     SEK:= V+X;
     MIN:= T+U;
     TIM:= R+S;
     WRITE('      ',DAG,'/',MON,'-',AAR,'.    KL ',TIM,':');
     WRITE(MIN,':');
     WRITE(SEK,'    ');
     write(lst,'      ',dag,'/',mon,'-',AAR,'.   kl ',tim,':');
     WRITE(LST,MIN,':');
     WRITE(LST,SEK,'    ');
     write(lst);
  END;

procedure page;
begin
   WRITELN(LST);
   write(lst,'    Side:',side:3,'    ');
   write('    Side:',side:3,'    ');
   IF HVAD='J' THEN DATOTID;
   WRITELN(NAVN,'s printerudskrift. ');
   writeln(lst,NAVN,'s printerudskrift. ');
  writeln(lst);
  writeln(lst);
  side := succ(side);
  linno := 2;
end;

PROCEDURE DATO;
    BEGIN
      DISPLAY;
      WRITE('    Skriv dato      dag RETURN maaned RETURN   ');
      READ(DAG);WRITE('/');READ(MON);WRITELN('-',AAR);
      WRITE('    Skal uret stilles  J/N ');
      READLN(UR);
      IF UR='J' THEN SETTIME; 
    END;  

(* PROGRAM START *)
begin
  WRITE(CLRHOM);
  WRITE('    Skal der dato og tid paa udskrift  < J/N > ');
  READLN(HVAD);
  IF HVAD='J' THEN DATO;  
  found := false;
  filn := copy(cmdlin,2,len(cmdlin)-1);
  repeat
    if filn <> '' then
    begin
      for i := 1 to len(filn) do
          if filn(.i.) in (.'a'..'z'.)
          then filn(.i.) := char(ord(filn(.i.))-$20);
      assign(fil,filn);
      (*$I-*)
      reset(fil);
      found := iores=0;
      (*$I+*)
    end;
    if not found then
    begin
      filn := '';
      write('    Filenavn: ');
      readln(filn);
    end;
  until (filn = '') or found;
  if found then
  begin
    pf := true;
    side := 1;
    linno := 0;
    while (not eof(fil)) and (not keypress) do
    begin
      readln(fil,linie);
      for i := 1 to len(linie) do
      begin
        if (i = 1) and (linno = 0) and (linie(.i.) <> ^L) then page;
        if linie(.i.) = ^L then page else write(lst,linie(.i.));
      end;
      writeln(lst);
      linno := succ(linno) mod ANTAL;
    end;
  end;
end.

«eof»