10 REM ><BasicSave$Dir>.MsgSize
   20 REM by Steven Flintham
   30 REM
   40 REM Version 0.10
   50 REM based on SendMes 2.11
   60 REM
   70 REM Saturday 1st November 1997
   80 REM Tuesday 4th November 1997
   90 REM Thursday 6th November 1997
  100 :
  110 MODE 7
  120 PROCinit
  130 :
  140 REM Get the submission disc - this involves unpleasant code because of
  150 REM the error trapping required
  160 ON ERROR VDU 3:PROCoscli("FX3"):CLOSE #0:MODE 7:IF ERR=17 THEN PROCenable:END ELSE REPORT:PRINT " at line ";ERL:PROCenable:END
  170 *FX229
  180 fs$=FNprompt_sub_disc
  190 *FX229,1
  200 ON ERROR PROCbeep:fs$=" ":GOTO 210
  210 IF fs$=" " AND FNfs=4 THEN fs$="D"
  220 IF fs$=" " AND FNfs=8 THEN fs$="A"
  230 IF fs$="A" THEN PROCinit_adfs
  240 IF fs$="D" THEN PROCinit_dfs
  250 ON ERROR VDU 3:PROCoscli("FX3"):CLOSE #0:MODE 7:IF ERR=17 THEN PROCenable:END ELSE REPORT:PRINT " at line ";ERL:PROCenable:END
  260 *FX229
  270 :
  280 IF NOT FNexist("!Mesg") THEN PROCfatal("There is no message file on this disc to resize.")
  290 IF FNexist("!MesgX") THEN PROCfatal("There is already a !MesgX file on this disc.")
  300 PROCvalidate_and_read_mesg_file
  310 DIM to_list$(max_mesg%-1), deleted%(max_mesg%-1)
  320 PROCcache_message_data
  330 new_max_mesg%=FNget_new_size
  340 *FX229,1
  350 ON ERROR CLOSE #0:PROCproblem("An error has occurred while changing the size of the message file."):MODE 7:REPORT:PRINT " at line ";ERL:PROCenable:END
  360 PROCresize_message_file(new_max_mesg%)
  370 *Delete !Mesg
  380 *Rename !MesgX !Mesg
  390 :
  400 MODE 7
  410 PROCenable
  420 END
  430 :
  440 DEF PROCdisable
  450 *FX229,1
  460 *FX4,1
  470 ENDPROC
  480 :
  490 DEF PROCenable
  500 *FX118
  510 *FX229
  520 *FX4
  530 ENDPROC
  540 :
  550 DEF PROCinit
  560 ON ERROR MODE 7:REPORT:PRINT " at line ";ERL:PROCenable:END
  570 CLOSE #0
  580 PROCdisable
  590 PROCcursor_off
  600 PROCinit_colours
  610 PROCinit_screen
  620 DIM block% 32, message% 4096
  630 ENDPROC
  640 :
  650 DEF FNS="MsgSize"
  660 :
  670 DEF PROCinit_adfs
  680 *ADFS
  690 *MOUNT 0
  700 *DIR $
  710 ENDPROC
  720 :
  730 DEF PROCinit_dfs
  740 *DISC
  750 *DRIVE 0
  760 *DIR $
  770 ENDPROC
  780 :
  790 DEF PROCcursor_off
  800 VDU 23,1,0;0;0;0;
  810 ENDPROC
  820 :
  830 DEF PROCcursor_on
  840 VDU 23,1,1;0;0;0;
  850 ENDPROC
  860 :
  870 DEF PROCoscli($block%)
  880 LOCAL X%,Y%
  890 X%=block% MOD 256
  900 Y%=block% DIV 256
  910 CALL &FFF7
  920 ENDPROC
  930 :
  940 DEF PROCinit_colours
  950 border%=150
  960 heading%=147
  970 text%=135
  980 input%=131
  990 ENDPROC
 1000 :
 1010 DEF PROCinit_screen
 1020 LOCAL repeat%
 1030 VDU 26,12
 1040 PRINTTAB(0,23);CHR$(border%);"ÿüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüüÿ";
 1050 VDU 30,11,30
 1060 PRINT "           ";CHR$(border%);"ÿ¯¯¯¯¯¯¯¥ÿ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ÿ";
 1070 PRINT CHR$(border%);"ÿ¯¯¯¯¯¯¯¯¯¯¯ª¯¯¯¯¯¯¯¯                ";CHR$(border%);"ÿ";
 1080 PRINT CHR$(border%);"ÿ";CHR$(heading%);"¶£Ž ·éšè° ¶© °à€ôà à ° °à          ";CHR$(border%);"ÿ";
 1090 PRINT CHR$(border%);"ÿ";CHR$(heading%);"¶£Ž¡·éêê  ²éêê꡵êèêàîê œ¡         ";CHR$(border%);"ÿ";
 1100 PRINT CHR$(border%);"";CHR$(heading%);"¢£  £¡¢ ¡ ¢¡ ¡¢ ¢ ¡¡ £¢ ¢¡         "
 1110 FOR repeat%=1 TO 19
 1120 PRINT CHR$(border%);"ÿ";SPC(36);CHR$(border%);"ÿ";
 1130 NEXT
 1140 PRINTTAB(5,5);CHR$(heading%-16);"8BS message file resizer 0.10"
 1150 VDU 28,2,23,37,7
 1160 ENDPROC
 1170 :
 1180 DEF PROCprint(T$)
 1190 PROCpretty_print(T$,text%,TRUE)
 1200 ENDPROC
 1210 :
 1220 REM N%=TRUE means go onto a new line afterwards
 1230 DEF PROCpretty_print(T$,C%,N%)
 1240 REPEAT
 1250 IF LEN(T$)<36 THEN PRINT CHR$(C%);T$;SPC((35-LEN(T$))*-N%);:T$="" ELSE A%=INSTR(T$," ",37):A%=A%+(A%=0)*-36:REPEAT:A%=A%-1:UNTIL MID$(T$,A%,1)=" ":PRINT CHR$(C%);LEFT$(T$,A%-1);SPC(36-A%);:T$=MID$(T$,A%+1)
 1260 UNTIL T$=""
 1270 ENDPROC
 1280 :
 1290 DEF PROCproblem(error$)
 1300 CLS
 1310 PROCprint(error$)
 1320 PRINT'CHR$(text%);"Press SPACE to continue..."
 1330 *FX21
 1340 REPEAT UNTIL GET=32
 1350 ENDPROC
 1360 :
 1370 DEF PROCfatal(error$)
 1380 CLS
 1390 PROCprint(error$)
 1400 PRINT'CHR$(text%);"Press SPACE to return to BASIC"
 1410 *FX21
 1420 REPEAT UNTIL GET=32
 1430 VDU 26,12
 1440 PROCcursor_on
 1450 PROCenable
 1460 END
 1470 :
 1480 DEF FNprompt_sub_disc
 1490 LOCAL key%,key$
 1500 CLS
 1510 PROCprint("Please insert your submission disc in drive 0. This disc should remain in the drive at all times when you are using this program.")
 1520 PRINT
 1530 PROCprint("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 current filing system.")
 1540 PRINT
 1550 PROCprint("If in doubt, just press SPACE.")
 1560 REPEAT
 1570 *FX21
 1580 key%=GET
 1590 key$=CHR$((key% AND &DF)-32*(key%=32))
 1600 UNTIL INSTR(" AD",key$)<>0
 1610 =key$
 1620 :
 1630 DEF FNfs
 1640 LOCAL A%,Y%
 1650 A%=0
 1660 Y%=0
 1670 =(USR(&FFDA) AND &FF)
 1680 :
 1690 DEF PROCbeep
 1700 SOUND 1,-10,52,5
 1710 ENDPROC
 1720 :
 1730 DEF FNexist(fname$)
 1740 LOCAL chan%
 1750 chan%=OPENIN(fname$)
 1760 IF chan%<>0 THEN CLOSE #chan%
 1770 =(chan%<>0)
 1780 :
 1790 DEF PROCvalidate_and_read_mesg_file
 1800 LOCAL chan%,version%,discard$
 1810 CLS
 1820 PRINT CHR$(text%);"Please wait, scanning messages..."
 1830 chan%=OPENIN("!Mesg")
 1840 version%=BGET #chan%
 1850 IF version%<>1 THEN PROCfatal("The !Mesg file on this disc is a version "+STR$(version%)+" file. This program can only handle version 1 files.")
 1860 INPUT #chan%,discard$
 1870 INPUT #chan%,discard$
 1880 max_mesg%=(EXT #chan%-256)/4096
 1890 IF ((EXT #chan%-256) MOD 4096)<>0 OR max_mesg%<5 OR max_mesg%>25 THEN PROCfatal("The !Mesg file is an unacceptable size.")
 1900 CLOSE #chan%
 1910 ENDPROC
 1920 :
 1930 DEF FNget_new_size
 1940 LOCAL s$,min%,new_max_mesg%
 1950 CLS
 1960 IF num_mesg%=1 THEN s$="" ELSE s$="s"
 1970 PROCprint("This message file has room for "+STR$(max_mesg%)+" messages and contains "+STR$(num_mesg%)+" message"+s$+" at present.")
 1980 IF num_mesg%<5 THEN min%=5 ELSE min%=num_mesg%
 1990 REPEAT
 2000 PRINT'
 2010 PROCprint("How many messages do you wish to have room for in the message file?")
 2020 PRINT'CHR$(text%);"Messages (";min%;"-25):";CHR$(input%);
 2030 new_max_mesg%=VAL(FNinput(1,2,""))
 2040 UNTIL new_max_mesg%>=min% AND new_max_mesg%<=25
 2050 =new_max_mesg%
 2060 :
 2070 DEF FNinput(min%,max%,text$)
 2080 LOCAL xpos%,ypos%,key%
 2090 xpos%=POS
 2100 ypos%=VPOS
 2110 PRINT LEFT$(text$+STRING$(max%,"."),max%);TAB(xpos%+LEN(text$),ypos%);
 2120 REPEAT
 2130 REPEAT
 2140 *FX21
 2150 key%=GET
 2160 UNTIL key%=13 OR (key%>=32 AND key%<=127)
 2170 IF key%=127 AND LEN(text$)>0 THEN VDU 8,46,8:text$=LEFT$(text$,LEN(text$)-1)
 2180 IF key%<>127 AND key%<>13 AND LEN(text$)<max% THEN VDU key%:text$=text$+CHR$(key%)
 2190 UNTIL (key%=13 AND LEN(text$)>=min%)
 2200 =text$
 2210 :
 2220 DEF PROCresize_message_file(new_max_mesg%)
 2230 LOCAL in%,out%,string$,create%,to%,from%
 2240 CLS:PRINT CHR$(text%);"Please wait, resizing file..."
 2250 in%=OPENIN("!Mesg")
 2260 out%=OPENOUT("!MesgX")
 2270 BPUT #out%,BGET #in%:REM version byte
 2280 INPUT #in%,string$:PRINT #out%,string$:REM sender ID
 2290 INPUT #in%,string$:PRINT #out%,string$:REM sender name
 2300 FOR create%=0 TO new_max_mesg%-1
 2310 PTR #out%=256+create%*4096
 2320 PRINT #out%,"XXX"
 2330 BPUT #out%,1
 2340 NEXT
 2350 PTR #out%=256+new_max_mesg%*4096
 2360 to%=0
 2370 FOR from%=0 TO max_mesg%-1
 2380 IF deleted%(from%)=0 THEN PROCcopy_message(in%,from%,out%,to%):to%=to%+1
 2390 NEXT
 2400 CLOSE #in%
 2410 CLOSE #out%
 2420 ENDPROC
 2430 :
 2440 DEF PROCcopy_message(in%,from%,out%,to%)
 2450 LOCAL A%,X%,Y%
 2460 block%?0=in%
 2470 block%!1=message%
 2480 block%!5=4096
 2490 block%!9=256+from%*4096
 2500 A%=3:X%=block% MOD 256:Y%=block% DIV 256:CALL &FFD1
 2510 block%?0=out%
 2520 block%!1=message%
 2530 block%!5=4096
 2540 block%!9=256+to%*4096
 2550 A%=1:X%=block% MOD 256:Y%=block% DIV 256:CALL &FFD1
 2560 ENDPROC
 2570 :
 2580 DEF PROCcache_message_data
 2590 LOCAL chan%,read%,to$,discard%
 2600 chan%=OPENIN("!Mesg")
 2610 FOR read%=0 TO max_mesg%-1
 2620 PTR #chan%=256+read%*4096
 2630 INPUT #chan%,to$
 2640 deleted%(read%)=BGET #chan%
 2650 IF deleted%(read%)<>1 THEN to_list$(read%)=to$
 2660 NEXT
 2670 CLOSE #chan%
 2680 num_mesg%=FNnum_messages
 2690 ENDPROC
 2700 :
 2710 DEF FNnum_messages
 2720 LOCAL num_mesg%,read%
 2730 num_mesg%=0
 2740 FOR read%=0 TO max_mesg%-1
 2750 IF deleted%(read%)=0 THEN num_mesg%=num_mesg%+1
 2760 NEXT
 2770 =num_mesg%