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 - metrics - download

⟦6e65344ed⟧ TextFile

    Length: 3584 (0xe00)
    Types: TextFile
    Names: »PAGEBOX.PAS«

Derivation

└─⟦d814f614c⟧ Bits:30008872 EDB Trænings- og Erhvervs Center / Almen Nyttig Data Service
    └─⟦this⟧ »PAGEBOX.PAS« 

TextFile

program jk;

(* program .....: jk.pas
   udarbejdet af: john e.k. knudsen
   den .........: oktober 1988
*)

(* bemærk at CONFI skal være defineret for LINE med følgende værdier
   hastighed 1200 baud
   databit      7
   paritet   lige
*)

var
   SIDER     : ARRAYÆ1..400Å OF STRINGÆ80Å;
   SIDENR    : ARRAYÆ1..50Å  OF INTEGER;
   TEGN      : STRINGÆ1Å;
   T         : TEXT;
   LNR	     : INTEGER;
   SNR       : INTEGER;
   K         : INTEGER;
   J         : INTEGER;
   SIDELGD   : INTEGER;
   SIDSTE    : INTEGER;
   i, q, valg    : integer;
   c		: char;
   res           : integer;
   teller        : integer;
   tgn           : integer;


CONST
   DELSCR = 12;

label
  FOREVER,
  NYSIDE,
  igen,
  ud;
  

function rdrstatus : boolean;
var res : byte;
begin
 code
  $2A,$01,$00,                 (*       LD   HL,(1)  *)
  $01,$4A,$00,                 (*       LD   BC,04AH *)
  $09,                         (*       ADD  HL,BC   *)
  $CD,*+7,                     (*       CALL L1      *)
  $32,RES,                     (*       LD   (RES),A *)
  $18,1,                       (*       JR   L2      *)
  $E9;                         (*  L1:  JP   (HL)    *)
                               (*  L2:               *)
  rdrstatus := (res > 0);
end;


(*
BEGIN
igen:
   for i := 1 to 500 do 
   begin
      if rdrstatus then 
      begin
         teller := teller + 1;
         write('signal modtaget på porten !!! --> ',teller);
         read(aux,c);
         tgn := ord(c);
         if tegn = 0   then writeln('blå  tast');
         if tegn = 192 then writeln('grøn tast');
         if tegn = 240 then writeln('gul  tast');
         if tegn = 252 then writeln('rød  tast');
      end;
   END;

*)

PROCEDURE GOTOXY(X,Y: INTEGER);
BEGIN
   WRITE(CHR(6),CHR(Y+32),CHR(X+32));
END;

BEGIN
   ASSIGN(T,'TEKST.TXT'); RESET(T);
   LNR     := 0;
   WRITE(CHR(DELSCR));
   SIDELGD := 0;
   SNR     := 0;

   WHILE NOT EOF(T) DO
   BEGIN
      LNR := LNR + 1;
      READLN(T,SIDERÆLNRÅ);
      IF POS('<**>',SIDERÆLNRÅ) > 0 THEN BEGIN
         SNR := SNR + 1;
         SIDENRÆSNRÅ := LNR;
      END;
   END;
   CLOSE(T);
   SIDSTE := SNR;
   SNR    := 0;

FOREVER:
   WRITE(CHR(DELSCR));
   SIDELGD := 0;
   FOR I := 1 TO LNR DO BEGIN
NYSIDE:
      IF POS('<**>',SIDERÆIÅ) = 0 THEN BEGIN
         K := LEN(SIDERÆIÅ);
         IF K > 0 THEN  SIDELGD := SIDELGD + 1;
         WRITELN(SIDERÆIÅ);
      END;

      IF POS('<**>',SIDERÆIÅ) > 0  THEN BEGIN
         GOTOXY(0,24);
         WRITE(' ');
         FOR K := 1 TO SIDELGD DO BEGIN
            WRITE('.');
         END;
         WRITE('. > NÆSTE SIDE ...');
         FOR K := 1 TO SIDELGD  DO BEGIN
            GOTOXY(K,24);
            WRITE(' ');
            FOR J := 1 TO 1400 DO BEGIN
               if keypress then begin
                  goto ud;
               end;
               IF RDRSTATUS THEN BEGIN
                  READ(AUX,C);
                  SNR := SNR + 1;
                  IF SIDSTE = SNR THEN BEGIN
                     SNR := 1;
                     (* GOTO UD; *)
                  END;
                  I := SIDENRÆSNRÅ + 1;
                  sidelgd := 0;
                  write(chr(delscr));
                  GOTO NYSIDE;
               END;
            END;
         END;
         WRITE(CHR(DELSCR));
         SIDELGD := 0;
      END;
   END;
   GOTO FOREVER;
UD:
END.
«eof»