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";