10 REM > DownToCSV
   20 REM Extract data from 1881 Census downloads
   30 :
   40 REM Need to continue canonicalising addresses
   50 REM Need to split birthplace with single comma into place/county/country
   60 :
   70 verbose%=TRUE
   80 max%=19:year%=1881:month%=4
   90 :
  100 A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256
  110 s$=".":fmax%=255:IFos%AND32:d$="\" ELSE IFos%AND8:d$="/" ELSE s$="/":d$=".":fmax%=10
  120 DIM head$(max%),info$(max%),addr$(max%)
  130 FOR A%=0 TO max%:READ head$(A%):NEXT
  140 DATA "HOUSEHOLD NUMBER","SURNAME","NAME","AGE","RELATIONSHIP","SEX","MARITAL STATUS","STREET ADDRESS"
  150 DATA "OCCUPATION","BIRTH YEAR","BIRTH PLACE","BIRTH COUNTY","BIRTH COUNTRY","INDIVIDUAL NUMBER"
  160 DATA "CIVIL PARISH","SUB-REGISTRATION DISTRICT","ENUMERATION DISTRICT","PIECE","PAGE","FOLIO"
  170 :
  180 ON ERROR PRINTTAB(0,max%)'':REPORT:PROCClose_All:PRINT" at line ";ERL:END:IF ERR=17:QUIT ELSE END
  190 out%=OPENOUT(LEFT$("Whitby"+STR$year%+s$+"csv",fmax%))
  200 IF out%=0:PRINT"Couldn't open output file, is it already open?":END
  210 :
  220 PROCcsv_wr(out%,head$())
  230 IF verbose%:CLS:PRINT':FOR A%=0 TO max%:PRINTFNd0(A%,2);": ";head$(A%);":":NEXT:OFF
  240 head$(4)="RELATIONSHIP TO HEAD":head$(5)="GENDER":head$(10)="WHERE BORN"
  250 head$(16)="ED, INSTITUTION, OR VESSEL":head$(18)="PAGE NUMBER"
  260 :
  270 lookup$="Addrs"+s$+"csv"
  280 lookup%=OPENIN(lookup$):lookptr%=0:looklast%=0
  290 PROCcsv_rd(lookup%,addr$()):FOR A%=0 TO max%
  300   IF addr$(A%)="HOUSEHOLD"           :idxHousehold%=A%
  310   IF addr$(A%)="CIVIL PARISH"        :idxParish%=A%
  320   IF addr$(A%)="ENUMERATION DISTRICT":idxDistrict%=A%
  330   IF LEFT$(addr$(A%),4)="ED, "       :idxDistrict%=A%
  340   IF addr$(A%)="PAGE"                :idxPage%=A%
  350 NEXT A%
  360 :
  370 FOR item%=26392000 TO 26499999
  380   dir%=(item%DIV1000)MOD1000
  390   item$="Downloads"+STR$dir%+d$+LEFT$(STR$item%+s$+"htm",fmax%)
  400   IF verbose%:VDU 30:PRINT SPC4;item%;
  410   in%=OPENIN(item$):IF in%:PROCprocess
  420   REM IF item%=30421000:item%=32000000
  430 NEXT item%
  440 IF lookup%:CLOSE#lookup%:lookup%=0
  450 CLOSE#out%:out%=0
  460 QUIT
  470 :
  480 DEFPROCprocess
  490 REM IF verbose%:VDU 30:PRINT SPC4;item%;
  500 info$()=""
  510 info$(13)=STR$item%
  520 REPEAT:a$=GET$#in%:UNTIL INSTR(a$,"id=""recordData"""OR EOF#in%
  530 REPEAT
  540   a$=FNuc(GET$#in%)
  550   IF INSTR(a$,"<TH>"THEN
  560     REPEAT
  570       A%=INSTR(a$,"<"):B%=INSTR(a$,">",A%)
  580       IF A%:a$=LEFT$(a$,A%-1)+MID$(a$,B%+1)
  590     UNTIL A%=0
  600     REPEAT:b$=FNs(GET$#in%):UNTIL INSTR(FNuc(b$),"<TD"OR EOF#in%
  610     b$=MID$(b$,INSTR(b$,"<"))
  620     REPEAT
  630       A%=INSTR(b$,"<"):B%=INSTR(b$,">",A%)
  640       IF A%:b$=LEFT$(b$,A%-1)+MID$(b$,B%+1)
  650     UNTILA%=0
  660     REPEAT
  670       A%=INSTR(b$,"&")
  680       IF A%:b$=LEFT$(b$,A%-1)+"&"+MID$(b$,A%+5)
  690     UNTILA%=0
  700     FOR A%=max% TO 1 STEP -1
  710       IF INSTR(a$,head$(A%)+":"):IF info$(A%)="":info$(A%)=b$
  720     NEXT A%
  730   ENDIF
  740 UNTIL INSTR(a$,"HOUSEHOLD MEMBERS:"OR EOF#in%
  750 REPEAT:A$=GET$#in%:A%=INSTR(A$,"Class:"):UNTIL A% OR EOF#in%
  760 IF A%:A$=MID$(A$,A%):A$=MID$(A$,INSTR(A$,">")+1):A$=LEFT$(A$,INSTR(A$,"<")-1):info$(17)=A$+"/"+info$(17)
  770 REM REPEAT:A$=GET$#in%:A%=INSTR(A$,"iid="):UNTIL A% OR EOF#in%
  780 REM iid$="":IF A%:iid$=MID$(A$,A%+5,22)
  790 CLOSE#in%:in%=0
  800 A$=FNuc(info$(14)):IF A$="WHITBY" OR A$="RUSWARP" OR A$="HELREDALE" OR A$="HAWSKER" ELSE ENDPROC
  810 REM A$=FNuc(info$(14)):IF A$="WHITBY" OR A$="RUSWARP" OR A$="HELREDALE" OR A$="HAWSKER" ELSE OSCLI"Delete "+item$:ENDPROC
  820 :
  830 REM Clean entries, assumes entry in [] is correct data
  840 FOR A%=0 TO max%
  850   A$=info$(A%)
  860   B%=INSTR(A$,"["):IF B%:REPEAT:A$=MID$(A$,B%+1):B%=INSTR(A$,"["):UNTILB%=0
  870   B%=INSTR(A$,"]"):IF B%:A$=LEFT$(A$,B%-1)+"*":REM Temp, add '*'
  880   IF A$<>"":info$(A%)=A$
  890 NEXT A%
  900 IF verbose%:PRINTSPC3;info$(2);SPC(33-LENinfo$(2))'SPC4;info$(7);SPC(50-LENinfo$(7))
  910 info$(15)="Whitby"
  920 District%=VALinfo$(16):info$(16)=FNd(District%,3)
  930 Page%    =VALinfo$(18):info$(18)=FNd(Page%,3)
  940 Folio%   =VALinfo$(19):info$(19)=FNd(Folio%,3)
  950 :
  960 REM Seperate surname
  970 A%=LENinfo$(2):REPEAT:A%=A%-1:UNTILMID$(info$(2),A%,1)=" " OR A%<1
  980 IF A%:info$(1)=MID$(info$(2),A%+1):info$(2)=LEFT$(info$(2),A%-1)
  990 :
 1000 REM Tidy address
 1010 A$=info$(7)
 1020 A$=FNswap(A$,"""","")
 1030 A$=FNswap(A$,"""",",")
 1040 :
 1050 REPEAT
 1060   A%=LENA$
 1070   IF RIGHT$(A$,6) =" Yorks"    :A$=LEFT$(A$,LENA$-6)
 1080   IF RIGHT$(A$,10)=" Yorkshire":A$=LEFT$(A$,LENA$-10)
 1090   IF RIGHT$(A$,1) =","         :A$=LEFT$(A$,LENA$-1)
 1100   IF RIGHT$(A$,7) =" Whitby"   :A$=LEFT$(A$,LENA$-7)
 1110   IF RIGHT$(A$,1) =","         :A$=LEFT$(A$,LENA$-1)
 1120 UNTIL A%=LENA$
 1130 :
 1140 REM Spelling mistakes:
 1150 A$=FNswap(A$,"Constguard","Coast Guard")
 1160 A$=FNswap(A$,"Folly Gareleris ","Folly Gardens, ")
 1170 A$=FNswap(A$,"Bridget ","Bridge ")
 1180 :
 1190 REM Abbreviations:
 1200 A$=FNswap(A$,"Guard St ","Guard Station, ")
 1210 A$=FNswap(A$,"Guard Stn ","Guard Station, ")
 1220 A$=FNswap(A$,"C G Station ","Coast Guard Station, ")
 1230 A$=FNswap(A$,"Coast Gd ","Coast Guard ")
 1240 A$=FNswap(A$,"Terr ","Terrace, ")
 1250 A$=FNswap(A$,"St ","Street, ")
 1260 A$=FNswap(A$,"Street, Ann","St Ann")
 1270 A$=FNswap(A$,"Street, H","St. H")
 1280 A$=FNswap(A$,"Rd ","Road, ")
 1290 A$=FNswap(A$,"Yd ","Yard, ")
 1300 A$=FNswap(A$,"Ch St","Church Street")
 1310 A$=FNswap(A$,"Nat School","National School")
 1320 A$=FNswap(A$,"N S Yd","National School Yard")
 1330 :
 1340 REM Swap roads and subroads:
 1350 IF LEFT$(A$,15)="Church Street, ":A$=MID$(A$,16)+", Church Street"
 1360 :
 1370 REM Add commas:
 1380 A$=FNswap(A$,"Station ","Station, ")
 1390 A$=FNswap(A$,"Station, Av","Station Av")
 1400 A$=FNswap(A$,"Cottage ","Cottage, ")
 1410 A$=FNswap(A$,"Terrace ","Terrace, ")
 1420 A$=FNswap(A$,"Street ","Street, ")
 1430 A$=FNswap(A$,"Bridge ","Bridge, ")
 1440 A$=FNswap(A$,"Bridge, St","Bridge St")
 1450 A$=FNswap(A$,"Close ","Close, ")
 1460 A$=FNswap(A$,"Cliff ","Cliff, ")
 1470 A$=FNswap(A$,"Cliff, St","Cliff St")
 1480 A$=FNswap(A$,"Farm ","Farm, ")
 1490 A$=FNswap(A$,"Lane ","Lane, ")
 1500 A$=FNswap(A$,"Road ","Road, ")
 1510 A$=FNswap(A$,"Yard ","Yard, ")
 1520 A$=FNswap(A$,"Hill ","Hill, ")
 1530 A$=FNswap(A$,"Whitby ","Whitby, ")
 1540 A$=FNswap(A$,"Vale ","Vale, ")
 1550 :
 1560 A$=FNswap(A$," Spital",", Spital")
 1570 A$=FNswap(A$,",, Spital",", Spital")
 1580 :
 1590 REM Add apostrophes:
 1600 A$=FNswap(A$,"s Y","'s Y")
 1610 A$=FNswap(A$,"''s Y","'s Y")
 1620 :
 1630 REM Remove erroneous apostrophes
 1640 A$=FNswap(A$,"York's","Yorks")
 1650 info$(7)=A$
 1660 :
 1670 REM Split up birth location
 1680 A$=info$(10)
 1690 A%=INSTR(A$,","):IF A%:B%=INSTR(A$,",",A%+1):IF B%=0:A%=0
 1700 IF A%:info$(12)=MID$(A$,B%+2):info$(11)=MID$(A$,A%+2,B%-A%-2):info$(10)=LEFT$(A$,A%-1)
 1710 :
 1720 REM Find household
 1730 REM A$="":IF info$(0)="" OR info$(3)="" OR info$(9)="":A$=FNlookup(TRUE,0,District%,Page%) :REM Look for household
 1740 A$=FNlookup(TRUE,0,District%,Page%,13)                               :REM Look for household for this ID
 1750 IF A$<>"" THEN
 1760   info$(0)=A$
 1770   IF addr$(3)<>"":info$(3)=addr$(3)                                  :REM Age under one year old
 1780   IF addr$(9)<>"":info$(9)=addr$(9)                                  :REM Year of birth under one year old
 1790   FOR A%=1 TO max%
 1800     IF RIGHT$(info$(A%),1)="*":IF addr$(A%)<>"":info$(A%)=addr$(A%)  :REM Replace any '*' entries
 1810   NEXT
 1820 ENDIF
 1830 :
 1840 REM Tidy age
 1850 REM 1881 census gives "" for under 1 year old, needs transcribing manually
 1860 age$=info$(3)
 1870 A%=INSTR(age$,"/12"):IF A%:age$=LEFT$(age$,A%-1)+" mths":IF VALage$<2:age$=LEFT$(age$,LENage$-1)
 1880 IF info$(9)="" AND VALage$ THEN
 1890   info$(9)="abt "+STR$(year%-VALage$-1)
 1900   IF INSTR(age$,"m"THEN
 1910     info$(9)=STR$(year%-(VALage$-month%+13)DIV12)
 1920   ENDIF
 1930   IF INSTR(age$,"d"OR INSTR(age$,"w"):info$(9)=STR$year%
 1940 ENDIF
 1950 info$(3)=age$
 1960 :
 1970 IF verbose%:FOR A%=0 TO max%:PRINTTAB(36,A%+2);LEFT$(info$(A%),56);SPC(56-LENLEFT$(info$(A%),56));:NEXT
 1980 PROCcsv_wr(out%,info$())
 1990 ENDPROC
 2000 :
 2010 DEFFNlookup(Z%,   R%,     D%,       S%,   F%)
 2020 REM         flag, return, district, page, field
 2030 IF lookup%=0:=""
 2040 lookptr%=PTR#lookup%
 2050 match%=FALSE
 2060 PROCcsv_rd(lookup%,addr$())
 2070 IF VALaddr$(16)>D%:PTR#lookup%=0 ELSE PTR#lookup%=lookptr%:REM Step back if too far forward for this D%
 2080 REPEAT
 2090   PROCcsv_rd(lookup%,addr$())
 2100   D2%=VALaddr$(16):IF D2%<D%:lookptr%=PTR#lookup%
 2110   IF addr$(F%)=info$(F%):match%=TRUE
 2120 UNTIL match% OR EOF#lookup% OR D2%>D%
 2130 PTR#lookup%=lookptr%
 2140 IF match%:=addr$(R%)
 2150 =""
 2160 :
 2170 DEFFNswap(in$,match$,swap$)
 2180 A%=INSTR(in$,match$):IF A%:in$=LEFT$(in$,A%-1)+swap$+MID$(in$,A%+LENmatch$)
 2190 =in$
 2200 :
 2210 DEFPROCClose_All
 2220 lookup%=lookup%:IFlookup%:A%=lookup%:lookup%=0:CLOSE#A%
 2230 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
 2240 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
 2250 ENDPROC
 2260 :
 2270 DEFPROCcsv_rd(i%,array$())
 2280 LOCAL n%:n%=0:array$()="":A$=GET$#i%:IF A$="":A$=GET$#i%
 2290 A$=A$+","
 2300 REPEAT
 2310   IF LEFT$(A$,2)="=""":A$=MID$(A$,2)
 2320   IF LEFT$(A$,1)="""" THEN
 2330     A%=INSTR(A$,""",",2)+1:array$(n%)=MID$(A$,2,A%-3)
 2340   ELSE
 2350     A%=INSTR(A$,","):array$(n%)=LEFT$(A$,A%-1)
 2360   ENDIF
 2370   A$=MID$(A$,A%+1):n%=n%+1
 2380 UNTIL A$=""
 2390 ENDPROC
 2400 :
 2410 DEFPROCcsv_wr(o%,array$())
 2420 LOCAL n%,q%:n%=DIM(array$(),1)
 2430 FOR A%=0 TO n%:A$=array$(A%)
 2440   q%=INSTR(A$,",")
 2450   IF q%=0:q%=(ASCA$=48)AND(INSTR(A$,"/")=0)     :REM leading zeros 00001
 2460   IF q%=0:IFVALLEFT$(A$,1):q%=INSTR(A$,"E")     :REM preserve 1234E5678
 2470   IF q%=0:q%=LENSTR$VALA$>8                     :REM long numbers 12345678901234
 2480   IF q%=0:IFVALA$:q%=INSTR(A$,"/")AND(ASCA$<>48):REM fractions 12/34
 2490   IF q%=0:q%=LEFT$(A$,1)="-"                    :REM leading hyphen -
 2500   IF q%=0:q%=MID$(A$,3,1)=" "ANDMID$(A$,7,1)=" ":REM dates xx XXX xxxx
 2510   IF q%:A$=""""+A$+"""":IFINSTR(A$,",")=0:A$="="+A$
 2520   BPUT#o%,A$;:IF A%<>n%:BPUT#o%,",";
 2530 NEXT A%:BPUT#o%,""
 2540 ENDPROC
 2550 :
 2560 DEFFNd(A%,N%)=RIGHT$("        "+STR$A%,N%)
 2570 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
 2580 DEFFNuc(A$):IFA$="":=""
 2590 FOR A%=1TOLENA$:IFMID$(A$,A%,1)>"_":A$=LEFT$(A$,A%-1)+CHR$(ASCMID$(A$,A%,1)AND&DF)+MID$(A$,A%+1)
 2600 NEXT:=A$
 2610 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
 2620 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
 2630 =A$