vishniac@wanginst.UUCP (Ephraim Vishniac) (07/29/85)
For the benefit of people who have been crying for an antiquated version
of binhex, here it is. Note that this version, which is a Microsoft
Basic program, helps with the "bootstrapping problem." If someone would
kindly use it to encode and post a copy of BinHex 4.0, it might help
others get off the ground.
(The intended procedure is this:
Download BinHex.bas, which is text, and binhex4.hex (which is
encoded).
Use the Basic program to decode the current version.
Use the current version to decode all the .hqx, .hcx, and .hex
files which are posted in net.sources.mac.
I don't have BinHex4.hex handy for posting, but perhaps someone else
will make one up.)
---------------------snip, snip---------------------------------------------
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