10 REM > CSVtoText
   20 REM Create census sheets from census CSV files
   30 verbose%=TRUE
   40 :
   50 src$=""
   60 dst$=""
   70 max%=20
   80 year$=""
   90 page%=TRUE
  100 folio%=TRUE
  110 lpp%=30
  120 indent%=8
  130 occlen%=26
  140 namelen%=25
  150 A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256
  160 s$=".":fmax%=255:IFos%AND32:d$="\" ELSE IFos%AND8:d$="/" ELSE s$="/":d$=".":fmax%=10
  170 :
  180 A$="":in%=OPENIN("!MkText"):IF in%=0:in%=OPENIN("!MkText"+s$):IF in%=0:in%=OPENIN("!MkText"+s$+"bat")
  190 IF in%:REPEAT:A$=GET$#in%+" ":UNTIL EOF#in% OR INSTR(A$,"rem"OR INSTR(A$,"REM"):CLOSE#in%:in%=0
  200 A%=INSTR(A$,"src=")  :IF A%:src$ =FNs(MID$(A$,A%+4,INSTR(A$," ",A%)-A%-4))
  210 A%=INSTR(A$,"dst=")  :IF A%:dst$ =FNs(MID$(A$,A%+4,INSTR(A$," ",A%)-A%-4))
  220 A%=INSTR(A$,"year=") :IF A%:year$=FNs(MID$(A$,A%+5,INSTR(A$," ",A%)-A%-5))
  230 A%=INSTR(A$,"max=")  :IF A%:max% =VALMID$(A$,A%+4)
  240 A%=INSTR(A$,"page=") :IF A%:page%=VALMID$(A$,A%+5)
  250 A%=INSTR(A$,"folio="):IF A%:folio%=VALMID$(A$,A%+6)
  260 :
  270 DIM head$(max%),info$(max%),len%(max%),addr$(max%)
  280 ON ERROR PRINTTAB(0,max%)':REPORT:PROCClose_All:PRINT" at line ";ERL:IF ERR=17:QUIT ELSE END
  290 :
  300 in%=OPENIN(src$):IF in%=0:PRINT "Couldn't open input file":END
  310 out%=OPENOUT(dst$):IF out%=0:PROCClose_All:PRINT "Couldn't open output file, is it already open?":END
  320 PROCcsv_rd(in%,head$())
  330 FOR idx%=0 TO max%:A$=FNuc(head$(idx%))
  340   IF LEFT$(A$,9)="HOUSEHOLD"   :idxHouse%      =idx%
  350   IF A$="SURNAME"              :idxSurname%    =idx%
  360   IF A$="NAME"                 :idxName%       =idx%
  370   IF A$="AGE"                  :idxAge%        =idx%
  380   IF A$="RELATIONSHIP"         :idxRelation%   =idx%
  390   IF A$="SEX"                  :idxSex%        =idx%
  400   IF LEFT$(A$,7)="MARITAL"     :idxMarital%    =idx%
  410   IF INSTR(A$,"ADDRESS")       :idxAddress%    =idx%
  420   IF A$="OCCUPATION"           :idxOccupation% =idx%
  430   IF A$="BIRTH YEAR"           :idxYear%       =idx%
  440   IF A$="BIRTH PLACE"          :idxPlace%      =idx%
  450   IF A$="BIRTH COUNTY"         :idxCounty%     =idx%
  460   IF A$="BIRTH COUNTRY"        :idxCountry%    =idx%
  470   IF LEFT$(A$,10)="INDIVIDUAL" :idxIndividual% =idx%
  480   IF A$="CIVIL PARISH"         :idxParish%     =idx%
  490   IF LEFT$(A$,7)="SUB-REG"     :idxSubDistrict%=idx%
  500   IF LEFT$(A$,11)="ENUMERATION":idxDistrict%   =idx%
  510   IF A$="PIECE"                :idxPiece%      =idx%
  520   IF A$="FOLIO"                :idxFolio%      =idx%
  530   IF A$="PAGE"                 :idxPage%       =idx%
  540 NEXT idx%
  550 IF verbose%:CLS:PRINT:FOR A%=0 TO max%:PRINTFNd0(A%,2);": ";head$(A%);":":NEXT:OFF
  560 :
  570 line%=0
  580 lHouse%=0
  590 lDistrict%=0
  600 Page$ ="":Piece$ =""
  610 cPage$="":cPiece$=""
  620 REPEAT
  630   PROCcsv_rd(in%,info$())
  640   PROCentry
  650 UNTIL EOF#in%
  660 CLOSE#out%:out%=0
  670 CLOSE#in%:in%=0
  680 QUIT
  690 :
  700 DEFPROCentry
  710 IF verbose%:FOR A%=0 TO max%:PRINTTAB(32,A%+1);LEFT$(info$(A%),48);SPC(len%(A%)-LENLEFT$(info$(A%),48));:len%(A%)=LENLEFT$(info$(A%),48):NEXT
  720 :
  730 REM New page
  740 IF page% :Page$=STR$VALinfo$(idxPage%)
  750 IF folio%:Folio$=FNs(info$(idxFolio%))
  760 A%=VALinfo$(idxDistrict%):IF A%<>lDistrict%:lHouse%=0:lDistrict%=A%
  770 A%=INSTR(Page$,"/"):IF A%:Page$=LEFT$(Page$,A%-1):REM Remove line within page
  780 IF cPage$<>Page$ OR cPiece$<>info$(idxPiece%) THEN
  790   PROCpage
  800   cPage$ =Page$
  810   cPiece$=info$(idxPiece%)
  820 ENDIF
  830 :
  840 REM New pageheader
  850 IF line%=0 THEN
  860   A%=22-(LENinfo$(idxParish%)+LENinfo$(idxPiece%)+LENFolio$-6*(Folio$<>"")+LENPage$-6*(Page$<>""))/2:IF A%<0:A%=0
  870   BPUT#out%,year$+" Census  ";
  880   BPUT#out%,STRING$(A%," ");
  890   BPUT#out%,"SubDistrict: Whitby  Enumeration: "+FNs(info$(idxDistrict%))+"  Parish: "+info$(idxParish%);
  900   BPUT#out%,STRING$(A%," ");
  910   BPUT#out%,"  "+info$(idxPiece%)+" ";
  920   IF Folio$<>"":BPUT#out%,"folio "+Folio$;
  930   IF Page$<>"":BPUT#out%," page "+Page$;
  940   BPUT#out%,"":BPUT#out%,""
  950   cHouse$=""
  960   cStreet$=""
  970 ENDIF
  980 :
  990 REM Household title
 1000 House$=info$(idxHouse%)
 1010 Street$=info$(idxAddress%)
 1020 A%=INSTR(House$,"/"):IF A%:House$=LEFT$(House$,A%-1):REM Remove person within household
 1030 IF cStreet$<>Street$ OR cHouse$<>House$ THEN
 1040   REM IF VALHouse$:IF RIGHT$(House$,1)<"@":BPUT#out%,STR$VALHouse$; ELSE BPUT#out%,House$;
 1050   IF House$="":BPUT#out%,STRING$(LENSTR$lHouse%," "); ELSE BPUT#out%,House$;:lHouse%=VALHouse$
 1060   BPUT#out%,": "+Street$
 1070   cHouse$=House$
 1080   cStreet$=Street$
 1090 ENDIF
 1100 :
 1110 REM Individual entry
 1120 BPUT#out%,STRING$(indent%," ");
 1130 A$=", "+info$(idxName%)::IF A$=", ":A$=""
 1140 A$=info$(idxSurname%)+A$
 1150 BPUT#out%,A$;
 1160 IF LENA$<namelen%:BPUT#out%,STRING$(namelen%-LENA$," "); ELSE BPUT#out%,"":BPUT#out%,STRING$(indent%+namelen%," ");:line%=line%+1
 1170 BPUT#out%,"- ";
 1180 BPUT#out%,FNpadR(info$(idxRelation%),8)+" - ";
 1190 BPUT#out%,LEFT$(info$(idxMarital%)+" ",1)+" ";
 1200 BPUT#out%,LEFT$(info$(idxSex%)+" ",1)+" ";
 1210 BPUT#out%,FNpadL(info$(idxAge%),2)+" - ";
 1220 A$=info$(idxOccupation%):A%=LENA$+LENMID$(info$(idxAge%),3)+LENMID$(info$(idxRelation%),9)
 1230 BPUT#out%,A$;:IF A%<occlen%:BPUT#out%,STRING$(occlen%-A%," ");
 1240 BPUT#out%," -";
 1250 IF info$(idxCountry%)<>"England":BPUT#out%," "+info$(idxCountry%);:IF info$(idxCounty%)+info$(idxPlace%)<>"":BPUT#out%,";";
 1260 IF info$(idxCounty%)<>"":BPUT#out%," "+info$(idxCounty%);:IF info$(idxPlace%)<>"":BPUT#out%,",";
 1270 IF info$(idxPlace%)<>"":BPUT#out%," "+info$(idxPlace%);
 1280 :
 1290 BPUT#out%,""
 1300 line%=line%+1:REM IF line%>lpp%-4 THEN PROCpage
 1310 ENDPROC
 1320 :
 1330 DEFPROCpage
 1340 REM IF line%>0:FOR A%=line% TO lpp%:BPUT#out%,"":NEXT A%
 1350 IF line%>0:BPUT#out%,""
 1360 BPUT#out%,STRING$(110,"-"):line%=0
 1370 ENDPROC
 1380 :
 1390 :
 1400 DEFPROCClose_All
 1410 lookup%=lookup%:IFlookup%:A%=lookup%:lookup%=0:CLOSE#A%
 1420 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
 1430 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
 1440 ENDPROC
 1450 :
 1460 DEFPROCcsv_rd(i%,array$())
 1470 LOCAL n%:n%=0:array$()="":A$=GET$#i%:IFA$="":A$=GET$#i%
 1480 A$=A$+","
 1490 REPEAT
 1500   IF LEFT$(A$,2)="=""":A$=MID$(A$,2)
 1510   IF LEFT$(A$,1)="""" THEN
 1520     A%=INSTR(A$,""",",2)+1:array$(n%)=MID$(A$,2,A%-3)
 1530   ELSE
 1540     A%=INSTR(A$,","):array$(n%)=LEFT$(A$,A%-1)
 1550   ENDIF
 1560   A$=MID$(A$,A%+1):n%=n%+1
 1570 UNTILA$=""
 1580 ENDPROC
 1590 :
 1600 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
 1610 DEFFNuc(A$):IFA$="":=""
 1620 FOR A%=1TOLENA$:IFMID$(A$,A%,1)>"_":A$=LEFT$(A$,A%-1)+CHR$(ASCMID$(A$,A%,1)AND&DF)+MID$(A$,A%+1)
 1630 NEXT:=A$
 1640 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
 1650 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
 1660 =A$
 1670 DEFFNpadL(A$,A%):IFLENA$>A%:=A$ELSE=STRING$(A%-LENA$," ")+A$
 1680 DEFFNpadR(A$,A%):IFLENA$>A%:=A$ELSE=A$+STRING$(A%-LENA$," ")