10REM Program to produce a complete
   20REM 1-page newspaper from Ceefax
   30REM (C) John Robinson 1989
   40:
   50REM Program to process the news pages on Ceefax, turning them into
   60REM continuous text files
   70REM (C) John Robinson 1989
   80:
   90MODE 7
  100ON ERROR GOTO 530
  110PROCx_initialise
  120:
  130INPUT "Please give the filename for the"'"text output: " outfile$
  140outhandle=OPENOUT outfile$
  150IF outhandle=0 THEN PRINT "Couldn't open file for output":END
  160PRINT "Automatic selection? ";
  170IF (GET OR &20)=ASC "y" THEN PRINT "Yes":automatic=TRUE ELSE PRINT "No":automatic=FALSE
  180CLS
  190*TTIME
  200*TDATE
  210datetime$=FNx_scrstr(0,0,5,TRUE)+" on "+FNx_scrstr(0,1,6,TRUE)+FNx_scrstr(8,1,2,TRUE)
  220CLS
  230PROCx_write("CEEFAX news for "+datetime$)
  240BPUT#outhandle,13
  250*HON
  260:
  270PROCx_page(2)
  280FOR line=7 TO 20
  290IF FNx_character(8,line)=ASC "*" THEN xtra_on_2(line-4)=TRUE
  300headline$(line-4)=FNx_remspaces(FNx_scrstr(10,line,30,TRUE))
  310NEXT line
  320:
  330FOR page=3 TO 16
  340PROCx_page(page)
  350PRINTTAB(0,24);CHR$134;" Output";CHR$137;"Again";CHR$137;"Next";CHR$137;"Quit";CHR$131;"?";CHR$8;
  360REPEAT
  370IF automatic THEN key=INKEY(200) OR &20 ELSE key=GET OR &20
  380UNTIL INSTR("anoq",CHR$ key) OR automatic
  390IF key=ASC "a" THEN PRINT "Retrying";TAB(8,24);CHR$136;:GOTO 340
  400IF key=ASC "o" OR (automatic AND key=-1) THEN PRINT "Please wait";TAB(1,24);CHR$136;:PROCx_output
  410IF key=ASC "q" THEN PRINT ;CHR$137;TAB(19,24);CHR$136:page=16
  420IF key=ASC "n" THEN PRINT " ";TAB(14,24);CHR$136;
  430NEXT page
  440:
  450*HOFF
  460*TTXOFF
  470CLOSE#outhandle
  480CLS
  490PRINT ;"""";outfile$;""" now completed"'
  500$&780=outfile$
  510GOTO 1770
  520:
  530ON ERROR OFF
  540*HOFF
  550*TTXOFF
  560CLS
  570REPORT
  580PRINT " (";ERR;") at line ";ERL
  590ON ERROR GOTO 610
  600CLOSE#outhandle
  610ON ERROR OFF
  620END
  630:
  640DEFPROCx_initialise
  650osbyte=&FFF4
  660DIM screendata &800
  670*TTXON
  680defmagazine=200
  690PROCx_magazine(defmagazine)
  700DIM headline$(16),xtra_on_2(16)
  710ENDPROC
  720:
  730DEFPROCx_magazine(mag)
  740magazine=mag
  750OSCLI "CH "+STR$(magazine DIV 100)
  760ENDPROC
  770:
  780DEFPROCx_page(page)
  790page=page+magazine
  800PRINTTAB(0,0);"  P";page;" ";
  810VDU 23,1;0;0;0;0
  820OSCLI "PAGE "+STR$page
  830OSCLI "DATA "+STR$~screendata
  840CLS
  850OSCLI "DISPLAY "+STR$~screendata
  860PRINTTAB(1,0);CHR$130;"P";page;CHR$135;
  870VDU 23,1,1;0;0;0;
  880ENDPROC
  890:
  900DEFPROCx_output
  910BPUT#outhandle,13
  920PROCx_headline
  930IF xtra_on_2(page) AND magazine<>200 THEN oldmag=magazine:PROCx_magazine(200):PROCx_subpages(1):PROCx_magazine(oldmag) ELSE IF FNx_character(37,1)=ASC "/" THEN PROCx_subpages(1) ELSE PROCx_main_data
  940ENDPROC
  950:
  960DEFFNx_character(x,y) LOCAL character
  970IF y>24 THEN =ASC "*"
  980PRINTTAB(x,y);
  990A%=&87
 1000character=(USR(osbyte) AND &FF00) DIV 256
 1010IF NOT(character>128 AND character<160) THEN character=character AND &7F
 1020=character
 1030:
 1040DEFPROCx_headline
 1050BPUT#outhandle,13
 1060FOR char=1 TO LEN headline$(page)
 1070BPUT#outhandle,FNx_caps(ASC MID$(headline$(page),char,1))
 1080NEXT char
 1090BPUT#outhandle,13
 1100oldheadline$=headline$(page)
 1110ENDPROC
 1120:
 1130DEFFNx_caps(char) IF char>=ASC "a" AND char<=ASC "z" THEN =char AND &DF ELSE =char
 1140:
 1150DEFPROCx_main_data
 1160FOR line=5 TO 22
 1170newline=0
 1180line$=FNx_scrstr(1,line,39,FALSE)
 1190linewidth=LEN line$
 1200IF linewidth=0 THEN newline=line:GOTO 1290
 1210colour=FNx_character(0,line) AND &1F
 1220FOR char=1 TO linewidth
 1230character=ASC MID$(line$,char,1)
 1240IF (character>=&81 AND character<=&87) OR (character>=&91 AND character<=&97) THEN colour=character AND &1F
 1250IF character>=&80 THEN IF character<&A0 THEN character=ASC " "
 1260IF colour>&10 THEN IF (character<&40 OR character>&5F) AND character<>ASC " " THEN character=ASC "*"
 1270BPUT#outhandle,character
 1280NEXT char
 1290IF newline=line THEN PTR#outhandle=PTR#outhandle-1:BPUT#outhandle,13:BPUT#outhandle,13 ELSE BPUT#outhandle,ASC " "
 1300NEXT line
 1310ENDPROC
 1320:
 1330DEFPROCx_subpages(first)
 1340PROCx_extract_numbers
 1350FOR subpage=first TO how_many
 1360IF current<>subpage THEN PROCx_find(subpage)
 1370headline$(page)=FNx_scrstr(29,2,11,TRUE)
 1380character=FNx_character(29,3)
 1390IF character>=&81 AND character<=&87 THEN headline$(page)=headline$(page)+" "+FNx_remspaces(FNx_scrstr(30,3,11,TRUE))
 1400headline$(page)=FNx_remspaces(headline$(page))
 1410IF headline$(page)<>"" AND headline$(page)<>oldheadline$ THEN PROCx_headline
 1420PROCx_main_data
 1430NEXT subpage
 1440ENDPROC
 1450:
 1460DEFPROCx_extract_numbers
 1470how_many=VAL(FNx_scrstr(38,1,2,TRUE))
 1480current=VAL(FNx_scrstr(35,1,2,TRUE))
 1490ENDPROC
 1500:
 1510DEFFNx_scrstr(x,y,len,remove) LOCAL char,return$,char$
 1520FOR char=x TO x+len-1
 1530char$=CHR$ FNx_character(char,y)
 1540IF ASC char$>127 AND remove THEN char$=" "
 1550return$=return$+char$
 1560NEXT char
 1570FOR char=len TO 1 STEP -1
 1580IF RIGHT$(return$,1)=" " THEN return$=LEFT$(return$,LEN return$ -1) ELSE char=1
 1590NEXT char
 1600=return$
 1610:
 1620DEFPROCx_find(subpage)
 1630REPEAT
 1640PROCx_page(page)
 1650PROCx_extract_numbers
 1660UNTIL subpage=current
 1670ENDPROC
 1680:
 1690DEFFNx_remspaces(a$) IF LEFT$(a$,1)=" " THEN =FNx_remspaces(MID$(a$,2)) ELSE =a$
 1700:
 1710DEFPROCx_write(a$) LOCAL char
 1720FOR char=1 TO LEN a$
 1730BPUT#outhandle,ASC MID$(a$,char,1)
 1740NEXT char
 1750ENDPROC
 1760:
 1770REM Program to put Teletext news pages into multi-column (newspaper)
 1780REM format. Uses condensed elite text (160 chars/line) and superscript
 1790REM (132 lines/page) for main text, giving 3 columns of 50 characters,
 1800REM each 120 lines long, and a normal size header across the top
 1810REM (C) John Robinson 1989
 1820:
 1830CLEAR
 1840MODE 7
 1850ON ERROR GOTO 2080
 1860PROCinitialise
 1870:
 1880infile$=$&780
 1890inhandle=OPENIN infile$
 1900PROCheader
 1910:
 1920PROCget_lengths
 1930PROCsort_lengths
 1940PROCselect_items
 1950:
 1960CLOSE#inhandle
 1970FOR column=1 TO 3
 1980inhandle(column)=OPENIN infile$
 1990NEXT column
 2000PROCprint_data
 2010:
 2020FOR column=1 TO 3
 2030CLOSE#inhandle(column)
 2040NEXT column
 2050MODE 7
 2060END
 2070:
 2080CLOSE#0
 2090*FX3
 2100REPORT
 2110PRINT " at line ";ERL
 2120END
 2130:
 2140DEFPROCinitialise
 2150DIM inhandle(3),datastart(20),itemlength(20),column(20),columnlength(3),item(3),returns(3),newline(3),blanks(3),subhead(3)
 2160*FX3 10
 2170VDU 27,ASC "S",0,27,ASC "M",15,27,ASC "A",6
 2180*FX3
 2190ENDPROC
 2200:
 2210DEFPROCheader
 2220header$=FNget_line
 2230*FX3 10
 2240PRINT
 2250VDU 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
 2260PRINT "CEEFAX NEWS at "+MID$(header$,17)+"  (C)BBC"
 2270VDU 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
 2280PRINT
 2290PRINT
 2300*FX3
 2310ENDPROC
 2320:
 2330DEFPROCget_lengths
 2340oldbyte=13
 2350returns=2
 2360item=0
 2370lines=0
 2380line$=""
 2390datastart=0
 2400REPEAT
 2410byte=BGET#inhandle
 2420IF oldbyte=13 THEN returns=returns+1
 2430IF oldbyte=13 AND byte<>13 THEN PROCnewline
 2440IF byte>=32 AND byte<127 THEN line$=line$+CHR$ byte
 2450IF LEN line$>50 THEN PROCwordwrap
 2460oldbyte=byte
 2470UNTIL EOF#inhandle
 2480datastart(item)=datastart
 2490itemlength(item)=lines+1
 2500items=item
 2510ENDPROC
 2520:
 2530DEFPROCnewline
 2540IF returns>=4 THEN PROCnewitem
 2550IF returns=3 THEN lines=lines+1
 2560lines=lines+1
 2570line$="   "
 2580returns=0
 2590ENDPROC
 2600:
 2610DEFPROCnewitem
 2620IF item<1 THEN GOTO 2660
 2630datastart(item)=datastart
 2640itemlength(item)=lines+1
 2650PRINT ;item;" """;header$;""" (";lines+1;")"
 2660item=item+1
 2670datastart=PTR#inhandle-1
 2680lines=1
 2690header$=CHR$ byte+FNget_line
 2700byte=BGET#inhandle
 2710ENDPROC
 2720:
 2730DEFPROCwordwrap
 2740FOR find_space=LEN line$ TO 1 STEP -1
 2750IF MID$(line$,find_space,1)=" " THEN line$=MID$(line$,find_space+1):find_space=1
 2760NEXT find_space
 2770lines=lines+1
 2780ENDPROC
 2790:
 2800DEFFNget_line LOCAL byte,return$
 2810REPEAT
 2820byte=BGET#inhandle
 2830IF byte>=32 AND byte<127 THEN return$=return$+CHR$ byte
 2840UNTIL byte=13 OR EOF#inhandle
 2850=return$
 2860:
 2870DEFPROCsort_lengths
 2880FOR item=1 TO items
 2890itemlength(item)=itemlength(item)+item/items
 2900NEXT item
 2910PROCqsort(1,items)
 2920FOR item=1 TO items
 2930itemlength(item)=INT(itemlength(item)-item/items+.00001)
 2940NEXT item
 2950ENDPROC
 2960:
 2970DEFPROCqsort(b%,t%)LOCALl%,h%,p%,t:l%=b%:h%=t%:p%=b%:REPEAT:IFl%>=h%THENGOTO2990
 2980IFitemlength(l%)<itemlength(h%)PROCswap ELSEPROChigh_down
 2990UNTILl%>=h%:IFABS(t%-b%)<2ENDPROC
 3000PROCqsort(b%,p%-1):PROCqsort(p%+1,t%):ENDPROC
 3010:
 3020DEFPROCswap
 3030t=itemlength(l%):itemlength(l%)=itemlength(h%):itemlength(h%)=t
 3040t=datastart(l%):datastart(l%)=datastart(h%):datastart(h%)=t
 3050IFp%=l%l%=l%+1:p%=h%ELSEh%=h%-1:p%=l%
 3060ENDPROC
 3070:
 3080DEFPROChigh_down IFp%=l%h%=h%-1ELSEl%=l%+1
 3090ENDPROC
 3100:
 3110DEFPROCselect_items
 3120FOR item=1 TO items
 3130column=1
 3140placefound=FALSE
 3150IF columnlength(2)<columnlength(1) THEN column=2
 3160IF columnlength(3)<columnlength(2) THEN column=3
 3170IF columnlength(column)+itemlength(item)<=120 THEN column(item)=column:columnlength(column)=columnlength(column)+itemlength(item):placefound=TRUE
 3180IF NOT placefound THEN column(item)=-1:PRINT "Not enough space for item ";item
 3190NEXT item
 3200ENDPROC
 3210:
 3220DEFPROCprint_data
 3230PROCget_item(1)
 3240PROCget_item(2)
 3250PROCget_item(3)
 3260*FX3 10
 3270FOR line=1 TO 120
 3280PRINT ;"|";
 3290FOR column=1 TO 3
 3300line$=""
 3310PRINT ;" ";
 3320inhandle=inhandle(column)
 3330IF item(column)=-1 THEN GOTO 3470
 3340IF blanks(column)>0 THEN blanks(column)=blanks(column)-1:GOTO 3470
 3350IF PTR#inhandle=datastart(item(column)) THEN VDU 27,ASC "T",27,ASC "G":blanks(column)=1
 3360IF subhead(column) THEN VDU 27,ASC "G":subhead(column)=FALSE
 3370IF newline(column) THEN line$="   ":newline(column)=FALSE
 3380REPEAT
 3390byte=BGET#inhandle
 3400IF byte>=32 AND byte<127 THEN line$=line$+CHR$ byte
 3410UNTIL byte=13 OR LEN line$>50 OR EOF#inhandle
 3420IF EOF#inhandle THEN PROCnewitem3:returns(column)=0:GOTO 3470
 3430IF byte=13 THEN PROCnewline3:GOTO 3470
 3440FOR char=LEN line$ TO 1 STEP -1
 3450IF RIGHT$(line$,1)<>" " THEN line$=LEFT$(line$,LEN line$ -1):PTR#inhandle=PTR#inhandle-1 ELSE char=1
 3460NEXT char
 3470PRINT ;line$;STRING$(51-LEN line$," ");
 3480VDU 27,ASC "S",0,27,ASC "H"
 3490PRINT ;"|";
 3500NEXT column
 3510PRINT
 3520NEXT line
 3530*FX3
 3540ENDPROC
 3550:
 3560DEFPROCget_item(column)
 3570item=item(column)
 3580REPEAT
 3590item=item+1
 3600UNTIL column(item)=column OR item>items
 3610IF item>items THEN item(column)=-1 ELSE item(column)=item:PTR#inhandle(column)=datastart(item)
 3620ENDPROC
 3630:
 3640DEFPROCnewline3
 3650returns=1
 3660REPEAT
 3670byte=BGET#inhandle
 3680IF byte=13 THEN returns=returns+1
 3690UNTIL byte<>13
 3700PTR#inhandle=PTR#inhandle-1
 3710IF returns>=4 THEN PROCnewitem3 ELSE IF returns=3 THEN PROCsubhead ELSE newline(column)=TRUE
 3720returns(column)=0
 3730ENDPROC
 3740:
 3750DEFPROCnewitem3
 3760PROCget_item(column)
 3770blanks(column)=1
 3780ENDPROC
 3790:
 3800DEFPROCsubhead
 3810subhead(column)=TRUE
 3820blanks(column)=1
 3830ENDPROC
 3840: