10 REM > MkReg 1.12
   20 REM Create a paper register from EARS, EOR, or Census data
   30 REM Based on EarsList 1.03
   40 REM v1.01 15-Sep-2009 - Cleans output text to remove sprurious '{' and '}'s
   50 REM v1.02 22-Dec-2009 - Can output all PDs in a ward
   60 REM v1.03 27-Aug-2012 - Lists total number of electors and households
   70 REM v1.04 03-Sep-2012 - Cancelling Input/Output dialog doesn't clear filename
   80 REM       Multiple PDs have seperate page titles, title has year
   90 REM       Tightened up protection for over-long strings
  100 REM       Can source from multiple wards, allows eg Whole Parish or Whole Constituency
  110 REM v1.09 25-May-2019 - Can source from census CSV file, ERO elector file
  120 REM v1.10 14-Jun-2019 - Cleaned up processing of input data, rewrote output processing
  130 REM       Checks output filename for year, removes polling district name from address
  140 REM       Final blank page removed
  150 REM v1.11 15-Jan-2021 - PDName/WardName not dropped if only part of address
  160 REM       If first line is village name (has no spaces), second line (if has spaces)
  170 REM       is road, made upper case
  180 REM       Needs some special case testing
  190 REM       Added \column to page to next column
  200 REM v1.12 05-Dec-2022 - If PDcode + PDname + Wardname too long for page header, drop PDname
  210 REM To do: household eg "59A" should be output correctly
  220 REM If address identical, but in different fields in source, causes address split
  230 REM Sometimes caused because of, eg Rake Lane, Lealholmside, Lealholm vs Rake Lane, Lealholmside, Whitby
  240 :
  250 test%=0
  260 ON ERROR REPORT:PROCexit(ERR)
  270 A$=FNOS_GetEnv+" ":rtf%=TRUE:fmax%=15:DIM fn$(fmax%):in$="":out$=""
  280 test%=FNcl("-debug",0)ORtest%
  290 edt%=NOTFNcl("-f",0)       :REM Full un-edited register
  300 all%=FNcl("-a",0)          :REM Whole ward
  310 pds$=FNcl("-n",1)          :REM PD lookup file
  320 tit$=FNcl("-t",1)          :REM Title
  330 fn%=-1:REPEAT:fn%=fn%+1:fn$(fn%)=FNcl("",0):UNTIL fn$(fn%)="" OR fn%>fmax%
  340 IF fn%=1 OR FNcl("-?",0):PRINT "Syntax: MkReg <infile> <outfile> -all -full -n <namefile> -title <title>":A%=INKEY(200):PROCexit(0)
  350 PROCInit:ON ERROR PRINT:REPORT:PROCCloseOut:PROCCloseIn:PRINT " at ";ERL:A%=INKEY(200):PROCexit(ERR)
  360 IF fn%>1:out$=fn$(fn%-1):fn%=fn%-1:PROCConvert:PROCexit(0)
  370 REPEAT:UNTIL FNmenu:PROCexit(0)
  380 :
  390 DEFPROCInit
  400 ver$="1.12"
  410 width%=40 :REM Column width
  420 cols%=3   :REM Number of columns
  430 lpp%=108  :REM Lines per column for A4
  440 IdxMax%=21:REM Maximum number of CSV fields
  450 name%=0:fore%=0:numb%=0:data%=0:flat%=0:code%=0:out%=0:in%=0:csv%=FALSE
  460 eol$=CHR$10:PROCf_init:REM IF os%>6:eol$=CHR$13+CHR$10
  470 IF os%<>32:ENDPROC
  480 KeyRoot$="Software\J.G.Harston\EARS\MkRegister\"
  490 DIM fs{lStructSize%, hwndOwner%, hInstance%, lpstrFilter%, \
  500 \      lpstrCustomFilter%, nMaxCustFilter%, nFilterIndex%, \
  510 \      lpstrFile%, nMaxFile%, lpstrFileTitle%, \
  520 \      nMaxFileTitle%, lpstrInitialDir%, lpstrTitle%, \
  530 \      flags%, nFileOffset{l&,h&}, nFileExtension{l&,h&}, \
  540 \      lpstrDefExt%, lCustData%, lpfnHook%, lpTemplateName%}
  550 DIM fp{t&(260)}
  560 DIM info$(IdxMax%),head$(IdxMax%)
  570 ENDPROC
  580 :
  590 DEFFNmenu:CLS
  600 PRINT "Create Electoral Register ";ver$;" (C)2009-2022 JGH"'
  610 PRINT "1: Input file:    "fn$(0)
  620 PRINT "   PDname file:   "pds$
  630 IF fn$(0)<>"":PRINT "   Sample:";SPC8;Ward$" - "PDName$" - "PDCode$
  640 PRINT "3: Output file:   "out$
  650 PRINT "4: Range:         "MID$("Single PD      Whole ward     Whole register",(all%*-10+1)OR(csv%AND30),15)
  660 PRINT "   Output type:   Electoral Register (Full)"
  670 PRINT "6: Create RTF file"
  680 PRINT'"0: Exit"
  690 REPEAT:A$=GET$:UNTILINSTR("01234569",A$):IF A$="0":=TRUE
  700 IF A$="1":PROCInFile:PROCpdFile:PROCpdCheck:PROCCloseIn:=0
  710 IF A$="3":PROCOutFile:PROCpdCheck:=0
  720 IF A$="4":all%=NOTall%:=0
  730 IF A$="6":PROCConvert:=0
  740 =0
  750 :
  760 DEFPROCInFile
  770 IF os%=32:A$=FNFile_Open("Select EARS data file to read") ELSE INPUT "Polling district: "A$
  780 IF A$<>"":in$=A$:fn$(0)=A$:fn%=1
  790 ENDPROC
  800 :
  810 DEFPROCOutFile
  820 IF os%=32:A$=FNFile_Save("Select RTF output file to save to") ELSE INPUT "Output file: "A$
  830 IF A$<>"":out$=A$
  840 ENDPROC
  850 :
  860 DEFPROCpdFile
  870 IF pds$<>"":ENDPROC
  880 Y$=FNfn_noext(FNfn_leaf(fn$(0)))
  890 REM Look for a year
  900 IF VALLEFT$(Y$,4):Y$=LEFT$(Y$,4) ELSE IF VALRIGHT$(Y$,4):Y$=RIGHT$(Y$,4) ELSE ENDPROC
  910 REM Try YYYY
  920 A$=FNfn_path(fn$(0))+Y$+"-Names"+s$+"csv":in%=OPENIN(A$):IF in%:CLOSE#in%:in%=0:pds$=A$:ENDPROC
  930 REM Try YYYY+1
  940 Y$=FNd(VALY$+1,4)
  950 A$=FNfn_path(fn$(0))+Y$+"-Names"+s$+"csv":in%=OPENIN(A$):IF in%:CLOSE#in%:in%=0:pds$=A$:ENDPROC
  960 ENDPROC
  970 :
  980 DEFPROCpdCheck
  990 ears%=FALSE:csv%=FALSE
 1000 IdxStatus%=0
 1010 Constit$="":Ward$="":Parish$="":PDCode$="":PDName$="":PDTitle$="":Year$=""
 1020 path$=FNfn_path(in$):pd$=FNfn_noext(FNfn_leaf(in$))
 1030 pd$=MID$(pd$,2)
 1040 name$=path$+"E"+pd$+s$+"MP"
 1050 fore$=path$+"E"+pd$+s$+"V2"
 1060 numb$=path$+"E"+pd$+s$+"TP"
 1070 data$=path$+"E"+pd$+s$+"VX"
 1080 flat$=path$+"E"+pd$+s$+"T1"
 1090 code$=path$+"E"+pd$+s$+"RX"
 1100 logf$=path$+"Log"+s$+"txt"
 1110 name%=OPENIN(name$)
 1120 IF name% THEN
 1130   ears%=TRUE:REM EARS data files
 1140   size%=&80 :REM Entry size
 1150   phsz%=10  :REM Phone number size
 1160   PTR#name%=&01:Constit$=FNRdStrN(name%)
 1170   PTR#name%=&25:Ward$   =FNRdStrN(name%)
 1180   PTR#name%=&73:PDCode$ =FNRdStrN(name%)
 1190   PTR#name%=&7B:PDName$ =FNRdStrN(name%)
 1200   A$="":data%=OPENIN(logf$):IF data%:A$=GET$#data%:CLOSE#data%:data%=0
 1210   A%=INSTR(A$,"logging"):IF A%:A$=MID$(A$,A%+11,7):Year$=STR$(VALMID$(A$,4)+(VALLEFT$(A$,2)<2))
 1215   PROCpdName
 1220   ENDPROC
 1230 ENDIF
 1240 :
 1250 name%=OPENIN(in$)
 1260 IF name% THEN
 1270   A$=GET$#name%
 1280   IF INSTR(A$,",")=0:CLOSE#name%:name%=0:ENDPROC
 1290   all%=FALSE:REM Single source file
 1300   csv%=TRUE :REM CSV file
 1310   size%=0   :REM Entry size, 0=not fixed size
 1320   PTR#name%=0:PROCcsv_rd(name%,info$()):REM Read header
 1330   IdxHousehold%=0:IdxIndividual%=0:IdxAge%     =0
 1340   IdxPD%       =0:IdxNum%       =0:IdxEnum%    =0
 1350   IdxSurname%  =0:IdxForename%  =0:IdxMiddle%  =0
 1360   IdxStreet%   =0:IdxAddress%   =0:IdxPostcode%=0
 1370   FOR n%=0 TO IdxMax%:A$=FNs(FNuc(info$(n%)))
 1380     IF LEFT$(A$,15)="POLLINGDISTRICT":IdxPD%=n%
 1390     IF A$="PD"               :IdxPD%        =n%
 1400     IF A$="NUM"              :IdxNum%       =n%
 1410     IF A$="ENO"              :IdxNum%       =n%
 1420     IF LEFT$(A$,7)="ELECTOR" :IdxNum%       =n%
 1430     IF A$="PD:NUM"           :IdxIndividual%=n%
 1440     IF A$="NAME"             :IdxForename%  =n%
 1450     IF A$="FIRSTNAME"        :IdxForename%  =n%
 1460     IF A$="FIRST NAME"       :IdxForename%  =n%
 1470     IF A$="INITIALS"         :IdxMiddle%    =n%
 1480     IF A$="MIDDLE NAME"      :IdxMiddle%    =n%
 1490     IF A$="SURNAME"          :IdxSurname%   =n%
 1500     IF A$="LASTNAME"         :IdxSurname%   =n%
 1510     IF A$="LAST NAME"        :IdxSurname%   =n%
 1520     IF A$="AGE"              :IdxAge%       =n%
 1530     IF A$="ADDRESS 1"        :IdxAddress%   =n%:IdxOff%=2
 1540     IF A$="ADDRESS1"         :IdxAddress%   =n%:IdxOff%=0
 1550     IF RIGHT$(A$,5)="LINE1"  :IdxAddress%   =n%:IdxOff%=0
 1560     IF A$="ADDRESS"          :IdxStreet%    =n%
 1570     IF A$="STREET ADDRESS"   :IdxStreet%    =n%
 1580     IF A$="POSTCODE"         :IdxPostcode%  =n%
 1590     IF A$="POSTALCODE"       :IdxPostcode%  =n%
 1600     IF A$="STATUS"           :IdxStatus%    =n%
 1610     REM IF A$="OPT OUT"      :              :REM "Z"=on edited register
 1620     IF LEFT$(A$,10)="INDIVIDUAL":IdxIndividual%=n%
 1630     IF A$="ENUMERATION DISTRICT":IdxEnum%   =n%
 1640   NEXT
 1650   :
 1660   FOR A%=0 TO 1
 1670     IF A%:A$=FNfn_noext(FNfn_leaf(out$)) ELSE A$=FNfn_noext(FNfn_leaf(in$))
 1680     IF VAL LEFT$(A$,4)>999:Year$=LEFT$(A$,4):Ward$=MID$(A$,5)
 1690     IF VAL RIGHT$(A$,4)>999:Ward$=LEFT$(A$,LENA$-4):Year$=RIGHT$(A$,4)
 1700   NEXT
 1710   REPEAT:A%=LEFT$(Ward$,1)<"A":IF A%:Ward$=MID$(Ward$,2)
 1720     IF A%=0:A%=RIGHT$(Ward$,1)<"A":IF A%:Ward$=LEFT$(Ward$,LENWard$-1)
 1730   UNTIL A%=0
 1740   :
 1750   PROCcsv_rd(name%,info$()):REM Read first record
 1760   PDCode$=info$(IdxPD%):IF VALPDCode$:PDCode$=""
 1770   A$=info$(IdxIndividual%)
 1780   IdxPoll%=INSTR(A$,":"):IF IdxPoll%:PDCode$=LEFT$(A$,IdxPoll%-1)
 1790   PTR#name%=0:PROCcsv_rd(name%,info$())
 1800   PROCpdName
 1810 ENDIF
 1820 ENDPROC
 1830 :
 1840 DEFPROCpdName
 1850 REM PDTitle$=""
 1860 REM IF NOT csv% OR pds$="":ENDPROC
 1865 IF pds$="":ENDPROC
 1870 code%=OPENIN(pds$):IF code%=0:code%=OPENIN(FNfn_path(in$)+FNfn_leaf(pds$))
 1880 IF code%=0:ENDPROC
 1890 PDName$="":Ward$="":Parish$=""
 1900 PROCcsv_rd(code%,head$())
 1910 REPEAT:PROCcsv_rd(code%,head$()):IF head$(0)=PDCode$:Ward$=FNs(head$(3)):PDName$=FNs(head$(5)):Parish$=FNs(head$(4))
 1920 UNTIL EOF#code% OR PDName$<>""
 1930 CLOSE#code%:code%=0
 1940 PDTitle$=PDName$
 1950 PROCwardName
 1960 ENDPROC
 1970 :
 1980 DEFPROCwardName
 1990 WardTitle$=Ward$:PageTitle$=tit$
 2000 IF Year$="" THEN
 2010 ELSE
 2020   IF PageTitle$="" THEN
 2030     IF Parish$="" THEN
 2040       WardTitle$=WardTitle$+" "+Year$
 2050     ELSE
 2060       PageTitle$=Parish$+STRING$(2-((LENParish$) AND 1)," ")+Year$
 2070     ENDIF
 2080   ELSE
 2090     PageTitle$=PageTitle$+STRING$(2-((LENWardTitle$-LENPageTitle$) AND 1)," ")+Year$
 2100   ENDIF
 2110 ENDIF
 2120 ENDPROC
 2130 :
 2140 DEFPROCConvert
 2150 PRINT "Creating RTF file...";
 2160 in$=fn$(0):IF in$="" OR out$="":PRINT '"No file selected";:A%=INKEY(200):ENDPROC
 2170 PROCpdCheck:IF name%:PROCCloseIn ELSE PRINT '"Can't open input files";:A%=INKEY(200):ENDPROC
 2180 IF os%=32:IF FNfn_ext(out$)="":out$=out$+"."
 2190 out%=OPENOUT(out$):IF out%=0:PRINT '"Can't open '"out$"'";:A%=INKEY(200):ENDPROC
 2200 A$=FNfn_noext(FNfn_leaf(out$))
 2210 IF VAL LEFT$(A$,4)>999:Year$=LEFT$(A$,4)
 2220 IF VAL RIGHT$(A$,4)>999:Year$=RIGHT$(A$,4)
 2230 PROCwardName
 2240 PROCrtfHeader
 2250 line%=0
 2260 column%=0
 2270 path$=FNfn_root(fn$(0))
 2280 FOR file%=0 TO fn%-1
 2290   in$=fn$(file%)
 2300   IF FNfn_root(in$)="":in$=path$+in$
 2310   PROCConvertFile
 2320 NEXT file%
 2330 PROCrtfFooter
 2340 PROCCloseOut
 2350 ENDPROC
 2360 :
 2370 DEFPROCConvertFile
 2380 IF all% THEN
 2390   leaf$=FNfn_noext(FNfn_leaf(in$)):leaf$=LEFT$(leaf$,LENleaf$-1)
 2400   inpath$=FNfn_path(in$)
 2410   pdx$="A"
 2420   REPEAT
 2430     in$=inpath$+leaf$+pdx$+s$+"A"
 2440     PROCpdCheck:ok%=name%
 2450     IF ok%:PRINT " ";pd$;:PROCConvertPD:pdx$=CHR$(ASCpdx$+1)
 2460   UNTIL ok%=0
 2470 ELSE
 2480   PROCpdCheck:IF name%:PROCConvertPD
 2490 ENDIF
 2500 ENDPROC
 2510 :
 2520 DEFPROCConvertPD
 2530 PROCOpenFiles
 2540 REM PROCwardName
 2550 IF csv%:PROCNewSection
 2560 NumOfHouses%=0
 2570 LastHouseNo$=""
 2580 cRoadName$=""
 2590 cCottage$=""
 2600 cPostCode$=""
 2610 cPDCode$=""
 2620 cEnum$=""
 2630 rollno%=0
 2640 subnum%=0
 2650 entry%=0
 2660 text$=""
 2670 REPEAT
 2680   PROCInputEntry
 2690   IF PDCode$<>cPDCode$ THEN
 2700     IF cPDCode$<>"":PROCSummary
 2710     cPDCode$=PDCode$
 2720     REM PROCpdName
 2730     PROCNewSection
 2740     REM NumOfHouses%=0
 2750     REM entry%=0
 2760   ENDIF
 2770   PROCOutputEntry
 2780 UNTIL entry%*size%>=EXT#data% OR EOF#data%
 2790 PROCSummary
 2800 PROCCloseIn
 2810 ENDPROC
 2820 :
 2830 DEFPROCNewSection
 2840 IF column%>0 OR line%>0:PROCOut(FNrtf("\sect ")+eol$):line%=0:column%=cols%*(column%DIVcols%+1)
 2850 PROCrtfSection
 2860 ENDPROC
 2870 :
 2880 REM BUG preventing blank final page loses subtitle on last polling district
 2890 DEFPROCSummary
 2900 PROCOutNL(eol$):IF line%>lpp%-3:PROCFoot
 2910 IF entry%>0:PROCOutNL(eol$)
 2920 IF entry%>0:PROCOutNL("Houses:  "+FNd(NumOfHouses%,5)+eol$)
 2930 IF entry%>0:PROCOutNL("People:  "+FNd(entry%,5)+eol$)
 2940 cRoadName$=""
 2950 NumOfHouses%=0
 2960 entry%=0
 2970 ENDPROC
 2980 :
 2990 DEFPROCOpenFiles
 3000 IF ears%:PROCOpenFilesEARS
 3010 IF csv%:PROCOpenFilesCSV
 3020 ENDPROC
 3030 :
 3040 DEFPROCOpenFilesEARS
 3050 fore%=OPENIN(fore$):IF fore%=0:PRINT "Can't open '"fore$"'"
 3060 numb%=OPENIN(numb$):IF numb%=0:PRINT "Can't open '"numb$"'"
 3070 data%=OPENIN(data$):IF data%=0:PRINT "Can't open '"data$"'"
 3080 flat%=OPENIN(flat$):IF flat%=0:PRINT "Can't open '"flat$"'"
 3090 code%=OPENIN(code$):IF code%=0:PRINT "Can't open '"code$"'"
 3100 ENDPROC
 3110 :
 3120 DEFPROCOpenFilesCSV
 3130 data%=name%:name%=0
 3140 ENDPROC
 3150 :
 3160 DEFPROCInputEntry
 3170 IF ears%:PROCInputEntryEARS:ENDPROC
 3180 IF csv% :PROCInputEntryCSV:ENDPROC
 3190 ENDPROC
 3200 :
 3210 DEFPROCInputEntryEARS
 3220 PTR#data%=entry%*size%+00:rollno%=FNRd16(data%)
 3230 suffix$=FNRdStrN(data%):IF suffix$<>"":suffix$="/"+suffix$
 3240 PTR#data%=entry%*size%+09:houseflag%=BGET#data%
 3250 nameptr%=FNRd16(data%):persptr%=FNRd16(data%)
 3260 postptr%=FNRd16(data%):HouseNo%=FNRd16(data%)
 3270 PTR#data%=entry%*size%+&4C:phoneptr%=256*BGET#data%+BGET#data%
 3280 PTR#data%=entry%*size%+&58:mosaic%=BGET#data%:ctax%=BGET#data%
 3290 mosaic1%=(mosaic%AND3)*4+(ctax%AND&C0)DIV64
 3300 mosaic%=mosaic%DIV4:ctax%=(ctax%AND&3C)DIV4
 3310 :
 3320 PTR#name%=nameptr%+&200:Surname$=FNRdStrB7(name%)
 3330 PTR#fore%=(persptr%-1)*16:Pername$=FNRdStrN(fore%)
 3340 PTR#code%=postptr%*&1C+0:cottptr%=FNRd16(code%):roadptr%=FNRd16(code%)
 3350 PTR#code%=postptr%*&1C+8:PostCode$=FNRdStrN(code%)
 3360 PTR#name%=roadptr%+&200:RoadName$=FNRdStrB7(name%)
 3370 Cottage$="":IF cottptr%:PTR#name%=cottptr%+&200:Cottage$=FNRdStrB7(name%)
 3380 IF houseflag%=1:HouseNo$=STR$HouseNo% ELSE HouseNo$="":IF HouseNo%:PTR#flat%=HouseNo%:HouseNo$=FNRdStrB7(flat%)
 3390 Phone$=FNRdPhone(phoneptr%)
 3400 Enum$=""
 3410 REM Post town?
 3420 ENDPROC
 3430 :
 3440 DEFPROCInputEntryCSV
 3450 PROCcsv_rd(data%,info$())
 3460 :
 3470 REM Get individual indentifier (elector number or census number)
 3480 lastroll%=rollno%
 3490 IF IdxPoll% THEN
 3500   A$=info$(IdxIndividual%):A%=INSTR(A$,":")
 3510   PDCode$=LEFT$(A$,A%-1):A$=MID$(A$,A%+1)
 3520   rollno%=VAL A$:suffix$=""
 3530   A%=INSTR(A$,"/"):IF A%:suffix$=MID$(A$,A%)
 3540 ELSE
 3550   suffix$=info$(0):A%=INSTR(suffix$+"/","/")
 3560   rollno%=VALLEFT$(suffix$,A%-1)
 3570   IF rollno%<>lastroll%:subnum%=0
 3580   suffix$=MID$(suffix$,A%)
 3590   IF suffix$="":subnum%=subnum%+1:suffix$="/"+FNd0(subnum%,2-(subnum%>99))
 3600   subnum%=VALMID$(suffix$,2)
 3610 ENDIF
 3620 IF IdxNum%:PDCode$=FNs(info$(IdxPD%)):A$=info$(IdxNum%):rollno%=VALA$:A%=INSTR(A$+"/","/"):suffix$=FNs(MID$(A$,A%)):subnum%=0
 3630 :
 3640 REM If PDCode changes, get new PDName (caller updates cPDCode)
 3650 IF PDCode$<>cPDCode$:PROCpdName
 3660 :
 3670 REM Get name and surname
 3680 Surname$=FNs(info$(IdxSurname%))
 3690 Pername$=FNs(info$(IdxForename%))
 3700 IF IdxSurname%=0:A%=FNinstrR(Pername$," "):Surname$=FNs(MID$(Pername$,A%+1)):Pername$=FNs(LEFT$(Pername$,A%-1))
 3710 IF IdxMiddle%:A$=FNs(info$(IdxMiddle%)):IF A$<>"":Pername$=Pername$+" "+A$
 3720 :
 3730 REM Get address
 3740 Village$ =""
 3750 RoadName$=""
 3760 Cottage$ =""
 3770 HouseNo$ =""
 3780 IF IdxStreet%=0:A$="":A%=IdxAddress%:REPEAT:A$=A$+", "+info$(A%):A%=A%+1:UNTIL info$(A%+IdxOff%)="" OR A%=IdxPostcode%-2:A$=MID$(A$,3)
 3790 IF IdxStreet%>0:A$=info$(IdxStreet%)
 3800 :
 3810 REM Clean up the string
 3820 REPEAT:A%=INSTR(A$,"{["):IF A%:A$=LEFT$(A$,A%-1)+MID$(A$,A%+1)
 3830 UNTIL A%=0
 3840 REPEAT:A%=INSTR(A$,"]}"):IF A%:A$=LEFT$(A$,A%-1)+MID$(A$,A%+1)
 3850 UNTIL A%=0
 3860 REPEAT:A%=INSTR(A$," / "):IF A%:A$=LEFT$(A$,A%-1)+"/"+MID$(A$,A%+3)
 3870 UNTIL A%=0
 3880 REPEAT:A%=INSTR(A$," - "):IF A%:A$=LEFT$(A$,A%-1)+"-"+MID$(A$,A%+3)
 3890 UNTIL A%=0
 3900 :
 3910 REM GRRRRRRR PDName$ is PD of ***LAST*** PD
 3920 REM Remove final address entry if it matches polling district name
 3930 REM IF RIGHT$(A$,2+LENPDName$)=", "+PDName$:A$=LEFT$(A$,LENA$-LENPDName$-2)
 3940 :
 3950 IF test% AND 1 THEN
 3960   PROCOutNL("")
 3970   PROCOutNL("A$:       "+LEFT$(A$,width%-10))
 3980   PROCOutNL("HouseNo:  "+LEFT$(HouseNo$,width%-10))
 3990   PROCOutNL("Cottage:  "+LEFT$(Cottage$,width%-10))
 4000   PROCOutNL("RoadName: "+LEFT$(RoadName$,width%-10))
 4010   PROCOutNL("PDName:   "+LEFT$(PDName$,width%-10))
 4020   REM PROCOutNL("cPDName:  "+LEFT$(cPDName$,width%-10))
 4030   REM PROCOutNL("Name:     "+LEFT$(Surname$+", "+Pername$,width%-10))
 4040   PROCFoot
 4050 ENDIF
 4060 :
 4070 REM Flat At, 24 -> Flat At 24
 4080 A%=INSTR(A$," At, "):IF A%:A$=LEFT$(A$,A%+2)+MID$(A$,A%+4)
 4090 A%=INSTR(A$," at, "):IF A%:A$=LEFT$(A$,A%+2)+MID$(A$,A%+4)
 4100 A%=INSTR(A$," of, "):IF A%:A$=LEFT$(A$,A%+2)+MID$(A$,A%+4)
 4110 :
 4120 REM Last item is road address
 4130 A%=FNinstrR(A$,","):RoadName$=FNs(MID$(A$,A%+1)):A$=FNs(LEFT$(A$,A%-1)):IF A%=0:A$=""
 4140 IF RoadName$="":RoadName$="-"
 4150 :
 4160 REM If there's another item, this is subroad
 4170 A%=FNinstrR(A$,","):IF A%:Cottage$=FNs(MID$(A$,A%+1)):A$=FNs(LEFT$(A$,A%-1))
 4180 IF STR$VALCottage$=Cottage$ OR STR$VALCottage$=LEFT$(Cottage$,LENCottage$-1) OR INSTR(Cottage$,"-"):A$=A$+", "+Cottage$:Cottage$=""
 4190 IF LEFT$(A$,2)=", ":A$=MID$(A$,3)
 4200 :
 4210 REM REM GRRRRRRR PDName$ is PD of ***LAST*** PD
 4220 REM REM Remove final address entry if it matches polling district name
 4230 REM IF Cottage$<>"":IF RoadName$=PDName$:RoadName$=""
 4240 REM IF RoadName$="":RoadName$=Cottage$:Cottage$=""
 4250 :
 4260 REM Strip house number from road
 4270 A%=INSTR(RoadName$," "):IF MID$(RoadName$,A%+1,1)="&":A%=INSTR(RoadName$," ",A%+3)
 4280 IF A%:IF VALRoadName$ OR VALMID$(RoadName$,2) OR LEFT$(RoadName$,3)="[*]":A$=A$+", "+LEFT$(RoadName$,A%-1):RoadName$=FNs(MID$(RoadName$,A%+1))
 4290 IF LEFT$(A$,2)=", ":A$=MID$(A$,3)
 4300 IF RIGHT$(A$,1)=",":A$=LEFT$(A$,LENA$-1)
 4310 :
 4320 REM Strip subroad from house name/number if no subname yet
 4330 REM Need to avoid splitting "2nd Floor Flat" but split "2A Road Name"
 4340 A%=0:IF Cottage$="":A%=INSTR(A$," "):IF MID$(A$,A%+1,1)="&":A%=INSTR(A$," ",A%+3)
 4350 IF A%:IF MID$(A$,A%-2)>"@":IF VAL MID$(A$,A%-2)=0:A%=0
 4360 IF A%:IF VAL A$:Cottage$=FNs(MID$(A$,A%+1)):A$=LEFT$(A$,A%-1)
 4370 IF RIGHT$(A$,1)=",":A$=LEFT$(A$,LENA$-1)
 4380 :
 4390 REM Strip subroad where there's no house number
 4400 A%=0:IF Cottage$="":A%=INSTR(A$," ")
 4410 IF A%:IF VAL A$=0:Cottage$=A$:A$=""
 4420 :
 4430 REM Strip leading house number from subroad
 4440 A%=INSTR(Cottage$," "):IF A%=0:IF INSTR(Cottage$,"/"):A%=LEN Cottage$+1
 4450 IF A%:IF VALCottage$ OR VALMID$(Cottage$,2) OR LEFT$(Cottage$,3)="[*]":A$=A$+", "+LEFT$(Cottage$,A%-1):Cottage$=FNs(MID$(Cottage$,A%+1))
 4460 IF LEFT$(A$,2)=", ":A$=MID$(A$,3)
 4470 :
 4480 REM Strip duplicate within road and subroad
 4490 IF RIGHT$(A$,LENCottage$+2)=", "+Cottage$ THEN
 4500   A$=LEFT$(A$,LENA$-LENCottage$-2)
 4510 ENDIF
 4520 :
 4530 REM Strip trailing house number from subroad
 4540 REM This gives formatting suitable for Lockey's Yard, 3
 4550 REM A%=0:IF A$="":A%=INSTR(Cottage$,",")
 4560 REM IF A%:IF VALMID$(Cottage$,A%+2) OR VALMID$(Cottage$,A%+3):A$=FNs(MID$(Cottage$,A%+1)):Cottage$=FNs(LEFT$(Cottage$,A%-1))
 4570 :
 4580 REM Split flat number from house name
 4590 IF A$="":A$=Cottage$:Cottage$=""
 4600 IF Cottage$="":IF LEFT$(A$,5)="Flat ":A%=INSTR(A$," ",6):IF A%:IF INSTR(A$,"House",A%):Cottage$=MID$(A$,A%+1):A$=LEFT$(A$,A%-1)
 4610 A%=INSTR(RoadName$," of "):IF A%=0:A%=INSTR(RoadName$," in ")
 4620 IF A%:A%=INSTR(RoadName$," ",A%+4):IF A%:A$=LEFT$(RoadName$,A%-1)+A$:RoadName$=MID$(RoadName$,A%+1)
 4630 REM IF Cottage$="" THEN
 4640 REM IF LEFT$(A$,5)="Flat " THEN
 4650 REM A%=INSTR(A$," ",6)
 4660 REM IF A%:IF INSTR(A$,"House",A%) THEN
 4670 REM Cottage$=MID$(A$,A%+1):A$=LEFT$(A$,A%-1)
 4680 REM ENDIF
 4690 REM ENDIF
 4700 REM ENDIF
 4710 :
 4720 REM Clear address for external electors
 4730 IF FNuc(A$)="OTHER ELECTORS":RoadName$=A$:Cottage$="":HouseNo$=""
 4740 :
 4750 REM Sort out: (no-number) Foo Yard, Bar Street
 4760 REM Needs to be A$="", Cottage$="Foo Yard", RoadName$="Bar Street"
 4770 A%=0
 4780 IF A%=0:A%=RIGHT$(A$,3)="Top"
 4790 IF A%=0:A%=RIGHT$(A$,4)="Yard"
 4800 IF A%=0:A%=RIGHT$(A$,4)="Bank"
 4810 IF A%=0:A%=RIGHT$(A$,4)="Lane"
 4820 IF A%=0:A%=RIGHT$(A$,4)="Road"
 4830 IF A%=0:A%=RIGHT$(A$,4)="Walk"
 4840 IF A%=0:A%=RIGHT$(A$,4)="Hill"
 4850 IF A%=0:A%=RIGHT$(A$,5)="Steps"
 4860 IF A%=0:A%=RIGHT$(A$,5)="Ghaut"
 4870 IF A%=0:A%=RIGHT$(A$,5)="Court"
 4880 IF A%=0:A%=RIGHT$(A$,5)="Place"
 4890 IF A%=0:A%=RIGHT$(A$,6)="Square"
 4900 IF A%=0:A%=RIGHT$(A$,6)="Castle"
 4910 IF A%=0:A%=RIGHT$(A$,7)="Gallery"
 4920 IF A%=0:A%=RIGHT$(A$,7)="Terrace"
 4930 IF A%=0:A%=RIGHT$(A$,8)="Hospital"
 4940 IF A%=0:A%=RIGHT$(A$,9)="Buildings"
 4950 IF A%=0:A%=RIGHT$(A$,9)="Workhouse"
 4960 IF A%=0:A%=RIGHT$(A$,4)="Home"
 4970 IF A%=0:A%=RIGHT$(A$,6)="Priory"
 4980 IF A%=0:A%=RIGHT$(A$,7)="Convent"
 4990 IF A%=0:A%=INSTR(A$,"Police Station")
 5000 IF A%:IF VALA$=0:IF Cottage$="":Cottage$=A$:A$=""
 5010 :
 5020 REM Check for unjoined and floating numbers
 5030 A%=0
 5040 REM IF LEFT$(RoadName$,1)="/":A%=INSTR(RoadName$," ",3)
 5050 IF LEFT$(RoadName$,1)="&":A%=INSTR(RoadName$," ",3)
 5060 IF FNuc(LEFT$(RoadName$,4))="AND ":A%=INSTR(RoadName$," ",5)
 5070 IF A%:A$=A$+" "+LEFT$(RoadName$,A%-1):RoadName$=FNs(MID$(RoadName$,A%+1))
 5080 :
 5090 REM Final check for duplicates
 5100 IF A$=RoadName$:IF Cottage$="":A$=""
 5110 IF A$=Cottage$:A$=""
 5120 :
 5130 REM Final tidying
 5140 A$=FNs(A$):IF RIGHT$(A$,1)=",":A$=LEFT$(A$,LENA$-1)
 5150 :
 5160 HouseNo$ =A$
 5170 PostCode$="":IF IdxPostcode%:PostCode$=info$(IdxPostcode%)
 5180 Status$  ="":IF IdxStatus%  :Status$  =info$(IdxStatus%)
 5190 Enum$    ="":IF IdxEnum%    :Enum$    =info$(IdxEnum%)
 5200 Phone$   =""
 5210 ENDPROC
 5220 :
 5230 DEFFNIsYard(A$)
 5240 A%=0
 5250 IF A%=0:A%=RIGHT$(A$,4)="Yard"
 5260 IF A%=0:A%=RIGHT$(A$,4)="Mews"
 5270 IF A%=0:A%=RIGHT$(A$,5)="Place"
 5280 IF A%=0:A%=RIGHT$(A$,6)="Square"
 5290 =A%
 5300 :
 5310 DEFPROCOutputEntry
 5320 REM IF rollno%=0:ENDPROC
 5330 IF Surname$="":ENDPROC
 5340 REM IF edt%:IF IdxStatus%:IF Status$<>"E":ENDPROC:REM Edited register - *BUG* wrong field
 5350 REM OptOut%="Z" - edited register
 5360 IF IdxStatus%:IF Status$="D":ENDPROC          :REM Entry deleted
 5370 IF IdxStatus%:IF LEFT$(Status$,1)="X":ENDPROC :REM Incorrect entry
 5380 REM IF csv%:IF Surname$="vacant":ENDPROC
 5390 entry%=entry%+1
 5400 :
 5410 REM Some pre-output pre-processing
 5420 A%=0:IF LEN HouseNo$>width%-14:A%=FNinstrR(HouseNo$,",")
 5430 IF A% THEN
 5440   IF Cottage$<>"":RoadName$=Cottage$
 5450   Cottage$=FNs(MID$(HouseNo$,A%+1)):HouseNo$=LEFT$(HouseNo$,A%-1)
 5460   IF STR$VALCottage$=Cottage$:RoadName$=Cottage$+" "+RoadName$:Cottage$=""
 5470 ENDIF
 5480 :
 5490 REM Remove final address entry if it matches polling district name or ward name
 5500 IF (FNuc(PDName$)=FNuc(RoadName$) OR FNuc(Ward$)=FNuc(RoadName$)) AND Cottage$<>"" THEN
 5510   RoadName$=Cottage$:Cottage$="":A%=INSTR(HouseNo$,",")
 5520   IF A%:A$=MID$(HouseNo$,A%+2):IF VALA$=0:Cottage$=A$:HouseNo$=LEFT$(HouseNo$,A%-1)
 5530 ENDIF
 5540 :
 5550 REM Overly-long house name, put into Cottage
 5560 IF Cottage$="":IF LENHouseNo$>width%*0.66:Cottage$=HouseNo$:HouseNo$=""
 5570 IF Cottage$="":IF HouseNo$=cCottage$:Cottage$=HouseNo$:HouseNo$=""
 5580 :
 5590 IF test% AND 2 THEN
 5600   PROCOutNL("")
 5610   PROCOutNL("HouseNo:  "+LEFT$(HouseNo$,width%-10))
 5620   PROCOutNL("Cottage:  "+LEFT$(Cottage$,width%-10))
 5630   PROCOutNL("RoadName: "+LEFT$(RoadName$,width%-10))
 5640   REM PROCOutNL("Village:  "+LEFT$(Village$,width%-10))
 5650   PROCOutNL("PDName:   "+LEFT$(PDName$,width%-10))
 5660   PROCOutNL("Name:     "+LEFT$(Surname$+", "+Pername$,width%-10))
 5670   PROCFoot
 5680   cCottage$ =Cottage$
 5690   cRoadName$=RoadName$
 5700   cPostCode$=PostCode$
 5710   ENDPROC
 5720 ENDIF
 5730 REM RoadName$=FNuc(RoadName$)
 5740 :
 5750 REM End of a section
 5760 REM Really fiddly mess in 1939 register, vacant houses cause a page throw
 5770 REM IF column%>0:IF (rollno%=1 AND subnum%=1) OR (Enum$<>cEnum$):PROCSummary:PROCPage:PROCOut("")
 5780 IF column%>0:IF Enum$<>cEnum$:IF subnum%<>0:PROCSummary:PROCPage:PROCOut("")
 5790 REM IF column%>0 OR line%>0:IF entry%>0:IF Enum$<>cEnum$:PROCSummary:PROCPage:PROCOut("")
 5800 cEnum$=Enum$
 5810 :
 5820 REM New road or subroad
 5830 IF cCottage$<>Cottage$ OR cRoadName$<>RoadName$ OR cPostCode$<>PostCode$ THEN
 5840   PROCFoot:PROCOutNL("")
 5850   IF cCottage$=Cottage$ AND cRoadName$=RoadName$ AND PostCode$<>"" AND line%>1 THEN
 5860     PROCOutNL(FNrtf("{\b ")+FNpad(width%,PostCode$)+FNrtf("}"))
 5870   ELSE
 5880     RN$=FNuc(RoadName$):CT$=Cottage$
 5890     IF Cottage$="" THEN
 5900       REM Single address line
 5910       IF LENRoadName$+LENPostCode$<width%-4 THEN
 5920         PROCOutNL(FNrtf("{\b ")+RN$+FNpad(width%-LENRoadName$,PostCode$)+FNrtf("}"))
 5930       ELSE
 5940         PROCOutNL(FNrtf("{\b ")+LEFT$(RN$,width%)+FNrtf("}"))
 5950         PROCOutNL(FNrtf("{\b ")+FNpad(width%,PostCode$)+FNrtf("}"))
 5960       ENDIF
 5970     ELSE
 5980       REM Two address lines
 5990       IF INSTR(RN$," ")=0 AND INSTR(CT$," ") THEN
 6000         REM Either: RN$: Commondale   or FLOWERGATE
 6010         REM         CT$: NEW LANE        Oystons Yard
 6020         IF FNIsYard(CT$)=0:RN$=RoadName$:CT$=FNuc(Cottage$)
 6030       ENDIF
 6040       REM TO DO - remove embedded tests, delegate to external user-writable file
 6050       REM Annoying special cases
 6060       REM Really a road name
 6070       IF RoadName$="Bagdale":RN$=FNuc(RoadName$):CT$=Cottage$
 6080       IF RoadName$="Waterloo":RN$=FNuc(RoadName$):CT$=Cottage$
 6090       IF RoadName$="Underhill":RN$=FNuc(RoadName$):CT$=Cottage$
 6100       IF RoadName$="Baxtergate":RN$=FNuc(RoadName$):CT$=Cottage$
 6110       IF RoadName$="Haggersgate":RN$=FNuc(RoadName$):CT$=Cottage$
 6120       IF RoadName$="Eskdaleside":RN$=FNuc(RoadName$):CT$=Cottage$
 6130       REM Really a village name
 6140       IF RoadName$="Lealholm":RN$=RoadName$:CT$=FNuc(Cottage$)
 6150       IF RoadName$="Sleights":RN$=RoadName$:CT$=FNuc(Cottage$)
 6160       IF RoadName$="Iburndale":RN$=RoadName$:CT$=FNuc(Cottage$)
 6170       IF RoadName$="Ravenscar":RN$=RoadName$:CT$=FNuc(Cottage$)
 6180       IF RoadName$="Beck Hole":RN$=RoadName$:CT$=FNuc(Cottage$)
 6190       IF RoadName$="Green End":RN$=RoadName$:CT$=FNuc(Cottage$)
 6200       IF RoadName$="Castle Park":RN$=RoadName$:CT$=FNuc(Cottage$)
 6210       IF RoadName$="Low Hawsker":RN$=RoadName$:CT$=FNuc(Cottage$)
 6220       IF RoadName$="High Hawsker":RN$=RoadName$:CT$=FNuc(Cottage$)
 6230       IF RoadName$="Runswick Bay":RN$=RoadName$:CT$=FNuc(Cottage$)
 6240       IF RoadName$="Egton Bridge":RN$=RoadName$:CT$=FNuc(Cottage$)
 6250       IF RoadName$="Egton Grange":RN$=RoadName$:CT$=FNuc(Cottage$)
 6260       IF RoadName$="Port Mulgrave":RN$=RoadName$:CT$=FNuc(Cottage$)
 6270       IF RoadName$="Robin Hoods Bay":RN$=RoadName$:CT$=FNuc(Cottage$)
 6280       PROCOutNL(FNrtf("{\b ")+LEFT$(RN$,width%)+FNrtf("}"))
 6290       IF LENCottage$+LENPostCode$<width%-4 THEN
 6300         PROCOutNL(FNrtf("{\b ")+CT$+FNpad(width%-LENCT$,PostCode$)+FNrtf("}"))
 6310       ELSE
 6320         PROCOutNL(FNrtf("{\b ")+LEFT$(CT$,width%)+FNrtf("}"))
 6330         PROCOutNL(FNrtf("{\b ")+FNpad(width%,PostCode$)+FNrtf("}"))
 6340       ENDIF
 6350     ENDIF
 6360   ENDIF
 6370 ENDIF
 6380 cCottage$ =Cottage$
 6390 cRoadName$=RoadName$
 6400 cPostCode$=PostCode$
 6410 :
 6420 HouseNo$=LEFT$(HouseNo$,width%)
 6430 IF suffix$="/NOR":PROCOut(FNrtf("{\strike"))
 6440 IF rollno%:PROCOut(FNrtf("{\b{")+FNd(rollno%,4)+LEFT$(suffix$+"     ",5)+FNrtf("}}")) ELSE PROCOut(STRING$(9," "))
 6450 text$=LEFT$(Surname$,width%-10)+", "                     :REM width%-10 (eg 30) chars for surname
 6460 IF LENSurname$+LENPername$<width%-16+5 THEN
 6470   REM Surname and name fit on one line
 6480   text$=text$+Pername$:IF RIGHT$(text$,2)=", ":text$=LEFT$(text$,LENtext$-2)
 6490   IF LENtext$+LENHouseNo$<width%-10 THEN
 6500     REM Surname, name and house fit on one line
 6510     text$=text$+FNpad(width%-9-LENtext$,HouseNo$)
 6520     PROCOutNL(FNclean(text$))
 6530   ELSE
 6540     REM Surname and name fit on one line, house on next line
 6550     PROCOutNL(FNclean(text$))
 6560     text$=FNpad(width%,LEFT$(HouseNo$,width%-2))
 6570     PROCOutNL(FNclean(text$))
 6580   ENDIF
 6590 ELSE
 6600   REM Surname and name don't fit on one line
 6610   PROCOutNL(FNclean(text$))                              :REM Output surname
 6620   IF LENPername$+LENHouseNo$<width%-10 THEN
 6630     REM Name and house number fit on one line
 6640     text$=RIGHT$(STRING$(13," ")+Pername$,width%-LENHouseNo$-2)
 6650     A%=width%-LENtext$-LENHouseNo$
 6660     text$=text$+STRING$(A%," ")+HouseNo$
 6670     PROCOutNL(FNclean(text$))
 6680   ELSE
 6690     REM Name and house number don't fit on one line
 6700     text$=RIGHT$(STRING$(13," ")+Pername$,width%-1)      :REM width%-1 (eg 39) chars for forenames
 6710     PROCOutNL(FNclean(text$))
 6720     text$=FNpad(width%,LEFT$(HouseNo$,width%-2))         :REM width%-2 (eg 38) for house number
 6730     PROCOutNL(FNclean(text$))
 6740   ENDIF
 6750 ENDIF
 6760 IF suffix$="/NOR":PROCOut(FNrtf("}"))
 6770 REM text$ left over holding last line output
 6780 :
 6790 IF HouseNo$<>LastHouseNo$ OR subnum%=1:NumOfHouses%=NumOfHouses%+1:LastHouseNo$=HouseNo$
 6800 :
 6810 REM Lines allowed before an entry forces a new column
 6820 IF line%>lpp%-2-1:PROCFoot:line%=0:cRoadName$="":cCottage$="":cPostCode$=""
 6830 ENDPROC
 6840 :
 6850 REM Lines allowed before a new road forces a new column
 6860 DEFPROCFoot
 6870 IF line%>lpp%-4-2:PROCPage
 6880 ENDPROC
 6890 :
 6900 DEFPROCPage
 6910 REM IF line%<lpp%:REPEAT:PROCOutNL(""):UNTIL line%>lpp%-1
 6920 PROCOut(FNrtf("\column")+eol$)
 6930 line%=0:column%=column%+1
 6940 ENDPROC
 6950 :
 6960 DEFPROCOutNL(A$):PROCOut(A$):PROCOut(FNrtf("\line")+eol$):line%=line%+1:ENDPROC
 6970 :
 6980 DEFPROCOut(A$):IF out%:BPUT#out%,A$;:ENDPROC
 6990 PRINT A$;:ENDPROC
 7000 :
 7010 DEFFNrtf(A$):IF rtf%:=A$ ELSE =""
 7020 :
 7030 DEFPROCrtfHeader:IF NOT rtf%:ENDPROC
 7040 PROCOut("{\rtf1\ansi\deff0{\fonttbl"+eol$)
 7050 REM PROCOut("{\xxx1\ansi\deff0{\fonttbl"+eol$)
 7060 PROCOut("{\f0 Courier New;}"+eol$)
 7070 PROCOut("{\f1 Times New Roman;}"+eol$)
 7080 PROCOut("}\f0\fs12\ql "+eol$)
 7090 PROCOut(eol$)
 7100 PROCOut("\paperw11907\paperh16840\margl1077\margr1077\margt448\margb448"+eol$)
 7110 PROCOut("\widowctrl\ftnbj\aenddoc\noxlattoyen\expshrtn\noultrlspc\dntblnsbdb"+eol$)
 7120 PROCOut("\nospaceforul\hyphcaps0\horzdoc\dghspace120\dgvspace120\dghorigin1701"+eol$)
 7130 PROCOut("\dgvorigin1984\dghshow0\dgvshow3\jcompress\viewkind1\viewscale100\nolnhtadjtbl"+eol$)
 7140 PROCOut("\fet0\sectd\psz9\linex0\headery284\footery567\cols3\colsx450\linebetcol\sectdefaultcl"+eol$)
 7150 PROCOut(eol$)
 7160 ENDPROC
 7170 :
 7180 DEFPROCrtfSection:IF NOT rtf%:ENDPROC
 7190 REM Can't get centring to take effect, have to centre with spaces
 7200 PROCOut("{\header\fs24\qc"+eol$)
 7210 PROCOut("\line"+eol$)
 7220 IF PageTitle$<>"":PROCOut(STRING$((1.5*width%-LENPageTitle$)/2+4," ")+PageTitle$+eol$)
 7230 PROCOut("\line"+eol$)
 7240 A%=1.666*width%-(2*LENPDCode$+2*LENPDTitle$+LENWardTitle$)-6
 7250 ::::IF A%<0:PDTitle$=""                                   :REM Remove PDTitle to fit if too long
 7260 REM IF A%<0:PDTitle$=FNs(LEFT$(PDTitle$,LENPDTitle$+A%/2)):REM Truncate PDTitle to fit if too long
 7270 PROCOut(PDCode$+" "+PDTitle$)
 7280 PROCOut(STRING$((1.666*width%-LENWardTitle$-2*LENPDCode$-2*LENPDTitle$)/2," "))
 7290 PROCOut(WardTitle$)
 7300 PROCOut(STRING$((1.666*width%-LENWardTitle$-2*LENPDCode$-2*LENPDTitle$-1)/2," "))
 7310 PROCOut(PDTitle$+" "+PDCode$+"}"+eol$)
 7320 :
 7330 PROCOut("{\footer \ltrpar \pard\plain \ltrpar\s16\qc \li0\ri0\widctlpar\tqc\tx4153\tqr\tx8306\")
 7340 PROCOut("wrapdefault\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0\pararsid732895 \rtlch\fcs1 \af0\afs24\alang1025 \ltrch\fcs0")
 7350 PROCOut("\fs24\lang2057\langfe2057\cgrid\langnp2057\langfenp2057")
 7360 PROCOut("{\rtlch\fcs1 \af2 \ltrch\fcs0 \f2\insrsid732895\charrsid732895 PAGE }")
 7370 PROCOut("{\field")
 7380 PROCOut("{\*\fldinst")
 7390 PROCOut("{\rtlch\fcs1 \af2 \ltrch\fcs0 \cs17\f2\insrsid732895\charrsid732895  PAGE }")
 7400 PROCOut("}")
 7410 PROCOut("{\fldrslt")
 7420 PROCOut("{\rtlch\fcs1 \af2 \ltrch\fcs0 \cs17\f2\lang1024\langfe1024\noproof\insrsid732895 2}")
 7430 PROCOut("}")
 7440 PROCOut("}\sectd \linex0\endnhere\sectdefaultcl\sftnbj")
 7450 PROCOut("{\rtlch\fcs1 \af2 \ltrch\fcs0 \f2\insrsid732895\charrsid732895 \par }")
 7460 PROCOut("}")
 7470 ENDPROC
 7480 :
 7490 DEFPROCrtfFooter:IF NOT rtf%:ENDPROC
 7500 PROCOut("}"+eol$)
 7510 ENDPROC
 7520 :
 7530 DEFPROCCloseIn
 7540 IF name%:A%=name%:name%=0:CLOSE#A%
 7550 IF fore%:A%=fore%:fore%=0:CLOSE#A%
 7560 IF numb%:A%=numb%:numb%=0:CLOSE#A%
 7570 IF data%:A%=data%:data%=0:CLOSE#A%
 7580 IF flat%:A%=flat%:flat%=0:CLOSE#A%
 7590 IF code%:A%=code%:code%=0:CLOSE#A%
 7600 ENDPROC
 7610 :
 7620 DEFPROCCloseOut
 7630 IF out%:A%=out%:out%=0:CLOSE#A%
 7640 ENDPROC
 7650 :
 7660 DEFFNpad(N%,A$):IF A$="":=""
 7670 =STRING$(N%-LENA$," ")+A$
 7680 :
 7690 DEFFNclean(A$)
 7700 A%=INSTR(A$,"{"):IF A%:A$=LEFT$(A$,A%-1)+"["+MID$(A$,A%+1)
 7710 A%=INSTR(A$,"}"):IF A%:A$=LEFT$(A$,A%-1)+"]"+MID$(A$,A%+1)
 7720 =A$
 7730 :
 7740 DEFFNRdPhone(ptr%):IF ptr%=0:=""
 7750 IF ptr%*phsz%>EXT#numb%:=FNh0(ptr%,4)
 7760 LOCAL A$,A%,B%:PTR#numb%=ptr%*phsz%-phsz%
 7770 FOR A%=1 TO 8:B%=BGET#numb%
 7780   IF (B%AND&F0)=&F0:A$=A$+"T" ELSE IF (B%AND&F0)=&A0:A$=A$+" " ELSE A$=A$+STR$~(B%DIV16)
 7790   IF (B%AND&0F)=&0F:A$=A$+"T" ELSE IF (B%AND&0F)=&0A:A$=A$+" " ELSE A$=A$+STR$~(B%AND15)
 7800 NEXT:=A$
 7810 :
 7820 :
 7830 DEFFNRdStrN(i%):LOCAL n%,A$:A%=BGET#i%:IFA%=0:=""
 7840 FOR n%=1 TO A%:A$=A$+CHR$BGET#i%:NEXT:=A$
 7850 :
 7860 DEFFNRdStrB7(i%):LOCAL n%,A$
 7870 REPEATn%=BGET#i%:A$=A$+CHR$(n%AND127):UNTIL(n%AND128)ORLENA$>254OREOF#i%:=A$
 7880 :
 7890 DEFFNRd16(i%):=BGET#i%+256*BGET#i%
 7900 :
 7910 DEFFNd(A%,N%)=RIGHT$("         "+STR$A%,N%)
 7920 DEFFNd0(A%,N%)=RIGHT$("000000000"+STR$A%,N%)
 7930 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
 7940 :
 7950 DEFFNFile_Open(ft$)
 7960 ft$=ft$+CHR$0
 7970 LastLoad$=FNReg_Rd(KeyRoot$+"LastLoad")+CHR$0
 7980 ff$="All files"+CHR$0+"*.*"+CHR$0+CHR$0
 7990 $$fp{}=LastLoad$
 8000 fs.lStructSize% = DIM(fs{})
 8010 fs.hwndOwner% = @hwnd%
 8020 fs.lpstrFilter% = !^ff$
 8030 fs.lpstrInitialDir% = !^LastLoad$
 8040 fs.lpstrFile% = fp{}
 8050 fs.nMaxFile% = 260
 8060 fs.lpstrTitle% = !^ft$
 8070 fs.flags% = 6
 8080 SYS "GetOpenFileName", fs{} TO result%
 8090 IF result%:ff$=$$fp{}:PROCReg_Wr(KeyRoot$+"LastLoad",ff$):=ff$
 8100 =""
 8110 :
 8120 DEFFNFile_Save(ft$)
 8130 ft$=ft$+CHR$0
 8140 LastSave$=FNReg_Rd(KeyRoot$+"LastSave")+CHR$0
 8150 ff$="All files"+CHR$0+"*.rtf"+CHR$0+CHR$0
 8160 $$fp{}=LastSave$
 8170 fs.lStructSize% = DIM(fs{})
 8180 fs.hwndOwner% = @hwnd%
 8190 fs.lpstrFilter% = !^ff$
 8200 fs.lpstrInitialDir% = !^LastSave$
 8210 fs.lpstrFile% = fp{}
 8220 fs.nMaxFile% = 260
 8230 fs.lpstrTitle% = !^ft$
 8240 fs.flags% = 6
 8250 SYS "GetSaveFileName", fs{} TO result%
 8260 IF result%:ff$=$$fp{}:PROCReg_Wr(KeyRoot$+"LastSave",ff$):=ff$
 8270 =""
 8280 :
 8290 REM > BLib.Win.Reg
 8300 :
 8310 DEFFNReg_Rd(Key$)
 8320 LOCAL K%,R%,L%,T%,Item$,Value$
 8330 Item$=Key$:REPEAT:K%=INSTR(Item$,"\"):IF K%:Item$=MID$(Item$,K%+1)
 8340 UNTIL K%=0:Key$=LEFT$(Key$,LENKey$-LENItem$-1)
 8350 SYS "RegOpenKeyEx",&80000001,Key$,0,&20001,^K% TO R%
 8360 IF R%=0 THEN
 8370   SYS "RegQueryValueEx",K%,Item$,0,^T%,0,^L%:DIM Buf% LOCAL L%
 8380   SYS "RegQueryValueEx",K%,Item$,0,^T%,Buf%,^L% TO R%
 8390   IF R%=0:Buf%?(L%-1)=13:Value$=$Buf%
 8400   SYS "RegCloseKey",K%
 8410 ENDIF
 8420 =Value$
 8430 :
 8440 DEFPROCReg_Wr(Key$,Value$)
 8450 LOCAL K%,D%,R%,Item$
 8460 Item$=Key$:REPEAT:K%=INSTR(Item$,"\"):IF K%:Item$=MID$(Item$,K%+1)
 8470 UNTIL K%=0:Key$=LEFT$(Key$,LENKey$-LENItem$-1)
 8480 SYS "RegCreateKeyEx",&80000001,Key$,0,"",0,&F003F,0,^K%,^D% TO R%
 8490 IF R%=0 THEN
 8500   SYS "RegSetValueEx",K%,Item$,0,1,Value$,LENValue$+1
 8510   SYS "RegCloseKey",K%
 8520 ENDIF
 8530 ENDPROC
 8540 :
 8550 REM > BLib.FileCSV 1.02 10-Aug-2017
 8560 REM Read and write CSV files, protecting entries from Excel
 8570 REM Needs BASIC V or equivalent for DIM(), GET$#, BPUT#n,s$
 8580 :
 8590 DEFPROCcsv_rd(i%,array$())
 8600 LOCAL n%:array$()="":A$=GET$#i%:IFA$="":A$=GET$#i%
 8610 A$=A$+","
 8620 REPEAT
 8630   IF LEFT$(A$,2)="=""":A$=MID$(A$,2)
 8640   IF LEFT$(A$,1)="""" THEN
 8650     A%=INSTR(A$,""",",2)+1:array$(n%)=MID$(A$,2,A%-3)
 8660   ELSE
 8670     A%=INSTR(A$,","):array$(n%)=LEFT$(A$,A%-1)
 8680   ENDIF
 8690   A$=MID$(A$,A%+1):n%=n%+1
 8700 UNTIL A$="" OR n%>DIM(array$(),1)
 8710 ENDPROC
 8720 :
 8730 DEFPROCcsv_wr(o%,array$())
 8740 LOCAL n%,q%:n%=DIM(array$(),1)
 8750 FOR A%=0 TO n%:A$=array$(A%)
 8760   q%=INSTR(A$,",")
 8770   IF q%=0:q%=(ASCA$=48)AND(INSTR(A$,"/")=0)               :REM leading zeros 00001
 8780   IF q%=0:IFVALLEFT$(A$,1):q%=INSTR(A$,"E")+INSTR(A$,"e") :REM preserve 1234E5678
 8790   IF q%=0:q%=LENSTR$VALA$>8                               :REM long numbers 12345678901234
 8800   IF q%=0:IFVALA$:q%=INSTR(A$,"/")AND(ASCA$<>48)          :REM fractions 12/34
 8810   IF q%=0:q%=LEFT$(A$,1)="-"                              :REM leading hyphen -
 8820   IF q%=0:q%=MID$(A$,3,1)=" "ANDMID$(A$,7,1)=" "          :REM dates xx XXX xxxx
 8830   IF q%:A$=""""+A$+"""":IFINSTR(A$,",")=0:A$="="+A$
 8840   BPUT#o%,A$;:IF A%<>n%:BPUT#o%,",";
 8850 NEXT A%:BPUT#o%,""
 8860 ENDPROC
 8870 :
 8880 REM > BLib.File 1.02 J.G.Harston
 8890 REM Platform-independant filing functions
 8900 :
 8910 REM PROCf_init - initialise filing-system variables
 8920 REM -----------------------------------------------
 8930 DEFPROCf_init
 8940 d$=".":s$="/":IF(os%AND-24):d$="/":s$=".":IF(os%AND-32):d$="\"
 8950 ENDPROC
 8960 :
 8970 REM FNfn_root(path$) - return root of path
 8980 REM --------------------------------------
 8990 DEFFNfn_root(A$):LOCALA%,B%:IFLEFT$(A$,2)=d$+d$:=LEFT$(A$,INSTR(A$+d$,d$,3)-1)
 9000 A%=INSTR(A$,":",2):B%=INSTR(A$,d$,A%)AND(A%<>0):IFB%:A%=B%-1
 9010 IFA%:=LEFT$(A$,A%)
 9020 IFINSTR(":$%&^@\-",LEFT$(A$,1)):=LEFT$(A$,INSTR(A$+d$,d$)-1)
 9030 =""
 9040 :
 9050 REM FNfn_leaf(path$) - returns leafname
 9060 REM -----------------------------------
 9070 DEFFNfn_leaf(A$):LOCALA%,B%:A%=INSTR(A$,":",2)
 9080 REPEATB%=A%:A%=INSTR(A$,d$,A%+1):UNTILA%=0:=MID$(A$,B%+1)
 9090 :
 9100 REM FNfn_path(path$) - returns pathname
 9110 REM -----------------------------------
 9120 DEFFNfn_path(A$):LOCALA%,B%:A%=INSTR(A$,":",2)
 9130 REPEATB%=A%:A%=INSTR(A$,d$,A%+1):UNTILA%=0:=LEFT$(A$,B%)
 9140 :
 9150 REM FNfn_ext(path$) - returns leafname's extension
 9160 REM ----------------------------------------------
 9170 DEFFNfn_ext(A$):IFINSTR(A$,s$)=0:=""
 9180 LOCAL A%:A%=LENA$+1:REPEATA%=A%-1:UNTILINSTR(":"+d$+s$,MID$(A$,A%,1))
 9190 IFMID$(A$,A%,1)=s$:=MID$(A$,A%) ELSE =""
 9200 :
 9210 REM FNfn_noext(path$) - returns path with no extension
 9220 REM --------------------------------------------------
 9230 DEFFNfn_noext(A$):IFINSTR(A$,s$)=0:=A$
 9240 LOCAL A%:A%=LENA$+1:REPEATA%=A%-1:UNTILINSTR(":"+s$+d$,MID$(A$,A%,1))
 9250 IFMID$(A$,A%,1)=s$:=LEFT$(A$,A%-1) ELSE =A$
 9260 :
 9270 REM FNfn_fullpath(path$, file$) - return full absolute path
 9280 REM -------------------------------------------------------
 9290 DEFFNfn_fullpath(P$,A$)
 9300 IFINSTR("$%&^\-",LEFT$(A$,1)):IF(os%AND-24)=0:=A$
 9310 IFINSTR(A$,":")ORLEFT$(A$,1)=d$:=A$
 9320 =P$+LEFT$(d$,RIGHT$(P$,1)<>d$)+A$
 9330 :
 9340 REM > BLib.ProgEnv 1.05 25Feb2014
 9350 :
 9360 REM Program Environment Functions
 9370 REM =============================
 9380 :
 9390 REM Return command line tail, sets run$ to execution filename
 9400 REM Works on BBCIO,T6502,TZ80,ARMEval,ARMCoPro,RISCOS,DOS,Windows,BBC09,T6809
 9410 REM --------------------------------------------------------------------------------
 9420 DEFFNOS_GetEnv:LOCALA$,A%,X%,Y%:X%=1:os%=((USR&FFF4)AND&FF00)DIV256
 9430 IFos%>31:IFPAGE>&FFFFF:DIMX%LOCAL256:SYS"GetModuleFileName",0,X%,255:run$=$$X%:=@cmd$
 9440 A%=(HIMEM>&FFFF)AND&900:IF?(TOP-3):A%=((PAGE>&9FFF)ANDA%)OR((&1400-PAGE)AND(A%=0))ELSEA%=((A%-&500)OR&200)AND&FFF
 9450 A$=$(PAGE-&E00+A%):IFA%=0:run$=A$:SYS16TOA$,,A%:SYS72,"",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$
 9460 FORY%=-1TO0:A$=" "+A$:REPEATA$=MID$(A$,2):UNTILASCA$<>32
 9470   IFY%:IFASCA$=34:A%=INSTR(A$,"""",2)+1 ELSEIFY%:A%=INSTR(A$+" "," ")
 9480   IFY%:run$=MID$(A$,1-(ASCA$=34),A%-1+2*(ASCA$=34)):IFrun$<>"":A$=MID$(A$,A%+1)
 9490 NEXT:=A$
 9500 :
 9510 REM Run a program, passing it a command line
 9520 REM If program is *Command, called with OSCLI, else CHAINed
 9530 REM -------------------------------------------------------
 9540 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFA$<>"":CHAINA$
 9550 ENDPROC
 9560 :
 9570 REM Exit program, setting return value
 9580 REM ----------------------------------
 9590 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)
 9600 IFPAGE>&FFFFF:QUIT A%
 9610 IFos%<6:END ELSE *Quit
 9620 ENDPROC
 9630 :
 9640 REM > BLib.CmdLine 1.11 27Jul2009
 9650 REM v1.10 Parses "quoted" options
 9660 REM v1.11 -opt "quoted" doesn't return trailing quote
 9670 :
 9680 REM Command Line Parsing
 9690 REM ~~~~~~~~~~~~~~~~~~~~
 9700 :
 9710 REM FNcl() - parse command line for switches, options and parameters
 9720 REM ----------------------------------------------------------------
 9730 REM FNcl("",0) - return next parameter
 9740 REM FNcl(switch$,0) - return TRUE/FALSE if switch$ present
 9750 REM FNcl(option$,1) - return option string if present or ""
 9760 :
 9770 DEFFNcl(l$,n%):IFl$="":A$=FNs(A$):IFASCA$=34:A%=INSTR(A$+" "" ",""" ",2):l$=MID$(A$,2,A%-2):A$=FNs(MID$(A$,A%+1)):=l$
 9780 IFl$="":A%=INSTR(A$+" "," "):l$=LEFT$(A$,A%-1):A$=FNs(MID$(A$,A%+1)):=l$
 9790 IFn%=0:IFl$<>"":A%=INSTR(A$,l$):IFA%:A$=FNs(LEFT$(A$,A%-1)+MID$(A$,INSTR(A$," ",A%)+1))+" ":=TRUE
 9800 IFn%=0:IFl$<>"":=FALSE
 9810 A%=INSTR(LEFT$(" ",ASCl$=32)+A$,l$):IFA%=0:=""
 9820 A$=LEFT$(A$,A%-1)+FNs(MID$(A$,INSTR(A$," ",A%)+1))
 9830 IFASCl$=32:l$=MID$(A$,A%):A$=LEFT$(A$,A%-1):=MID$(l$,1-(ASCl$=34),LENl$+2*(ASCl$=34))
 9840 IFASCMID$(A$,A%,1)<>34:l$=MID$(A$,A%,INSTR(A$+" "," ",A%)-A%):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+1):=l$
 9850 l$=MID$(A$,A%+1,INSTR(A$+" ",""" ",A%+1)-A%-1):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+3):=l$
 9860 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
 9870 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
 9880 =A$
 9890 DEFFNuc(A$):LOCAL B$:IFA$="":=""
 9900 REPEATB$=B$+CHR$(ASCA$AND((A$<"@")OR&DF)):A$=MID$(A$,2):UNTILA$="":=B$
 9910 :
 9920 DEFFNinstrR(A$,B$):A%=LENA$+1:REPEATA%=A%-1:UNTILMID$(A$,A%,LENB$)=B$ORA%=0:=A%

Download MkReg112.bbc

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.