atkinsd@sol.cc.deakin.OZ.AU (Damon Atkins,Archimedes Services,0000,1111) (01/22/91)
Part 1 OF 3
Here is a programme for all news readers with an Archimedes, this is the
first programme of two which encode a file recording all file
information and the second un-encoding the text file produced by the
first programme. This will allow the transfer of files over any text
media. They are two BASIC 5 programmes, save each programme as a text
file, then go into basic and load each file and then save them in
basic with SAVE
There is also a small test to follow.
How it works. The TextToFile programme searches for %Begin
when found it reads the file information off the same line.
the next line it searches for is 0........1 then 2.......3,....,
8.......9,0.......1. the ...... is the data for the line.
This continues until %End is found, and other information is
found on the same line, numberf of lines in hex. and chksum
of the encoded file of text.
First programme.
10 REM > FileToText
20 REM Created By Damon Atkins Copywrite (C) 15/1/91
30 REM Nomad Software.
40 REM This Software is free and may be freely copied
50 REM under the condition it is not altered in any way
55 REM and that no price is charged for it.
60 REM Mail : nomad@cc.deakin.OZ.AU or datkins@cc.deakin.OZ.AU
70 REM 6 Woodlands Drive,Ocean Grove 3226,Victoria,Australia.
80 REM Current Status : Student & Staff member at Deakin University
90 REM Not an owner of an Archimedes or any other computer.
100 REM But owner of the RISC OS Programmer's Ref. Manual
110 REM Wish List : Archimedes A260, and the Uni. to by some Archimedes.
120 REM Disclaimer : All views are my own and may not represent views
130 REM of people associated with me. I do not accept any responsibility
140 REM whatsoever for damage to hardware or software or data
150 REM as a result of using this software.
160 :
170 DIM argument$(3),Buffer% 256,writeBuffer% 80
180 MaxArg%=3
190 PROCargument("FileToText")
200 IF argument$(0)="" OR argument$(1)="" OR argument$(0)="?" THEN
210 PROChelp(argument$(0))
220 ELSE
230 PROCdatatotext(argument$(0),argument$(1))
240 ENDIF
250 END
255 :
260 DEF PROCargument(commandName$)
270 LOCAL commline%,addr%,letter%,found%,nextarg%,arg%
280 FOR letter%=1 TO LEN(commandName$)
290 MID$(commandName$,letter%,1)=CHR$(ASC(MID$(commandName$,letter%,1)) OR 32)
300 NEXT letter%
310 SYS "OS_GetEnv" TO commline%
320 addr%=commline%
330 WHILE ?addr%>31
340 addr%+=1
350 ENDWHILE
360 ?addr%=13
370 addr%=commline%
380 WHILE ?addr%>31 AND NOT(found%)
390 addr%+=1
400 letter%=1
410 WHILE CHR$(addr%?(letter%-1) OR 32)=MID$(commandName$,letter%,1)
420 letter%+=1
430 ENDWHILE
440 found%=(letter%-1=LEN(commandName$))
450 ENDWHILE
460 IF NOT(found%) THEN PRINT "Rename file back to orginal name - ";commandName$:END
470 nextarg%=INSTR($addr%," ")
480 arg%=0
490 WHILE nextarg%<>0 AND arg%<MaxArg%
500 addr%+=nextarg%
510 nextarg%=INSTR($addr%," ")
520 argument$(arg%)=LEFT$($addr%,nextarg%-1)
530 IF argument$(arg%)<>"" THEN arg%+=1
540 ENDWHILE
550 ENDPROC
560 :
570 DEF FNpaddedHex(a%)
580 =RIGHT$("0000000"+STR$~(a%),8)
590 :
600 DEF PROCdatatotext(input$,output$)
601 LOCAL objectType%,loadAddr%,execAddr%,length%,attrib%,q%
602 LOCAL fileName$,chanInput%,chanOutput%,dot%
603 LOCAL marker%,line%,chksum%
610 SYS "OS_File",13,input$,,,"" TO objectType%,,loadAddr%,execAddr%,length%,attrib%
620 IF objectType%=0 THEN PRINT input$;" Not Found" : END
630 dot%=0
640 FOR q%=1 TO LEN(input$)
650 IF MID$(input$,q%,1)="." THEN dot%=q%
660 NEXT q%
670 fileName$=MID$(input$+" ",dot%+1,14)
680 chanInput%=OPENIN(input$)
690 chanOutput%=OPENOUT(output$)
700 PRINT STRING$(length% DIV 1026,"%");STRING$(length% DIV 1026,CHR$(8));
710 $writeBuffer%="%Begin "+fileName$+" "+FNpaddedHex(loadAddr%)+" "
720 $writeBuffer%+=FNpaddedHex(execAddr%)+" "+FNpaddedHex(length%)+" "
730 $writeBuffer%+=FNpaddedHex(attrib%)
740 writeBuffer%?57=&A
750 SYS "OS_GBPB",2,chanOutput%,writeBuffer%,58
760 marker%=0 : line%=0 : chksum%=0
770 WHILE NOT(EOF#chanInput%)
780 SYS "OS_GBPB",4,chanInput%,Buffer%,57 TO ,,,NotTrans%
790 $writeBuffer%=STR$(marker%)
800 PROCconvertBlock8to6(Buffer%,writeBuffer%+1,57)
810 FOR q%=1 TO 76
820 chksum%=(chksum%+q%*13+writeBuffer%?q%) MOD &7FFFFFFF
830 writeBuffer%?q%+=59
840 NEXT q%
850 line%+=1
860 IF line% MOD 18=0 THEN PRINT ;"/";
870 marker%+=1
880 $(writeBuffer%+77)=STR$(marker%)
890 marker%=(marker%+1) MOD 10
900 ?(writeBuffer%+78)=&A
910 SYS "OS_GBPB",2,chanOutput%,writeBuffer%,79
920 ENDWHILE
930 $writeBuffer%="%End "+FNpaddedHex(line%)+" "+FNpaddedHex(chksum%)
940 writeBuffer%?22=&A
950 SYS "OS_GBPB",2,chanOutput%,writeBuffer%,22
960 CLOSE #chanInput%
970 CLOSE #chanOutput%
980 PRINT
990 ENDPROC
1000 :
1010 DEF PROCconvertBlock8to6(input%,output%,size%)
1020 LOCAL n%,n2%
1030 IF (size% MOD 3)<>0 THEN PRINT "Error not a multipal of 24 bits" : END
1040 FOR n%=0 TO size%-1 STEP 3
1050 PROCconvert8to6(input%+n%,output%+n2%)
1060 n2%+=4
1070 NEXT n%
1080 ENDPROC
1085 :
1090 DEF PROCconvert8to6(input%,output%)
1110 ?output%=?input%>>2
1112 output%?1=(?input%<<4)+(input%?1>>4) AND %111111
1120 output%?2=(input%?1<<2)+(input%?2>>6) AND %111111
1122 output%?3=(input%?2 AND %111111)
1150 ENDPROC
1155 :
1280 DEF PROChelp(key$)
1290 IF key$="?" THEN
1300 PRINT"*FileToText: Created By Damon Atkins Copywrite ) 15/1/91"
1310 PRINT" Nomad International Software."
1320 PRINT" This Software is free and may be freely copied"
1330 PRINT" under the condition it is not altered in any way"
1335 PRINT" and that no price is charged for it."
1340 PRINT" Purpose : Converts a file into text, for transmission over"
1350 PRINT" modems, electronic mail, etc."
1360 PRINT" <Data file>: the source file containing data."
1370 PRINT" eg. Sprite, Template, Modules, etc."
1380 PRINT" <Text file>: the destination file containing"
1390 PRINT" converted data into text."
1400 PRINT" Syntax : *FileToText <Data file> <Text file>"
1410 ELSE
1420 PRINT" Syntax : *FileToText <Data file> <Text file>"
1430 PRINT" For more information : *FileToText ?"
1440 ENDIF
1450 ENDPROC
1460 :
1470 REM End Of Programme FileToText