tdn@cmu-cs-spice.ARPA (Thomas Newton) (12/10/84)
Here is the BASIC version of BinHex, a program for the Mac that converts
resource/data files into mailable .Hex files and back. Use it to convert
BinHex.Hex (which follows in my next message)
------------------------- C U T H E R E -------------------------
10 'BinHex version 3.0.0 - By William B. Davis, Jr {CIS 71505,410}
20 'with modifications by Bob VanBurkleo {CIS 74435,1373}
30 'using subroutines by:
40 ' Dennis Brothers of Brothers Associates {CIS 70065,172}
50 ' Ronald H. Nicholson, Jr {CIS 71505,410}
60 'Permission is hereby granted for personal, non-commercial reproduction
70 'and use of this program, provided that this notice is included.
100 CLEAR,24000
110 CLEAR:DEFINT P:DIM PARAMLIST%(39),RECT%(5),BACKPATTERN%(4),GETFILEINFOCODE%(25)
120 DIM SETFILEINFOCODE%(25),P(89),DBUF%(256),VBUF%(266)
130 X255%=255:LFR=0:LFD=0:RFN=0
140 A=0:BOX=0:BX=0:BY=0:TRUE=-1:FALSE=0:CHOICE=0:CKSUM%=0:COUNT=0:E=0
150 FILE=0:FILEINFO!=0:FL=0:LF=0:FP!=0:I=0:LP=0:P=0:PARAM!=0:TR=0:PX=0:PY=0
160 R=0:RC=0:RF=0:RN=0:RW=0:RX=0:S=0:SETFILEINFO!=0:GETFILEINFO!=0:X=0:X9=0:Y=0:XX%=0
170 A$="":BF$="":D$="":E$="":DD$="":F$="":FT$="":HF$="":HX$="":RET$="":S$="":TEXT$="":FILE.EXISTS=0
180 TYPEAPPL$="":X$="":XX$=""
1000 WIDTH "SCRN:",255
1010 WHILE TRUE
1020 GOSUB 8000:CALL SHOWCURSOR
1030 RECT%(0)=2:RECT%(1)=10:RECT%(2)=275:RECT%(3)=475:GOSUB 7100
1040 RECT%(0)=5:RECT%(1)=13:RECT%(2)=272:RECT%(3)=472:GOSUB 7200
1050 CALL TEXTFONT(0):CALL TEXTSIZE(12)
1060 CALL TEXTMODE(1):CALL TEXTFACE(8)
1070 CALL MOVETO (45,20)
1080 PRINT"BinHex -- Hex to binary/Binary to hex file conversion"
1090 CALL MOVETO(140,40):CALL TEXTFACE(0)
1100 CALL TEXTFONT(1):CALL TEXTSIZE(9)
1110 PRINT" Version 3.0.0 - Data & Resource Files";
1120 CALL MOVETO(35,260)
1130 PRINT"Copyright ";CHR$(169);"1984 by Calypso! Software ";
1140 PRINT"- May be reproduced for non-commercial use only.";
1150 CALL TEXTFONT(0):CALL TEXTSIZE(12)
1160 CALL MOVETO (120,68):PRINT"Click on the desired conversion method:";
1170 RESTORE 1200:GOSUB 6000
1180 ON CHOICE GOSUB 3000,2000,1500,1600
1185 GOTO 110
1190 WEND:STOP
1200 DATA 75,90,"Application document --> Upload format document"
1210 DATA 75,130,"Upload format document --> Application document"
1220 DATA 75,170,"Quit BinHex and return to the Macintosh Desktop"
1230 DATA 75,210,"Quit BinHex and return to Microsoft BASIC"
1240 DATA -1,-1,"Dummy end of list"
1500 GOSUB 8000
1510 RECT%(0)=100:RECT%(1)=100:RECT%(2)=150:RECT%(3)=400:GOSUB 7100
1520 RECT%(0)=103:RECT%(1)=103:RECT%(2)=147:RECT%(3)=397:GOSUB 7200
1530 CALL MOVETO(120,130):PRINT"Returning to Macintosh DeskTop....";
1540 SYSTEM
1600 CLS:CALL TEXTFONT(1):CALL TEXTSIZE(12)
1610 CALL TEXTMODE(0):CALL TEXTFACE(0)
1620 PRINT"Entering MS-BASIC Command mode....":END
1630 '--------------------------------------------------------
1640 '" Hex ---> Binary conversion procedure
1650 '--------------------------------------------------------
2000 CHOICE=1
2010 WHILE CHOICE=1:GOSUB 8000:ON ERROR GOTO 0
2020 CALL TEXTMODE(1):CALL TEXTFACE(8)
2030 RECT%(0)=32:RECT%(1)=2:RECT%(2)=200:RECT%(3)=480:GOSUB 7100
2040 RECT%(0)=35:RECT%(1)=5:RECT%(2)=197:RECT%(3)=477:GOSUB 7200
2050 CALL MOVETO(15,52)
2060 PRINT "Convert Upload document (hex) to an Application document";
2070 CALL TEXTFACE(32):CALL MOVETO (15,73)
2080 PRINT "Enter name of Upload Document to convert FROM (Press RETURN to cancel):";
2090 CALL MOVETO(15,153)
2100 PRINT "Enter name of Application Document to CREATE (RETURN key skips back):";
2110 RECT%(0)=80:RECT%(1)=15:RECT%(2)=105:RECT%(3)=450:GOSUB 7000
2120 RECT%(0)=160:RECT%(1)=15:RECT%(2)=185:RECT%(3)=450:GOSUB 7000
2130 BX=20:BY=95:GOSUB 7500:HF$=RET$:IF HF$="" THEN RETURN
2140 FILE.EXISTS=TRUE
2150 ON ERROR GOTO 3600:OPEN"I",1,HF$
2160 CLOSE:IF NOT FILE.EXISTS THEN 2000
2170 BX=20:BY=175:GOSUB 7500:BF$=RET$:IF BF$="" THEN 2000
2180 OPEN"I",1,HF$,1:OPEN"O",2,BF$
2185 F$=HF$:GOSUB 4580:GOSUB 4000:LF=LFD
2190 ' Read in lines from file & ignore anything until the
2200 ' Type/Creator header information is encountered.
2210 CKSUM%=0
2220 LINE INPUT #1,D$:'" Prime the pump....
2230 WHILE LEFT$(D$,1)<>"#" AND NOT EOF(1)
2240 LINE INPUT #1,D$
2250 WEND
2260 ' if we reach this point (1) we have found the header, of the form
2270 ' #TYPECRTR where TYPE is 4 byte type code & CRTR is 4 byte
2280 ' creator code; or (2) we have reached EOF of hex file.
2290 WHILE NOT EOF(1)
2300 TYPEAPPL$=MID$(D$,2,8)
2310 GOSUB 8000
2320 RECT%(0)=50:RECT%(1)=100:RECT%(2)=200:RECT%(3)=400
2330 CALL PENNORMAL:GOSUB 7000
2340 RECT%(0)=53:RECT%(1)=103:RECT%(2)=197:RECT%(3)=397
2350 CALL PENSIZE(2,2):GOSUB 7000:CALL PENNORMAL
2360 CALL MOVETO(110,80):CALL TEXTFACE(0):CALL TEXTMODE(1)
2370 PRINT "TYPE of new file is................:";MID$(TYPEAPPL$,1,4)
2380 CALL MOVETO(110,95)
2390 PRINT "CREATOR of new file is..........:";MID$(TYPEAPPL$,5,4)
2400 CALL MOVETO(110,110)
2410 PRINT USING "Length of new file will be approx : ###.##K";(LOF(1)/2)/1024;
2420 CALL MOVETO(110,175)
2430 PRINT "Conversion in process - Please stand by...."
2440 CALL TEXTMODE(0)
2450 F$=BF$:GOSUB 4660:GOSUB 4200:'" Set type and creator of file
2460 LINE INPUT #1,D$
2470 IF LEFT$(D$,12)="***DATA FORK" THEN LINE INPUT #1,D$:CALL MOVETO (110,140):PRINT BF$;": a Data File"
2475 IF LEFT$(D$,11)="***RESOURCE" THEN CALL MOVETO(110,140):PRINT BF$;": a Resource File":GOSUB 21000:GOTO 2540
2480 WHILE NOT EOF(1) AND LEFT$(D$,14)<>"***END OF DATA"
2490 GOSUB 2800:' Convert string to binary
2500 LINE INPUT #1,D$
2510 WEND
2520 IF NOT EOF(1) THEN LINE INPUT #1,D$:'get checksum if available
2525 GOTO 2540
2530 WEND
2540 CLOSE:GOSUB 8000
2550 RECT%(0)=30:RECT%(1)=80:RECT%(2)=220:RECT%(3)=410:GOSUB 7100
2560 RECT%(0)=33:RECT%(1)=83:RECT%(2)=217:RECT%(3)=407:GOSUB 7200
2570 CALL MOVETO (100,55):CALL TEXTMODE(1)
2580 PRINT "Conversion of upload format document to";
2590 CALL MOVETO(100,70)
2600 PRINT "application document has been completed!";
2610 CALL MOVETO(140,100)
2620 IF LEFT$(D$,12)="***CHECKSUM:" THEN PRINT "Checksum in file: ";MID$(D$,13,2);
2630 IF LEFT$(D$,12)<>"***CHECKSUM:" THEN PRINT "No checksum present in file...";
2640 XX$=HEX$(CKSUM%):IF LEN(XX$)<2 THEN XX$="0"+XX$
2650 CALL MOVETO (140,115):PRINT "Calculated Checksum: ";XX$;
2660 BEEP:RESTORE 2690:GOSUB 6000:CALL TEXTMODE(0)
2670 WEND:' of the WHILE CHOICE=1
2680 RETURN:' if CHOICE=2
2690 DATA 130,155,"Convert another upload document"
2700 DATA 130,180,"Return to Main Conversion menu"
2710 DATA -1,-1,"dummy end of list"
2720 '----- Loop to break down input line into byte-pairs & convert -----
2800 FOR I=1 TO LEN(D$) STEP 2
2810 XX%=VAL("&H"+MID$(D$,I,2)):CKSUM%=(CKSUM%+XX%) AND 255
2820 PRINT #2,CHR$(XX%);
2830 NEXT I:RETURN
2840 '-------------------------------------------------------
2850 ' Binary ---> Hex conversion procedure
2860 '-------------------------------------------------------
3000 CHOICE=1
3010 WHILE CHOICE=1:GOSUB 8000
3020 ON ERROR GOTO 0:CALL TEXTMODE(1):CALL TEXTFACE(8)
3030 RECT%(0)=32:RECT%(1)=2:RECT%(2)=200:RECT%(3)=480:GOSUB 7100
3040 RECT%(0)=35:RECT%(1)=5:RECT%(2)=197:RECT%(3)=477:GOSUB 7200
3050 CALL MOVETO(15,52)
3060 PRINT "Convert Application document to an Upload document (hex)";
3070 CALL TEXTFACE(32):CALL MOVETO (15,73)
3080 PRINT "Enter name of Application Document to convert FROM (Press RETURN to cancel):";
3090 CALL MOVETO(15,153)
3100 PRINT "Enter name of Upload Document to CREATE (RETURN key skips back):";
3110 RECT%(0)=80:RECT%(1)=15:RECT%(2)=105:RECT%(3)=450:GOSUB 7000
3120 RECT%(0)=160:RECT%(1)=15:RECT%(2)=185:RECT%(3)=450:GOSUB 7000
3130 BX=20:BY=95:GOSUB 7500:BF$=RET$:IF BF$="" THEN RETURN
3140 FILE.EXISTS=TRUE
3150 ON ERROR GOTO 3600:OPEN"I",1,BF$
3160 ON ERROR GOTO 0: CLOSE:IF NOT FILE.EXISTS THEN 3000
3170 BX=20:BY=175:GOSUB 7500:HF$=RET$
3180 OPEN"O",2,HF$
3190 F$=BF$:GOSUB 4580:GOSUB 4000:LF=LFD+LFR
3200 CLS:CALL TEXTFACE(0)
3210 PRINT "LENGTH of Application document is:";LF;" bytes (characters)"
3220 PRINT "TYPE of Application document is: ";LEFT$(TYPEAPPL$,4)
3230 PRINT "CREATOR of Application document is: ";RIGHT$(TYPEAPPL$,4)
3235 PRINT "DOCUMENT is a ";:IF LFD=0 THEN PRINT "Resource File":ELSE PRINT "Data File"
3240 PRINT:CALL TEXTFONT(4):CALL TEXTSIZE(9)
3250 PRINT "<---Hex data being output--------------------------------------> ";
3260 PRINT"Processed/Total"
3270 CKSUM%=0:COUNT=0
3275 IF LFD=0 THEN GOSUB 22000:GOTO 3380
3280 PRINT #2,"#";TYPEAPPL$:PRINT #2,"***DATA FORK"
3285 OPEN "R",1,BF$,1:FIELD 1,1 AS D$
3290 FOR I = 1 TO LFD
3300 GET 1,I
3310 DD$=HEX$(ASC(D$)):IF LEN(DD$)<2 THEN DD$="0"+DD$
3320 CKSUM%=(CKSUM%+ASC(D$)) AND 255
3330 PRINT #2,DD$;:PRINT DD$;
3340 COUNT=COUNT+1
3350 IF COUNT=32 THEN COUNT=0:PRINT #2,"":PRINT USING " ######_/";I;:PRINT LFD
3360 NEXT I
3370 IF COUNT<32 THEN PRINT #2,""
3380 PRINT #2,"***END OF DATA"
3390 XX$=HEX$(CKSUM%):IF LEN(XX$)<2 THEN XX$="0"+XX$
3400 PRINT #2,"***CHECKSUM:";XX$
3410 CLOSE:CALL TEXTFONT(0):CALL TEXTSIZE(12)
3420 RECT%(0)=30:RECT%(1)=80:RECT%(2)=220:RECT%(3)=410:GOSUB 7100
3430 RECT%(0)=33:RECT%(1)=83:RECT%(2)=217:RECT%(3)=407:GOSUB 7200
3440 CALL MOVETO(90,70):CALL TEXTMODE(1)
3450 PRINT "Conversion of Application document to an";
3460 CALL MOVETO (90,85)
3470 PRINT "Upload format document has been completed!";
3480 BEEP:RESTORE 3510:GOSUB 6000
3490 WEND: ' of the WHILE CHOICE=1
3500 RETURN: ' if CHOICE=2
3510 DATA 110,120,"Convert another Application document"
3520 DATA 110,160,"Return to Main Conversion Menu"
3530 DATA -1,-1,"dummy end of list"
3540 '------ Subroutine to handle file-not-found condition ------
3600 RECT%(0)=75:RECT%(1)=100:RECT%(2)=165:RECT%(3)=400:GOSUB 7100
3610 RECT%(0)=79:RECT%(1)=103:RECT%(2)=162:RECT%(3)=397:GOSUB 7200
3620 CALL MOVETO(160,110):PRINT"That document does not exist!";
3630 BEEP:BEEP:RESTORE 3640:GOSUB 6000
3640 DATA 150,130,"<--Click here to select another file"
3650 DATA -1,-1,"Dummy end of File not found list"
3660 FILE.EXISTS=FALSE:RESUME NEXT
3670 '------------------------------------------------------------
3680 ' _GetFileInfo -- Subroutine to get type and application of a file
3690 '------------------------------------------------------------
4000 FL=LEN(F$)
4010 F$=CHR$(FL)+F$
4020 FP!=VARPTR(F$)
4030 PARAM!=VARPTR(PARAMLIST%(0))
4040 FOR I=0 TO 79: POKE PARAM!+I,0: NEXT I
4050 POKE PARAM!+19,PEEK(FP!+2)
4060 POKE PARAM!+20,PEEK(FP!+3)
4070 POKE PARAM!+21,PEEK(FP!+4)
4080 GETFILEINFO!=VARPTR(GETFILEINFOCODE%(0))
4090 CALL GETFILEINFO!(PARAM!)
4100 TYPEAPPL$ = ""
4110 FOR I = 1 TO 8
4120 TYPEAPPL$ = TYPEAPPL$ + CHR$(PEEK(PARAM!+31+I))
4130 NEXT I
4135 LFD=PEEK(PARAM!+56)*256+PEEK(PARAM!+57)
4136 LFR=PEEK(PARAM!+66)*256+PEEK(PARAM!+67)
4140 RETURN
4150 '-------------------------------------------------------------
4160 ' _SetFileInfo -- Subroutine to set type and application of a file
4170 '-------------------------------------------------------------
4200 FL=LEN(F$)
4210 F$=CHR$(FL)+F$
4220 PARAM!=VARPTR(PARAMLIST%(0))
4230 FP!=VARPTR(F$)
4240 FOR I=0 TO 79: POKE PARAM!+I,0: NEXT I
4250 POKE PARAM!+19,PEEK(FP!+2)
4260 POKE PARAM!+20,PEEK(FP!+3)
4270 POKE PARAM!+21,PEEK(FP!+4)
4280 GETFILEINFO!=VARPTR(GETFILEINFOCODE%(0))
4290 CALL GETFILEINFO!(PARAM!)
4300 FOR I=1 TO LEN(TYPEAPPL$)
4310 POKE PARAM!+31+I,ASC(MID$(TYPEAPPL$,I,1))
4320 NEXT I
4330 SETFILEINFO!=VARPTR(SETFILEINFOCODE%(0))
4340 CALL SETFILEINFO!(PARAM!)
4350 RETURN
4360 '-----------------------------------------------------------
4370 ' Setup Machine Language Toolkit calls
4380 '-----------------------------------------------------------
4560 ' Set up _GetFileInfo ToolKit call
4580 RESTORE 4610:I=0
4590 READ A:GETFILEINFOCODE%(I)=A
4600 I=I+1:IF A<>-1 THEN GOTO 4590
4605 RETURN
4610 DATA &H4E56, &HFFF8, &H48EE, &H0101, &HFFF8, &H206E, &H0008, &HA00C
4620 DATA &H4CEE, &H0101, &HFFF8, &H4E5E, &H4E75
4630 DATA -1
4640 ' Set up _SetFileInfo Toolkit call
4660 RESTORE 4700:I=0
4670 READ A:SETFILEINFOCODE%(I)=A
4680 I=I+1:IF A<>-1 THEN GOTO 4670
4690 RETURN
4700 DATA &H4E56, &HFFF8, &H48EE, &H0101, &HFFF8, &H206E, &H0008, &HA00D
4710 DATA &H4CEE, &H0101, &HFFF8, &H4E5E, &H4E75
4720 DATA -1
4730 '----------------------------------------------------------
4740 ' Pseudo-Dialog-Box subroutine
4750 '----------------------------------------------------------
6000 BOX=0:READ X,Y,TEXT$
6010 WHILE X<>-1
6020 BOX=BOX+1:CHECKBOX(BOX,1)=X:CHECKBOX(BOX,2)=Y
6030 CHECKTEXT$(BOX)=TEXT$:READ X,Y,TEXT$
6040 WEND
6050 FOR I=1 TO BOX
6060 CIRCLE(CHECKBOX(I,1),CHECKBOX(I,2)),7
6070 CIRCLE(CHECKBOX(I,1),CHECKBOX(I,2)),5
6080 CALL MOVETO(CHECKBOX(I,1)+15,CHECKBOX(I,2)+5)
6090 PRINT CHECKTEXT$(I);
6100 NEXT I
6110 CHOICE=0
6120 WHILE CHOICE=0
6130 WHILE MOUSE(0)<>-1:WEND
6140 PX=MOUSE(1):PY=MOUSE(2)
6150 FOR I=1 TO BOX
6160 P=SQR((PX-CHECKBOX(I,1))^2+(PY-CHECKBOX(I,2))^2)
6170 IF P<5 THEN CHOICE=I:I=BOX :' once choice found, stop loop.
6180 NEXT I
6190 WEND
6200 FOR I=0 TO 4
6210 CIRCLE(CHECKBOX(CHOICE,1),CHECKBOX(CHOICE,2)),I
6220 NEXT I
6230 WHILE MOUSE(0)<>1:WEND:RETURN
6240 '---------------------------------------------------
6250 ' Routines used to draw Dialog boxes
6260 '---------------------------------------------------
7000 CALL ERASERECT(VARPTR(RECT%(0)))
7010 CALL FRAMERECT(VARPTR(RECT%(0)))
7020 RETURN
7100 CALL PENNORMAL:GOSUB 7000:RETURN
7200 CALL PENSIZE(2,2):GOSUB 7000:CALL PENNORMAL:RETURN
7210 '---------------------------------------------------------
7220 ' Controlled Keyboard input routine, with cursor
7230 '---------------------------------------------------------
7500 A$="":RET$=""
7510 CALL MOVETO(BX,BY):CALL TEXTMODE(0)
7520 CALL PENSIZE(1,1):CALL SHOWPEN
7530 CALL OBSCURECURSOR:CALL LINE(0,-10)
7540 WHILE A$<>CHR$(13) AND A$<> CHR$(9) AND A$<>CHR$(3)
7550 A$=INKEY$
7560 IF A$<>"" AND A$>CHR$(31) THEN GOSUB 7630
7570 IF A$=CHR$(8) AND LEN(RET$)>0 THEN GOSUB 7660
7580 IF A$=CHR$(8) AND LEN(RET$)=0 THEN GOSUB 7690
7590 IF LEN(RET$)>65 THEN BEEP:A$=CHR$(13)
7600 WEND
7610 CALL MOVETO(BX,BY):PRINT RET$;" ";:RETURN
7620 '-------- Handle normal input of letter ASCII 32-255 ------------
7630 RET$=RET$+A$:CALL LINE(0,10)
7640 PRINT A$;:CALL LINE(0,-10):RETURN
7650 '------- Hande Backspacing with input length >0 ----------------
7660 CALL MOVETO(BX,BY):RET$=LEFT$(RET$,LEN(RET$)-1)
7670 PRINT RET$;:CALL LINE(0,-10):RETURN
7680 '------- Handle Backspacing when input length goes to 0 ------
7690 CALL MOVETO(BX,BY):PRINT" ";:CALL LINE(0,-10):
7700 CALL MOVETO (BX,BY):CALL LINE(0,-10):RETURN
7710 '------- Change Window Background pattern to grey -------
8000 FOR I=0 TO 4:BACKPATTERN%(I)=&HAA55:NEXT I
8010 CALL BACKPAT(VARPTR(BACKPATTERN%(0))):CLS
8020 FOR I=0 TO 4:BACKPATTERN%(I)=0:NEXT I
8030 CALL BACKPAT(VARPTR(BACKPATTERN%(0))):RETURN
10000 ' Open Resource Fork For E$
10010 IF P(0)<>&H41FA THEN GOSUB 15000
10020 P(8)=&HA20A:' Open RF
10030 Y=VARPTR(P(42)):'length of file name
10040 POKE Y,LEN(E$)
10050 FOR I=1 TO LEN(E$):POKE (Y+I),ASC(MID$(E$,I,1)):NEXT I
10060 P(25)=INT(Y/65536!):GOSUB 20000
10070 P(26)=X:'lsw of name
10080 P(27)=0:'volume
10090 P(29)=RW:'version and R/W Permission
10100 P(30)=0'Nil-> default volume buffer msw
10110 P(31)=0:'Nil-> default volume buffer lsw
10115 IF RW=1 THEN GOTO 10160
10120 Y=VARPTR(VBUF%(0))
10130 P(30)=INT(Y/65536!):GOSUB 20000:' volume buffer msw
10140 P(31)=X:'volume buffer lsw
10160 X=VARPTR(P(0)):CALL X:'open the Fork
10170 RC=P(16):'return code
10180 RFN=P(28):'reference number
10190 RETURN
10500 ' Close RF at RefNum
10510 IF P(0)<>&H41FA THEN GOSUB 15000
10520 P(8)=&HA201:'Close RF byte
10530 P(28)=RFN:'Refnum
10540 GOTO 10030 :'insert into main loop
11000 'Set up for Write RF
11010 IF P(0)<>&H41FA THEN GOSUB 15000
11020 P(8)=&HA203:'Write byte
11030 P(39)=0:' offset msw
11033 Y=VARPTR(VBUF%(0)):P(30)=INT(Y/65536!):GOSUB 20000
11036 P(31)=X
11040 P(40)=0:'offset lsw
11050 TR=VARPTR(DBUF%(0))
11060 P(32)=INT(TR/65535!):Y=TR:GOSUB 20000
11080 P(33)=X:'buffer
11090 P(34)=0:'count high
11100 P(35)=1:'count low
11110 P(38)=1:'mode as absolute offset
11120 RETURN
12000 'Write RF (hex->bin)
12010 IF EOF (1) THEN GOTO 12990:' return
12020 E=0: IF EOF(1) THEN CLS:PRINT "Hex File Error":GOTO 12990
12030 INPUT #1,D$
12040 IF MID$(D$,1,6)="***END" THEN 12100
12050 FOR I=1 TO LEN (D$) STEP 2
12060 X=VAL("&H"+MID$(D$,I,2)):CKSUM%=(CKSUM%+X) AND X255%
12070 GOSUB 13000:E=E+1:'write byte at offset E
12080 NEXT I
12085 CALL MOVETO(190,158):PRINT USING "####.##_K";(E/1024)
12090 GOTO 12030
12100 INPUT #1,D$:'get the checksum
12990 CLOSE:RETURN
13000 'Write Byte X at offset E
13010 POKE VARPTR(DBUF%(0)),X
13015 P(39)=INT(E/65536!):Y=E:GOSUB 20000:' offset msw
13020 P(40)=X:'offset lsw
13030 X=VARPTR (P(0)):CALL X:' write it!
13040 RC=P(16):'return code
13050 IF RC<>0 THEN CLS: PRINT "Write RF Error":GOSUB 14000:CLOSE:END
13060 RETURN
14000 'Close RF
14010 GOSUB 10500:'Closing Header to RF routine
14020 IF RC=0 THEN RETURN
14030 PRINT "File Error on Closing RF"
14040 GOTO 14100
14050 'Open RF for E$
14060 RW=1:'set to read
14070 GOSUB 10000:'Open RF
14080 IF RC=0 THEN RETURN
14090 CLS:PRINT "FILE ERROR ON OPENING RF"
14100 PRINT "Return Code = ";RC
14110 CLOSE :END
15000 'Load Code Array
15010 I=0
15020 RESTORE 15500
15030 READ X:IF X<>-5 THEN P(I)=X:I=I+1:GOTO 15030
15040 RETURN
15500 DATA &H41FA,&H001E,&H2278,&H011C
15510 DATA &H2269,&H0010,&H2251,&H4280,&HA40A
15520 DATA &H41FA,&H000A,&H3080,&H4E75,&H7268,&H6E00,0
15530 DATA &H0000,&H0000,&H0005,&H0000
15540 DATA &H0000,&H0000,&H0000,&H0000
15550 DATA &H0001,&H0000,&H0000,&H0000
15560 DATA &HFFFE,&H0000,&H0000,&H0000
15570 DATA &H0001,&H3000,&H0000,&H0200
15580 DATA &H0000,&H0000,&H0001,&H0000,&H0000
15590 DATA-5
16000 'REad RF at E
16010 IF P(0)<>&H41FA THEN GOSUB 15000
16020 P(8)=&HA202:'Read byte
16030 P(39)=INT(E/65536!):Y=E:GOSUB 20000:'offset msw
16040 P(40)=X: 'offset lsw
16050 TR=VARPTR(DBUF%(0))
16060 P(32)=INT(TR/65536!):Y=TR:GOSUB 20000:'buffer msw
16070 P(33)=X:'buffer lsw
16080 P(34)=0:'count high
16090 P(35)=RN:'count low
16100 P(38)=1:'mode is absolute offset
16110 X=VARPTR(P(0)):CALL X:'read it!
16120 RC= P(16):'return code
16130 RX=P(37):'returned count
16140 IF RC<>0 THEN CLS:PRINT "Read RF Error":GOSUB 14000:CLOSE:END
16150 RETURN
18000 'Dump the RF
18010 E=0:CKSUM%=0:S=0
18020 IF E>=LFR-1 THEN RN=0: GOTO 18140: ELSE RN=256:IF LFR-E<=256 THEN RN=LFR-E
18030 GOSUB 16000:'get the buffer filled with RF
18040 FOR I=0 TO RX-1
18050 X9=(PEEK(VARPTR(DBUF%(0))+I))
18060 HX$=HEX$(X9):IF LEN(HX$)<2 THEN HX$="0"+HX$
18070 CKSUM%=(CKSUM%+X9) AND X255%
18080 PRINT HX$;: PRINT #2,HX$;
18090 S=S+1:IF S>31 THEN S=0:PRINT USING " ######_/";(E+I+1);:PRINT LFR:PRINT #2,""
18120 NEXT I
18140 IF S>0 THEN PRINT #2,""
18150 IF RN<256 THEN RETURN
18160 E=E+256:GOTO 18020
18170 END
20000 X=Y-65536!*INT(Y/65536!):IF X>=32768! THEN X=X-65536!
20010 RETURN
21000 'Resource hex->bin Subroutine
21010 CLOSE #2:E$=BF$:RW=2:GOSUB 14070:'Open RF to write
21020 GOSUB 11000:'Setup To Write to RF
21030 GOSUB 12000:'Dump the Hex->RF
21040 GOSUB 14000:'Close rf
21050 RETURN
22000 'Resource Bin-> hex subroutine
22010 PRINT #2,"#";TYPEAPPL$:PRINT #2,"***RESOURCE FORK"
22020 E$=BF$:RW=1
22030 GOSUB 14070:'Open RF
22040 GOSUB 18000:'Dump Fork
22050 GOSUB 14000:'Close Fork
22060 RETURN