10REM Program to process the news pages on Ceefax, turning them into
   20REM continuous text files
   30REM (C) John Robinson 1989
   40:
   50MODE 7
   60ON ERROR GOTO 480
   70PROCinitialise
   80:
   90INPUT "Please give the filename for the"'"text output: " outfile$
  100outhandle=OPENOUT outfile$
  110IF outhandle=0 THEN PRINT "Couldn't open file for output":END
  120PRINT "Automatic selection? ";
  130IF (GET OR &20)=ASC "y" THEN PRINT "Yes":automatic=TRUE ELSE PRINT "No":automatic=FALSE
  140CLS
  150*TTIME
  160*TDATE
  170datetime$=FNscrstr(0,0,5,TRUE)+" on "+FNscrstr(0,1,6,TRUE)+FNscrstr(8,1,2,TRUE)
  180CLS
  190PROCwrite("CEEFAX news for "+datetime$)
  200BPUT#outhandle,13
  210*HON
  220:
  230PROCpage(2)
  240FOR line=7 TO 20
  250IF FNcharacter(8,line)=ASC "*" THEN xtra_on_2(line-4)=TRUE
  260headline$(line-4)=FNremspaces(FNscrstr(10,line,30,TRUE))
  270NEXT line
  280:
  290FOR page=3 TO 16
  300PROCpage(page)
  310PRINTTAB(0,24);CHR$134;" Output";CHR$137;"Again";CHR$137;"Next";CHR$137;"Quit";CHR$131;"?";CHR$8;
  320REPEAT
  330IF automatic THEN key=INKEY(200) OR &20 ELSE key=GET OR &20
  340UNTIL INSTR("anoq",CHR$ key) OR automatic
  350IF key=ASC "a" THEN PRINT "Retrying";TAB(8,24);CHR$136;:GOTO 300
  360IF key=ASC "o" OR (automatic AND key=-1) THEN PRINT "Please wait";TAB(1,24);CHR$136;:PROCoutput
  370IF key=ASC "q" THEN PRINT ;CHR$137;TAB(19,24);CHR$136:page=16
  380IF key=ASC "n" THEN PRINT " ";TAB(14,24);CHR$136;
  390NEXT page
  400:
  410*HOFF
  420*TTXOFF
  430CLOSE#outhandle
  440CLS
  450PRINT ;"""";outfile$;""" now completed"'
  460END
  470:
  480ON ERROR OFF
  490*HOFF
  500*TTXOFF
  510CLS
  520REPORT
  530PRINT " (";ERR;") at line ";ERL
  540ON ERROR GOTO 560
  550CLOSE#outhandle
  560ON ERROR OFF
  570END
  580:
  590DEFPROCinitialise
  600osbyte=&FFF4
  610DIM screendata &800
  620*TTXON
  630defmagazine=200
  640PROCmagazine(defmagazine)
  650DIM headline$(16),xtra_on_2(16)
  660ENDPROC
  670:
  680DEFPROCmagazine(mag)
  690magazine=mag
  700OSCLI "CH "+STR$(magazine DIV 100)
  710ENDPROC
  720:
  730DEFPROCpage(page)
  740page=page+magazine
  750PRINTTAB(0,0);"  P";page;" ";
  760VDU 23,1;0;0;0;0
  770OSCLI "PAGE "+STR$page
  780OSCLI "DATA "+STR$~screendata
  790CLS
  800OSCLI "DISPLAY "+STR$~screendata
  810PRINTTAB(1,0);CHR$130;"P";page;CHR$135;
  820VDU 23,1,1;0;0;0;
  830ENDPROC
  840:
  850DEFPROCoutput
  860BPUT#outhandle,13
  870PROCheadline
  880IF xtra_on_2(page) AND magazine<>200 THEN oldmag=magazine:PROCmagazine(200):PROCsubpages(1):PROCmagazine(oldmag) ELSE IF FNcharacter(37,1)=ASC "/" THEN PROCsubpages(1) ELSE PROCmain_data
  890ENDPROC
  900:
  910DEFFNcharacter(x,y) LOCAL character
  920IF y>24 THEN =ASC "*"
  930PRINTTAB(x,y);
  940A%=&87
  950character=(USR(osbyte) AND &FF00) DIV 256
  960IF NOT(character>128 AND character<160) THEN character=character AND &7F
  970=character
  980:
  990DEFPROCheadline
 1000BPUT#outhandle,13
 1010FOR char=1 TO LEN headline$(page)
 1020BPUT#outhandle,FNcaps(ASC MID$(headline$(page),char,1))
 1030NEXT char
 1040BPUT#outhandle,13
 1050oldheadline$=headline$(page)
 1060ENDPROC
 1070:
 1080DEFFNcaps(char) IF char>=ASC "a" AND char<=ASC "z" THEN =char AND &DF ELSE =char
 1090:
 1100DEFPROCmain_data
 1110FOR line=5 TO 22
 1120newline=0
 1130line$=FNscrstr(1,line,39,FALSE)
 1140linewidth=LEN line$
 1150IF linewidth=0 THEN newline=line:GOTO 1240
 1160colour=FNcharacter(0,line) AND &1F
 1170FOR char=1 TO linewidth
 1180character=ASC MID$(line$,char,1)
 1190IF (character>=&81 AND character<=&87) OR (character>=&91 AND character<=&97) THEN colour=character AND &1F
 1200IF character>=&80 THEN IF character<&A0 THEN character=ASC " "
 1210IF colour>&10 THEN IF (character<&40 OR character>&5F) AND character<>ASC " " THEN character=ASC "*"
 1220BPUT#outhandle,character
 1230NEXT char
 1240IF newline=line THEN PTR#outhandle=PTR#outhandle-1:BPUT#outhandle,13:BPUT#outhandle,13 ELSE BPUT#outhandle,ASC " "
 1250NEXT line
 1260ENDPROC
 1270:
 1280DEFPROCsubpages(first)
 1290PROCextract_numbers
 1300FOR subpage=first TO how_many
 1310IF current<>subpage THEN PROCfind(subpage)
 1320headline$(page)=FNscrstr(29,2,11,TRUE)
 1330character=FNcharacter(29,3)
 1340IF character>=&81 AND character<=&87 THEN headline$(page)=headline$(page)+" "+FNremspaces(FNscrstr(30,3,11,TRUE))
 1350headline$(page)=FNremspaces(headline$(page))
 1360IF headline$(page)<>"" AND headline$(page)<>oldheadline$ THEN PROCheadline
 1370PROCmain_data
 1380NEXT subpage
 1390ENDPROC
 1400:
 1410DEFPROCextract_numbers
 1420how_many=VAL(FNscrstr(38,1,2,TRUE))
 1430current=VAL(FNscrstr(35,1,2,TRUE))
 1440ENDPROC
 1450:
 1460DEFFNscrstr(x,y,len,remove) LOCAL char,return$,char$
 1470FOR char=x TO x+len-1
 1480char$=CHR$ FNcharacter(char,y)
 1490IF ASC char$>127 AND remove THEN char$=" "
 1500return$=return$+char$
 1510NEXT char
 1520FOR char=len TO 1 STEP -1
 1530IF RIGHT$(return$,1)=" " THEN return$=LEFT$(return$,LEN return$ -1) ELSE char=1
 1540NEXT char
 1550=return$
 1560:
 1570DEFPROCfind(subpage)
 1580REPEAT
 1590PROCpage(page)
 1600PROCextract_numbers
 1610UNTIL subpage=current
 1620ENDPROC
 1630:
 1640DEFFNremspaces(a$) IF LEFT$(a$,1)=" " THEN =FNremspaces(MID$(a$,2)) ELSE =a$
 1650:
 1660DEFPROCwrite(a$) LOCAL char
 1670FOR char=1 TO LEN a$
 1680BPUT#outhandle,ASC MID$(a$,char,1)
 1690NEXT char
 1700ENDPROC
 1710: