perm filename QQ.SAI[GEM,BGB] blob
sn#030964 filedate 1973-03-25 generic text, type T, neo UTF8
00100 BEGIN "QQ"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300
00400 DEFINE CALLI="'047000000000";
00500 DEFINE SWAR ="'043000000000";
00600 DEFINE UPG ="'703000000000";
00700
00800 ITG ARRAY DPYBUF [0:2000];
00900 ITG ARRAY FRAME[0:15];
01000 ITG ARRAY SIZE[0:15];
01100 ITG I,J,FLG;
01200 ITG PTR,SIZ,CHR;
01300 INTEGER FILM;
01400 LABEL L1,L2;
01500 STRING STR;
01600
01700 L1: OUTSTR(↓&9&"FILE NAME = ");
01800 STR ← INCHWL;
01810 FOR I←1 TO 40 DO OUTSTR(↓);
01900 FILM ← INTSCAN(STR,0);
02000 L2: PTR ← 0;
02100 α LOAD 'EM UP;
02300 I ← 0;
02400 BEGIN
02500 OPEN(1,"DSK",8,3,0,0,0,0);
02600 LOOKUP(1,CVS(FILM)&".PLT",FLG);
02700 IF FLG THEN GO L1;
02800 J ← WORDIN(1);
02900 SIZ ← WORDIN(1);
03000 ARRYIN(1,DPYBUF[PTR],SIZ);
03100 RELEASE(1);
03200 FRAME[I]←LOCATION(DPYBUF[PTR]);
03300 SIZE[I]←SIZ;
03400 PTR←PTR+SIZ;
03500 END;
03600
00100 S⊂
00200
00300 SETZM I;
00400 MOVE 1,I; ADD 1,FRAME; MOVE (1); MOVEM PTR;
00500 MOVE 1,I; ADD 1,SIZE; MOVE (1); MOVEM SIZ;
00600 UPG PTR;
00700 JFCL;
00800 END;
00900 IF CHR="." THEN ⊂ FILM←FILM+10;IF FILM>1040 THEN FILM←0;GO L2;⊃;
01000 CHR ← INCHRW;
01010 IF CHR="." THEN GO L2;
01100 IF CHR=";" THEN ⊂ FILM←FILM-10;GO L2;⊃ ELSE
01200 IF CHR=":" THEN ⊂ FILM←FILM+10;GO L2;⊃ ELSE
01300 IF CHR=")" THEN ⊂ FILM←FILM+100;GO L2;⊃ ELSE
01400 IF CHR="(" THEN ⊂ FILM←FILM-100;GO L2;⊃ ELSE GO L1;
01500 END "QQ";