8-Bit Software Online Conversion

ASCII to Message File - Listing

100: 120MODE7 130PROCa 140PROCb 150: 180ONERRORPROCc:d$=" ":GOTO200 190d$=FNe 200IFd$=" "ANDFNf=8THENd$="A" 210IFd$=" "ANDFNf<>8THENd$="D" 220IFd$="A"ORd$="a"THENPROCg("ADFS"):P ROCg("MOUNT 0"):h%=TRUE 230IFd$="D"ORd$="d"THENPROCg("DISC"):P ROCg("DRIVE 0"):h%=FALSE 240ONERRORMODE7:CLOSE#0:REPORT:PRINT" at line ";ERL:PROCi:END 250: 260PROCj 270PROCk 280PROCl(m$,"!Mesg") 290MODE7 300PROCi 310END 320: 330DEFPROCa 340*FX229,1 350*FX4,1 360PROCn 370ENDPROC 380: 390DEFPROCi 400PROCo 410*FX229,0 420*FX4,0 430ENDPROC 440: 450DEFPROCb 460ONERRORMODE7:CLOSE#0:REPORT:PRINT" at line ";ERL:PROCi:END 470p%=4096 480q%=25 490r%=-1:s%=-1 500DIMt%256,u%p%,v%p% 510PROCw 520PROCx 530ENDPROC 540: 550DEFPROCn 560VDU23,1,0;0;0;0; 570ENDPROC 580: 590DEFPROCo 600VDU23,1,1;0;0;0; 610ENDPROC 620: 630DEFFNS 640="ASC2Mes" 650: 660DEFPROCw 670y%=6 680z%=3 690aa%=3 700ba%=7 710ca%=7 720k%=7 730da%=3 740ea%=2 750fa%=3 760l%=7 770ga%=3 780ha%=7 790ENDPROC 800: 810DEFPROCx 820LOCALia% 830VDU26,12 840PRINT" ";CHR$(144+y%);"/ //////%/////////////////"; 850PRINTCHR$(144+y%);"///////////*/// ///// ";CHR$(144+y%);""; 860PRINTCHR$(144+y%);"";CHR$(144+z%); "jk 74$5 j£`p`pj 0 0p0p`p ";CH R$(144+y%);""; 870PRINTCHR$(144+y%);"";CHR$(144+z%); "jk"!7457 "kjjj$j!545=55j. ";CH R$(144+y%);""; 880PRINTCHR$(144+y%);" ";CHR$(144+z%); ""£ £ !£! "£"£" "!££!!!!"£ ";CH R$(145);" "; 890FORia%=1TO18 900PRINTCHR$(144+y%);"";SPC(36);CHR$( 144+y%);""; 910NEXT 920PRINTCHR$(144+y%);"||||||||||||||| ||||||||||||||||||||||"; 930VDU28,2,22,37,5 940ENDPROC 950: 960DEFPROCg($t%) 970LOCALX%,Y% 980X%=t%MOD256 990Y%=t%DIV256 1000CALL&FFF7 1010ENDPROC 1020: 1030DEFFNe 1060PROCaa 1070PRINT'CHR$(128+ba%);"Please insert your submission disc"'CHR$(128+ba%);"(wh ich should also contain the"'CHR$(128+ba %);"message text file) into drive 0." 1080PRINT'CHR$(128+ba%);"Press A if thi s disc is in ADFS"'CHR$(128+ba%);"format , D if it is in DFS format or";CHR$(128+ ba%);"SPACE to use the current format. I f";CHR$(128+ba%);"in doubt, press SPACE. " 1090=FNja("AaDd ",FALSE) 1100: 1110DEFPROCj 1120REPEAT 1130PROCaa 1140PRINT'CHR$(128+ca%);"Please enter t he filename of the"'CHR$(128+ca%);"text: ";CHR$(128+da%); 1150IFh%THENm$=FNda(1,10)ELSEm$=FNda(1, 7) 1160IFNOTFNka(m$)THENPRINT':PROCla(m$+" does not exist.",ca%):PRINT'CHR$(128+ca %);"Press SPACE to continue...":PROCma 1170UNTILFNka(m$) 1180ENDPROC 1190: 1200DEFFNja(na$,oa%) 1210LOCALd$ 1220REPEAT 1230*FX21 1240IFoa%THENd$=CHR$(GETAND&DF)ELSEd$=G ET$ 1250UNTILINSTR(na$,d$)<>0 1260=d$ 1270: 1280DEFPROCma 1290*FX21 1300REPEATUNTILGET=32 1310ENDPROC 1320: 1330DEFPROCk 1340LOCALpa% 1350pa%=OPENIN(m$) 1360qa$=FNra(FNsa(FNta(pa%))) 1370IFLEN(qa$)<>3THENCLOSE#pa%:PROCua(" Your ID is given as "+qa$+" which cannot be correct since ID's have 3 digits."): END 1380IFEOF#pa%THENCLOSE#pa%:PROCua("This text file is far too short - it only co ntains your user ID."):END 1390va$=FNsa(FNta(pa%)) 1400IFLEN(va$)>30THENva$=LEFT$(va$,30): PROCwa("Your name is too long! I have sh ortened it to "+va$+".") 1410IFEOF#pa%THENCLOSE#pa%:PROCua("This text file is far too short - it only co ntains your name and user ID."):END 1420CLOSE#pa% 1430IFFNka("!Mesg")THENPROCxaELSEPROCya 1440ENDPROC 1450: 1460DEFPROCxa 1470LOCALza%,ab%,d$,bb$ 1480PROCaa 1490za%=OPENUP("!Mesg") 1500ab%=BGET#za% 1510IFab%>0THENCLOSE#za%:PROCua("There is a !Mesg file on this disc with a vers ion numbr higher than 0."):END 1520PRINT'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+da%); 1530d$=FNja("AR",TRUE):PRINTd$ 1540IFd$="R"THENPRINT'CHR$(128+k%);"Are you sure? (Y or N)";CHR$(128+da%);:IFFN cbTHENCLOSE#za%:PRINT"Yes":PROCya:ENDPRO C 1550IFd$="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...":PROCma 1560INPUT#za%,bb$ 1570IFbb$<>qa$THENCLOSE#za%:PROCua("The existing !Mesg file has a different sen der ID ("+bb$+") to the text message fil e ("+qa$+"). This should not occur - ple ase correct the error."):END 1580INPUT#za%,va$ 1590va$=FNsa(va$) 1600db%=PTR#za% 1610CLOSE#za% 1620ENDPROC 1630: 1640DEFFNsa(eb$) 1650IFLEFT$(eb$,1)=" "THENREPEAT:eb$=MI D$(eb$,2):UNTILLEFT$(eb$,1)<>" "OReb$="" 1660IFRIGHT$(eb$,1)=" "THENREPEAT:eb$=L EFT$(eb$,LEN(eb$)-1):UNTILRIGHT$(eb$,1)< >" "OReb$="" 1670=eb$ 1680: 1690DEFPROCya 1700LOCALza% 1710za%=OPENOUT("!Mesg") 1720BPUT#za%,0 1730PRINT#za%,qa$ 1740PRINT#za%,LEFT$(va$+STRING$(20," ") ,20) 1750db%=PTR#za% 1760PRINT#za%,0 1770CLOSE#za% 1780ENDPROC 1790: 1800DEFFNta(za%) 1810LOCALeb$ 1820REPEAT 1830eb$=FNfb(za%) 1840UNTILEOF#za%ORFNsa(eb$)<>"" 1850=eb$ 1860: 1870DEFFNfb(za%) 1880LOCALeb$,gb% 1890eb$="" 1900REPEAT 1910gb%=BGET#za% 1920IFgb%=13ORgb%=10ANDr%=-1THENr%=gb%: s%=23-r% 1930IFgb%<>r%ANDgb%<>s%THENeb$=eb$+CHR$ (gb%) 1940UNTILgb%=r%OREOF#za%ORLEN(eb$)>40 1950=eb$ 1960: 1970DEFPROCl(hb$,ib$) 1980LOCALib%,jb%,hb%,kb$,lb% 1990ib%=OPENIN(ib$) 2000PTR#ib%=db% 2010INPUT#ib%,jb% 2020CLOSE#ib% 2030hb%=OPENIN(hb$) 2040kb$=FNta(hb%) 2050kb$=FNta(hb%) 2060lb%=1 2070REPEAT 2080IFjb%+lb%>q%THENCLOSE#hb%:PROCua("T here is a limit of 25 messages in the !M esg file and this has now been reached." ):END 2090PROCmb(lb%,hb$,ib$,hb%) 2100lb%=lb%+1 2110UNTILEOF#hb% 2120CLOSE#hb% 2130ENDPROC 2140: 2150DEFPROCmb(nb%,hb$,ib$,hb%) 2160LOCALob$,pb$,qb$,rb%,sb%,tb$,ub%,vb %,gb%,wb%,xb%,yb% 2170PROCaa 2180ob$=FNsa(FNta(hb%)) 2190IFEOF#hb%THENCLOSE#hb%:PROCua("Mess age "+STR$(nb%)+" is too short. Please e ither finish or remove it."):END 2200IFLEN(ob$)>30THENob$=LEFT$(ob$,30): PROCwa("Message "+STR$(nb%)+" has a dest ination which is too long. I will shorte n it to "+ob$+".") 2210IFob$="999"ANDLEN(ob$)=3THENob$="99 9 (all members)" 2220IFLEFT$(ob$,3)="CCC"ORFNra(ob$)="PR OGRAM COMMENT"THENob$="Program comment": pb$="CCC"ELSEpb$=LEFT$(ob$,3) 2230qb$=FNsa(FNta(hb%)) 2240IFEOF#hb%THENCLOSE#hb%:PROCua("Mess age "+STR$(nb%)+" is not complete. Pleas e either finish or remove it."):END 2250IFLEN(qb$)>30THENqb$=LEFT$(qb$,30): PROCwa("Message "+STR$(nb%)+" has a subj ect which is too long. I will shorten it to "+qb$+".") 2260PRINT 2270IFpb$="CCC"THENPROCla("Converting m essage "+STR$(nb%)+", which is a program comment on "+qb$+".",l%)ELSEPROCla("Con verting message "+STR$(nb%)+", which is a message to "+ob$+" about "+qb$+".",l%) 2280rb%=FNzb(ob$,qb$) 2290sb%=PTR#hb% 2300tb$=FNsa(FNta(hb%)) 2310IFINSTR(tb$,"~")<>0THENPROCac(pb$,r b%):ENDPROC 2320IFFNbc(tb$)THENtb%=FNcc(tb$)ELSEtb% =128+ga%:PTR#hb%=sb% 2330ub%=FNdc(hb%) 2340vb%=0 2350REPEAT 2360gb%=u%?vb%:vb%=vb%+1 2370UNTILgb%>32 2380IFgb%=126THENREPEAT:gb=u%?vb%:vb%=v b%+1:UNTILgb%=r%ORvb%=ub%:PROCac(pb$,rb% ):ENDPROC 2390vb%=vb%-1 2400REPEAT 2410v%?rb%=tb% 2420FORwb%=rb%+1TOrb%+39:v%?wb%=32:NEXT 2430rb%=rb%+1 2440xb%=1 2450yb%=-1 2460REPEAT 2470gb%=u%?vb%:vb%=vb%+1 2480IFgb%>=32ANDgb%<>126THENv%?rb%=gb% 2490IFgb%=32THENyb%=rb% 2500IFgb%<>s%:rb%=rb%+1:xb%=xb%+1 2510UNTILgb%=r%ORgb%=126ORvb%=ub%ORxb%= 40 2520IFxb%=40ANDyb%<>-1ANDgb%<>32ANDNOT( gb%=r%ORgb%=126ORvb%=ub%)THENFORwb%=yb%+ 1TOrb%-1:v%?wb%=32:NEXT:vb%=vb%-(rb%-yb% -1) 2530IFgb%=r%THENrb%=rb%+(40-xb%) 2540UNTILgb%=126ORvb%=ub%ORrb%>=(p%-80) 2550IFrb%>=(p%-80)THENCLOSE#hb%:PROCua( "Message "+STR$(nb%)+" takes more than t he allowed space in teletext format. Ple ase shorten or remove it."):END 2560IFgb%=126THENrb%=rb%-1 2570IFgb%=126ANDvb%<>ub%THENREPEAT:gb%= u%?vb%:vb%=vb%+1:UNTILgb%=r%ORvb%=ub% 2580PTR#hb%=PTR#hb%-(ub%-vb%) 2590PROCac(pb$,rb%) 2600ENDPROC 2610: 2620DEFFNdc(za%) 2630LOCALA%,X%,Y% 2640?t%=za% 2650t%!1=u% 2660t%!5=p% 2670A%=4 2680X%=t%MOD256 2690Y%=t%DIV256 2700CALL&FFD1 2710=p%-t%!5 2720: 2730DEFFNbc(tb$) 2740LOCALec$,kb% 2750tb$=FNra(FNsa(tb$)) 2760RESTORE2910 2770REPEAT 2780READec$,kb% 2790UNTILec$="WHITE"ORtb$=ec$ 2800=(tb$=ec$) 2810: 2820DEFFNcc(tb$) 2830LOCALec$,fc% 2840tb$=FNra(FNsa(tb$)) 2850RESTORE2910 2860REPEAT 2870READec$,fc% 2880UNTILec$=tb$ 2890=fc% 2900: 2910DATA 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 2920: 2930DEFFNzb(ob$,qb$) 2940LOCALwb%,gc%,hc%,ic$ 2950FORwb%=0TO156STEP4 2960v%!wb%=&20202020 2970NEXT 2980gc%=128+ea%:hc%=128+fa% 2990IFva$=""THENic$=qa$ELSEic$=qa$+" (" +va$+")" 3000IFob$<>"Program comment"THENPROCjc( CHR$(gc%)+"To: "+CHR$(hc%)+ob$,v%):P ROCjc(CHR$(gc%)+"From: "+CHR$(hc%)+ic$ ,v%+40):PROCjc(CHR$(gc%)+"Subject:"+CHR$ (hc%)+qb$,v%+80):=160 3010PROCjc(CHR$(gc%)+"From: "+CHR$(hc %)+ic$,v%) 3020PROCjc(CHR$(gc%)+"Program:"+CHR$(hc %)+qb$,v%+40) 3030=120 3040: 3050DEFPROCaa 3060CLS 3070PRINTTAB(2,0);CHR$(128+aa%);"Text t o message converter 0.20" 3080ENDPROC 3090: 3100DEFFNf 3110LOCALA%,Y% 3120A%=0 3130Y%=0 3140=(USR(&FFDA)AND&FF) 3150: 3160DEFFNka(kc$) 3170LOCALza% 3180za%=OPENIN(kc$) 3190IFza%=0THEN=FALSE 3200CLOSE#za% 3210=TRUE 3220: 3230DEFFNra(pa$) 3240LOCALlc$,mc%,nc% 3250lc$="" 3260FORmc%=1TOLEN(pa$) 3270nc%=ASC(MID$(pa$,mc%,1)) 3280IFnc%>=ASC("a")ANDnc%<=ASC("z")THEN nc%=nc%-32 3290lc$=lc$+CHR$(nc%) 3300NEXT 3310=lc$ 3320: 3330DEFFNda(oc%,pc%) 3340LOCALmc%,qc%,pa$,d% 3350mc%=POS 3360qc%=VPOS 3370pa$="" 3380REPEAT 3390REPEAT 3400*FX21 3410d%=GET 3420UNTILd%=13OR(d%>=32ANDd%<=127) 3430IFd%=127ANDLEN(pa$)>0THENVDU127:pa$ =LEFT$(pa$,LEN(pa$)-1) 3440IFd%<>127ANDd%<>13ANDLEN(pa$)<pc%TH ENVDUd%:pa$=pa$+CHR$(d%) 3450UNTIL(d%=13ANDLEN(pa$)>=oc%) 3460=pa$ 3470: 3480DEFPROCjc(rc$,sc%) 3490LOCALtc% 3500FORtc%=sc%TOsc%+LEN(rc$)-1 3510?tc%=ASC(MID$(rc$,tc%-sc%+1,1)) 3520NEXT 3530ENDPROC 3540: 3550DEFPROCc 3560SOUND1,-10,101,5 3570ENDPROC 3580: 3590DEFPROCac(uc$,rb%) 3600LOCALza%,A%,X%,Y% 3610v%?rb%=152 3620za%=OPENUP("!Mesg") 3630PTR#za%=db% 3640INPUT#za%,vc% 3650PTR#za%=db% 3660PRINT#za%,vc%+1 3670PTR#za%=EXT#za% 3680PRINT#za%,uc$ 3690BPUT#za%,0 3700t%?0=za% 3710t%!1=v% 3720t%!5=rb%+1 3730A%=2 3740X%=t%MOD256 3750Y%=t%DIV256 3760CALL&FFD1 3770CLOSE#za% 3780ENDPROC 3790: 3800DEFFNcb 3810LOCALd$ 3820REPEAT 3830d$=CHR$(GETAND&DF) 3840UNTILd$="Y"ORd$="N" 3850=(d$="Y") 3860: 3870DEFPROCua(wc$) 3880PROCaa 3890PRINT 3900PROCla(wc$,ha%) 3910PRINT'CHR$(128+ha%);"Press SPACE to continue..." 3920PROCma 3930VDU26,12 3940PROCi 3950END 3960: 3970DEFPROCwa(wa$) 3980PROCaa 3990PRINT 4000PROCla(wa$,ha%) 4010PRINT'CHR$(128+ha%);"Press SPACE to continue..." 4020PROCma 4030ENDPROC 4040: 4050DEFPROCla(T$,C%) 4060REPEAT 4070IFLEN(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) 4080UNTILT$="" 4090ENDPROC