It can be copied from this page and should be saved in Mac OS 7 or later format as a text file with a .bas extension. It will then run in Chipmunk BASIC v.3.5.6.
On RUNning, the following menu appears:
Moire Profiler v.3.2
Petur Knutsson, heimspekideild Haskola Islands / University of Iceland, 1997, 1998, 1999
Version 3.3 June 2002
Settings:
i Line interval: whole file
m moiré flag: <,>
l Low-res processing YES
b record parentheses YES
p use parentheses to process both structural and lexical
c parenthesized p-terms are interpreted as c
d decimal places % 0
f file capture NO
t trace NO
s show text NO
x special xl chart capture NO
o disp.closure check NO
Toggle i, m, l, b, p, c, f, t, s, x, o
h for history and information, q to quit
RETURN to open file: _
Hitting RETURN will open a text file with running analysis (such as
breca.html) and perform analysesEntering i, m, l, b, p, c, f, t, s, x, or o at the prompt will change the settings. The important settings are:
Links to explanatory sections in Intimations will be posted in due course.c, which toggles between parenthesized p-terms are interpreted as c parenthesized p-terms are interpreted verbatimp, which toggles between:use parentheses to process both structural and lexical use parentheses to process only structural use parentheses to process only lexicalf file capture should be set to YES to send results to a text file.
NB. I've just noticed (1 Sep 2003) that text files aren't captured when line interval is set to other than whole file. I might get round to putting that right some time.
10 rem Petur Knutsson, heimspekideild Háskóla Íslands / University of Iceland, 1997, 1998, 1999,2002
15 rem this program runs in Chipmunk BASIC v.3.5.6, Copyright 1998 by Ronald H. Nicholson, Jr.
20 rem set variables *****************************
30 trace = 0 : printline = O : capture = 0 : rem spooling file
40 spec = 0 : spc = 0 : rem reportspecial and counter
50 warning = 0 : rem if disclos warning encountered in sub checkdisclos
60 bracks = 1 : rem register or ignore parentheses in reading
70 brackson = 0 : rem whether parentheses encountered in plot
80 brackset = 3 : rem whether parentheses used in computing
90 perc$ = "###" : rem print using variable
100 dim brackset$(3) : brackset$(1) = "process only structural" : brackset$(2) = "process only lexical" : brackset$(3) = "process both structural and lexical"
110 alldata = 0 : rem whether send all data to file
120 lowres = 1 : rem lowres registered or ignored in reading
130 lowres$ = "TSMABC"
140 lowresprefix$ = ""
145 moireflag$ = ","
150 lineinterval = 500000
160 tot = 0 : rem plot total
170 disclos = 0 : rem displacement closure check
180 conly = 1 : rem regard parenthesized a and b as c
190 clearprofilevariables()
200 label$ = "TSMABCsmabcjkxqnoztrghi012345/\|()"
210 normres$ = "smabcjkxqnoztrghi012345"
220 nsysterms$ = "jkxqnotghi"
230 dim plot$(10000)
240 dim plot(10000)
250 rem initial control panel ******************************
260 intromenu()
270 if spec then spc = 0 : dim linespec(500) : dim sspec(500) : dim mspec(500) : dim sysspec(500) : dim nsysspec(500) : dim z0spec(500)
280 if spec then dim aspec(500) : dim bspec(500) : dim cspec(500) : dim cohspec(500) : dim ncohspec(500)
300 rem open files *****************************
310 open "SFGetFile" for input as #1
320 if capture then open "SFPutFile" for output as #2
330 print : print "Reading text file"
340 if capture then print "and spooling to file"
350 rem *****************************
360 print "Explain values and types? (y/n, RETURN=n): "; : get g$ : print g$ : print : if g$ <> "y" then goto 590
370 prynt("values reported for each interval are:")
380 prynt("headings:")
390 prynt("line = mean frequency per line")
400 prynt("plot = mean frequency per plot, expressed in percentages;")
410 prynt("weight = mean weight of non-sys terms, 1-5")
420 prynt("displ = mean displacement")
430 prynt("res-ph = resolution phasing for s and m = mean S or M support (percentages)")
440 prynt("res-ph for sys and nonsys = mean support of S and M together (percentages) -- Not implemented")
450 prynt("plot-ph = plot phasing (mean pool width)")
460 prynt("psm-ph = psm phasing")
470 prynt("types:")
480 prynt("a = a-sys, b = b-sys, c = c-sys")
490 prynt("sys = total values for all sys")
500 prynt("coh = coherent non-sys, 1-5")
510 prynt("ncoh = non-coherent non-sys, k,j,x,q")
520 prynt("nsys = total values for all non-sys")
530 prynt("0 = zero p-reflection. Note this does not count 0,")
540 prynt(" but any non-occurrence of any of abc12345")
550 prynt("z = moiré failure")
560 prynt("S, M percentages by plot")
570 prynt("A, B, C percentages by line")
580 prynt("")
590 if disclos then prynt("Checking for possible breaches of displacement closure")
600 if bracks then pryntnc("Parentheses used to ")
610 if bracks then prynt(brackset$(brackset))
620 if brackset = 2 then goto 650
630 if conly then prynt("Parenthesized p-terms interpreted as c") : else prynt("Parenthesized p-terms interpreted verbatim")
640 rem main loop ******************************************
650 while
660 clearprofilevariables()
670 if trace then prynt("********************** Starting new interval")
680 rem line interval *****************************
690 for j = 1 to lineinterval
700 input #1,e$
710 if eof(1) then j = lineinterval : goto 740
720 extrnumber(e$) : if j = 1 then initlinenum = linenum
730 if left$(e$,1) = moireflag$ then doline(e$) : else goto 700
740 next j
750 rem *****************************
760 makeprofile() : if not capture then if not spec then print "-- any key --" : get g$
770 wend eof(1)
780 rem end main loop *****************************
790 if capture then if lineinterval = 500000 then print "Save plot list and raw data to file? (y/n)? "; : get g$ : print g$ : if g$ = "y" then savedata()
800 if spec then print "special chart data to file? (y/n)? "; : get g$ : print g$ : if g$ = "y" then savedataspecial()
810 close #2
820 if warning then prynt("") : prynt("WARNING: POSSIBLE BREACHES OF DISPLACEMENT CLOSURE HAVE BEEN ENCOUNTERED")
830 end
840 rem *************************************
850 rem *************************************
860 rem *************************************
870 rem subroutines *****************************
880 rem *************************************
890 sub intromenu() : rem called before main loop
900 cls : print "Moire Profiler v.3.2" : print "Petur Knutsson, heimspekideild Haskola Islands / University of Iceland, 1997, 1998, 1999"
905 print "Version 3.3 June 2002"
910 print : print "Settings:" : if brackset > 3 then brackset = 1
920 print tab (5)"i Line interval: "; : if lineinterval = 500000 then print "whole file" : else print ;lineinterval
925 print tab (5)"m moiré flag: <";moireflag$;">"
930 print tab (5)"l Low-res processing "; : if lowres then print "YES" : else print "NO"
940 print tab (5)"b record parentheses "; : if bracks then print "YES" : else print "NO"
950 print tab (5)"p use parentheses to "; : print brackset$(brackset)
960 print tab (5)"c parenthesized p-terms "; : if conly then print "are interpreted as c" : else print "are interpreted verbatim"
970 print tab (5)"d decimal places % "; : if perc$ = "###.##" then print "2" : else print "0"
980 print tab (5)"f file capture "; : if capture then print "YES" : else print "NO"
990 print tab (5)"t trace "; : if trace then print "YES" : else print "NO"
995 print tab (5)"s show text "; : if printline then print "YES" : else print "NO"
1000 print tab (5)"x special xl chart capture "; : if spec then print "YES" : else print "NO"
1010 print tab (5)"o disp.closure check "; : if disclos then print "YES" : else print "NO"
1020 print : print tab (5)"Toggle i, m, l, b, p, c, f, t, s, x, o"
1030 print tab (5)"h for history and information, q to quit"
1040 print tab (5)"RETURN to open file: ";
1050 get p$ : print p$ : if p$ = "q" then end
1060 if p$ = "h" then history() : intromenu()
1070 if p$ = "t" then if trace then trace = 0 : intromenu() : else if p$ = "t" then trace = 1 : intromenu()
1075 if p$ = "s" then if printline then printline = 0 : intromenu() : else if p$ = "s" then printline = 1 : intromenu()
1080 if p$ = "l" then if lowres then lowres = 0 : intromenu() : else if p$ = "l" then lowres = 1 : intromenu()
1090 if p$ = "b" then if bracks then bracks = 0 : brackset = 3 : intromenu() : else if p$ = "b" then bracks = 1 : intromenu()
1100 if p$ = "p" then brackset = brackset+1 : intromenu()
1110 if p$ = "i" then interval() : intromenu()
1115 if p$ = "m" then print : print tab (5); : input "New moire flag: "; moireflag$ : intromenu()
1120 if p$ = "f" then if capture then capture = 0 : intromenu() : else if p$ = "f" then capture = 1 : intromenu()
1130 if p$ = "d" then if perc$ = "###" then perc$ = "###.##" : intromenu() : else if p$ = "d" then perc$ = "###" : intromenu()
1140 if p$ = "x" then if spec then spec = 0 : intromenu() : else if p$ = "x" then spec = 1 : capture = 0 : intromenu()
1150 if p$ = "o" then if disclos then disclos = 0 : intromenu() : else if p$ = "o" then disclos = 1 : intromenu()
1160 if p$ = "c" then if conly then conly = 0 : intromenu() : else if p$ = "c" then conly = 1 : intromenu()
1170 if p$ = chr$(13) then goto 1190
1180 goto 900
1190 end sub
1200 rem *********************************************
1210 sub history() : cls : print "Moiré Profiler v.3" : print "Petur Knutsson, Heimspekideild Háskóla Íslands / University of Iceland"
1220 print "Version 1 Harris & Monge 1996; Version 2 Copen 1996; Version 3 Rvk 1997-9"
1225 print "Version 3.3 Jaðar June 2002"
1230 print "History/status:"
1240 print "¶ reads ";label$
1250 print "¶ reads 0 1 ... 5 as coherent"
1260 print "¶ reads j3 as j3 plus q3; same with k3 and x3"
1270 print "¶ for double noncoh such as kx3, increments both s and k but increments q only once (Tarbert 9. mars 1996)"
1280 print "¶ 14/4 97: lowres plots do not have to be separated from following normres"
1290 print "¶ Parenthesis processing added Apr 97"
1300 print "¶¶ NB needs a space before ( except after lowres"
1310 print " i.e. reads SM(a) correctly but not sma(r)"
1320 print "¶ Reorganisation of depth and width processing, 1997"
1330 print "¶ displacement closure check added 6.12.98"
1340 print "¶ parenthesized a and b read as c - toggle 13.1.98"
1350 print "¶ corrections made to width processing after realising that the formula was a^2+b^2+c^2+d^2...+n^2 / a+b+c+d...+n, 22 Feb 98"
1360 print "also same day rearranged chnul to add 0 to all plots which have no reflection (since 0 not always written) - before chnul had been a compute subroutine."
1370 print "¶ Bug appeared in Chipmunk 3.5: function val() can't deal with strings beginning with , or =. 17.Dec 99 fixed by excluding these strings from sub extrnumber."
1371 print "¶ special capture reformulated as xl chart capture, Jan 00"
1372 print "¶ Jadar, June 2002: printout reformulated for Intimations:"
1373 print " e-terms > p-terms"
1374 print " depth > res phasing, width > serial plor phasing, psupp > smp phasing"
1375 print "¶ July 2002, some prynt bugs fixed; also division by 0 fixed by adding checkzero as variable passed to pryntuse"
1380 print "-- any key --" : get x$ : end sub
1390 rem *********************************************
1400 sub extrnumber(x$) : rem called by main line interval loop
1410 rem this is OK in Chipmunk 3.2, but in 3.5 can't deal with stings beginning with "," or "=" and including / and numbers
1420 if printline then print x$
1430 if (left$(x$,1) = "=") or (left$(x$,1) = ",") or (left$(x$,1) = "*") then goto 1450
1440 if val(x$) > 0 then linenum = val(x$)
1450 end sub
1460 rem *********************************************
1470 sub interval() : rem called by intromenu
1480 print : print tab (5)"Line interval is ";lineinterval
1490 input " Enter new line interval (enter 0 for whole file): ";lineinterval
1500 if lineinterval = 0 then lineinterval = 500000
1510 end sub
1520 rem ********************************************
1530 sub doline(x$) : rem called by main line interval loop; extracts words, registers bracks, registers allits, sends words to book
1540 rem can't read parenthesized e's as c here because have to accommodate r and (r) in subroutine book; so deal with this there
1550 if trace then prynt(str$(linenum)+" "+x$)
1560 word$ = ""
1570 for w = 2 to len(x$)
1580 i$ = mid$(x$,w,1)
1590 if i$ = " " then goto 1630
1600 if i$ = "(" then brackson = 1 : goto 1630
1610 if i$ = ")" then goto 1630
1620 word$ = word$+i$
1630 if i$ = " " or i$ = ")" or w = len(x$) then book(word$) : word$ = ""
1640 if i$ = "/" then if len(word$) > 1 then if instr(normres$,mid$(x$,w-1,1)) then book(left$(word$,len(word$)-1)) : word$ = "/"
1650 if i$ = "\" then if len(word$) > 1 then if instr(normres$,mid$(x$,w-1,1)) then book(left$(word$,len(word$)-1)) : word$ = "\"
1660 rem next allows lowres plots not to be divided from next plot by space *************************************
1670 if len(word$) > 0 then if instr(lowres$,left$(word$,1)) then if instr(normres$,i$) then book(left$(word$,len(word$)-1))) : word$ = i$
1680 if i$ = "(" and len(word$) > 1 then if not instr(lowres$,left$(word$,1)) then prynt("Warning: can't read "+word$+"( in "+str$(linenum))
1690 if i$ = ")" then brackson = 0
1700 next
1710 rem registers allits *************************************
1720 if allit$ = "A" then aallit = aallit+1
1730 if allit$ = "B" then ballit = ballit+1
1740 if allit$ = "C" then callit = callit+1
1750 end sub
1760 rem *********************************************
1770 sub book(s$) : rem called by doline; arranges prefixes and parentheses, and books if acceptable
1780 if s$ = "" then end sub
1790 if instr(lowres$,left$(s$,1)) then lowresprefix$ = s$ : dolowres(s$) : end sub
1800 if bracks then if brackson then if brackset = 2 then end sub
1810 if bracks then if not brackson then if brackset = 1 then end sub
1820 if s$ = "r" then s$ = olds$
1830 olds$ = s$
1840 if conly and brackson then xconly(s$)
1850 chnul(s$) : if nul then s$ = s$+"0" : rem adds 0 to s$ if no reflection
1860 if lowres then s$ = lowresprefix$+s$
1870 if bracks then if brackson then s$ = s$+"("
1880 tot = tot+1
1890 plot$(tot) = s$
1900 plot(tot) = linenum
1910 end sub
1920 rem ********************************************
1930 sub xconly(c$) : rem scans parenthesized plots and changes all p's to c if conly
1940 rem print "changing (";c$;") to (";
1950 cc$ = ""
1960 for xx = 1 to len(c$) : xx$ = mid$(c$,xx,1)
1970 if xx$ = "a" or xx$ = "b" then xx$ = "c"
1980 if instr("123456789",xx$) then xx$ = "c"
1990 if instr(nsysterms$,xx$) then xx$ = ""
2000 cc$ = cc$+xx$
2010 next xx
2020 s$ = cc$
2030 rem print s$
2040 end sub
2050 rem ********************************************
2060 sub prynt(p$)
2070 print p$
2080 if capture then print #2,p$
2090 end sub
2100 rem ********************************************
2110 sub pryntnc(p$)
2120 print p$;
2130 if capture then print #2,p$;
2140 end sub
2150 rem ********************************************
2160 sub pryntnum(p)
2170 print ;p;
2180 if capture then print #2,p;
2190 end sub
2200 rem ********************************************
2210 sub pryntuse(u,tb,zerocheck)
2220 if zerocheck = 0 then u = 0
2230 if u < 10 then print using "#.##";u; : else print using "##.##";u;
2240 if tb then print chr$(9);
2250 if capture then if u < 10 then print #2, using "#.##";u; : else if capture then print #2, using "##.##";u;
2260 if tb then if capture then print #2, chr$(9);
2270 end sub
2280 rem ********************************************
2290 sub pryntusepc(u,tb)
2300 if u < 0 then u = 0
2310 print using perc$;u*100; : print "%";
2320 if tb then print chr$(9);
2330 if capture then print #2,using perc$;u*100; : print #2,"%"; : if tb then print #2,chr$(9);
2340 end sub
2350 rem ********************************************
2360 sub clearprofilevariables()
2370 tot = 0
2380 stot = 0 : sdis = 0 : slrsupp = 0 : rem total, displ, and pool depth (res phasing)
2390 mtot = 0 : mdis = 0 : mlrsupp = 0
2400 bigstot = 0 : bigmtot = 0
2410 rem bigSsupp = 0 : bigMsupp = 0 are not used, since the value is the same as slrsupp and mlrsupp, i.e. if S+s and M+m occur in the plot - see lines 2140 ff
2420 atot = 0 : adis = 0
2430 btot = 0 : bdis = 0
2440 ctot = 0 : cdis = 0
2450 systot = 0 : sysdis = 0 : syslrsupp = 0 : rem syslrsupp is sys supported by S+M
2460 cohtot = 0 : cohaccum = 0 : cohdis = 0 : rem cohaccum = accumulated coh, to be divided by cohtot
2470 ncohtot = 0 : ncohaccum = 0 : ncohdis = 0 : rem ncohaccum = accumulated ncoh, to be divided by ncohtot
2480 nsystot = 0 : nsysaccum = 0 : nsysdis = 0 : nsyslrsupp = 0
2490 nulltot = 0 : nulldis = 0
2500 ztot = 0 : zdis = 0
2510 rem peer support on/off variables
2520 son = 0 : mon = 0 : syson = 0 : cohon = 0 : ncohon = 0 : rem snsyson not necessary, covered by cohon and ncohon
2530 rem peer support variables
2540 spsupp = 0 : mpsupp = 0 : syspsupp = 0 : nsyspsupp = 0 : cohpsupp = 0 : ncohpsupp = 0
2550 rem pool variables (all labelled "wid")
2560 swidaccum = 0 : swid = 0 : swiddis = 0
2570 mwidaccum = 0 : mwid = 0 : mwiddis = 0
2580 syswidaccum = 0 : syswid = 0 : syswiddis = 0
2590 nsyswidaccum = 0 : nsyswid = 0 : nsyswiddis = 0
2600 nullwidaccum = 0 : nullwid = 0 : nullwiddis = 0
2610 zwidaccum = 0 : zwid = 0 : zwiddis = 0
2620 aallit = 0 : ballit = 0 : callit = 0 : allit$ = ""
2630 end sub
2640 rem ********************************************
2650 sub makeprofile() : rem called by main loop; reports line numbers for the interval; calls compute, report, reportspecial
2660 if tot = 0 then goto 2770
2670 realinterval = linenum-initlinenum+1
2680 prynt("-----------------------------") : prynt("profile for lines "+str$(initlinenum)+" to "+str$(linenum)+": plot total "+str$(tot))
2690 if not trace then goto 2740
2700 for p = 1 to tot
2710 pryntnc(plot$(p)+" ")
2720 next
2730 prynt("")
2740 for p = 1 to tot : compute(p) : next
2750 s_pool(0) : m_pool(0) : sys_pool(0) : nsys_pool(0) : null_pool(0) : z_pool(0) : rem final round - sends once more to s_pool before closing
2760 if spec then reportspecial() : else report()
2770 end sub
2780 rem ********************************************
2790 sub compute(p) : rem p = plot number
2800 rem called by makeprofile; reads the terms and augments variables, calling dis, num.
2810 rem checks for pools calling x_pool etc.
2820 displ = 0
2830 for seg = 1 to len(plot$(p))
2840 m$ = mid$(plot$(p),seg,1)
2850 if m$ = "/" or m$ = "\" then dis() : seg = seg-1 : goto 3040
2860 if m$ = "|" then displ = 0 : goto 3040
2870 if instr(label$,m$) = 0 then print "*** WARNING: anomalous plot ";plot$(p);" at line ";plot(p)
2880 if m$ = "s" then stot = stot+1 : sdis = sdis+displ : son = 1 : spsupp = spsupp+1
2890 if m$ = "s" then if instr(plot$(p),"S") then slrsupp = slrsupp+1 : rem slrsupp = lowres support
2900 if m$ = "S" then bigstot = bigstot+1
2910 if m$ = "m" then mtot = mtot+1 : mdis = mdis+displ : mon = 1 : mpsupp = mpsupp+1
2920 if m$ = "m" then if instr(plot$(p),"M") then mlrsupp = mlrsupp+1
2930 if m$ = "M" then bigmtot = bigmtot+1
2940 if m$ = "a" then atot = atot+1 : adis = adis+displ : systot = systot+1 : sysdis = sysdis+displ : syson = 1 : syspsupp = syspsupp+1
2950 if m$ = "a" then if instr(plot$(p),"S") then if instr(plot$(p),"M") then syslrsupp = syslrsupp+1
2960 if m$ = "b" then btot = btot+1 : bdis = bdis+displ : systot = systot+1 : sysdis = sysdis+displ : syson = 1 : syspsupp = syspsupp+1
2970 if m$ = "b" then if instr(plot$(p),"S") then if instr(plot$(p),"M") then syslrsupp = syslrsupp+1
2980 if m$ = "c" then ctot = ctot+1 : cdis = cdis+displ : systot = systot+1 : sysdis = sysdis+displ : syson = 1 : syspsupp = syspsupp+1
2990 if m$ = "c" then if instr(plot$(p),"S") then if instr(plot$(p),"M") then syslrsupp = syslrsupp+1
3000 if m$ > "0" and m$ < ":" then num(plot$(p),seg) : rem IF m$ IS A NUMBER. Passing plot & position in plot
3010 if m$ > "0" and m$ < ":" then if instr(plot$(p),"S") then if instr(plot$(p),"M") then nsyslrsupp = nsyslrsupp+1
3020 if m$ = "0" then nulltot = nulltot+1 : nulldis = nulldis+displ
3030 if m$ = "z" then ztot = ztot+1 : zdis = zdis+displ
3040 next
3050 rem check for pools
3060 if instr(plot$(p),"s") then s_pool(swidcount) : swidcount = 1 : else swidcount = 0
3070 if instr(plot$(p),"m") then m_pool(mwidcount) : mwidcount = 1 : else mwidcount = 0
3080 if (instr(plot$(p),"a") or instr(plot$(p),"b") or instr(plot$(p),"c")) then sys_pool(syswidcount) : syswidcount = 1 : else syswidcount = 0
3090 if (instr(plot$(p),"1") or instr(plot$(p),"2") or instr(plot$(p),"3") or instr(plot$(p),"4") or instr(plot$(p),"5")) then nsys_pool(nsyswidcount) : nsyswidcount = 1 : else nsyswidcount = 0
3100 if instr(plot$(p),"0") then null_pool(nullwidcount) : nullwidcount = 1 : else nullwidcount = 0
3110 if instr(plot$(p),"z") then z_pool(zwidcount) : zwidcount = 1 : else zwidcount = 0
3120 psupport() : rem compute peer support, or coincident moirés
3130 if disclos then if displ > 0 then if lineinterval < 500000 then checkdisclos(plot$(p),plot(p)) : rem checks for breach of displacement closure
3140 end sub
3150 rem ***************************************************
3160 sub chnul(chnul$) : nul = 1 : rem adds 0 to plot if no reflection
3170 if instr(chnul$,"a") then nul = 0
3180 if instr(chnul$,"b") then nul = 0
3190 if instr(chnul$,"c") then nul = 0
3200 if instr(chnul$,"1") then nul = 0
3210 if instr(chnul$,"2") then nul = 0
3220 if instr(chnul$,"3") then nul = 0
3230 if instr(chnul$,"4") then nul = 0
3240 if instr(chnul$,"5") then nul = 0
3250 if instr(chnul$,"z") then nul = 0
3260 if instr(chnul$,"0") then nul = 0
3270 end sub
3280 rem ***************************************************
3290 sub s_pool(counting) : rem computes s-pools; called by compute
3300 if swiddis <> displ then counting = 0
3310 if swidslant$ <> slant$ then counting = 0
3320 if counting then swid = swid+1 : else swidaccum = swidaccum+(swid*swid) : swid = 1 : swiddis = displ : swidslant$ = slant$
3330 rem swidaccum is not augmented on the final round, so makeprofile sends once more to s_pool before closing - search "rem final round"
3340 end sub
3350 rem ***************************************************
3360 sub m_pool(counting)
3370 if mwiddis <> displ then counting = 0
3380 if mwidslant$ <> slant$ then counting = 0
3390 if counting then mwid = mwid+1 : else mwidaccum = mwidaccum+(mwid*mwid) : mwid = 1 : mwiddis = displ : mwidslant$ = slant$
3400 end sub
3410 rem ***************************************************
3420 sub sys_pool(counting)
3430 if syswiddis <> displ then counting = 0
3440 if syswidslant$ <> slant$ then counting = 0
3450 if counting then syswid = syswid+1 : else syswidaccum = syswidaccum+(syswid*syswid) : syswid = 1 : syswiddis = displ : syswidslant$ = slant$
3460 end sub
3470 rem ***************************************************
3480 sub nsys_pool(counting)
3490 if nsyswiddis <> displ then counting = 0
3500 if nsyswidslant$ <> slant$ then counting = 0
3510 if counting then nsyswid = nsyswid+1 : else nsyswidaccum = nsyswidaccum+(nsyswid*nsyswid) : nsyswid = 1 : nsyswiddis = displ : nsyswidslant$ = slant$
3520 end sub
3530 rem ***************************************************
3540 sub null_pool(counting)
3550 if nullwiddis <> displ then counting = 0
3560 if nullwidslant$ <> slant$ then counting = 0
3570 if counting then nullwid = nullwid+1 : else nullwidaccum = nullwidaccum+(nullwid*nullwid) : nullwid = 1 : nullwiddis = displ : nullwidslant$ = slant$
3580 end sub
3590 rem ***************************************************
3600 sub z_pool(counting)
3610 if zwiddis <> displ then counting = 0
3620 if zwidslant$ <> slant$ then counting = 0
3630 if counting then zwid = zwid+1 : else zwidaccum = zwidaccum+(zwid*zwid) : zwid = 1 : zwiddis = displ : zwidslant$ = slant$
3640 end sub
3650 rem ***************************************************
3660 sub psupport() : rem peer support, or coincident moirés; called by compute
3670 rem augments variable by 2 if three together, and by 1 if 2 together, because they are augmented by 1 when they occur in sub compute
3680 if son and mon and syson then spsupp = spsupp+2 : mpsupp = mpsupp+2 : syspsupp = syspsupp+2 : goto 3780
3690 if son and mon and cohon then spsupp = spsupp+2 : mpsupp = mpsupp+2 : cohpsupp = cohpsupp+2 : nsyspsupp = nsyspsupp+2 : goto 3780
3700 if son and mon and ncohon then spsupp = spsupp+2 : mpsupp = mpsupp+2 : ncohpsupp = ncohpsupp+2 : nsyspsupp = nsyspsupp+2 : goto 3780
3710 if son and mon then spsupp = spsupp+1 : mpsupp = mpsupp+1 : goto 3780
3720 if son and syson then spsupp = spsupp+1 : syspsupp = syspsupp+1 : goto 3780
3730 if son and cohon then spsupp = spsupp+1 : cohpsupp = cohpsupp+1 : nsyspsupp = nsyspsupp+1 : goto 3780
3740 if son and ncohon then spsupp = spsupp+1 : nsyspsupp = nsyspsupp+1 : ncohpsupp = ncohpsupp+1 : goto 3780
3750 if mon and syson then mpsupp = mpsupp+1 : syspsupp = syspsupp+1 : goto 3780
3760 if mon and cohon then mpsupp = mpsupp+1 : cohpsupp = cohpsupp+1 : nsyspsupp = nsyspsupp+1 : goto 3780
3770 if mon and ncohon then mpsupp = mpsupp+1 : ncohpsupp = ncohpsupp+1 : nsyspsupp = nsyspsupp+1
3780 son = 0 : mon = 0 : syson = 0 : cohon = 0 : ncohon = 0
3790 end sub
3800 rem ***************************************************
3810 sub dolowres(lr$)
3820 if instr(lr$,"A") then allit$ = "A"
3830 if instr(lr$,"B") then allit$ = "B"
3840 if instr(lr$,"C") then allit$ = "C"
3850 end sub
3860 rem ***************************************************
3870 sub dis() : rem counts slants to augment displ. Called by compute
3880 rem also finds slant$
3890 displ = 0
3900 while mid$(plot$(p),seg,1) = "/" or mid$(plot$(p),seg,1) = "\"
3910 displ = displ+1 : seg = seg+1
3920 wend
3930 if instr(plot$(p),"/") then slant$ = "/"
3940 if instr(plot$(p),"\") then slant$ = "\"
3950 end sub
3960 rem ***************************************************
3970 sub num(x$,x) : rem decides whether coh or ncoh and computes tot and weight for coh, ncoh nsys etc.
3980 rem called by compute; no subs
3990 weight = val(mid$(x$,x,1)) : rem print x$:print weight: get g$
4000 rem first check if jkxqgnhiot preceeds, i.e. non-coherent echo: if so augment ncohtot and add weight to ncohaccum(ulated)
4010 rem if instr(nsysterms$,mid$(x$,x-1,1)) then print x$
4020 if instr(nsysterms$,mid$(x$,x-1,1)) then ncohtot = ncohtot+1 : ncohaccum = ncohaccum+weight : ncohdis = ncohdis+displ : nsystot = nsystot+1 : nsysaccum = nsysaccum+weight : nsysdis = nsysdis+displ
4030 if instr(nsysterms$,mid$(x$,x-1,1)) then ncohon = 1 : ncohpsupp = ncohpsupp+1 : nsyspsupp = nsyspsupp+1 : goto 4070
4040 rem if none of above then the numeral stands alone and means coherent
4050 cohtot = cohtot+1 : cohaccum = cohaccum+weight : cohdis = cohdis+displ : nsystot = nsystot+1 : nsysaccum = nsysaccum+weight
4060 nsysdis = nsysdis+displ : cohon = 1 : cohpsupp = cohpsupp+1 : nsyspsupp = nsyspsupp+1
4070 end sub
4080 rem ***************************************************
4090 sub report() : rem prints results
4100 rem first prints raw data if trace
4110 if not trace then goto 4270
4120 prynt("tot "+str$(tot)+" realinterval "+str$(realinterval))
4130 prynt("bigStot "+str$(bigstot)+" bigMtot "+str$(bigmtot))
4140 prynt("stot "+str$(stot)+" sdis "+str$(sdis)+" slrsupp "+str$(slrsupp)+" swidaccum "+str$(swidaccum))
4150 prynt("mtot "+str$(mtot)+" mdis "+str$(mdis)+" mlrsupp "+str$(mlrsupp)+" mwidaccum "+str$(mwidaccum))
4160 prynt("systot "+str$(systot)+" sysdis "+str$(sysdis)+" syslrsupp "+str$(syslrsupp)+" syswidaccum "+str$(syswidaccum))
4170 prynt("atot "+str$(atot)+" adis "+str$(adis))
4180 prynt("btot "+str$(btot)+" bdis "+str$(bdis))
4190 prynt("ctot "+str$(ctot)+" cdis "+str$(cdis))
4200 prynt("nsystot "+str$(nsystot)+" nsysaccum "+str$(nsysaccum)+" nsysdis "+str$(nsysdis)+" nsyslrsupp "+str$(nsyslrsupp)+" nsyswidaccum "+str$(nsyswidaccum))
4210 prynt("spsupp "+str$(spsupp)+" mpsupp "+str$(mpsupp)+" syspsupp "+str$(syspsupp))
4220 prynt("nsyspsupp "+str$(nsyspsupp)+" cohpsupp "+str$(cohpsupp)+" ncohpsupp "+str$(ncohpsupp))
4230 prynt("cohtot "+str$(cohtot)+" cohaccum "+str$(cohaccum)+" cohdis "+str$(cohdis))
4240 prynt("ncohtot "+str$(ncohtot)+" ncohaccum "+str$(ncohaccum)+" ncohdis "+str$(ncohdis))
4250 prynt("nulltot "+str$(nulltot)+" nulldis "+str$(nulldis)+" nullwidaccum "+str$(nullwidaccum))
4260 prynt("ztot "+str$(ztot)+" zdis "+str$(zdis)+" zwidaccum "+str$(zwidaccum))
4270 rem start here if not trace ********************************************
4280 prynt("type"+chr$(9)+"line"+chr$(9)+"plot"+chr$(9)+"weight"+chr$(9)+"displ"+chr$(9)+"res-ph"+chr$(9)+"plot-ph"+chr$(9)+"smp-ph")
4290 rem s ********************************************
4300 pryntnc("s"+chr$(9)) : pryntuse(stot/realinterval,1,1) : pryntusepc(stot/tot,1) : pryntnc(chr$(9)) : pryntuse(sdis/stot,1,stot)
4305 pryntusepc(slrsupp/stot,1) : pryntuse(swidaccum/stot,1,stot) : pryntuse(spsupp/stot,1,stot)
4310 prynt("")
4320 rem m ********************************************
4330 pryntnc("m"+chr$(9)) : pryntuse(mtot/realinterval,1,1) : pryntusepc(mtot/tot,1) : pryntnc(chr$(9)) : pryntuse(mdis/mtot,1,mtot)
4335 pryntusepc(mlrsupp/mtot,1) : pryntuse(mwidaccum/mtot,1,mtot) : pryntuse(mpsupp/mtot,1,mtot)
4340 prynt("")
4350 rem a ********************************************
4360 pryntnc("a"+chr$(9)) : pryntuse(atot/realinterval,1,1) : pryntusepc(atot/tot,1) : pryntnc(chr$(9)) : pryntuse(adis/atot,1,atot)
4370 prynt("")
4380 rem b ********************************************
4390 pryntnc("b"+chr$(9)) : pryntuse(btot/realinterval,1,1) : pryntusepc(btot/tot,1) : pryntnc(chr$(9)) : pryntuse(bdis/btot,1,btot)
4400 prynt("")
4410 rem c ********************************************
4420 pryntnc("c"+chr$(9)) : pryntuse(ctot/realinterval,1,1) : pryntusepc(ctot/tot,1) : pryntnc(chr$(9)) : pryntuse(cdis/ctot,1,ctot)
4430 prynt("")
4440 rem sys ********************************************
4450 pryntnc("sys"+chr$(9)) : pryntuse(systot/realinterval,1,1) : pryntusepc(systot/tot,1) : pryntnc(chr$(9)) : pryntuse(sysdis/systot,1,systot)
4455 pryntnc(chr$(9)) : pryntuse(syswidaccum/systot,1,systot) : pryntuse(syspsupp/systot,1,systot)
4460 prynt("")
4470 rem coh ********************************************
4480 pryntnc("coh"+chr$(9)) : pryntuse(cohtot/realinterval,1,1) : pryntusepc(cohtot/tot,1) : pryntuse(cohaccum/cohtot,0,cohtot) : pryntnc(chr$(9))
4485 pryntuse(cohdis/cohtot,1,cohtot)
4490 prynt("")
4500 rem ncoh ********************************************
4510 pryntnc("ncoh"+chr$(9)) : pryntuse(ncohtot/realinterval,1,1) : pryntusepc(ncohtot/tot,1) : pryntuse(ncohaccum/ncohtot,0,ncohtot) : pryntnc(chr$(9))
4515 pryntuse(ncohdis/ncohtot,1,ncohtot)
4520 prynt("")
4530 rem nsys ********************************************
4540 pryntnc("nsys"+chr$(9)) : pryntuse(nsystot/realinterval,1,1) : pryntusepc(nsystot/tot,1) : pryntuse(nsysaccum/nsystot,0,nsystot) : pryntnc(chr$(9))
4550 pryntuse(nsysdis/nsystot,1,nsystot) : pryntnc(chr$(9)) : pryntuse(nsyswidaccum/nsystot,0,nsystot) : pryntnc(chr$(9)) : pryntuse(nsyspsupp/nsystot,1,nsystot)
4560 prynt("")
4570 rem 0 ********************************************
4580 pryntnc("0"+chr$(9)) : pryntuse(nulltot/realinterval,1,1) : pryntusepc(nulltot/tot,1) : pryntnc(chr$(9)) : pryntuse(nulldis/nulltot,1,nulltot) : pryntnc(chr$(9)) : pryntuse(nullwidaccum/nulltot,1,nulltot)
4590 prynt("")
4600 rem z ********************************************
4610 pryntnc("z"+chr$(9)) : pryntuse(ztot/realinterval,1,1) : pryntusepc(ztot/tot,1) : pryntnc(chr$(9)) : pryntuse(zdis/ztot,1,ztot) : pryntnc(chr$(9)) : pryntuse(zwidaccum/ztot,1,ztot)
4620 prynt("")
4630 rem lowres ********************************************
4640 if not lowres then goto 4690
4650 pryntnc("Lowres plot percentages: S ") : pryntusepc(bigstot/tot,1) : pryntnc(" M ") : pryntusepc(bigmtot/tot,1)
4660 prynt("")
4670 pryntnc(" A ") : pryntusepc(aallit/realinterval,0) : pryntnc(" B ")
4680 pryntusepc(ballit/realinterval,0) : pryntnc(" C ") : pryntusepc(callit/realinterval,0)
4690 prynt("")
4720 end sub
4730 rem ********************************************
4740 sub savedata() : rem saves plot list and raw data to file; called following main loop. Calls rearrangeplot
4750 print "saving raw data"
4760 print #2, : print #2,"Raw data follows"
4770 print #2,"tot"+chr$(9)+str$(tot)
4780 print #2,"term: tot - accum - dis - lrsupp - widaccum - psupp"
4790 print #2,"s"+chr$(9)+str$(stot)+chr$(9)+chr$(9)+str$(sdis)+chr$(9)+str$(slrsupp)+chr$(9)+str$(swidaccum)+chr$(9)+str$(spsupp)
4800 print #2,"m"+chr$(9)+str$(mtot)+chr$(9)+chr$(9)+str$(mdis)+chr$(9)+str$(mlrsupp)+chr$(9)+str$(mwidaccum)+chr$(9)+str$(mpsupp)
4810 print #2,"sys"+chr$(9)+str$(systot)+chr$(9)+chr$(9)+str$(sysdis)+chr$(9)+chr$(9)+str$(syswidaccum)+chr$(9)+str$(syspsupp)
4820 print #2,"a"+chr$(9)+str$(atot)+chr$(9)+chr$(9)+str$(adis)
4830 print #2,"b"+chr$(9)+str$(btot)+chr$(9)+chr$(9)+str$(bdis)
4840 print #2,"c"+chr$(9)+str$(ctot)+chr$(9)+chr$(9)+str$(cdis)
4850 print #2,"nsys"+chr$(9)+str$(nsystot)+chr$(9)+str$(nsysaccum)+chr$(9)+str$(nsysdis)+chr$(9)+chr$(9)+str$(nsyswidaccum)chr$(9)+str$(nsyspsupp)
4860 print #2,"coh"+chr$(9)+str$(cohtot)+chr$(9)+str$(cohaccum)+chr$(9)+str$(cohdis)+chr$(9)+chr$(9)+str$(cohwidaccum)+chr$(9)+str$(cohpsupp)
4870 print #2,"ncoh"+chr$(9)+str$(ncohtot)+chr$(9)+str$(ncohaccum)+chr$(9)+str$(ncohdis)+chr$(9)+chr$(9)+str$(ncohwidaccum)+chr$(9)+str$(ncohpsupp)
4880 print #2,"0"+chr$(9)+str$(nulltot)+chr$(9)+chr$(9)+str$(nulldis)+chr$(9)+chr$(9)+str$(nullwidaccum)
4890 print #2,"z"+chr$(9)+str$(ztot)+chr$(9)+chr$(9)+str$(zdis)+chr$(9)+chr$(9)+str$(zwidaccum)
4900 print #2,"List of plots:"
4910 for s = 1 to tot
4920 rearrangeplot(s)
4930 next
4940 print #2,"End of plot list"
4950 print "raw data saved"
4960 close #2
4970 end sub
4980 rem ********************************************
4990 sub rearrangeplot(r) : rem Called by savedata. Rewrites plot format to: plotresplots + lowresplots + /n
5000 lo$ = "" : strike = 0 : c = 0
5010 r$ = plot$(r)
5020 while instr("SMABC",left$(r$,1))
5030 lo$ = lo$+left$(r$,1) : r$ = right$(r$,len(r$)-1)
5040 wend
5050 while left$(r$,1) = "/" or left$(r$,1) = "\"
5060 strike = strike+1 : r$ = right$(r$,len(r$)-1)
5070 wend
5080 if right$(r$,1) = "(" then c = 1 : r$ = left$(r$,len(r$)-1)
5090 r$ = r$+" "+lo$
5100 if strike then r$ = r$+" /"+str$(strike)
5110 if c = 1 then r$ = r$+" ("
5120 print #2,r$+chr$(9)+str$(plot(s))
5130 end sub
5140 rem ********************************************
5150 sub reportspecial() : rem saves special data to file instead of sub report; called by makeprofile
5160 spc = spc+1
5170 linespec(spc) = initlinenum
5180 sspec(spc) = int(stot/tot*100)
5190 mspec(spc) = int(mtot/tot*100)
5200 sysspec(spc) = int(systot/tot*100)
5210 aspec(spc) = int(atot/tot*100)
5220 bspec(spc) = int(btot/tot*100)
5230 cspec(spc) = int(ctot/tot*100)
5240 nsysspec(spc) = int(nsystot/tot*100)
5250 cohspec(spc) = int(cohtot/tot*100)
5260 ncohspec(spc) = int(ncohtot/tot*100)
5270 z0spec(spc) = int((nulltot+ztot)/tot*100)
5280 end sub
5290 rem ********************************************
5300 sub savedataspecial() : rem saves special data to file if spec; called after main loop
5310 open "SFPutFile" for output as #2
5320 print #2,"line";chr$(9);"s";chr$(9);"m";chr$(9);"sys";chr$(9);"a";chr$(9);"b";chr$(9);"c";chr$(9);"nsys";chr$(9);"coh";chr$(9);"ncoh";chr$(9);"z+0";chr$(13)
5330 for j = 1 to spc
5340 print #2,linespec(j),sspec(j),mspec(j),sysspec(j),aspec(j),bspec(j),cspec(j),nsysspec(j),cohspec(j),ncohspec(j),z0spec(j)
5350 next
5360 close #2
5370 print "special xl chart data saved to file"
5380 end sub
5390 rem ********************************************
5400 sub checkdisclos(d$,d)
5410 rem print "checking ";d$;" at line ";d;" "
5420 rem print" position at line ";d-initlinenum+1
5430 rem print "from end: ";lineinterval+initlinenum-d
5440 if (slant$ = "\") and (displ > d-initlinenum+1) then whatisthis()
5450 if slant$ = "/" then if displ > lineinterval+initlinenum-d then whatisthis()
5460 rem get g$
5470 end sub
5480 rem ********************************************
5490 sub whatisthis() : rem this seems to be the only way to get prynt to work in sub checkdisclos
5500 prynt("*** WARNING: plot "+d$+" in line "+str$(d)+" may breach displacement closure")
5510 warning = 1
5520 end sub