110:
120*FX119
130MODE7
140PROCa
150PROCb
160:
190ONERRORPROCc:d$=" ":GOTO210
200d$=FNe
210IFd$=" "ANDFNf=8THENd$="A"
220IFd$=" "ANDFNf<>8THENd$="D"
230IFd$="A"ORd$="a"THENPROCg("ADFS"):P
ROCg("MOUNT 0"):h%=TRUE
240IFd$="D"ORd$="d"THENPROCg("DISC"):P
ROCg("DRIVE 0"):h%=FALSE
250ONERRORPROCi:END
260:
270PROCj
280PROCk
290PROCl(m$,"!Mesg")
300MODE7
310PROCn
320END
330:
340DEFPROCa
350*FX229,1
360*FX4,1
370PROCo
380ENDPROC
390:
400DEFPROCn
410PROCp
420*FX229,0
430*FX4,0
440ENDPROC
450:
460DEFPROCb
470ONERRORPROCi:END
480q%=4096
490r%=25
500s%=-1:t%=-1
510DIMu%256,v%q%,w%q%
520PROCx
530PROCy
540ENDPROC
550:
560DEFPROCi
570IF(ERR<&CCORERR>&CE)ANDERR<>&D6THEN
VDU26,12:CLOSE#0:REPORT:PRINT" at line "
;ERL:PROCn:END
580PROCc
590GOTO270
600:
610DEFPROCo
620VDU23,1,0;0;0;0;
630ENDPROC
640:
650DEFPROCp
660VDU23,1,1;0;0;0;
670ENDPROC
680:
690DEFFNS
700="ASC2Mes"
710:
720DEFPROCx
730z%=6
740aa%=3
750ba%=3
760ca%=7
770da%=7
780k%=7
790ea%=3
800fa%=2
810ga%=3
820l%=7
830ha%=3
840ia%=7
850ENDPROC
860:
870DEFPROCy
880LOCALja%
890VDU26,12
900PRINT" ";CHR$(144+z%);"¶/
//////%¶/////////////////¶";
910PRINTCHR$(144+z%);"¶///////////*///
///// ";CHR$(144+z%);"¶";
920PRINTCHR$(144+z%);"¶";CHR$(144+aa%)
;"jk 74$5 j£`p`pj 0 0p0p`p ";C
HR$(144+z%);"¶";
930PRINTCHR$(144+z%);"¶";CHR$(144+aa%)
;"jk"!7457 "kjjj$j!545=55j. ";C
HR$(144+z%);"¶";
940PRINTCHR$(144+z%);";""£ £ !£! "£"£" "!££!!!!"£ ";C
HR$(145);" ";
950FORja%=1TO18
960PRINTCHR$(144+z%);"¶";SPC(36);CHR$(
144+z%);"¶";
970NEXT
980PRINTCHR$(144+z%);"¶|||||||||||||||
||||||||||||||||||||||¶";
990VDU28,2,22,37,5
1000ENDPROC
1010:
1020DEFPROCg($u%)
1030LOCALX%,Y%
1040X%=u%MOD256
1050Y%=u%DIV256
1060CALL&FFF7
1070ENDPROC
1080:
1090DEFFNe
1120PROCba
1130PRINT'CHR$(128+ca%);"Please insert
your submission disc"'CHR$(128+ca%);"(wh
ich should also contain the"'CHR$(128+ca
%);"message text file) into drive 0."
1140PRINT'CHR$(128+ca%);"Press A if thi
s disc is in ADFS"'CHR$(128+ca%);"format
, D if it is in DFS format or";CHR$(128+
ca%);"SPACE to use the current format. I
f";CHR$(128+ca%);"in doubt, press SPACE.
"
1150=FNka("AaDd ",FALSE)
1160:
1170DEFPROCj
1180REPEAT
1190PROCba
1200PRINT'CHR$(128+da%);"Please enter t
he filename of the"'CHR$(128+da%);"text:
";CHR$(128+ea%);
1210IFh%THENm$=FNea(1,37)ELSEm$=FNea(1,
12)
1220IFNOTFNla(m$)THENPRINT':PROCma(m$+"
does not exist.",da%):PRINT'CHR$(128+da
%);"Press SPACE to continue...":PROCna
1230UNTILFNla(m$)
1240ENDPROC
1250:
1260DEFFNka(oa$,pa%)
1270LOCALd$
1280REPEAT
1290*FX21
1300IFpa%THENd$=CHR$(GETAND&DF)ELSEd$=G
ET$
1310UNTILINSTR(oa$,d$)<>0
1320=d$
1330:
1340DEFPROCna
1350*FX21
1360REPEATUNTILGET=32
1370ENDPROC
1380:
1390DEFPROCk
1400LOCALqa%
1410qa%=OPENIN(m$)
1420ra$=FNsa(FNta(FNua(qa%)))
1430IFLEN(ra$)<>3THENCLOSE#qa%:PROCva("
Your ID is given as "+ra$+" which cannot
be correct since ID's have 3 digits."):
END
1440IFEOF#qa%THENCLOSE#qa%:PROCva("This
text file is far too short - it only co
ntains your user ID."):END
1450wa$=FNta(FNua(qa%))
1460IFLEN(wa$)>30THENwa$=LEFT$(wa$,30):
PROCxa("Your name is too long! I have sh
ortened it to "+wa$+".")
1470IFEOF#qa%THENCLOSE#qa%:PROCva("This
text file is far too short - it only co
ntains your name and user ID."):END
1480CLOSE#qa%
1490IFFNla("!Mesg")THENPROCyaELSEPROCza
1500ENDPROC
1510:
1520DEFPROCya
1530LOCALab%,bb%,d$,cb$
1540PROCba
1550ab%=OPENUP("!Mesg")
1560bb%=BGET#ab%
1570IFbb%>0THENCLOSE#ab%:PROCva("There
is a !Mesg file on this disc with a vers
ion numbr higher than 0."):END
1580PRINT'CHR$(128+k%);"There is alread
y a message file on"'CHR$(128+k%);"this
disc. Do you want to replace"'CHR$(128+k
%);"it (R) or add the new messages to"'C
HR$(128+k%);"it (A)?";CHR$(128+ea%);
1590d$=FNka("AR",TRUE):PRINTd$
1600IFd$="R"THENPRINT'CHR$(128+k%);"Are
you sure? (Y or N)";CHR$(128+ea%);:IFFN
dbTHENCLOSE#ab%:PRINT"Yes":PROCza:ENDPRO
C
1610IFd$="R"THENPRINT"No"''CHR$(128+k%)
;"I will add the new messages to the"'CH
R$(128+k%);"old ones."''CHR$(128+k%);"Pr
ess SPACE to continue...":PROCna
1620INPUT#ab%,cb$
1630IFcb$<>ra$THENCLOSE#ab%:PROCva("The
existing !Mesg file has a different sen
der ID ("+cb$+") to the text message fil
e ("+ra$+"). This should not occur - ple
ase correct the error."):END
1640INPUT#ab%,wa$
1650wa$=FNta(wa$)
1660eb%=PTR#ab%
1670CLOSE#ab%
1680ENDPROC
1690:
1700DEFFNta(fb$)
1710IFLEFT$(fb$,1)=" "THENREPEAT:fb$=MI
D$(fb$,2):UNTILLEFT$(fb$,1)<>" "ORfb$=""
1720IFRIGHT$(fb$,1)=" "THENREPEAT:fb$=L
EFT$(fb$,LEN(fb$)-1):UNTILRIGHT$(fb$,1)<
>" "ORfb$=""
1730=fb$
1740:
1750DEFPROCza
1760LOCALab%
1770ab%=OPENOUT("!Mesg")
1780BPUT#ab%,0
1790PRINT#ab%,ra$
1800PRINT#ab%,LEFT$(wa$+STRING$(20," ")
,20)
1810eb%=PTR#ab%
1820PRINT#ab%,0
1830CLOSE#ab%
1840ENDPROC
1850:
1860DEFFNua(ab%)
1870LOCALfb$
1880REPEAT
1890fb$=FNgb(ab%)
1900UNTILEOF#ab%ORFNta(fb$)<>""
1910=fb$
1920:
1930DEFFNgb(ab%)
1940LOCALfb$,hb%
1950fb$=""
1960REPEAT
1970hb%=BGET#ab%
1980IFhb%=13ORhb%=10ANDs%=-1THENs%=hb%:
t%=23-s%
1990IFhb%<>s%ANDhb%<>t%THENfb$=fb$+CHR$
(hb%)
2000UNTILhb%=s%OREOF#ab%ORLEN(fb$)>40
2010=fb$
2020:
2030DEFPROCl(ib$,jb$)
2040LOCALjb%,kb%,ib%,lb$,mb%
2050jb%=OPENIN(jb$)
2060PTR#jb%=eb%
2070INPUT#jb%,kb%
2080CLOSE#jb%
2090ib%=OPENIN(ib$)
2100lb$=FNua(ib%)
2110lb$=FNua(ib%)
2120mb%=1
2130REPEAT
2140IFkb%+mb%>r%THENCLOSE#ib%:PROCva("T
here is a limit of 25 messages in the !M
esg file and this has now been reached."
):END
2150PROCnb(mb%,ib$,jb$,ib%)
2160mb%=mb%+1
2170UNTILEOF#ib%
2180CLOSE#ib%
2190ENDPROC
2200:
2210DEFPROCnb(ob%,ib$,jb$,ib%)
2220LOCALpb$,qb$,rb$,sb%,tb%,ub$,vb%,wb
%,hb%,xb%,yb%,zb%
2230PROCba
2240pb$=FNta(FNua(ib%))
2250IFEOF#ib%THENCLOSE#ib%:PROCva("Mess
age "+STR$(ob%)+" is too short. Please e
ither finish or remove it."):END
2260IFLEN(pb$)>30THENpb$=LEFT$(pb$,30):
PROCxa("Message "+STR$(ob%)+" has a dest
ination which is too long. I will shorte
n it to "+pb$+".")
2270IFpb$="999"ANDLEN(pb$)=3THENpb$="99
9 (all members)"
2280IFLEFT$(pb$,3)="CCC"ORINSTR(FNsa(pb
$),"COMMENT")<>0THENpb$="Comment":qb$="C
CC"ELSEqb$=LEFT$(pb$,3)
2290rb$=FNta(FNua(ib%))
2300IFEOF#ib%THENCLOSE#ib%:PROCva("Mess
age "+STR$(ob%)+" is not complete. Pleas
e either finish or remove it."):END
2310IFLEN(rb$)>30THENrb$=LEFT$(rb$,30):
PROCxa("Message "+STR$(ob%)+" has a subj
ect which is too long. I will shorten it
to "+rb$+".")
2320PRINT
2330IFqb$="CCC"THENPROCma("Converting m
essage "+STR$(ob%)+", which is a program
comment on "+rb$+".",l%)ELSEPROCma("Con
verting message "+STR$(ob%)+", which is
a message to "+pb$+" about "+rb$+".",l%)
2340sb%=FNac(pb$,rb$)
2350tb%=PTR#ib%
2360ub$=FNta(FNua(ib%))
2370IFINSTR(ub$,"÷")<>0THENPROCbc(qb$,s
b%):ENDPROC
2380IFFNcc(ub$)THENub%=FNdc(ub$)ELSEub%
=128+ha%:PTR#ib%=tb%
2390vb%=FNec(ib%)
2400wb%=0
2410REPEAT
2420hb%=v%?wb%:wb%=wb%+1
2430UNTILhb%>32
2440IFhb%=126THENREPEAT:hb=v%?wb%:wb%=w
b%+1:UNTILhb%=s%ORwb%=vb%:PROCbc(qb$,sb%
):ENDPROC
2450wb%=wb%-1
2460REPEAT
2470w%?sb%=ub%
2480FORxb%=sb%+1TOsb%+39:w%?xb%=32:NEXT
2490sb%=sb%+1
2500yb%=1
2510zb%=-1
2520REPEAT
2530hb%=v%?wb%:wb%=wb%+1
2540IFhb%>=32ANDhb%<>126THENw%?sb%=hb%
2550IFhb%=32THENzb%=sb%
2560IFhb%<>t%:sb%=sb%+1:yb%=yb%+1
2570UNTILhb%=s%ORhb%=126ORwb%=vb%ORyb%=
40
2580IFyb%=40ANDzb%<>-1ANDhb%<>32ANDNOT(
hb%=s%ORhb%=126ORwb%=vb%)THENFORxb%=zb%+
1TOsb%-1:w%?xb%=32:NEXT:wb%=wb%-(sb%-zb%
-1)
2590IFhb%=s%THENsb%=sb%+(40-yb%)
2600UNTILhb%=126ORwb%=vb%ORsb%>=(q%-80)
2610IFsb%>=(q%-80)THENCLOSE#ib%:PROCva(
"Message "+STR$(ob%)+" takes more than t
he allowed space in teletext format. Ple
ase shorten or remove it."):END
2620IFhb%=126THENsb%=sb%-1
2630IFhb%=126ANDwb%<>vb%THENREPEAT:hb%=
v%?wb%:wb%=wb%+1:UNTILhb%=s%ORwb%=vb%
2640PTR#ib%=PTR#ib%-(vb%-wb%)
2650PROCbc(qb$,sb%)
2660ENDPROC
2670:
2680DEFFNec(ab%)
2690LOCALA%,X%,Y%
2700?u%=ab%
2710u%!1=v%
2720u%!5=q%
2730A%=4
2740X%=u%MOD256
2750Y%=u%DIV256
2760CALL&FFD1
2770=q%-u%!5
2780:
2790DEFFNcc(ub$)
2800LOCALfc$,lb%
2810ub$=FNsa(FNta(ub$))
2820RESTORE2970
2830REPEAT
2840READfc$,lb%
2850UNTILfc$="WHITE"ORub$=fc$
2860=(ub$=fc$)
2870:
2880DEFFNdc(ub$)
2890LOCALfc$,gc%
2900ub$=FNsa(FNta(ub$))
2910RESTORE2970
2920REPEAT
2930READfc$,gc%
2940UNTILfc$=ub$
2950=gc%
2960:
2970DATA RED,129,GREEN,130,YELLOW,131,B
LUE,132,MAGENTA,133,PURPLE,133,PINK,133,
CYAN,134,LIGHT BLUE,134,TURQUOISE,134,WH
ITE,135
2980:
2990DEFFNac(pb$,rb$)
3000LOCALxb%,hc%,ic%,jc$
3010FORxb%=0TO156STEP4
3020w%!xb%=&20202020
3030NEXT
3040hc%=128+fa%:ic%=128+ga%
3050IFwa$=""THENjc$=ra$ELSEjc$=ra$+" ("
+wa$+")"
3060IFpb$<>"Comment"THENPROCkc(CHR$(hc%
)+"To: "+CHR$(ic%)+pb$,w%):PROCkc(CH
R$(hc%)+"From: "+CHR$(ic%)+jc$,w%+40):
PROCkc(CHR$(hc%)+"Subject:"+CHR$(ic%)+rb
$,w%+80):=160
3070PROCkc(CHR$(hc%)+"From: "+CHR$(ic
%)+jc$,w%)
3080PROCkc(CHR$(hc%)+"Subject:"+CHR$(ic
%)+rb$,w%+40)
3090=120
3100:
3110DEFPROCba
3120CLS
3130PRINTTAB(2,0);CHR$(128+ba%);"Text t
o message converter 0.21"
3140ENDPROC
3150:
3160DEFFNf
3170LOCALA%,Y%
3180A%=0
3190Y%=0
3200=(USR(&FFDA)AND&FF)
3210:
3220DEFFNla(lc$)
3230LOCALab%
3240ab%=OPENIN(lc$)
3250IFab%=0THEN=FALSE
3260CLOSE#ab%
3270=TRUE
3280:
3290DEFFNsa(qa$)
3300LOCALmc$,nc%,oc%
3310mc$=""
3320FORnc%=1TOLEN(qa$)
3330oc%=ASC(MID$(qa$,nc%,1))
3340IFoc%>=ASC("a")ANDoc%<=ASC("z")THEN
oc%=oc%-32
3350mc$=mc$+CHR$(oc%)
3360NEXT
3370=mc$
3380:
3390DEFFNea(pc%,qc%)
3400LOCALnc%,rc%,qa$,d%
3410nc%=POS
3420rc%=VPOS
3430qa$=""
3440REPEAT
3450REPEAT
3460*FX21
3470d%=GET
3480UNTILd%=13OR(d%>=32ANDd%<=127)
3490IFd%=127ANDLEN(qa$)>0THENVDU127:qa$
=LEFT$(qa$,LEN(qa$)-1)
3500IFd%<>127ANDd%<>13ANDLEN(qa$)<qc%TH
ENVDUd%:qa$=qa$+CHR$(d%)
3510UNTIL(d%=13ANDLEN(qa$)>=pc%)
3520=qa$
3530:
3540DEFPROCkc(sc$,tc%)
3550LOCALuc%
3560FORuc%=tc%TOtc%+LEN(sc$)-1
3570?uc%=ASC(MID$(sc$,uc%-tc%+1,1))
3580NEXT
3590ENDPROC
3600:
3610DEFPROCc
3620SOUND1,-10,101,5
3630ENDPROC
3640:
3650DEFPROCbc(vc$,sb%)
3660LOCALab%,A%,X%,Y%
3670w%?sb%=152
3680ab%=OPENUP("!Mesg")
3690PTR#ab%=eb%
3700INPUT#ab%,wc%
3710PTR#ab%=eb%
3720PRINT#ab%,wc%+1
3730PTR#ab%=EXT#ab%
3740PRINT#ab%,vc$
3750BPUT#ab%,0
3760u%?0=ab%
3770u%!1=w%
3780u%!5=sb%+1
3790A%=2
3800X%=u%MOD256
3810Y%=u%DIV256
3820CALL&FFD1
3830CLOSE#ab%
3840ENDPROC
3850:
3860DEFFNdb
3870LOCALd$
3880REPEAT
3890d$=CHR$(GETAND&DF)
3900UNTILd$="Y"ORd$="N"
3910=(d$="Y")
3920:
3930DEFPROCva(i$)
3940PROCba
3950PRINT
3960PROCma(i$,ia%)
3970PRINT'CHR$(128+ia%);"Press SPACE to
continue..."
3980PROCna
3990VDU26,12
4000PROCn
4010END
4020:
4030DEFPROCxa(xa$)
4040PROCba
4050PRINT
4060PROCma(xa$,ia%)
4070PRINT'CHR$(128+ia%);"Press SPACE to
continue..."
4080PROCna
4090ENDPROC
4100:
4110DEFPROCma(T$,C%)
4120REPEAT
4130IFLEN(T$)<36THENPRINTCHR$(128+C%);T
$;SPC(35-LEN(T$));:T$=""ELSEA%=INSTR(T$,
" ",37):A%=A%+(A%=0)*-36:REPEAT:A%=A%-1:
UNTILMID$(T$,A%,1)=" ":PRINTCHR$(128+C%)
;LEFT$(T$,A%-1);SPC(36-A%);:T$=MID$(T$,A
%+1)
4140UNTILT$=""
4150ENDPROC