COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	BEGOF("CNTRS")
C00004 00003	PUBLIC SIMPLE PROCEDURE CNTRS! $"#
C00005 00004	PUBLIC RECURSIVE PROCEDURE CLOSECOUNTER(INTEGER ITSIX BOOLEAN DISDECLAREIT) $"#
C00006 00005	PRIVATE INTEGER SIMPLE PROCEDURE CHRSALF(INTEGER INT, ALFABET) $"#
C00007 00006	PUBLIC PROCEDURE CRECOUNTER(INTEGER INLINE, PFROM, PTO, PBY, PIN
C00012 00007	PRIVATE STRING SIMPLE PROCEDURE CVALF(INTEGER ALFABET, VAL) $"#
C00015 00008	PUBLIC SIMPLE PROCEDURE DCOUNT $"#
C00017 00009	PUBLIC RECURSIVE PROCEDURE DNEXT $"#
C00018 00010	PUBLIC RECURSIVE PROCEDURE NEXTCOUNTER(INTEGER USYMB, UIX) $"#
C00022 00011	PUBLIC INTEGER SIMPLE PROCEDURE NEXTSTATEMENT $"#
C00023 00012	FINISHED
C00024 ENDMK
C⊗;
BEGOF("CNTRS")
COMMENT

A counter is represented by a COUNTERTYPE declaration record on ISTK
and SSTK.  Its implementation is obvious except for the trickiness
necessary to get responses triggered at the "right" time, and the
peculiarities of the PAGE counter.

;
PROCEDURES
PUBLIC SIMPLE PROCEDURE CNTRS! ;$"#
BEGIN "CNTRS!"
SYMPAGE←SYMNUM("PAGE") ;
CRECOUNTER(0,1,18,1,0,"1",SYMPAGE) ;
IXPAGE←LDB(IXN(SYMPAGE)) ;
PATPAGE←PATT!STRS(IXPAGE) ;
PAGEVAL ← NULL ;
! ← NULL ;
END "CNTRS!" ;
PUBLIC RECURSIVE PROCEDURE CLOSECOUNTER(INTEGER ITSIX; BOOLEAN DISDECLAREIT) ;$"#
BEGIN "CLOSECOUNTER"
INTEGER STRS, PP ;
CLOSET(ITSIX, TRUE, DISDECLAREIT) ;
IF DISDECLAREIT THEN
	BEGIN
	IF (PP ← PARENT(ITSIX)) THEN
		BEGIN
		LLSCAN(<SON(PP)>, <BROTHER>, LLTHIS=ITSIX) ;
		LLSKIP(<SON(PP)>, <BROTHER>) ;
		END ;
	STRS ← PATT!STRS(ITSIX) ;
	PATT!VAL(STRS)←PREFIX(STRS)←INFIX(STRS)←SUFFIX(STRS)←CTR!VAL(STRS)←NULL ;
	IF STRS=SHED THEN SHED←SHED-5 ;
	END ;
END "CLOSECOUNTER" ;
PRIVATE INTEGER SIMPLE PROCEDURE CHRSALF(INTEGER INT, ALFABET) ;$"#
BEGIN "CHRSALF"
INTEGER LABS, LSIGN ; STRING STR ; PRELOAD!WITH [2]3,2,[5]1,[2]0 ; OWN INTEGER ARRAY L[0:9] ;
LSIGN ← IF INT < 0 THEN 1 ELSE 0 ; INT ← ABS(INT) ; STR ← CVS(INT) ;
CASE ALFABET DIV 2 OF
BEGIN
COMMENT 1 ... "1" ; LABS ← LENGTH(STR) ;
COMMENT 2 ... i,I ; LABS ← 4*LENGTH(STR) - L[STR-"0"] ; comment, Believe-it-or-Not ;
COMMENT 3 ... a,A ; LABS ← LENGTH(CVALF(ALFABET, INT)) ;
END ;
RETURN(LABS + LSIGN) ;
END "CHRSALF" ;
PUBLIC PROCEDURE CRECOUNTER(INTEGER INLINE, PFROM, PTO, PBY, PIN;
	STRING PPRINTING; INTEGER USYMB) ;$"#
BEGIN "CRECOUNTER"
INTEGER TEMP, LENPAT, PARENTCHARS, POSNALF, POSN!, PS, ALF, UIX, PINIX, PINPS, PCHARS ;
STRING S!, SPAR, SPAR! ;
USYMB ← DECLARE(USYMB, COUNTERTYPE) ; TEMP ← DECLARE(SYMNUM(SYM[USYMB]&"!"), PCOUNTERTYPE) ;
UIX ← PUSHI(COUNTERWDS, COUNTERTYPE) ; PS ← PUSHS(5, NULL) ; PATT!STRS(UIX) ← PS ;
BIND(USYMB, UIX) ; DPB(UIX, IXN(TEMP)) ;
CTR!INIT(UIX) ← PFROM + TWO(14) ; CTR!STEP(UIX) ← PBY + TWO(6) ;
TES 10/25/73 ;  IN!LINE(UIX) ← IF UIX=IXPAGE THEN 0 ELSE INLINE ;
PINIX ← IF PIN THEN LDB(IXN(PIN)) ELSE 0 ; PARENT(UIX) ← PINIX ;
IF PIN = 0 THEN PARENTCHARS ← PINPS ← 0
ELSE IF LDB(TYPEN(PIN)) = COUNTERTYPE THEN
	BEGIN
	PARENTCHARS ← PATT!CHRS(PINIX) ;  PINPS ← PATT!STRS(PINIX) ;
	BROTHER(UIX) ← SON(PINIX) ; SON(PINIX) ← UIX ;
	END
ELSE BEGIN WARN("=","Undeclared Parent Unit "&SYMB) ; PINPS ← 0 ; PARENTCHARS ← 2 END ;
PCHARS ← LENGTH(CVS(PFROM)) MAX LENGTH(CVS(PTO)) ;
IF FULSTR(PPRINTING) AND PPRINTING=0 THEN
	BEGIN "TEMPLATE"
	PREFIX(PS) ← "!←" & PPRINTING[2 TO ∞] & ";!!!;;" ;
	PATT!ALF(UIX) ← 0 ;
	IF PIN NEQ 0 AND PINPS=0 THEN TEMP ← PCHARS + PARENTCHARS comment lousy guess ;
	ELSE	BEGIN
		S! ← ! ; CTR!VAL(PS) ← CVS(PTO - PBY) ; CTR!CHRS(UIX)←PATT!CHRS(UIX)←1000 ;
		IF PINPS THEN BEGIN SPAR ← CTR!VAL(PINPS) ; SPAR! ← PATT!VAL(PINPS) ;
		CTR!VAL(PINPS) ← "999999"[1 TO CTR!CHRS(PINIX)] ;
		PATT!VAL(PINPS) ← ! ← "9999999999999999"[1 TO PARENTCHARS] ; END ;
		NEXTCOUNTER(USYMB, -UIX) ; TEMP ← LENGTH(!) ;
		! ← S! ; IF PINPS THEN BEGIN CTR!VAL(PINPS) ← SPAR ; PATT!VAL(PINPS) ← SPAR! END ;
		END ;
	END "TEMPLATE"
ELSE	BEGIN "PATTERN"
	STRING PATCOPY ; LABEL FALF ; INTEGER ARRAY PCH[1:LENGTH(PPRINTING)] ;
	PRELOAD!WITH "1", "i", "I", "a", "A" ; OWN INTEGER ARRAY ALFS[1:5] ;
	PATCOPY ← PPRINTING ; LENPAT ← 0 ; WHILE FULSTR(PATCOPY) DO PCH[LENPAT←LENPAT+1]←LOP(PATCOPY) ;
	FOR POSNALF ← LENPAT DOWN 1 DO FOR ALF ← 1 THRU 5 DO IF ALFS[ALF]=PCH[POSNALF] THEN GO TO FALF;
	WARN("=",<"No 1, i, I, a, or A in pattern for "&SYM[SYMB]>) ;
	POSNALF ← LENPAT + 1 ; PPRINTING ← PPRINTING & "1" ;
	FALF: POSN! ← POSNALF - 1 ; WHILE POSN! AND PCH[POSN!] NEQ "!" DO POSN! ← POSN! - 1 ;
	PATT!ALF(UIX) ← ALF ; PATT!PARENT(UIX) ← IF POSN! THEN 1 ELSE 0 ;
	PREFIX(PS) ← PPRINTING[1 TO POSN!-1] ; INFIX(PS) ← PPRINTING[POSN!+1 TO POSNALF-1] ;
	SUFFIX(PS) ← PPRINTING[POSNALF+1 TO ∞] ; PATT!VAL(PS) ← NULL ;
	TEMP ← LENGTH(PREFIX(PS)) + PARENTCHARS + LENGTH(INFIX(PS)) + 
		(CHRSALF(PFROM,ALF) MAX CHRSALF(PTO,ALF)) + LENGTH(SUFFIX(PS));
	END "PATTERN" ;
PATT!CHRS(UIX) ← TEMP ; CTR!CHRS(UIX) ← PCHARS ; PATT!VAL(PS)←CTR!VAL(PS)←NULL ;
END "CRECOUNTER" ;
PRIVATE STRING SIMPLE PROCEDURE CVALF(INTEGER ALFABET, VAL) ;$"#
BEGIN "CVALF" COMMENT handles 1aAiI conversions ;
STRING S, A ; INTEGER I ;
PRELOAD!WITH	NULL, "i", "ii", "iii", "iv", "v", "vi", "vii", "viii", "ix",
		NULL, "x", "xx", "xxx", "xl", "l", "lx", "lxx", "lxxx", "xc",
		NULL, "c", "cc", "ccc", "cd", "d", "dc", "dcc", "dccc", "cm" ;
OWN STRING ARRAY LOWROMAN[0:2, 0:9] ;
PRELOAD!WITH	NULL, "I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX",
		NULL, "X", "XX", "XXX", "XL", "L", "LX", "LXX", "LXXX", "XC",
		NULL, "C", "CC", "CCC", "CD", "D", "DC", "DCC", "DCCC", "CM" ;
OWN STRING ARRAY UPROMAN[0:2, 0:9] ;
DEFINE BEG = [WHILE VAL DO BEGIN], OOPS = [WARN(<"=">,<"I only know roman numerals up to 1000, sorry">)] ;
IF VAL = 0 THEN RETURN("0") ;
IF VAL<0 THEN BEGIN S ← "-" ; VAL ← ABS(VAL) END ELSE S ← NULL ;
A ← NULL ; I ← -1 ;
CASE ALFABET - 1 OF
BEGIN
COMMENT 1 ... "1" ; A ← CVS(VAL) ;
COMMENT 2 ... "i" ; IF VAL < 1000 THEN BEG A ← LOWROMAN[I←I+1, VAL MOD 10]&A ;
		VAL← VAL DIV 10 END ELSE OOPS ;
COMMENT 3 ... "I" ; IF VAL < 1000 THEN BEG A ← UPROMAN[I←I+1, VAL MOD 10]&A ;
		VAL← VAL DIV 10 END ELSE OOPS ;
COMMENT 4 ... "a" ; BEG A ← ("a" + (VAL-1) MOD 26)&A ; VAL ← VAL DIV 26 END ;
COMMENT 5 ... "A" ; BEG A ← ("A" + (VAL-1) MOD 26)&A ; VAL ← VAL DIV 26 END ;
END ;
RETURN(S & A) ;
END "CVALF" ;
PUBLIC SIMPLE PROCEDURE DCOUNT ;$"#
BEGIN
INTEGER USYMB, INLINE ;
PRELOAD!WITH "FROM", "TO", "BY", "IN", "PRINTING" ;
OWN STRING ARRAY PRE[1:5] ; OWN STRING ARRAY PAR[1:5] ;
DPASS ; IF  NOT THISISID THEN BEGIN WARN("=","Unit must have a name") ; THISWD ← "!DUMMY" END ;
USYMB ← SYMNUM(THISWD) ; PASS ; IF ITS(INLINE) THEN BEGIN INLINE←TRUE; PASS END ELSE INLINE←FALSE ;
PAR[1]←PAR[2]←PAR[3]←PAR[5]←NULL;
PAR[4] ← 0 ; PARAMS(5, PRE, PAR, NULLS) ;
IF ON THEN CRECOUNTER( INLINE,
	IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]), comment, FROM -- ;
	IF NULSTR(PAR[2]) THEN 18 ELSE CVD(PAR[2]), comment, TO -- ;
	IF NULSTR(PAR[3]) THEN 1 ELSE CVD(PAR[3]), comment, BY -- ;
	IF PAR[4] = 0 THEN 0 ELSE SYMNUM(PAR[4]), comment IN -- ;
	IF NULSTR(PAR[5]) THEN "1" ELSE PAR[5], comment, PRINTING -- ;
	USYMB ) ;
END "DCOUNT" ;
PUBLIC RECURSIVE PROCEDURE DNEXT ;$"#
BEGIN
COMMENT Already PASSed "NEXT" ;
IF  NOT THISISID OR (THISTYPE NEQ COUNTERTYPE AND THISTYPE NEQ PCOUNTERTYPE) THEN WARN("=","NEXT what?")
ELSE IF ON THEN IF IX=IXPAGE THEN NEXTPAGE ELSE NEXTCOUNTER(SYMB, IX) ;
PASS ;
END "DNEXT" ;
PUBLIC RECURSIVE PROCEDURE NEXTCOUNTER(INTEGER USYMB, UIX) ;$"#
BEGIN "NEXTCOUNTER"
INTEGER PS, PARIX, PARTYPE, SONIX, SONPS, IVAL, SVTY, SVIX, SVSY, SVTHAT ;
INTEGER I;
STRING PARVAL, CVAL, PVAL, SVWD ;
IF UIX>0 AND  NOT IN!LINE(UIX) THEN DBREAK ;
IF UIX>0 AND FULSTR(CTR!VAL(PATT!STRS(UIX))) AND FINDTRAN(USYMB, 3) THEN RESPOND(LLTHIS) ;
IF UIX = IXPAGE AND OLDPGIDA THEN FINPAGE ELSE UIX ← ABS(UIX) ;
PS ← PATT!STRS(UIX) ; CVAL ← CTR!VAL(PS) ;
CTR!VAL(PS) ← CVAL ←
	CVS(IVAL←IF NULSTR(CVAL) THEN CTR!INIT(UIX)-TWO(14) ELSE CVD(CVAL)+CTR!STEP(UIX)-TWO(6)) ;
PARVAL ← IF PATT!PARENT(UIX) AND (PARIX ← PARENT(UIX)) THEN
	EVALV("(a parent counter)", PARIX, PCOUNTERTYPE) ELSE NULL ;
IF PATT!ALF(UIX) THEN
	PVAL ← ! ← PREFIX(PS)&PARVAL&INFIX(PS)&CVALF(PATT!ALF(UIX),IVAL)&SUFFIX(PS)
ELSE	BEGIN
	SVTY←THISTYPE ; SVIX←IX ; SVSY←SYMB ; SVWD←THISWD ; SVTHAT←THATISFULL ;
	SWICH(PREFIX(PS), -1, 0) ; PASS ; PVAL ← E(NULL, NULL) ;
	PASS ; IF ITS(;) THEN PASS ;
	IF  NOT ITS(!!!) THEN WARN("=","Unbalanced COUNT Template") ;
	SWICHBACK ;
	THISTYPE←SVTY ; IX←SVIX ; SYMB←SVSY ; THISWD←SVWD ;
	IF SVTHAT THEN RDENTITY ELSE EMPTYTHAT;
	END ;
IF LENGTH(CVAL) > CTR!CHRS(UIX) THEN
	BEGIN
	WARN("Counter underestimated","Underestimated counter "&SYM[USYMB]&" -- reached "&CVAL) ;
	CTR!CHRS(UIX) ← LENGTH(CVAL) ;
	END ;
IF LENGTH(PVAL) > PATT!CHRS(UIX) THEN
	BEGIN
	IF PATT!STRS(UIX) THEN WARN("Pattern underestimate",
		"Underestimated counter "&SYM[USYMB]&": --  reached "&PVAL) ;
	PATT!CHRS(UIX) ← LENGTH(PVAL) ;
	END ;
PATT!VAL(PS) ← PVAL ; SONIX ← SON(UIX) ;
WHILE SONIX > 0 DO
	BEGIN
	SONPS ← PATT!STRS(SONIX) ;
	IF SONIX NEQ IXPAGE AND FULSTR(CTR!VAL(SONPS)) AND FINDTRAN(LDB(BIXNUM(SONIX)),3) THEN RESPOND(LLTHIS) ;
	CTR!VAL(SONPS) ← PATT!VAL(SONPS) ← NULL ;
	IF SONIX = IXPAGE THEN NEXTCOUNTER(SYMPAGE, SONIX ← -SONIX) ;
	DO  SONIX ← IF SONIX>0 AND (K←SON(SONIX)) THEN K ELSE IF (K←BROTHER(ABS SONIX)) THEN K
		ELSE -PARENT(ABS SONIX)  UNTIL SONIX>0 OR SONIX=-UIX ;
	END ;
IF UIX NEQ IXPAGE AND FINDTRAN(USYMB, 4) THEN RESPOND(LLTHIS) ;
IF UIX = IXPAGE THEN PAGEVAL ← PATT!VAL(PATPAGE) ;
! ← PVAL ; C! ← CVAL ; comment RESPOND or NEXTCOUNTER(..PAGE..) might have changed it ;
END "NEXTCOUNTER" ;
PUBLIC INTEGER SIMPLE PROCEDURE NEXTSTATEMENT ;$"#
IF ITS(NEXT) THEN
	BEGIN
	INTEGER USYMB ; COMMENT, counter name symbol number ;
	PASS ; USYMB←IF THISTYPE=COUNTERTYPE THEN SYMB ELSE IF THISTYPE=PCOUNTERTYPE THEN -SYMB ELSE TWO(20) ;
	DNEXT ; RETURN(USYMB) ;
	END
ELSE RETURN(0) ;
FINISHED

ENDOF("CNTRS")