10REM ><BasicSave$Dir>.New2Old
20REM by Steven Flintham
30REM
40REM Version 0.10
50REM based on SendMes 2.10
60REM
70REM Tuesday 7th January 1997
80:
90MODE 7
100PROCinit
110:
120REM Get the submission disc - this
involves unpleasant code because of
130REM the error trapping required
140fs$=FNprompt`sub`disc
150ON ERROR PROCbeep:fs$=" ":GOTO 160
160IF fs$=" " AND FNfs=4 THEN fs$="D"
170IF fs$=" " AND FNfs=8 THEN fs$="A"
180IF fs$="A" THEN PROCinit`adfs
190IF fs$="D" THEN PROCinit`dfs
200ON ERROR VDU 3:PROCoscli("FX3"):CLO
SE #0:MODE 7:REPORT:PRINT " at line ";ER
L:PROCenable:END
210:
220CLS
230PROCprint("Please wait, converting
messages...")
240PROCcheck
250PROCinit2
260PROCconvert
270:
280MODE 7
290PROCenable
300END
310:
320DEF PROCdisable
330*FX229,1
340*FX4,1
350ENDPROC
360:
370DEF PROCenable
380*FX229
390*FX4
400ENDPROC
410:
420DEF PROCinit
430ON ERROR MODE 7:REPORT:PRINT " at l
ine ";ERL:PROCenable:END
440CLOSE #0
450PROCdisable
460PROCcursor`off
470PROCinit`colours
480PROCinit`screen
490buffer`size%=4080:REM 4096 minus en
ough for to$ and the deleted flag (could
probably increase further)
500DIM block% 32, buffer% buffer`size%
510ENDPROC
520:
530DEF PROCinit2
540LOCAL chan%
550chan%=OPENIN("!Mesg")
560max`mesg%=(EXT #chan%-256)/4096
570CLOSE #chan%
580ENDPROC
590:
600DEF FNS="New2Old"
610:
620DEF PROCinit`adfs
630*ADFS
640*MOUNT 0
650*DIR $
660ENDPROC
670:
680DEF PROCinit`dfs
690*DISC
700*DRIVE 0
710*DIR $
720ENDPROC
730:
740DEF PROCcursor`off
750VDU 23,1,0;0;0;0;
760ENDPROC
770:
780DEF PROCcursor`on
790VDU 23,1,1;0;0;0;
800ENDPROC
810:
820DEF PROCoscli($block%)
830LOCAL X%,Y%
840X%=block% MOD 256
850Y%=block% DIV 256
860CALL &FFF7
870ENDPROC
880:
890DEF PROCinit`colours
900border%=150
910heading%=147
920text%=135
930ENDPROC
940:
950DEF PROCinit`screen
960LOCAL repeat%
970VDU 26,12
980PRINTTAB(0,23);CHR$(border%);"¶||||
|||||||||||||||||||||||||||||||||¶";
990VDU 30,11,30
1000PRINT " ";CHR$(border%);"
¶///////%¶/////////////////¶";
1010PRINT CHR$(border%);"¶///////////*/
/////// ";CHR$(border%);"
¶";
1020PRINT CHR$(border%);"¶";CHR$(headin
g%);"6£4 7i(h0 6) 0`$t` ` 0 0`
";CHR$(border%);"¶";
1030PRINT CHR$(border%);"¶";CHR$(headin
g%);"6£4!7ijj 2ijjj!5jhj`nj =!
";CHR$(border%);"¶";
1040PRINT CHR$(border%);"g%);""£ £!" ! "! !" " !! £" "!
"
1050FOR repeat%=1 TO 19
1060PRINT CHR$(border%);"¶";SPC(36);CHR
$(border%);"¶";
1070NEXT
1080PRINTTAB(4,5);CHR$(heading%-16);"8B
S message file converter 0.10"
1090VDU 28,2,23,37,7
1100ENDPROC
1110:
1120DEF PROCprint(T$)
1130PROCpretty`print(T$,text%,TRUE)
1140ENDPROC
1150:
1160REM N%=TRUE means go onto a new lin
e afterwards
1170DEF PROCpretty`print(T$,C%,N%)
1180REPEAT
1190IF 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)
1200UNTIL T$=""
1210ENDPROC
1220:
1230DEF PROCfatal(error$)
1240CLS
1250PROCprint(error$)
1260PRINT'CHR$(text%);"Press SPACE to r
eturn to BASIC"
1270*FX21
1280REPEAT UNTIL GET=32
1290VDU 26,12
1300PROCcursor`on
1310PROCenable
1320END
1330:
1340DEF FNprompt`sub`disc
1350LOCAL key%,key$
1360CLS
1370PROCprint("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.")
1380PRINT
1390PROCprint("When you have done this,
press A if it an ADFS disc, D if it is
a DFS disc or SPACE to use the current f
iling system.")
1400PRINT
1410PROCprint("If in doubt, just press
SPACE.")
1420REPEAT
1430*FX21
1440key%=GET
1450key$=CHR$((key% AND &DF)-32*(key%=3
2))
1460UNTIL INSTR(" AD",key$)<>0
1470=key$
1480:
1490DEF FNfs
1500LOCAL A%,Y%
1510A%=0
1520Y%=0
1530=(USR(&FFDA) AND &FF)
1540:
1550DEF PROCbeep
1560SOUND 1,-10,52,5
1570ENDPROC
1580:
1590DEF FNexist(fname$)
1600LOCAL chan%
1610chan%=OPENIN(fname$)
1620IF chan%<>0 THEN CLOSE #chan%
1630=(chan%<>0)
1640:
1650DEF PROCcheck
1660LOCAL chan%,version%
1670IF NOT FNexist("!Mesg") THEN PROCfa
tal("This disc does not have a !Mesg fil
e on it.")
1680chan%=OPENIN("!Mesg")
1690version%=BGET #chan%
1700CLOSE #chan%
1710IF version%<>1 THEN PROCfatal("The
!Mesg file on this disc is a version "+S
TR$(version%)+" file. I can only convert
version 1 files to version 0.")
1720IF FNexist("!MsgOld") THEN PROCfata
l("This disc already has a !MsgOld file
on it, so I cannot keep the new format f
ile under this name.")
1730ENDPROC
1740:
1750DEF PROCconvert
1760LOCAL in%,out%,discard%,sender`id$,
sender`name$,mesg`num`offset%,num`messag
es%,convert%,to$,deleted%
1770*RENAME !Mesg !MsgOld
1780in%=OPENIN("!MsgOld")
1790out%=OPENOUT("!Mesg")
1800discard%=BGET #in%:BPUT #out%,0:REM
version 0
1810INPUT #in%,sender`id$:PRINT #out%,s
ender`id$
1820INPUT #in%,sender`name$:PRINT #out%
,sender`name$
1830mesg`num`offset%=PTR #out%
1840PRINT #out%,0:REM dummy number of m
essages for now
1850num`messages%=0
1860FOR convert%=0 TO max`mesg%-1
1870PTR #in%=256+convert%*4096
1880INPUT #in%,to$
1890deleted%=BGET #in%
1900IF deleted%=0 THEN PROCconvert`mess
age(in%,out%,to$):num`messages%=num`mess
ages%+1
1910NEXT
1920PTR #out%=mesg`num`offset%
1930PRINT #out%,num`messages%
1940CLOSE #in%
1950CLOSE #out%
1960ENDPROC
1970:
1980REM TODO: This is slow but simple;
it could be replaced with code which
1990REM loads and saves using OSGBPB an
d a machine code routine to find the
2000REM terminating 152
2010DEF PROCconvert`message(in%,out%,to
$)
2020LOCAL byte%
2030PRINT #out%,to$
2040BPUT #out%,0:REM not deleted
2050REPEAT
2060byte%=BGET #in%
2070BPUT #out%,byte%
2080UNTIL byte%=152
2090ENDPROC