8-Bit Software Online Conversion

Message Sizer - Listing

10REM ><BasicSave$Dir>.MsgSize 20REM by Steven Flintham 30REM 40REM Version 0.10 50REM based on SendMes 2.11 60REM 70REM Saturday 1st November 1997 80REM Tuesday 4th November 1997 90REM Thursday 6th November 1997 100: 110MODE 7 120PROCinit 130: 140REM Get the submission disc - this involves unpleasant code because of 150REM the error trapping required 160ON ERROR VDU 3:PROCoscli("FX3"):CLO SE #0:MODE 7:IF ERR=17 THEN PROCenable:E ND ELSE REPORT:PRINT " at line ";ERL:PRO Cenable:END 170*FX229 180fs$=FNprompt`sub`disc 190*FX229,1 200ON ERROR PROCbeep:fs$=" ":GOTO 210 210IF fs$=" " AND FNfs=4 THEN fs$="D" 220IF fs$=" " AND FNfs=8 THEN fs$="A" 230IF fs$="A" THEN PROCinit`adfs 240IF fs$="D" THEN PROCinit`dfs 250ON ERROR VDU 3:PROCoscli("FX3"):CLO SE #0:MODE 7:IF ERR=17 THEN PROCenable:E ND ELSE REPORT:PRINT " at line ";ERL:PRO Cenable:END 260*FX229 270: 280IF NOT FNexist("!Mesg") THEN PROCfa tal("There is no message file on this di sc to resize.") 290IF FNexist("!MesgX") THEN PROCfatal ("There is already a !MesgX file on this disc.") 300PROCvalidate`and`read`mesg`file 310DIM to`list$(max`mesg%-1), deleted% (max`mesg%-1) 320PROCcache`message`data 330new`max`mesg%=FNget`new`size 340*FX229,1 350ON ERROR CLOSE #0:PROCproblem("An e rror has occurred while changing the siz e of the message file."):MODE 7:REPORT:P RINT " at line ";ERL:PROCenable:END 360PROCresize`message`file(new`max`mes g%) 370*Delete !Mesg 380*Rename !MesgX !Mesg 390: 400MODE 7 410PROCenable 420END 430: 440DEF PROCdisable 450*FX229,1 460*FX4,1 470ENDPROC 480: 490DEF PROCenable 500*FX118 510*FX229 520*FX4 530ENDPROC 540: 550DEF PROCinit 560ON ERROR MODE 7:REPORT:PRINT " at l ine ";ERL:PROCenable:END 570CLOSE #0 580PROCdisable 590PROCcursor`off 600PROCinit`colours 610PROCinit`screen 620DIM block% 32, message% 4096 630ENDPROC 640: 650DEF FNS="MsgSize" 660: 670DEF PROCinit`adfs 680*ADFS 690*MOUNT 0 700*DIR $ 710ENDPROC 720: 730DEF PROCinit`dfs 740*DISC 750*DRIVE 0 760*DIR $ 770ENDPROC 780: 790DEF PROCcursor`off 800VDU 23,1,0;0;0;0; 810ENDPROC 820: 830DEF PROCcursor`on 840VDU 23,1,1;0;0;0; 850ENDPROC 860: 870DEF PROCoscli($block%) 880LOCAL X%,Y% 890X%=block% MOD 256 900Y%=block% DIV 256 910CALL &FFF7 920ENDPROC 930: 940DEF PROCinit`colours 950border%=150 960heading%=147 970text%=135 980input%=131 990ENDPROC 1000: 1010DEF PROCinit`screen 1020LOCAL repeat% 1030VDU 26,12 1040PRINTTAB(0,23);CHR$(border%);"|||| |||||||||||||||||||||||||||||||||"; 1050VDU 30,11,30 1060PRINT " ";CHR$(border%);" ///////%/////////////////"; 1070PRINT CHR$(border%);"///////////*/ /////// ";CHR$(border%);" "; 1080PRINT CHR$(border%);"";CHR$(headin g%);"6£4 7i(h0 6) 0`$t` ` 0 0` ";CHR$(border%);""; 1090PRINT CHR$(border%);"";CHR$(headin g%);"6£4!7ijj 2ijjj!5jhj`nj =! ";CHR$(border%);""; 1100PRINT CHR$(border%);" ";CHR$(headin g%);""£ £!" ! "! !" " !! £" "! " 1110FOR repeat%=1 TO 19 1120PRINT CHR$(border%);"";SPC(36);CHR $(border%);""; 1130NEXT 1140PRINTTAB(5,5);CHR$(heading%-16);"8B S message file resizer 0.10" 1150VDU 28,2,23,37,7 1160ENDPROC 1170: 1180DEF PROCprint(T$) 1190PROCpretty`print(T$,text%,TRUE) 1200ENDPROC 1210: 1220REM N%=TRUE means go onto a new lin e afterwards 1230DEF PROCpretty`print(T$,C%,N%) 1240REPEAT 1250IF LEN(T$)<36 THEN PRINT CHR$(C%);T $;SPC((35-LEN(T$))*-N%);:T$="" ELSE A%=I NSTR(T$," ",37):A%=A%+(A%=0)*-36:REPEAT: A%=A%-1:UNTIL MID$(T$,A%,1)=" ":PRINT CH R$(C%);LEFT$(T$,A%-1);SPC(36-A%);:T$=MID $(T$,A%+1) 1260UNTIL T$="" 1270ENDPROC 1280: 1290DEF PROCproblem(error$) 1300CLS 1310PROCprint(error$) 1320PRINT'CHR$(text%);"Press SPACE to c ontinue..." 1330*FX21 1340REPEAT UNTIL GET=32 1350ENDPROC 1360: 1370DEF PROCfatal(error$) 1380CLS 1390PROCprint(error$) 1400PRINT'CHR$(text%);"Press SPACE to r eturn to BASIC" 1410*FX21 1420REPEAT UNTIL GET=32 1430VDU 26,12 1440PROCcursor`on 1450PROCenable 1460END 1470: 1480DEF FNprompt`sub`disc 1490LOCAL key%,key$ 1500CLS 1510PROCprint("Please insert your submi ssion disc in drive 0. This disc should remain in the drive at all times when yo u are using this program.") 1520PRINT 1530PROCprint("When you have done this, press A if it is an ADFS disc, D if it is a DFS disc or SPACE to use the curren t filing system.") 1540PRINT 1550PROCprint("If in doubt, just press SPACE.") 1560REPEAT 1570*FX21 1580key%=GET 1590key$=CHR$((key% AND &DF)-32*(key%=3 2)) 1600UNTIL INSTR(" AD",key$)<>0 1610=key$ 1620: 1630DEF FNfs 1640LOCAL A%,Y% 1650A%=0 1660Y%=0 1670=(USR(&FFDA) AND &FF) 1680: 1690DEF PROCbeep 1700SOUND 1,-10,52,5 1710ENDPROC 1720: 1730DEF FNexist(fname$) 1740LOCAL chan% 1750chan%=OPENIN(fname$) 1760IF chan%<>0 THEN CLOSE #chan% 1770=(chan%<>0) 1780: 1790DEF PROCvalidate`and`read`mesg`file 1800LOCAL chan%,version%,discard$ 1810CLS 1820PRINT CHR$(text%);"Please wait, sca nning messages..." 1830chan%=OPENIN("!Mesg") 1840version%=BGET #chan% 1850IF version%<>1 THEN PROCfatal("The !Mesg file on this disc is a version "+S TR$(version%)+" file. This program can o nly handle version 1 files.") 1860INPUT #chan%,discard$ 1870INPUT #chan%,discard$ 1880max`mesg%=(EXT #chan%-256)/4096 1890IF ((EXT #chan%-256) MOD 4096)<>0 O R max`mesg%<5 OR max`mesg%>25 THEN PROCf atal("The !Mesg file is an unacceptable size.") 1900CLOSE #chan% 1910ENDPROC 1920: 1930DEF FNget`new`size 1940LOCAL s$,min%,new`max`mesg% 1950CLS 1960IF num`mesg%=1 THEN s$="" ELSE s$=" s" 1970PROCprint("This message file has ro om for "+STR$(max`mesg%)+" messages and contains "+STR$(num`mesg%)+" message"+s$ +" at present.") 1980IF num`mesg%<5 THEN min%=5 ELSE min %=num`mesg% 1990REPEAT 2000PRINT' 2010PROCprint("How many messages do you wish to have room for in the message fi le?") 2020PRINT'CHR$(text%);"Messages (";min% ;"-25):";CHR$(input%); 2030new`max`mesg%=VAL(FNinput(1,2,"")) 2040UNTIL new`max`mesg%>=min% AND new`m ax`mesg%<=25 2050=new`max`mesg% 2060: 2070DEF FNinput(min%,max%,text$) 2080LOCAL xpos%,ypos%,key% 2090xpos%=POS 2100ypos%=VPOS 2110PRINT LEFT$(text$+STRING$(max%,".") ,max%);TAB(xpos%+LEN(text$),ypos%); 2120REPEAT 2130REPEAT 2140*FX21 2150key%=GET 2160UNTIL key%=13 OR (key%>=32 AND key% <=127) 2170IF key%=127 AND LEN(text$)>0 THEN V DU 8,46,8:text$=LEFT$(text$,LEN(text$)-1 ) 2180IF key%<>127 AND key%<>13 AND LEN(t ext$)<max% THEN VDU key%:text$=text$+CHR $(key%) 2190UNTIL (key%=13 AND LEN(text$)>=min% ) 2200=text$ 2210: 2220DEF PROCresize`message`file(new`max `mesg%) 2230LOCAL in%,out%,string$,create%,to%, from% 2240CLS:PRINT CHR$(text%);"Please wait, resizing file..." 2250in%=OPENIN("!Mesg") 2260out%=OPENOUT("!MesgX") 2270BPUT #out%,BGET #in%:REM version by te 2280INPUT #in%,string$:PRINT #out%,stri ng$:REM sender ID 2290INPUT #in%,string$:PRINT #out%,stri ng$:REM sender name 2300FOR create%=0 TO new`max`mesg%-1 2310PTR #out%=256+create%*4096 2320PRINT #out%,"XXX" 2330BPUT #out%,1 2340NEXT 2350PTR #out%=256+new`max`mesg%*4096 2360to%=0 2370FOR from%=0 TO max`mesg%-1 2380IF deleted%(from%)=0 THEN PROCcopy` message(in%,from%,out%,to%):to%=to%+1 2390NEXT 2400CLOSE #in% 2410CLOSE #out% 2420ENDPROC 2430: 2440DEF PROCcopy`message(in%,from%,out% ,to%) 2450LOCAL A%,X%,Y% 2460block%?0=in% 2470block%!1=message% 2480block%!5=4096 2490block%!9=256+from%*4096 2500A%=3:X%=block% MOD 256:Y%=block% DI V 256:CALL &FFD1 2510block%?0=out% 2520block%!1=message% 2530block%!5=4096 2540block%!9=256+to%*4096 2550A%=1:X%=block% MOD 256:Y%=block% DI V 256:CALL &FFD1 2560ENDPROC 2570: 2580DEF PROCcache`message`data 2590LOCAL chan%,read%,to$,discard% 2600chan%=OPENIN("!Mesg") 2610FOR read%=0 TO max`mesg%-1 2620PTR #chan%=256+read%*4096 2630INPUT #chan%,to$ 2640deleted%(read%)=BGET #chan% 2650IF deleted%(read%)<>1 THEN to`list$ (read%)=to$ 2660NEXT 2670CLOSE #chan% 2680num`mesg%=FNnum`messages 2690ENDPROC 2700: 2710DEF FNnum`messages 2720LOCAL num`mesg%,read% 2730num`mesg%=0 2740FOR read%=0 TO max`mesg%-1 2750IF deleted%(read%)=0 THEN num`mesg% =num`mesg%+1 2760NEXT 2770=num`mesg%