DataMuseum.dk

top - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »SPBP1«

└─⟦a59f0a452⟧ Bits:30000472 DOMUS disk image
    └─⟦this⟧ 

TextFile

CONST

START=   "<10>***READY TYPE NL<10>",
B10=     32,
SP2A=    '<17>',
FIRSTOFFLINE= 8'040000,


LPTABLE=#

32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 46 60 40 43 85
38 32 32 32 32 32 32 32
32 32 33 93 42 41 59 32
45 47 32 32 32 32 32 32
32 32 32 44 37 95 62 63
32 32 32 32 32 32 32 32
32 32 58 91 92 39 61 34
32 65 66 67 68 69 70 71
72 73 32 32 32 32 32 32
32 74 75 76 77 78 79 80
81 82 32 32 32 32 32 32
32 32 83 84 85 86 87 88
89 90 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 32 32 32 32 32 32 32
32 65 66 67 68 69 70 71
72 73 32 32 32 32 32 32
32 74 75 76 77 78 79 80
81 82 32 32 32 32 32 32
32 32 83 84 85 86 87 88
89 90 32 32 32 32 32 32
48 49 50 51 52 53 54 55
56 57 94 32 32 32 32 32
#;
«ff»

VAR

OPSTRING:     STRING(80);
OPTEXT:       STRING(80);
OPLENGTH:     INTEGER;
MESS1:        INTEGER;
MESS2:        INTEGER;
SIDES:        INTEGER;
COUNT:        INTEGER;
MAXDSN:       INTEGER;
SIZE:         INTEGER;


IN:           FILE
              'FD0',
              14,
              2,
              128,
              U;
              GIVEUP FDERROR,
              2'0100000000000000
              OF STRING(128);


OUT:          FILE
              'LPT',
              2,
              2,
              129,
              U;
              CONV LPTABLE
              OF RECORD
              CCW:  STRING(1);
              DATA: STRING(128)
              END;


PROCEDURE OPERATOR;
BEGIN
  OPWAIT(OPLENGTH);
  OPTEXT:=OPSTRING;
  OPIN(OPSTRING);
END;


PROCEDURE SENCE;
BEGIN
  IF MESS2 SHIFT 10 SHIFT(-15) = 0 THEN SIDES:=1
                                   ELSE SIDES:=2;
  MESS1:=(MESS2 SHIFT 6 SHIFT (-11) +32) SHIFT 5 + 26;
  TRANSFER(IN,MESS1,-1);
  WAITTRANSFER(IN);
END;

PROCEDURE FDERROR;
BEGIN
    IF IN.ZMASK = FIRSTOFFLINE THEN
    REPEATSHARE(IN);
END;

«ff»

BEGIN
    OPIN(OPSTRING);
1:  OPMESS(START);
    OPERATOR;
    OPEN(OUT,7);
    OPEN(IN,17+B10);
    MESS2:=IN.ZFILE;
    SENCE;
    SETPOSITION(IN,0,5);
    GETREC(IN,SIZE);
    PUTREC(OUT,81);
    OUT^.CCW:=SP2A;
    MOVE(IN^,0,OUT^.DATA,0,80);
    IF SIDES = 1 THEN MAXDSN:=19
                 ELSE MAXDSN:=45;
    COUNT:=1;
    REPEAT
      BEGIN
        GETREC(IN,SIZE);
        PUTREC(OUT,81);
        OUT^.CCW:=SP2A;
        MOVE(IN^,0,OUT^.DATA,0,80);
        COUNT:=COUNT+1;
      END
    UNTIL COUNT >= MAXDSN;
    WAITZONE(OUT);
    CLOSE(OUT,1);
    CLOSE(IN,1);
    GOTO 1;
END;
«ff»
«ff»
«ff»
«nul»