10REM Program to put Teletext news pages into multi-column (newspaper)
   20REM format. Uses condensed elite text (160 chars/line) and superscript
   30REM (132 lines/page) for main text, giving 3 columns of 50 characters,
   40REM each 120 lines long, and a normal size header across the top
   50REM (C) John Robinson 1989
   60:
   70MODE 7
   80ON ERROR GOTO 330
   90PROCinitialise
  100:
  110REPEAT
  120INPUT "Filename of file for input? " infile$
  130inhandle=OPENIN infile$
  140UNTIL inhandle<>0
  150PROCheader
  160:
  170PROCget_lengths
  180PROCsort_lengths
  190PROCselect_items
  200:
  210CLOSE#inhandle
  220FOR column=1 TO 3
  230inhandle(column)=OPENIN infile$
  240NEXT column
  250PROCprint_data
  260:
  270FOR column=1 TO 3
  280CLOSE#inhandle(column)
  290NEXT column
  300MODE 7
  310END
  320:
  330CLOSE#0
  340*FX3
  350REPORT
  360PRINT " at line ";ERL
  370END
  380:
  390DEFPROCinitialise
  400DIM inhandle(3),datastart(20),itemlength(20),column(20),columnlength(3),item(3),returns(3),newline(3),blanks(3),subhead(3)
  410*FX3 10
  420VDU 27,ASC "S",0,27,ASC "M",15,27,ASC "A",6
  430*FX3
  440ENDPROC
  450:
  460DEFPROCheader
  470header$=FNget_line
  480*FX3 10
  490PRINT
  500VDU 27,ASC "T",27,ASC "P",18,27,ASC "W",1,27,ASC "E",27,ASC "G":REM,27,ASC "x",1,27,ASC "k",1
  510PRINT "CEEFAX NEWS at "+MID$(header$,17)+"  (C)BBC"
  520VDU 27,ASC "S",0,27,ASC "M",15,27,ASC "W",0,27,ASC "F",27,ASC "H":REM,27,ASC "x",0,27,ASC "k",0
  530PRINT
  540PRINT
  550*FX3
  560ENDPROC
  570:
  580DEFPROCget_lengths
  590oldbyte=13
  600returns=2
  610item=0
  620lines=0
  630line$=""
  640datastart=0
  650REPEAT
  660byte=BGET#inhandle
  670IF oldbyte=13 THEN returns=returns+1
  680IF oldbyte=13 AND byte<>13 THEN PROCnewline
  690IF byte>=32 AND byte<127 THEN line$=line$+CHR$ byte
  700IF LEN line$>50 THEN PROCwordwrap
  710oldbyte=byte
  720UNTIL EOF#inhandle
  730datastart(item)=datastart
  740itemlength(item)=lines+1
  750items=item
  760ENDPROC
  770:
  780DEFPROCnewline
  790IF returns>=4 THEN PROCnewitem
  800IF returns=3 THEN lines=lines+1
  810lines=lines+1
  820line$="   "
  830returns=0
  840ENDPROC
  850:
  860DEFPROCnewitem
  870IF item<1 THEN GOTO 910
  880datastart(item)=datastart
  890itemlength(item)=lines+1
  900PRINT ;item;" """;header$;""" (";lines+1;")"
  910item=item+1
  920datastart=PTR#inhandle-1
  930lines=1
  940header$=CHR$ byte+FNget_line
  950byte=BGET#inhandle
  960ENDPROC
  970:
  980DEFPROCwordwrap
  990FOR find_space=LEN line$ TO 1 STEP -1
 1000IF MID$(line$,find_space,1)=" " THEN line$=MID$(line$,find_space+1):find_space=1
 1010NEXT find_space
 1020lines=lines+1
 1030ENDPROC
 1040:
 1050DEFFNget_line LOCAL byte,return$
 1060REPEAT
 1070byte=BGET#inhandle
 1080IF byte>=32 AND byte<127 THEN return$=return$+CHR$ byte
 1090UNTIL byte=13 OR EOF#inhandle
 1100=return$
 1110:
 1120DEFPROCsort_lengths
 1130FOR item=1 TO items
 1140itemlength(item)=itemlength(item)+item/items
 1150NEXT item
 1160PROCqsort(1,items)
 1170FOR item=1 TO items
 1180itemlength(item)=INT(itemlength(item)-item/items+.00001)
 1190NEXT item
 1200ENDPROC
 1210:
 1220DEFPROCqsort(b%,t%)LOCALl%,h%,p%,t:l%=b%:h%=t%:p%=b%:REPEAT:IFl%>=h%THENGOTO1240
 1230IFitemlength(l%)<itemlength(h%)PROCswap ELSEPROChigh_down
 1240UNTILl%>=h%:IFABS(t%-b%)<2ENDPROC
 1250PROCqsort(b%,p%-1):PROCqsort(p%+1,t%):ENDPROC
 1260:
 1270DEFPROCswap
 1280t=itemlength(l%):itemlength(l%)=itemlength(h%):itemlength(h%)=t
 1290t=datastart(l%):datastart(l%)=datastart(h%):datastart(h%)=t
 1300IFp%=l%l%=l%+1:p%=h%ELSEh%=h%-1:p%=l%
 1310ENDPROC
 1320:
 1330DEFPROChigh_down IFp%=l%h%=h%-1ELSEl%=l%+1
 1340ENDPROC
 1350:
 1360DEFPROCselect_items
 1370FOR item=1 TO items
 1380column=1
 1390placefound=FALSE
 1400IF columnlength(2)<columnlength(1) THEN column=2
 1410IF columnlength(3)<columnlength(2) THEN column=3
 1420IF columnlength(column)+itemlength(item)<=120 THEN column(item)=column:columnlength(column)=columnlength(column)+itemlength(item):placefound=TRUE
 1430IF NOT placefound THEN column(item)=-1:PRINT "Not enough space for item ";item
 1440NEXT item
 1450ENDPROC
 1460:
 1470DEFPROCprint_data
 1480PROCget_item(1)
 1490PROCget_item(2)
 1500PROCget_item(3)
 1510*FX3 10
 1520FOR line=1 TO 120
 1530PRINT ;"|";
 1540FOR column=1 TO 3
 1550line$=""
 1560PRINT ;" ";
 1570inhandle=inhandle(column)
 1580IF item(column)=-1 THEN GOTO 1720
 1590IF blanks(column)>0 THEN blanks(column)=blanks(column)-1:GOTO 1720
 1600IF PTR#inhandle=datastart(item(column)) THEN VDU 27,ASC "T",27,ASC "G":blanks(column)=1
 1610IF subhead(column) THEN VDU 27,ASC "G":subhead(column)=FALSE
 1620IF newline(column) THEN line$="   ":newline(column)=FALSE
 1630REPEAT
 1640byte=BGET#inhandle
 1650IF byte>=32 AND byte<127 THEN line$=line$+CHR$ byte
 1660UNTIL byte=13 OR LEN line$>50 OR EOF#inhandle
 1670IF EOF#inhandle THEN PROCnewitem3:returns(column)=0:GOTO 1720
 1680IF byte=13 THEN PROCnewline3:GOTO 1720
 1690FOR char=LEN line$ TO 1 STEP -1
 1700IF RIGHT$(line$,1)<>" " THEN line$=LEFT$(line$,LEN line$ -1):PTR#inhandle=PTR#inhandle-1 ELSE char=1
 1710NEXT char
 1720PRINT ;line$;STRING$(51-LEN line$," ");
 1730VDU 27,ASC "S",0,27,ASC "H"
 1740PRINT ;"|";
 1750NEXT column
 1760PRINT
 1770NEXT line
 1780*FX3
 1790ENDPROC
 1800:
 1810DEFPROCget_item(column)
 1820item=item(column)
 1830REPEAT
 1840item=item+1
 1850UNTIL column(item)=column OR item>items
 1860IF item>items THEN item(column)=-1 ELSE item(column)=item:PTR#inhandle(column)=datastart(item)
 1870ENDPROC
 1880:
 1890DEFPROCnewline3
 1900returns=1
 1910REPEAT
 1920byte=BGET#inhandle
 1930IF byte=13 THEN returns=returns+1
 1940UNTIL byte<>13
 1950PTR#inhandle=PTR#inhandle-1
 1960IF returns>=4 THEN PROCnewitem3 ELSE IF returns=3 THEN PROCsubhead ELSE newline(column)=TRUE
 1970returns(column)=0
 1980ENDPROC
 1990:
 2000DEFPROCnewitem3
 2010PROCget_item(column)
 2020blanks(column)=1
 2030ENDPROC
 2040:
 2050DEFPROCsubhead
 2060subhead(column)=TRUE
 2070blanks(column)=1
 2080ENDPROC
 2090: