152 lines
5 KiB
OpenEdge ABL
152 lines
5 KiB
OpenEdge ABL
91300 #include "rundecs.h"
|
|
91310 (* COPYRIGHT 1983 C.H.LINDSEY, UNIVERSITY OF MANCHESTER *)
|
|
91320 (**)
|
|
91330 (*+05() PROCEDURE FLSBUF(P: PCFILE; CH: CHAR); EXTERN; ()+05*)
|
|
91340 (*+02()
|
|
91350 PROCEDURE STOPEN (VAR PF: FYL; VAR RF: OBJECTP; LFN: LFNTYPE; PROCEDURE CH(COV:OBJECTP;L:LFNTYPE) ); EXTERN;
|
|
91360 ()+02*)
|
|
91370 (**)
|
|
91380 (**)
|
|
91390 (**)
|
|
91400 (*******STAND OUT PRIMITIVES*******)
|
|
91410 PROCEDURE SONEWLINE(COV:OBJECTP; VAR FYLE :FYL);
|
|
91420 (*+05()
|
|
91430 PROCEDURE WRC(P: PCFILE; CH: CHAR); EXTERN;
|
|
91440 ()+05*)
|
|
91450 BEGIN WITH COV^ DO
|
|
91460 BEGIN LOFCPOS:=LOFCPOS+1;
|
|
91470 COFCPOS:=1;
|
|
91480 (*+05()
|
|
91490 WITH BOOK^ DO
|
|
91500 IF (*ISTTY*) (XFILE^.FLAG DIV 512) MOD 2 <> 0 THEN
|
|
91510 FLSBUF(XFILE, CHR(10))
|
|
91520 ELSE WRC(XFILE, CHR(10));
|
|
91530 ()+05*)
|
|
91540 (*-05() WRITELN(FYLE); ()-05*)
|
|
91550 IF LOFCPOS>LINEBOUND THEN STATUS:=STATUS+[PAGEOVERFLOW,LINEOVERFLOW]
|
|
91560 ELSE BEGIN STATUS:=STATUS-[LINEOVERFLOW];
|
|
91570 IF CARRIAGE IN STATUS THEN WRITE(FYLE, ' ')
|
|
91580 END
|
|
91590 END
|
|
91600 END;
|
|
91610 (**)
|
|
91620 (**)
|
|
91630 PROCEDURE SONEWPAGE(COV:OBJECTP; VAR FYLE :FYL);
|
|
91640 VAR I: INTEGER;
|
|
91650 BEGIN WITH COV^ DO
|
|
91660 BEGIN
|
|
91670 IF COFCPOS<>1 THEN SONEWLINE(COV, FYLE);
|
|
91680 (*+05()
|
|
91690 IF (*ISTTY*) (BOOK^.XFILE^.FLAG DIV 512) MOD 2 <> 0 THEN
|
|
91700 FOR I := LOFCPOS TO LINEBOUND DO SONEWLINE(COV, FYLE)
|
|
91710 ELSE
|
|
91720 ()+05*)
|
|
91730 (*-50() PAGE(FYLE); ()-50*)
|
|
91740 (*+50() PUTSEG(FYLE); ()+50*)
|
|
91750 COFCPOS:=1; LOFCPOS:=1; POFCPOS:=POFCPOS+1;
|
|
91760 STATUS:=STATUS-[PAGEOVERFLOW,LINEOVERFLOW];
|
|
91770 IF POFCPOS>PAGEBOUND THEN
|
|
91780 STATUS:=STATUS+[PFE,PAGEOVERFLOW,LINEOVERFLOW]
|
|
91790 ELSE IF CARRIAGE IN STATUS THEN WRITE(FYLE, '1')
|
|
91800 END
|
|
91810 END;
|
|
91820 (**)
|
|
91830 (**)
|
|
91840 PROCEDURE SORESET(COV: OBJECTP; VAR FYLE: FYL);
|
|
91850 (*OPENED,MOODOK*)
|
|
91860 BEGIN WITH COV^ DO
|
|
91870 BEGIN
|
|
91880 IF RESETPOSS IN POSSIBLES THEN
|
|
91890 BEGIN (*+01()(*-52()BOOK^.STATUS := 15B; (*TO FIX A BUG IN PASCAL MK 2*) ()-52*)()+01*)
|
|
91900 REWRITE(FYLE)
|
|
91910 END;
|
|
91920 IF CARRIAGE IN STATUS THEN
|
|
91930 WRITE(FYLE, '1');
|
|
91940 STATUS := STATUS-[NOTRESET]
|
|
91950 END
|
|
91960 END;
|
|
91970 (**)
|
|
91980 (**)
|
|
91990 (*+01() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; VAR FYLE: FYL); ()+01*)
|
|
92000 (*+02() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; EFET: FETROOMP); ()+02*)
|
|
92010 (*+05() PROCEDURE SOWRSTR(COV,STRNG: OBJECTP; LB,UB: INTEGER; EFET: FETROOMP); ()+05*)
|
|
92020 (*POSN OF NEXT WIDTH CHARS ENSURED*)
|
|
92030 VAR I, WIDTH, J, WORD: INTEGER;
|
|
92040 PTR: UNDRESSP;
|
|
92050 (*+01()
|
|
92060 (*$X0*)
|
|
92070 PROCEDURE WRS(VAR FYLE: FYL; ADDR: UNDRESSP; FLDLGTH, STRLGTH: INTEGER); EXTERN;
|
|
92080 PROCEDURE WRSN(VAR FYLE: FYL; SHORTSTR: INTEGER; FLDLGTH, STRLGTH: INTEGER); EXTERN;
|
|
92090 (*$X4*)
|
|
92100 ()+01*)
|
|
92110 (*+02()
|
|
92120 CPTR: IPOINT;
|
|
92130 PROCEDURE WRC(CH :CHAR; FIL :FETROOMP); EXTERN;
|
|
92140 PROCEDURE WRS(LEN :INTEGER; CP :IPOINT; FIL :FETROOMP); EXTERN;
|
|
92150 ()+02*)
|
|
92160 (*+05()
|
|
92170 CPTR: CHARPOINT ;
|
|
92180 PROCEDURE WRS(P: PCFILE; CP: CHARPOINT; LEN: INTEGER ); EXTERN;
|
|
92190 PROCEDURE WRC(P: PCFILE; CH: CHAR); EXTERN;
|
|
92200 ()+05*)
|
|
92210 BEGIN
|
|
92220 (*+01()
|
|
92230 WIDTH := 1;
|
|
92240 IF LB<0 THEN WRITE(FYLE,CHR(UB))
|
|
92250 ELSE BEGIN
|
|
92260 LB := LB-1;
|
|
92270 PTR := INCPTR(STRNG, STRINGCONST + LB DIV CHARPERWORD);
|
|
92280 WIDTH := UB-LB;
|
|
92290 IF LB MOD CHARPERWORD <> 0 THEN
|
|
92300 BEGIN
|
|
92310 IF WIDTH <= CHARPERWORD - LB MOD CHARPERWORD THEN I := WIDTH ELSE I := CHARPERWORD - LB MOD CHARPERWORD;
|
|
92320 WORD := PTR^.FIRSTWORD;
|
|
92330 FOR J := 1 TO LB MOD CHARPERWORD DO WORD := WORD * CHARSPACE ;
|
|
92340 WRSN(FYLE, WORD, I, I);
|
|
92350 PTR := INCPTR(PTR, SZWORD);
|
|
92360 END
|
|
92370 ELSE I := 0;
|
|
92380 WRS(FYLE, PTR, WIDTH-I, WIDTH-I)
|
|
92390 END;
|
|
92400 ()+01*)
|
|
92410 (*+02()
|
|
92420 IF LB<0 THEN (*CHAR*)
|
|
92430 BEGIN
|
|
92440 WIDTH := 1;
|
|
92450 WRC(CHR(UB),EFET);
|
|
92460 END
|
|
92470 ELSE (*STRING*)
|
|
92480 BEGIN
|
|
92490 WIDTH:=UB-LB+1;
|
|
92500 CPTR:= ORD(STRNG) + STRINGCONST + (LB *(SZWORD DIV CHARPERWORD)-1);
|
|
92510 WRS(WIDTH,CPTR,EFET);
|
|
92520 END;
|
|
92530 ()+02*)
|
|
92540 (*+05()
|
|
92550 IF LB<0 THEN
|
|
92560 BEGIN
|
|
92570 WIDTH := 1;
|
|
92580 WRC(EFET^.XFILE, CHR(UB))
|
|
92590 END
|
|
92600 ELSE BEGIN
|
|
92610 WIDTH := UB - LB + 1;
|
|
92620 CPTR := ASPTR(( ORD( STRNG ) + STRINGCONST )*2 + LB - 1) ;
|
|
92630 WRS( EFET^.XFILE , CPTR , WIDTH ) ;
|
|
92640 END;
|
|
92650 ()+05*)
|
|
92660 WITH COV^ DO
|
|
92670 BEGIN COFCPOS:=COFCPOS+WIDTH;
|
|
92680 IF COFCPOS>CHARBOUND THEN
|
|
92690 STATUS:=STATUS+[LINEOVERFLOW];
|
|
92700 END;
|
|
92710 END;
|
|
92720 (**)
|
|
92730 (**)
|
|
92740 (*-02()
|
|
92750 BEGIN (*OF A68*)
|
|
92760 END; (*OF A68*)
|
|
92770 ()-02*)
|
|
92780 (*+01()
|
|
92790 BEGIN (*OF MAIN PROGRAM*)
|
|
92800 END (*OF EVERYTHING*).
|
|
92810 ()+01*)
|