10 REM Teletext server version 1.1
   20 REM (C) A.R.B. Shimmin
   30 version$="1.1"
   50 *FX 200,1
   60 space%=HIMEM-TOP-&1B00
   70 max_chan_page%=space%/&500
   90 MODE 7
  100 VDU 28,0,24,39,2
  110 DIM copy &400
  120 DIM data% &20
  130 DIM num%(4)
  140 DIM time%(4)
  150 DIM station%(4,20)
  160 DIM page%(4,20)
  170 DIM message% &50
  180 DIM mem%(20)
  190 DIM rec%(20)
  200 DIM assoc_page%(20)
  210 DIM used%(20)
  220 DIM rec_flag%(20)
  230 DIM roll_flag%(4,20)
  240 DIM request_time%(4,20)
  250 DIM start_time%(20)
  260 DIM request_priority%(4,20)
  270 DIM blk% &30
  280 dummy%=&0FFFFFFF
  290 READ roll_time
  300 header%=TRUE
  310 request%=0
  320 FOR I%=1 TO 4
  330 READ time%(I%)
  340 request_priority%(I%,1)=dummy%
  350 NEXT
  360 VDU 23,1,0;0;0;0;
  370 DIM buff% &500*(max_chan_page%+1)
  380 PROCinit
  390 ?blk%=5
  400 blk%?1=255
  410 X%=blk%:Y%=X% DIV 256
  420 A%=&13:CALL osword
  430 queue%=0
  440 *TTXON
  450 *HON
  460 *CH3
  470 TIME=0
  480 PROCget_time_and_date
  490 PROCset_rows(30)
  500 */code
  510 B%=FNset_up_rx(&B2,0,message%,&50)
  520 Ch%=1
  530 REPEAT
  540 Ch%=FNnext_channel
  550 PROCinit_new_channel
  560 REPEAT
  570 PROCnetwork
  580 PROCteletext
  590 IF TIME>start_time%(rec%(1))+time%(Ch%) THEN PROCtoo_long
  600 UNTIL (FNnext_channel<>Ch%) OR ((TIME-last_update%>60*60*100) AND queue%=0)
  610 IF TIME-last_update%>60*60*100 THEN PROCget_time_and_date
  620 UNTIL FALSE
  630 END
  640 
  650 DEFPROCinit_new_channel
  660 PROCoscli("CH"+STR$(Ch%))
  670 PROCclear
  680 FOR I%=0 TO 20
  690 rec_flag%(I%)=0
  700 assoc_page%(I%)=0
  710 used%(I%)=0
  720 NEXT
  730 IF num%(Ch%)>0 THEN PROCset_up_records
  740 ENDPROC
  750 
  760 DEFFNfree_record(test_p%)
  770 match%=FALSE
  780 fr%=-1
  790 REPEAT
  800 fr%=fr%+1
  810 IF assoc_page%(fr%)=test_p% THEN match%=TRUE:match_page%=fr%
  820 UNTIL match%=TRUE OR fr%=max_chan_page%
  830 IF match%=TRUE THEN =match_page%
  840 fr%=-1
  850 REPEAT
  860 fr%=fr%+1
  870 UNTIL used%(fr%)=0 OR fr%=max_chan_page%
  880 IF fr%<max_chan_page% THEN =fr%
  890 fr%=-1
  900 REPEAT
  910 fr%=fr%+1
  920 UNTIL rec_flag%(fr%)=0
  930 =fr%
  940 
  950 DEFPROCtoo_long
  960 IF num%(Ch%)=0 THEN ENDPROC
  970 $(message%)="Timed out"
  980 PROCtx(&B3,&81,station%(Ch%,1),message%,&50)
  990 PROCreorder(1,Ch%)
 1000 ENDPROC
 1010 
 1020 DEFFNnext_channel
 1030 chosen%=dummy%
 1040 next_chan%=FNchannel
 1050 FOR find_lowest%=1 TO 4
 1060 IF request_priority%(find_lowest%,1)<chosen% THEN chosen%=request_priority%(find_lowest%,1):next_chan%=find_lowest% 
 1070 NEXT
 1080 =next_chan%
 1090 
 1100 DEFPROCset_up_records
 1110 FOR R%=1 TO num%(Ch%)
 1120 result%=FNalready(R%-1,page%(Ch%,R%))
 1130 IF result%=-1 THEN PROCunique(R%) ELSE PROCnot_unique(R%,result%)
 1140 NEXT
 1150 ENDPROC
 1160 
 1170 DEFPROCunique(U%)
 1180 free%=FNfree_record(page%(Ch%,U%))
 1190 rec%(U%)=free%
 1200 start_time%(free%)=TIME
 1210 rec_flag%(free%)=rec_flag%(free%)+1
 1220 mem%(U%)=buff%+&500*free%
 1230 PROCsetup_record(page%(Ch%,U%),free%,buff%+&500*free%)
 1240 ENDPROC
 1250 
 1260 DEFPROCnot_unique(U%,L%)
 1270 rec%(U%)=rec%(L%)
 1280 rec_flag%(rec%(L%))=rec_flag%(rec%(L%))+1
 1290 mem%(U%)=buff%+&500*rec%(L%)
 1300 ENDPROC
 1310 
 1320 DEFFNalready(max%,p%)
 1330 IF max%=0 THEN =-1
 1340 already%=FALSE
 1350 look%=0
 1360 REPEAT
 1370 look%=look%+1
 1380 IF page%(Ch%,look%)=p% THEN already%=TRUE
 1390 UNTIL look%=max% OR already%=TRUE
 1400 IF already%=TRUE =look%
 1410 =-1
 1420 
 1430 DEFPROCteletext
 1440 IF num%(Ch%)>0 THEN PROCpage_test
 1450 ENDPROC
 1460 
 1470 DEFPROCpage_test
 1480 R%=0
 1490 REPEAT
 1500 R%=R%+1
 1510 status%=FNread_record_flag(rec%(R%))
 1520 IF (status% AND 2)=2 THEN PROCtransmit_page
 1530 UNTIL R%>=num%(Ch%)
 1540 ENDPROC
 1550 
 1560 DEFPROCtransmit_page
 1570 IF ((TIME-request_time%(Ch%,R%))/time%(Ch%)<roll_time) AND roll_flag%(Ch%,R%) THEN ENDPROC
 1580 update%=TIME
 1590 REPEAT
 1600 UNTIL ((FNread_record_flag(rec%(R%)) AND 4)=0) OR TIME>update%+50
 1610 PROCdisplay(rec%(R%),mem%(R%),page%(Ch%,R%))
 1620 PRINTFNstation(station%(Ch%,R%));TAB(8)" receiving page ";page%(Ch%,R%);" on ";Ch%;
 1630 copy?&3FE=?(mem%(R%)+3)
 1640 copy?&3FF=?(mem%(R%)+4)
 1650 PROCtx(&B3,&80,station%(Ch%,R%),copy,&400)
 1660 PRINT
 1670 VDU 23,1,0;0;0;0;
 1680 PROCreorder(R%,Ch%)
 1690 R%=R%-1
 1700 *HON
 1710 IF header%=TRUE THEN CALL init
 1720 ENDPROC
 1730 
 1740 DEFPROCinit
 1750 osword=&FFF1
 1760 osbyte=&FFF4
 1770 oswrch=&FFEE
 1780 delete=&993
 1790 decode=&9B3
 1800 init=&978
 1810 ENDPROC
 1820 
 1830 DEFPROCcall(code%)
 1840 ?blk%=code%
 1850 X%=blk%:Y%=X% DIV 256
 1860 A%=&7A:CALL osword
 1870 ENDPROC
 1880 
 1890 DEFPROCclear
 1900 PROCcall(14)
 1910 ENDPROC
 1920 
 1930 DEFPROCset_rows(r%)
 1940 blk%?1=r%
 1950 PROCcall(7)
 1960 ENDPROC
 1970 
 1980 DEFFNread_record_flag(p%)
 1990 blk%?1=p%
 2000 PROCcall(2)
 2010 =blk%?2
 2020 
 2030 DEFPROCsetup_record(p%,r%,l%)
 2040 IF r%=max_chan_page% THEN ENDPROC
 2050 IF assoc_page%(r%)=p% THEN ENDPROC
 2060 PROCcall(16)
 2070 blk%?1=r%
 2080 blk%?2=p% DIV 100
 2090 lo%=p% MOD 10
 2100 hi%=(p% MOD 100) DIV 10
 2110 blk%?3=&10*hi%+lo%
 2120 blk%?4=p% MOD 10
 2130 blk%?4=&3F
 2140 blk%?5=&7F
 2150 blk%!6=l%
 2160 PROCcall(5)
 2170 PROCset_record_flag(r%,0)
 2180 assoc_page%(r%)=p%
 2190 used%(r%)=1
 2200 ENDPROC
 2210 
 2220 DEFPROCset_record_flag(p%,v%)
 2230 blk%?1=p%
 2240 blk%?2=v%
 2250 PROCcall(3)
 2260 ENDPROC
 2270 
 2280 DEFPROCdisplay(r%,loc%,p%)
 2290 !&70=loc%
 2300 !&76=copy
 2310 !&78=copy+40
 2320 CALL decode
 2330 check$=FNcheck(loc%)
 2340 L=LEN(check$)
 2350 $(copy+24*40)=STRING$(39-L," ")+check$
 2360 ENDPROC
 2370 
 2380 DEFPROCreorder(rd%,ch%)
 2390 LOCAL I%
 2400 IF num%(ch%)=0 THEN ENDPROC
 2410 IF Ch%=ch% THEN rec_flag%(rec%(rd%))=rec_flag%(rec%(rd%))-1
 2420 FOR I%=rd% TO num%(ch%)-1
 2430 page%(ch%,I%)=page%(ch%,I%+1)
 2440 station%(ch%,I%)=station%(ch%,I%+1)
 2450 IF ch%=Ch% THEN mem%(I%)=mem%(I%+1)
 2460 IF ch%=Ch% THEN rec%(I%)=rec%(I%+1)
 2470 request_priority%(ch%,I%)=request_priority%(ch%,I%+1)
 2480 roll_flag%(ch%,I%)=roll_flag%(ch%,I%+1)
 2490 request_time%(ch%,I%)=request_time%(ch%,I%+1)
 2500 NEXT
 2510 queue%=queue%-1
 2520 num%(ch%)=num%(ch%)-1
 2530 IF num%(ch%)=0 THEN request_priority%(ch%,1)=dummy%
 2540 ENDPROC
 2550 
 2560 DEFPROCdelay(time)
 2570 T%=TIME
 2580 REPEAT UNTIL TIME>T%+time
 2590 ENDPROC
 2600 
 2610 DEFFNcheck(l%)
 2620 blk%?1=l% MOD 256
 2630 blk%?2=l% DIV 256
 2640 PROCcall(23)
 2650 IF blk%?3=0 THEN ="No check"
 2660 IF blk%?3=1 THEN =""
 2670 IF blk%?3=&FF THEN ="Bad data"
 2680 ="Bad check"
 2690 
 2700 DEFPROCoscli(os$)
 2710 $blk%=os$
 2720 X%=blk%:Y%=X% DIV 256
 2730 CALL &FFF7:ENDPROC
 2740 
 2750 DEFPROCtx(p%,cb%,st%,b%,l%)
 2760 tries%=0
 2770 REPEAT
 2780 tries%=tries%+1
 2790 ?blk%=cb% 
 2800 blk%?1=p%
 2810 blk%!2=st%
 2820 blk%!4=b% 
 2830 blk%!8=b%+l%
 2840 X%=blk%:Y%=X% DIV 256:A%=&10
 2850 CALL osword
 2860 UNTIL tries%>5 OR FNpoll_tx=0
 2870 IF FNpoll_tx<>0 THEN PRINT'"Not listening";
 2880 ENDPROC
 2890 
 2900 DEFFNpoll_tx
 2910 REPEAT
 2920 A%=&32
 2930 r%=(USR(osbyte) AND &FF00) DIV &100
 2940 UNTIL r%<128
 2950 =r%
 2960 
 2970 DEFFNset_up_rx(p%,st%,b%,l%)
 2980 ?blk%=0
 2990 blk%?1=&7F
 3000 blk%?2=p%
 3010 blk%!3=st%
 3020 blk%!5=b%
 3030 blk%!9=b%+l%
 3040 X%=blk%:Y%=X% DIV 256:A%=&11
 3050 CALL osword
 3060 =?blk%
 3070 
 3080 DEFFNpoll_rx(r%)
 3090 A%=&33:X%=r%
 3100 =USR(osbyte) AND &8000
 3110 
 3120 DEFPROCread_rx(r%)
 3130 ?blk%=r%
 3140 X%=blk%:Y%=X% DIV 256:A%=&11
 3150 CALL osword
 3160 ENDPROC
 3170 
 3180 DEFPROCnetwork
 3190 IF FNpoll_rx(B%)>0 THEN PROCdeal_with_message
 3200 ENDPROC
 3210 
 3220 DEFPROCdeal_with_message
 3230 PROCread_rx(B%)
 3240 station%=blk%!3 AND &FFFF
 3250 control%=blk%?1
 3260 !data%=!message%
 3270 PRINTFNstation(station%);TAB(8);"CODE :";~control%;"  ";
 3280 IF control%=&81 THEN PROCrequest_page(FALSE,&81)
 3290 IF control%=&80 THEN PROCversion
 3300 IF control%=&82 THEN PROCcancel
 3310 IF control%=&83 THEN PROCmax_users
 3320 IF control%=&84 THEN PROCtime
 3330 IF control%=&85 THEN PROClogoff
 3340 IF control%=&86 THEN PROCrequest_page(TRUE,&86)
 3350 IF control%=&87 THEN PROCtemp
 3360 B%=FNset_up_rx(&B2,0,message%,&50)
 3370 PRINT
 3380 ENDPROC
 3390 
 3400 DEFFNstation(st_no%)
 3410 net$=FNformat(3,st_no% DIV 256)+"."
 3420 =net$+FNformat(3,st_no% MOD 256)
 3430 
 3440 DEFFNformat(z%,form%)
 3450 form$=STR$(form%)
 3460 =STRING$(z%-LEN(form$),"0")+form$
 3470 
 3480 
 3490 DEFPROCmax_users
 3500 PRINT"Max users";
 3510 ?message%=0
 3520 message%?1=max_chan_page%
 3530 PROCtx(&B0,&83,station%,message%,2)
 3540 ENDPROC
 3550 
 3560 DEFPROCtemp
 3570 port%=?data%
 3580 PRINT"Request port ";port%;
 3590 IF port%<0 OR port%>3 THEN PROCerror(&87,5,"Bad port"):ENDPROC
 3600 ?message%=0
 3610 message%!1=ADVAL(port%)
 3620 PROCtx(&B0,&87,station%,message%,3)
 3630 ENDPROC
 3640 
 3650 DEFPROCadd_a_record
 3660 result%=FNalready(num%(Ch%)-1,page%(Ch%,num%(Ch%)))
 3670 IF result%=-1 THEN PROCunique(num%(channel%)) ELSE PROCnot_unique(num%(channel%),result%)
 3680 ENDPROC
 3690 
 3700 DEFPROCversion
 3710 PRINT"Version number";
 3720 ?message%=0
 3730 $(message%+1)=version$
 3740 PROCtx(&B0,&80,station%,message%,&20)
 3750 ENDPROC
 3760 
 3770 DEFPROCtime_and_date
 3780 now%=TIME-last_update%
 3790 hrs$=FNformat(2,(hrs%+((now%+100*secs%+6000*mins%) DIV 360000))MOD 24)
 3800 mins$=FNformat(2,(mins%+((now%+100*secs%) DIV 6000))MOD 60)
 3810 secs$=FNformat(2,(secs%+(now% DIV 100))MOD 60)
 3820 time$=hrs$+":"+mins$+":"+secs$+date$
 3830 ?message%=0
 3840 $(message%+1)=time$
 3850 PROCtx(&B0,&84,station%,message%,22)
 3860 ENDPROC
 3870 
 3880 DEFPROCget_time_and_date
 3890 *CH3
 3900 IF queue%=0 THEN TIME=0
 3910 no_time%=FALSE
 3920 PROCdelay(150)
 3930 PROCcall(15)
 3940 PROCcall(21)
 3950 last_update%=TIME
 3960 IF blk%?10=&FF THEN no_time%=TRUE:ENDPROC
 3970 blk%?3=13:blk%?6=13:blk%?9=13
 3980 hrs%=VAL($(blk%+1))
 3990 mins%=VAL($(blk%+4))
 4000 secs%=VAL($(blk%+7))
 4010 PROCcall(22)
 4020 blk%?11=13
 4030 date$=$(blk%+1)
 4040 ENDPROC
 4050 
 4060 DEFPROCno_time
 4070 ?message%=4
 4080 $(message%+1)="Time unavailable"
 4090 PROCtx(&B0,&84,station%,message%,22)
 4100 ENDPROC
 4110 
 4120 DEFPROCtime
 4130 PRINT"Request time";
 4140 IF no_time%=TRUE THEN PROCno_time ELSE PROCtime_and_date
 4150 ENDPROC
 4160 
 4170 DEFFNchannel
 4180 PROCcall(0)
 4190 =(blk%?1)+1
 4200 
 4210 DEFFNlegal(char%)
 4220 IF char%<32 THEN char%=255
 4230 =char%
 4240 
 4250 DEFPROCrequest_page(roll%,byte%)
 4260 page$=CHR$(FNlegal(data%?1))+CHR$(FNlegal(data%?2))+CHR$(FNlegal(data%?3))
 4270 page%=VAL(page$)
 4280 channel%=?data%-48
 4290 PRINT"Request page ";page$;" on ";channel%;
 4300 page$=CHR$(data%?1)+CHR$(data%?2)+CHR$(data%?3)
 4310 IF channel%<1 OR channel%>4 THEN PROCerror(byte%,2,"Bad channel"):PROCcheck_matching_sts(TRUE,0):ENDPROC
 4320 IF page%<100 THEN PROCerror(byte%,1,"Bad page number"):PROCcheck_matching_sts(TRUE,0):ENDPROC
 4330 num%(channel%)=num%(channel%)+1
 4340 queue%=queue%+1
 4350 request%=request%+1
 4360 station%(channel%,num%(channel%))=station%
 4370 page%(channel%,num%(channel%))=page%
 4380 request_priority%(channel%,num%(channel%))=request%
 4390 request_time%(channel%,num%(channel%))=TIME
 4400 roll_flag%(channel%,num%(channel%))=roll%
 4410 marker%=request%
 4420 PROCcheck_matching_sts(FALSE,marker%)
 4430 IF Ch%=channel% THEN PROCadd_a_record
 4440 IF (Ch%=channel%) AND (FNfree_record(page%)>max_chan_page%) THEN PROCerror(byte%,3,"Channel busy"):PROCcheck_matching_sts(TRUE,0):ENDPROC
 4450 IF (Ch%<>channel%) AND (num%(channel%)>max_chan_page%) THEN PROCerror(byte%,3,"Channel busy"):PROCcheck_matching_sts(TRUE,0):ENDPROC
 4460 ?message%=0
 4470 message%?1=queue%
 4480 PROCtx(&B0,byte%,station%(channel%,num%(channel%)),message%,&20)
 4490 ENDPROC
 4500 
 4510 DEFPROCcancel
 4520 PRINT"Cancel pages";
 4530 PROCtx(&B0,&82,station%,message%,1)
 4540 PROCcheck_matching_sts(TRUE,0)
 4550 ENDPROC
 4560 
 4570 DEFPROClogoff
 4580 PRINT"Logoff";
 4590 PROCtx(&B0,&85,station%,message%,1)
 4600 PROCcheck_matching_sts(TRUE,0)
 4610 ENDPROC
 4620 
 4630 DEFPROCcheck_matching_sts(type,M%)
 4640 chan%=0
 4650 REPEAT
 4660 chan%=chan%+1
 4670 item%=0
 4680 REPEAT
 4690 item%=item%+1
 4700 IF FNdrop(type,M%) THEN PROCreorder(item%,chan%):item%=item%-1
 4710 UNTIL item%>=num%(chan%)
 4720 UNTIL chan%=4
 4730 ENDPROC
 4740 
 4750 DEFFNdrop(all,M1%)
 4760 IF all AND (station%(chan%,item%)=station%) THEN =TRUE
 4770 IF (station%(chan%,item%)=station%) AND (request_priority%(chan%,item%)<>M%) THEN =TRUE
 4780 =FALSE
 4790 
 4800 DEFPROCerror(con%,err%,err$)
 4810 ?message%=err%
 4820 $(message%+1)=err$
 4830 PRINT'"ERROR : ";$(message%+1);
 4840 PROCtx(&B0,con%,station%,message%,&20)
 4850 ENDPROC
 4860 
 4870 *FX 13,5
 4880 *HOFF
 4890 *TTXOFF
 4900 REPORT:PRINT" at line ";ERL
 4910 END
 4920 DATA 0.5
 4930 DATA 4000,4000,4000,4000