1000 REM ReHead 1.3 by Simon N Goodwin 2020
1010 CLEAR 32499
1020 plus3header=32600: REM Liebensraum
1030 header=32704: REM TAP 24 byte prefix here
1040 headLen=128: REM +3DOS prefix
1050 checker=32500: REM Hand-assembled byte XOR checksum loop
1060 POKE checker,1,0,0,33,0,0,17,0,0,122,179,200,126,169,79,35,27,24,246
1070 PRINT "ZX BASIC file header converter"
1080 ON ERROR GO TO %1100
1090 GO TO %1110
1100 PRINT "Unable to open ";f$: PRINT "Please try again"
1110 INPUT "File ";f$
1120 PRINT : IF f$="" THEN ON ERROR : STOP 
1130 OPEN # 4,"I>"+f$
1140 DIM #4 TO length
1150 PRINT f$;" is ";length;" bytes long"
1160 CLOSE # 4
1170 ON ERROR 
1175 IF length>32768 THEN PRINT "Length beyond 32K limit": STOP 
1180 q$=f$+" "+ STR$ length+" -m "+ STR$ header
1190 DPOKE header,0,0,0,0
1200 form=0: REM 1=TAP, 3=+3DOS
1210 .$ extract q$
1230 PRINT :p$= PEEK$ (header,8)
1240 IF p$="PLUS3DOS" THEN PRINT p$;" header found": PROC ReadHead():form=3
1250 IF PEEK header=19 AND PEEK (header+1)=0 AND ( PEEK (header+2)=0 OR PEEK (header+2)=255) THEN PRINT "TAP header found": PROC TapHead():form=1: PROC Stats()
1260 IF form=0 THEN PRINT "Unknown file header.": STOP 
1270 PRINT "Convert to ";p$ AND form=1;".TAP" AND form=3;" ";
1280 INPUT "Y/N? ";q$: PRINT 
1290   PROC UPPER(q$) TO q$
1300   IF q$="" THEN GO TO %1280
1310   IF q$(1)="N" THEN STOP 
1320   IF q$(1)<>"Y" THEN GO TO %1280
1330 IF form=1 THEN PROC SAVEPLUS3() 
1340 IF form=3 THEN PROC SAVETAP() 
1350 STOP 
1360  
1365 REM Display type, length, start, maybe var name, vars size 
1370 DEFPROC Stats()
1380 PRINT 'dlen;"-byte ";"ZX type ";type;" ";
1390 PRINT "BASICARRAYARRAYCODE "(1+type*5 TO 5+type*5);" file"
1400 IF type=3 OR (type=0 AND start<32768) THEN PRINT "Starts at ";start
1410 IF type=1 OR type=2 THEN PRINT "Array name "; CHR$ name;
1420 IF type=2 THEN PRINT "$"
1430 IF type=1 THEN PRINT 
1440 IF type=0 THEN PRINT vars;" BASIC bytes, ";dlen-vars;" variables"
1450 ENDPROC 
1460 :
1465 REM Validate .TAP data at header
1470 DEFPROC TapCheck()
1480 DPOKE checker+4,header+2: REM Start address
1490 DPOKE checker+7,18: REM Number of bytes to XOR
1500 sum= USR checker
1510 IF sum<> PEEK (header+20) THEN PRINT "Header block check failed": STOP 
1520 p$= PEEK$ (header+4,10): PRINT "TAP filename ";p$
1522 FOR i=10 TO 2 STEP -1: IF p$(i)=" " THEN p$=p$( TO i-1)
1524 NEXT i: REM Strip trailing spaces
1530 %h=header+21:%d=dlen+2: IF % DPEEK h<>d THEN PRINT "Data block length mismatch": STOP 
1540 IF PEEK (header+23)<>255 THEN PRINT "Data block marker missing": STOP 
1550 DPOKE checker+7,dlen+1: REM include flag byte in checksum
1560 DPOKE checker+4,header+23
1570 sum= USR checker
1580 IF sum<> PEEK (header+24+dlen) THEN PRINT "Data block check failed": STOP 
1590 PRINT "TAP file verified"
1600 ENDPROC 
1610 :
1615 REM Parse and verify TAP header and following data block
1620 DEFPROC TapHead()
1630 type= PEEK (header+3)
1640 IF type>3 THEN PRINT "Not a ZX block file!": STOP 
1650 PRINT "TAP file type is ";
1660 PRINT "BASICARRAYARRAYCODE "(1+type*5 TO 5+type*5)
1670 %h=header
1680 length=% DPEEK h
1690 dlen=% DPEEK (h+14)
1700 start=% DPEEK (h+16)
1710 IF type=1 OR type=2 THEN name=% PEEK (h+17) & 31+64
1720 vars=% DPEEK (h+18)
1730 PROC TapCheck()
1740 ENDPROC 
1760 :
1770 DEFPROC UPPER(t$)
1780 LOCAL i
1790 FOR i=1 TO LEN t$
1810   IF t$(i)>="a" AND t$(i)<="z" THEN LET t$(i)= CHR$ ( CODE t$(i)-32)
1820 NEXT i
1830 ENDPROC = t$
1840 :
1845 REM Populate +3 header with ZX tape header and write to #5
1850 DEFPROC SetHead(t,l,a,b)
1860 LOCAL p,q,t$,%s,%c
1870 POKE plus3header,"PLUS3DOS"+ CHR$ 26+ CHR$ 1+ CHR$ 0
1880 REM All PLUS3DOS files seem to be issue 1 version 0
1890 DPOKE plus3header+13,0: REM <64K, clear high word
1900 DPOKE plus3header+11,headLen+l
1910 POKE plus3header+15,t
1920 DPOKE plus3header+16,l,a,b 
1930 FOR %c=plus3header+22 TO plus3header+126: POKE %c,%0: NEXT %c
1940 LET %s=%0: REM Additive checksum of non-zero header bytes
1950 FOR p=plus3header TO plus3header+21
1960   LET %c= PEEK p
1970   LET %s=%s+c
1980 NEXT p
1990 POKE plus3header+headLen-1,%s & 255
2000 t$= PEEK$ (plus3header,headLen)
2010 PRINT #5;t$;
2020 ENDPROC 
2030 :
2040 REM 16-bit unsigned PEEK, like % DPEEK on Next 
2050 DEF FN d(p)= PEEK p+ 256* PEEK (p+1)
2060 :
2065 REM Replace TAP header with +3 one and write out
2070 DEFPROC SAVEPLUS3()
2080 e$="BASNUMSTRBIN"(1+type*3 TO 3+type*3)
2090 CLOSE # 5: OPEN # 5,"o>"+p$+"."+e$
2100 PROC SetHead(type,dlen,start,vars)
2110 REM Suffix PLUS3 header with data bytes copied in chunks
2120 PROC CopyOut(header+24,dlen)
2130 PRINT p$+"."+e$;" written out"
2140 ENDPROC 
2150 :
2155 REM Write 'left' bytes from address 'd' to stream #5
2160 DEFPROC CopyOut(d,left)
2170 chunk=500: REM Maximum number of bytes per string write
2180 REPEAT 
2190   IF left<chunk THEN t$= PEEK$ (d,left): PRINT #5;t$;:left=0
2200   IF left>=chunk THEN t$= PEEK$ (d,chunk): PRINT #5;t$;:left=left-chunk:d=d+chunk
2210 REPEAT UNTIL NOT left
2220 CLOSE # 5
2230 ENDPROC 
2240 :
2245 REM Overwrites +3 header with a TAP one, adding checksums
2250 DEFPROC SAVETAP()
2260 tap=header+headLen-24: REM TAP over end of PLUS3DOS header
2270 POKE tap,19,0,0,type: REM 19 byte ZX header follows
2272 FOR i=2 TO LEN f$: IF f$(i)="." THEN f$=f$( TO i-1):i=9999
2274 NEXT i: REM Discard anything from a full stop onwards
2280 DIM j$(10):j$=f$: REM space-pad or truncate to 10 bytes
2290 POKE tap+4,j$
2300 DPOKE tap+14,dlen,start,vars
2310 DPOKE checker+4,tap+2
2320 DPOKE checker+7,18
2330 c= USR checker
2340 POKE tap+20,c: REM Header checksum
2350 DPOKE tap+21,dlen+2: REM Data block length
2360 POKE tap+23,255: REM Data block start marker
2370 DPOKE checker+4,tap+23
2380 DPOKE checker+7,dlen+1
2390 c= USR checker
2400 POKE tap+24+dlen,c
2410 CLOSE # 5: OPEN # 5,"o>"+f$+".TAP"
2420 PROC CopyOut(tap,dlen+25)
2430 PRINT f$+".TAP written out"
2440 ENDPROC 
2450 :
2460 REM Sets length, type, dlen, start, vars, name
2470 DEFPROC ReadHead()
2480 LOCAL i,k,t$,%n
2510 LET length=% DPEEK ( INT {header}+11)
2520 LET length=length+ FN d(header+13)*2^16
2530 PRINT "File length = ";length;" bytes"
2540 LET type= PEEK (header+15)
2550 PRINT "ZX type = "; type;" ";
2560 IF type>3 THEN GO TO %2590
2570 PRINT "BASICARRAYARRAYCODE "(1+type*5 TO 5+type*5)
2580 LET dlen = FN d(header+16)
2590 PRINT "Data length = ";dlen;" bytes"
2600 IF type>0 THEN GO TO %2660
2610   LET start= FN d(header+18)
2620   LET vars= FN d(header+20)
2630   PRINT vars;" BASIC bytes, ";dlen-vars;" variables"
2640   IF start<32768 THEN PRINT "Start line = ";start
2650   GO TO %2750
2660 LET vars= FN d(header+20)
2663   LET start= FN d(header+18)
2666   IF type=3 THEN GO TO %2740
2670   LET %n= PEEK (header+19)
2680   LET name=%n & 31+64
2690   PRINT "Array name = "; CHR$ name;
2700   PRINT "$" AND type=2
2710   GO TO %2750
2740 PRINT "Default load address = ";start;" P32K= ";vars
2750 ENDPROC 
2760 :
2770 :
2780 DEFPROC FLIST()
2790 CLOSE # 4
2800 OPEN # 4,"o>d:/Rehead.txt"
2810 LIST #4
2820 CLOSE # 4
2830 ENDPROC 
2840 :
9980 STOP 
9990 PROC FLIST()
9999 SAVE "Rehead.bas"