REM Slammer 1.1.1 0 REM ::SLAMMER!:::BY IVAN X::::DO NOT MODIFY LINES 0-9!::FOFOFOFOFOFOFOFOFO$O%O8IF*XX*&B*&B*&B*&B*&B*&B*&B*&B%O8IT*XX*&@*&@*&@*&@*&@*&@*&@*&@%O8IB*XX*&;*&;*&;*&;*&;*&;*&;*&;%OE;*&>*&>*&>*&>*&>*&>*&>*&>%OIC*&?*&?*&?*&?*&?*&?*&?*&?%OIDP!### 1 REM #######################*&<*&<*&<*&<*&<*&<*&<*&<%OJI4*XX*&:*&:*&:*&:*&:*&:*&:*&:%OE:*&=*&=*&=*&=*&=*&=*&=*&=%O8IT*XX*&@*&@*&@*&@*&@*&@*&@*&@%OJI0*XX*&E*&E*&E*&E*&E*&E*&E*&E%OI$JJXXH%O8I/*8*H%OH@ 2 REM %OJIT*XX*&A*&A*&A*&A*&A*&A*&A*&A%OI(JJXXH%OI0JJXXH%OI)XXXXH%OI4JJXXH%OHI:H%OH@%OJIU*XX*&A*&A*&A*&A*&A*&A*&A*&A%OI(JJXXH%OIZXXXXH%OJI6*XXH%OI0JJXXH%OHI:H%OH@%O8IT*XX*&V*&V*&V*&V*&V*&V*&V*&V%OI4JJXX*&W*&W*&W*&W*&W*&W*&W*&WP2 3 REM %OI0 THEN GOTO 2003 : REM GOT HERE FROM FILE TYPE PRINTER, SO GO BACK THERE 11 IF PEEK(248)<248 THEN CALL ((PEEK(175)+PEEK(176)*256) + 20) : REM MAGIC GOTO HANDLER 12 CALL 2107 : REM INSTALL PRODOS MLI AND MAGIC GOTO 2.0 REM ProDOS MLI 13 REM ****:AD 30 BF 8D C1 03 20 00 BF 80 C0 03 60 03 00 00 40 00 00 00; PRODOS MLI READ/WRITE BLOCK COMMAND & PARAM LIST REM Magic Goto 2.0 14 REM :C6 6A A0 FE B1 69 85 06 C8 B1 69 85 07 E6 6A C8 84 D7 84 E3 84 EE 84 EF A5 67 85 42 85 EC A5 68 85 43 85 ED A0 05 98 D1 06 D0 12 88 10 F8 AE F7 01 E0 22 D0 5A A5 06 85 69 A5 07 85 6A A5 69 85; INSTALL MAGIC GOTO 2.0 15 REM :06 A5 6A 85 07 A9 00 A8 A2 14 91 69 E6 69 D0 02 E6 6A CA D0 F5 A0 05 98 91 06 88 10 FA C6 6A A5 07 91 69 88 A5 06 91 69 E6 6A A0 04 B1 EC C9 B2 D0 4C C8 B1 EC C9 20 D0 03 C8 D0 F7 C9 22 F0 11 16 REM :C9 53 D0 03 C8 C8 C8 B1 EC C9 5E D0 31 F0 02 D0 68 A5 69 69 01 85 69 A5 6A 69 00 85 6A 98 AA C6 6A A0 FE 88 B1 69 C8 C8 91 69 88 88 C0 FA D0 F3 8A 65 EC 91 69 A5 ED 69 00 C8 91 69 E6 6A A0 01 17 REM :B1 EC F0 0B AA 88 B1 EC 86 ED 85 EC 18 90 9B A5 73 A4 74 85 6F 84 70 A5 69 A4 6A 85 6B 84 6C 85 6D 84 6E BA CA 9A C6 F8 BD 00 01 9D FF 00 E8 E0 F9 90 F5 BA E0 F5 90 01 60 A5 06 18 69 10 85 40 18 REM :A5 07 69 00 85 41 B8 BA E0 F5 B0 23 BD 03 01 C9 B0 F0 1C C9 81 F0 18 A9 80 A0 06 91 06 A5 F6 85 EE A5 F7 85 EF A5 F4 85 CE A5 F5 85 CF D0 35 BA A0 06 B1 06 F0 13 24 B1 A9 00 91 06 A0 0D B1 06 19 REM :9D 00 01 CA 88 C0 07 B0 F5 BD 03 01 C9 B0 D0 2F BD 04 01 85 EE BD 05 01 85 EF BD 06 01 85 CE BD 07 01 85 CF 50 6F A2 01 A0 00 B1 CE D0 3B A0 02 B1 CE D0 28 A0 0A B1 06 85 EE C8 B1 06 85 EF 68 20 REM :68 A0 06 B1 06 10 0A A5 F6 85 75 A5 F7 85 76 50 08 A5 EE 85 75 A5 EF 85 76 4C 7C D9 A2 05 A0 03 B1 CE 85 EE C8 B1 CE 85 EF E6 CE D0 02 E6 CF CA D0 F7 A0 00 B1 CE C9 B0 D0 0E A0 01 B1 CE C9 40 21 REM :D0 B2 BA B8 50 83 D0 B7 C9 AB D0 9A 18 E6 CE D0 02 E6 CF B0 7A A0 00 B1 CE C9 22 F0 F0 24 B1 C9 24 F0 05 B8 C9 40 D0 33 BA A0 06 C8 E8 BD 00 01 91 06 C0 0D 90 F5 CA CA 9A 68 85 B8 68 85 B9 08 22 REM :20 95 D9 28 70 14 A0 01 B1 CE F0 09 C9 3A F0 05 C9 40 D0 B8 88 98 A0 06 91 06 60 A6 D7 D0 A7 A4 CE A6 CF 86 D7 C9 21 D0 06 A4 AF A6 B0 D0 0A C9 23 F0 06 C9 25 D0 E6 F0 0F 2A 85 E3 A5 69 E9 05 23 REM :85 40 A5 6A E9 00 85 41 84 42 86 43 8A D0 C3 24 E3 A2 01 A0 01 B1 40 D0 04 C0 00 D0 C0 D9 42 00 70 14 90 07 D0 21 88 30 1E F0 EA E6 40 D0 02 E6 41 CA F0 F7 30 DB 90 0F F0 EC A5 40 D0 02 C6 41 24 REM :C6 40 CA F0 F5 30 CA A0 01 B1 40 85 ED 88 B1 40 85 EC 88 C8 B1 CE F0 0C C9 22 F0 08 D1 EC F0 F3 50 C9 70 D6 B1 EC F0 0C C9 22 F0 08 C9 20 F0 04 C9 3A D0 EC A5 EC 85 B8 A5 ED 85 B9 A0 06 B1 06 25 REM :10 04 A9 00 91 06 4C DC D9 REM NuInput 2.1 26 POKE 251,PEEK(64) : POKE 252,PEEK(65) : REM CALL 250 FOR NUINPUT 27 CALL 2107 : REM INSTALL NUINPUT 2.1 28 REM :A6 76 E8 D0 22 4C DD FB 53 54 24 4B 4C 24 4B 43 24 44 45 24 53 54 24 D0 53 54 24 C8 22 22 1E EB EC D7 ED EE EF 08 09 A5 B8 48 A5 B9 48 20 54 FF 9A 68 E9 26 85 B8 68 E9 00 85 B9 A5 B8 69 15 85 29 REM :06 A5 B9 69 00 85 07 20 E3 DF 85 CE 84 CF 8A D0 05 86 FE CA 86 FD A9 00 85 0F 85 E3 A0 01 91 CE C8 98 91 CE 20 E3 DF A0 02 B1 06 AA B1 83 95 00 88 10 F6 E0 EF F0 0C A5 06 69 03 85 06 90 E5 E6 30 REM :07 B0 E1 A6 FD D0 03 CA 86 FD 24 FE 70 08 66 E3 E4 EF B0 02 86 EF C8 84 34 A2 01 98 81 CD F0 04 24 FE 70 32 24 E3 70 18 10 43 B1 08 C4 EF 90 04 06 E3 F0 39 C9 7F F0 04 C9 20 B0 42 A9 5E D0 3E 31 REM :10 06 C4 0F 90 6A 46 E3 C4 4F F0 04 A2 7F D0 71 46 E3 A5 08 30 17 20 46 DA 68 85 B9 68 85 B8 A5 08 24 FE 30 07 C9 03 D0 03 4C 63 D8 60 20 0C FD A4 34 29 7F F0 F7 85 08 84 09 A6 0F 86 4F AA 24 32 REM :FE 30 0A E0 03 D0 06 A9 C0 85 E3 D0 8A 24 FE 70 5B E0 0D D0 17 A5 FE 29 04 F0 04 A5 D7 D0 0D 84 4F 98 D0 E3 A5 FE 29 02 D0 E1 F0 DB E0 15 D0 09 C4 0F B0 B9 B9 00 02 90 31 E0 7F F0 04 E0 08 D0 33 REM :2B 98 F0 A9 A9 88 20 ED FD C4 0F 88 90 04 E0 7F F0 06 A5 FE 29 10 F0 0C A9 A0 20 ED FD A9 88 20 ED FD C6 0F 8A D0 A4 8A D0 83 90 67 E0 1B D0 12 A5 FE 29 08 F0 0C A5 4F F0 08 66 08 A9 00 85 4F 34 REM :F0 85 E0 1C B0 11 8A 09 40 A4 D7 88 30 D9 D1 ED D0 F9 A4 34 8A D0 8B C4 FD B0 C9 A4 E3 30 26 A4 1E F0 1C 8A 88 30 C0 D1 EB F0 14 A5 FE 6A B0 F3 8A C9 61 90 EE C9 7B B0 EA 29 DF D1 EB D0 E4 A5 35 REM :FE 29 20 D0 03 8A D0 0B 8A C9 61 90 06 C9 7B B0 02 29 DF A4 34 99 00 02 24 FE 70 05 09 80 20 ED FD C4 0F 90 02 E6 0F C8 38 B0 AE 09 REM prep ProDOS MLI 50 MLIADDR = (PEEK(175)+PEEK(176)*256) : PLADDR = (MLIADDR + 13) : REM MLI AND PARAM LIST ADDRESS 51 POKE MLIADDR+5,INT(PLADDR/256) : POKE MLIADDR+4,(PLADDR-(PEEK(MLIADDR+5)*256)) : REM SET MLI TO USE PL REM allocate 13K buffer and save start hi byte REM (12K: 24 directory blocks=312 files; 1K for block r/w and res buf) 60 LOMEM: ( (PEEK(106)*256+256) + 13*1024 ) 61 POKE (PEEK(175)+PEEK(176)*256 + 19),PEEK(106) REM init Magic Goto 62 GOSUB $ : REM INIT MAGIC GOTO AFTER LOMEM IS SET REM set F$ first so we know where to repoint it 63 F$ = "" REM init NuInput 65 NU = 250 : ST$ = "" : 90 TEXT : HOME 91 D$ = CHR$ (4) 92 DIM FA(60) 93 DIRBUF = (PEEK(PEEK(175)+PEEK(176)*256 + 19)*256 - 13*1024) : RWBUF = (DIRBUF + 12*1024) : RESBUF = (RWBUF + 512) : BUF = DIRBUF 94 PRINT D$;"PREFIX": INPUT PFX$ 95 MLI = (PEEK(175)+PEEK(176)*256):PL = MLI + 13 96 TT = -1 : SF = 0 : DZ = 0 : REM SET DZ=1 FOR READ/WRITE INFO 97 TEXT : HOME : PRINT "UNFORKIT 1.2 BY IVAN X" 98 POKE 34,5 99 GOSUB %"INIT" 100 REM GET CATALOG 101 ZX = 0 : ER = 0 102 ONERR GOTO 115 105 IF PFX$ = "/" OR PFX$ = "" THEN PRINT D$;"PREFIX /": PRINT D$;"PREFIX": INPUT PFX$: GOTO 105 106 IF OP$ = "" THEN OP$ = PFX$ 110 PRINT D$;"BLOAD ";PFX$;",TDIR,A";DIRBUF;",L$3000" : GOTO 120 115 IF ER = 1 THEN PFX$ = "/" : CALL -3288 : ER = 0 : GOTO 105 116 IF PEEK (222) = 6 OR PEEK(222) = 16 THEN PFX$ = OP$: ER = 1 : RESUME 117 POKE 216,0 : PRINT "AN ERROR OCCURRED WHEN SETTING PREFIX.": CALL -3288 : END 120 POKE 216,0 : VTAB 3 : HTAB 1 : ? SPC(70);: VTAB 3: HTAB 1 : PRINT PFX$: PRINT : GOSUB %"PARSE_DIR" 125 IF FL THEN 130 126 FOR ZZ = 1 TO LEN (PFX$): IF MID$ (PFX$,ZZ,1) < > "/" THEN NEXT 127 ZX = ZX + 1: NEXT : IF ZX > 2 THEN 129: REM NOT ROOT DIRECTORY 128 GOTO 155 129 PFX$ = PP$: GOTO 100 REM MENU 130 PRINT 131 VP = (PEEK(37) + 1) REM 135 PRINT "D-SET FILETYPE (CURRENT: "; REM 136 IF (TT = -1) THEN PRINT "SAME AS FILE"; : GOTO 139 REM 137 V1 = TT : GOSUB %"TO_HEX" : PRINT R1$; REM 139 PRINT ")" 139 REM 140 VTAB VP : HTAB 1 : PRINT SPC(39); : HTAB 1 : PRINT "A-ALL P-PREFIX F-FORKVIEW Q-QUIT" 141 PRINT SPC(39); : HTAB 1 : PRINT "#-SELECT: ";: 143 DE$ = "" : KL$ = "QPAF0123456789" : POKE 253,5 : POKE 254,(32+16+2) : CALL NU 144 IF ST$ = "Q" THEN PRINT : TEXT : HOME : END 145 IF ST$ = "P" THEN 155 146 IF ST$ = "A" THEN 200 147 IF ST$ = "F" THEN SF = (1 - SF) : GOTO 100 154 GOTO 160 155 OP$ = PFX$: PRINT 156 POKE 253,63 : POKE 254,(32+16+8): DE$=PFX$ : KL$ = "/.ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" 157 PRINT "NEW PREFIX: ";: CALL NU : PFX$ = ST$ : IF PFX$ = "" THEN PFX$ = OP$: GOTO 100 158 IF RIGHT$ (PFX$,1) < > "/" THEN PFX$ = PFX$ + "/" 159 GOTO 100 160 IN = VAL (ST$): IF IN=0 OR IN>FL THEN 140 165 TY = TT REM FC:FDE Index in subdir (starting from 1 for first file) REM BUF:location of FDE in memory 170 FI = FA(IN) - 1:BUF = DIRBUF + FI * 39 + ( INT (FI / 13) + 1) * 5 - 1 REM ST:Storage Type REM FR:Filename Length REM AU:If set, process all files in dir REM IN:list index 175 ST = INT ( PEEK (BUF) / 16):FR = PEEK (BUF) - ST * 16 180 F$ = "": FOR Z = 1 TO FR:F$ = F$ + CHR$ ( PEEK (BUF + Z)): NEXT 185 IF AU AND ST = 13 THEN NEXT : GOTO 100 190 IF ST = 13 THEN PP$ = PFX$:PFX$ = PFX$ + F$ + "/": GOTO 100 195 IF ST = 5 THEN 500 199 PRINT : PRINT "YOU SHOULD NEVER SEE THIS LINE.": END 200 PRINT 210 AU = 1: FOR IN = 1 TO FL 215 GOTO 170 500 REM UNFORK THE FILE 510 HOME 515 PRINT "WORKING ON ";F$ 520 RH = PEEK (BUF + 17) + PEEK (BUF + 18) * 256: REM RESOURCE HEADER BLOCK 530 VE = BUF: REM VOLUME ENTRY LOCATION 540 BK = RH:BUF = RESBUF: GOSUB %"READ_BLOCK": REM LOAD RES.HEADER 545 GOTO 600 550 REM SUB^PROCESS_RES_HEADER {} 560 RB = BUF: IF FK = 1 THEN RB = RB + 256 : REM IF FK, THEN RESOURCE FORK REM LE:Length of fork 570 LE(FK) = PEEK (RB + 5) + PEEK (RB + 6) * 256 + PEEK (RB + 7) * 65536 580 BU(FK) = PEEK (RB + 3) + PEEK (RB + 4) * 256: REM BLOCKS USED BY FORK 585 IB(FK) = PEEK (RB + 1) + PEEK (RB + 2) * 256: REM KEY BLOCK FOR FORK 590 ST(FK) = PEEK (RB): REM STORAGE TYPE 595 RETURN 600 REM INTERPRET FORKS 605 CB = 0:RF = 0:BB = 0 610 FK = 0: GOSUB #"PROCESS_RES_HEADER" 620 FK = 1: GOSUB #"PROCESS_RES_HEADER" 625 CB(CB) = RH:CB = CB + 1 626 IF TY = -1 THEN TY = 6 REM if both DF and RF have data, create new file 630 IF NOT LE(0) OR NOT LE(1) THEN 700 640 RF$ = LEFT$ (F$,13) + ".R" 641 RF = 1 645 PRINT D$;"CREATE ";PFX$;RF$;",T";TY 650 PRINT D$;"BLOAD ";PFX$;",TDIR,A";DIRBUF;",L$3000": REM RELOAD DIRECTORY 700 FK = (LE(0) = 0) 705 BUF = BUF + 256 * FK REM Set correct storage type in FDE (high nibble of first byte) 710 POKE VE, PEEK (VE) - INT ( PEEK (VE) / 16) * 16 + ST(FK) * 16 REM copy fork key block, blocks used, and file length to FDE 720 FOR Y = 1 TO 7: POKE VE + 16 + Y, PEEK (BUF + Y): NEXT : REM MOVE FORK INFO INTO DIR REM set file type (BIN), ProDOS version (0), min ProDOS version (0), aux type ($2000) 725 POKE VE + 16,TY: POKE VE + 28,0: POKE VE + 29,0: POKE VE + 31,0: POKE VE + 32,0: IF TY = 6 THEN POKE VE + 32,32 730 IF NOT RF THEN CB(CB) = IB(FK = 0):CB = CB + 1 740 GOSUB %"FIND_DIR_BLOCK": IF RF AND FK = 0 THEN 750 745 GOTO 900 750 REM SECOND FORK 755 FK = 1 760 GOSUB %"PARSE_DIR" REM CB = Catalog block? 765 CB(CB) = PEEK (VE + 17) + PEEK (VE + 18) * 256:CB = CB + 1 770 BUF = RESBUF: GOTO 705: REM POINT BACK AT RES.HEADER 800 REM SUB^FIND_DIR_BLOCK {} 815 FB = BK:XC = FI:BUF = RWBUF 820 BK = PEEK (VE + 37) + PEEK (VE + 38) * 256 825 GOSUB %"READ_BLOCK" 830 IF XC < 13 THEN DB = BK: GOTO 850: REM FOUND IT 835 XC = XC - 13:BK = PEEK (BUF + 2) + PEEK (BUF + 3) * 256: GOTO 825 850 REM WRITE THE MODIFIED DIRECTORY 855 BUF = DIRBUF + ( INT ((VE - DIRBUF) / 512) * 512) 860 GOSUB %"WRITE_BLOCK" REM if DF is empty, then rename unforked RF 866 IF FK AND NOT RF THEN PRINT D$;"RENAME ";PFX$;F$","PFX$; LEFT$ (F$,13) + ".R" 870 PRINT D$;"BLOAD ";PFX$",TDIR,A";DIRBUF;",L$3000": REM RELOAD DIRECTORY 875 RETURN 900 REM CLEAR UNWANTED BLOCKS FROM BLOCK BITMAP 910 FOR ZX = 0 TO CB - 1 920 BY = INT (CB(ZX) / 8):BT = CB(ZX) - BY * 8 925 IF BY > 511 THEN BB = BB + 1:BY = BY - 512: GOTO 925 930 BK = BB + 6:BUF = RWBUF: GOSUB %"READ_BLOCK": REM READ BITMAP BLOCK 935 POKE BUF + BY, PEEK (BUF + BY) + (2 ^ (7 - BT)): REM FLIP THE BIT 950 GOSUB %"WRITE_BLOCK": REM WRITE BITMAP BLOCK 955 NEXT 959 IF AU THEN NEXT 960 PRINT "FILE";: IF AU THEN PRINT "S"; 970 PRINT " UNFORKED." 975 PRINT : PRINT "PRESS ESC TO QUIT OR ANY KEY TO RESTART" 980 GOSUB %"WAIT_FOR_KEY" : RUN 1000 REM SUB^INIT {} 1010 POKE MLI,32: POKE MLI + 1,0: POKE MLI + 2,191: POKE MLI + 6,96: REM CALL PRODOS COMMAND 1020 POKE MLI + 5, INT (PL / 256): POKE MLI + 4,PL - PEEK (MLI + 5) * 256: REM ADDRESS OF PARM LIST 1030 POKE PL,3: REM # OF PARMS IN LIST 1050 POKE PL + 2,0: REM LOW BYTE OF DATA BUFFER 1060 RETURN 1100 REM SUB^READ_BLOCK {} 1110 POKE MLI + 3,128: REM SET READ COMMAND 1115 POKE PL + 1, PEEK (48944): REM PRODOS UNIT # 1120 POKE PL + 3,BUF / 256: REM BLOCK ADDRESS 1130 POKE PL + 5, INT (BK / 256): POKE PL + 4,BK - PEEK (PL + 5) * 256: REM SET BLOCK # 1134 IF DZ = 0 THEN 1145 1135 IF PEEK (MLI + 3) = 128 THEN PRINT "READ ";: GOTO 1137 1136 PRINT "WRITE"; 1137 PRINT " BLOCK "BK" ", 1138 IF PEEK (MLI + 3) = 128 THEN PRINT "INTO";: GOTO 1140 1139 PRINT "FROM"; 1140 PRINT " ADDRESS ";BUF 1143 IF BK=0 THEN STOP 1145 CALL MLI: REM READ OR WRITE IT 1150 RETURN 1200 REM SUB^WRITE_BLOCK {} 1210 POKE MLI + 3,129: REM SET WRITE COMMAND 1220 GOTO 1115: REM REST IS SAME 1300 REM SUB^WAIT_FOR_KEY {} 1301 WAIT - 16384,128:KB = PEEK ( - 16384): POKE - 16368,0: IF KB - 128 = 27 THEN TEXT : HOME : END 1310 RETURN 1500 REM SUB^PARSE_DIR {} 1501 HOME 1505 FL = 0:FI = 0:BUF = DIRBUF 1510 DB = 33 1520 TF = PEEK (BUF + 4 + DB) + PEEK (BUF + 5 + DB) * 256 + 1: REM TOTAL ENTRIES IN DIRECTORY 1530 IF TF > 312 THEN TF = 312 : REM MAX ENTRIES SUPPORTED 1540 BUF = (BUF + 4) : DB = 0 1545 FOR FC = 1 TO TF 1550 ST = INT ( PEEK (BUF) / 16): REM STORAGE TYPE 1551 FI = FI + 1 : REM INDEX OF FILE IN DIRECTORY 1553 IF ST = 14 OR ST = 15 THEN 1570 : REM SKIP VOL OR SUBDIR HEADER FIRST ENTRY 1555 FR = PEEK (BUF) - ST * 16: REM # OF CHARS IN FILENAME 1556 IF NOT RF THEN 1560 1557 FOR Z = 1 TO FR:XF$ = XF$ + CHR$ ( PEEK (BUF + Z)): NEXT : IF RF$ = XF$ THEN FI = FI - 1:VE = DIRBUF + FI * 39 + ( INT (FI / 13) + 1) * 5 - 1:XF$ = "": RETURN 1558 XF$ = "": GOTO 1570 1560 IF ST = 13 OR ST = 5 THEN 1580 1570 BUF = BUF + 39: IF INT (FI / 13) = FI / 13 THEN BUF = BUF + 5: REM NEXT BLOCK 1571 IF ST = 0 THEN 1550 : REM IF DELETED DON'T PERFORM NEXT SINCE NOT IN FILE COUNT 1575 NEXT 1576 RETURN 1580 REM DIRECTORY OR EXTENDED FILE REM point F$ to filename in buffer 1600 FF = PEEK(105)+PEEK(106)*256+2 : POKE FF,FR : POKE FF+2,INT((BUF+1)/256) : POKE FF+1,((BUF+1)-PEEK(FF+2)*256) REM 1600 FOR Z = 1 TO FR:F$ = F$ + CHR$ ( PEEK (BUF + Z)): NEXT : REM GET FILENAME 1605 IF F$ = "DESKTOP" THEN 1570 1606 FL = FL + 1:FA(FL) = FI 1610 PRINT FL;" ";: HTAB 5 1620 IF ST = 13 THEN PRINT " ";: GOTO 1635 1621 VE = BUF 1622 IF NOT SF THEN PRINT "FRK "; : GOTO 1630 1624 REM IDENTIFY IF RFORK, DFORK, OR BOTH 1625 DR$ = "D" : BK = PEEK (VE + 17) + PEEK (VE + 18) * 256 : BUF = RESBUF : GOSUB #"READ_BLOCK" 1626 IF (PEEK(BUF + 5) + PEEK(BUF + 6) + PEEK(BUF + 7)) = 0 THEN PRINT " "; : GOTO 1629 1628 PRINT DR$;" "; 1629 BUF = (BUF + 256) : IF BUF < (RESBUF + 512) THEN DR$ = "R" : GOTO 1626 1630 BUF = VE : PRINT " "; 1635 GOSUB %"GET_FILETYPE" : FT = 0 1636 PRINT PT$;" "; 1640 PRINT F$; 1641 IF ST = 13 THEN PRINT "/" : GOTO 1645 1642 PRINT 1645 IF FL / 15 = INT (FL / 15) THEN PRINT : PRINT "PRESS A KEY TO CONTINUE...": GOSUB #"WAIT_FOR_KEY" : VTAB 22: PRINT SPC( 35);: VTAB 21: HTAB 1 1650 GOTO 1570 1800 REM SUB^TO_HEX {} 1801 HEX$ = "0123456789ABCDEF" : HN = INT(V1/16) : LN = (V1 - (HN * 16)) : R1$ = ("$" + MID$(HEX$, (HN + 1), 1) + MID$(HEX$, (LN + 1), 1)) 1802 RETURN 2000 REM SUB^GET_FILETYPE REM this is the ProDOS 8 native recognized list, plus common extras 2001 FT = ( (PEEK(BUF+16)) + (-150*(PEEK(BUF+16)>149)) ) 2002 ON FT GOTO ,,,2004,,2006,2007,2008,,,,,,,2015,,,,,,,,,,2025,2026,2027,,2179,,,,,2184,2185,,,,2189,,,,,,,,,,,2200,,,,,,,,,,,,,,,,2216,,,,,,,,2224,,,,,,2080,2081,2082,,,,,,,2239,2240,,,,,,,,,,2250,2251,2252,2253,2254,2255 2003 V1 = FT + (150 * (FT>27 AND FT<150 AND FT<>80 AND FT<>81 AND FT<>82)): FT = 0 : GOSUB #"TO_HEX" : PT$ = R1$ : RETURN : REM IF NO MATCH 2004 PT$ = "TXT" : RETURN 2006 PT$ = "BIN" : RETURN 2007 PT$ = "FNT" : RETURN 2008 PT$ = "FOT" : RETURN 2015 PT$ = " " : RETURN 2025 PT$ = "ADB" : RETURN 2026 PT$ = "AWP" : RETURN 2027 PT$ = "ASP" : RETURN 2080 PT$ = "GWP" : RETURN 2081 PT$ = "GSS" : RETURN 2082 PT$ = "GDB" : RETURN 2179 PT$ = "S16" : RETURN 2184 PT$ = "NDA" : RETURN 2185 PT$ = "CDA" : RETURN 2189 PT$ = "FST" : RETURN 2200 PT$ = "FON" : RETURN 2216 PT$ = "SND" : RETURN 2224 IF (PEEK (BUF + 31) + PEEK (BUF + 32) * 256) = 32770 THEN PT$ = "BII" : RETURN 2225 IF (PEEK (BUF + 31) + PEEK (BUF + 32) * 256) = 32768 THEN PT$ = "SHK" : RETURN 2226 IF (PEEK (BUF + 31) + PEEK (BUF + 32) * 256) = 5 THEN PT$ = "IMG" : RETURN 2239 PT$ = "PAS" : RETURN 2240 PT$ = "CMD" : RETURN 2250 PT$ = "INT" : RETURN 2251 PT$ = "IVR" : RETURN 2252 PT$ = "BAS" : RETURN 2253 PT$ = "VAR" : RETURN 2254 PT$ = "REL" : RETURN 2255 PT$ = "SYS" : RETURN 63001 REM V0.1 7/24/94 63002 REM V0.2 9/1/14 63003 REM V1.2 7/1/15