DEFINT A-Z DECLARE SUB GETINFO (t$, inf$()) DECLARE SUB READBLOCK (buf$) DECLARE SUB LNXREADLINE (t$, line$) DECLARE SUB ARKREADLINE (t$, line$) OPTION BASE 1 TYPE entryline filename AS STRING * 16 blocks AS INTEGER lastblock AS INTEGER strwds AS INTEGER END TYPE ' strwds = +1 str +2 wds +4 pic +128 mus CLS PRINT ".ARK/LNX (sids) viewer. Input the name of a file." INPUT filename$ filename$ = UCASE$(filename$) IF RIGHT$(filename$, 4) = ".LNX" OR RIGHT$(filename$, 4) = ".ARK" THEN filetype$ = RIGHT$(filename$, 3): filename$ = LEFT$(filename$, LEN(filename$) - 4) IF filename$ = "" OR LEN(filename$) > 8 OR filetype$ = "" THEN PRINT "Invalid filename.": END PRINT : PRINT "(S)hort or (L)ong format ? "; DO: format$ = UCASE$(INKEY$): LOOP UNTIL format$ = "L" OR format$ = "S" PRINT format$ OPEN filename$ + "." + filetype$ FOR BINARY ACCESS READ AS 1 OPEN filename$ + "." + LEFT$(filetype$, 1) + format$ FOR OUTPUT AS 2 CALL READBLOCK(t$) SELECT CASE filetype$ CASE "LNX" zero = 0 post = 0 DO post = post + 1 IF MID$(t$, post, 1) = CHR$(0) THEN zero = zero + 1 ELSE zero = 0 IF post = 255 THEN PRINT "Error in file": END LOOP UNTIL zero = 3 DO post = post + 1 LOOP UNTIL MID$(t$, post, 1) <> CHR$(0) t$ = MID$(t$, post + 1) CALL LNXREADLINE(t$, l$) nblocks = VAL(l$) CALL LNXREADLINE(t$, l$) nfiles = VAL(l$) CASE "ARK" nfiles = ASC(t$) t$ = MID$(t$, 2) nblocks = INT((29 * nfiles + 1) / 254 + .999) END SELECT FOR i = 1 TO nblocks - 1 CALL READBLOCK(buf$) t$ = t$ + buf$ NEXT i REDIM entry(nfiles) AS entryline, info$(nfiles, 5), inf$(5) FOR i = 1 TO nfiles SELECT CASE filetype$ CASE "LNX" CALL LNXREADLINE(t$, l$) FOR j = 1 TO 16 IF MID$(l$, j, 1) = CHR$(160) THEN MID$(l$, j, 1) = CHR$(32) NEXT j entry(i).filename = l$ CALL LNXREADLINE(t$, l$) entry(i).blocks = VAL(l$) CALL LNXREADLINE(t$, l$) CALL LNXREADLINE(t$, l$) entry(i).lastblock = VAL(l$) CASE "ARK" CALL ARKREADLINE(t$, l$) entry(i).lastblock = ASC(MID$(l$, 2, 1)) FOR j = 3 TO 18 IF MID$(l$, j, 1) = CHR$(160) THEN MID$(l$, j, 1) = CHR$(32) NEXT j entry(i).filename = MID$(l$, 3, 16) entry(i).blocks = ASC(MID$(l$, 28, 1)) END SELECT NEXT i FOR i = 1 TO nfiles t$ = "" FOR j = 1 TO entry(i).blocks CALL READBLOCK(buf$) t$ = t$ + buf$ NEXT j IF RIGHT$(RTRIM$(entry(i).filename), 4) = ".MUS" THEN LOCATE 6, 1: PRINT USING " ###"; nfiles - i IF format$ = "L" THEN max = entry(i).blocks * 254 + entry(i).lastblock - 256 t$ = LEFT$(t$, max) CALL GETINFO(t$, inf$()) FOR k = 1 TO 5: info$(i, k) = inf$(k): NEXT k END IF fi$ = RTRIM$(entry(i).filename) fi$ = LEFT$(fi$, LEN(fi$) - 3) FOR j = 1 TO nfiles IF LEFT$(entry(j).filename, LEN(fi$)) = fi$ THEN z$ = RIGHT$(RTRIM$(entry(j).filename), 4) z = entry(i).strwds OR 128 IF z$ = ".STR" THEN z = z OR 1 IF z$ = ".WDS" THEN z = z OR 2 IF z$ = ".PIC" THEN z = z OR 4 entry(i).strwds = z END IF NEXT j END IF NEXT i CLOSE 1 first = 1 FOR i = 1 TO nfiles IF entry(i).strwds <> 0 THEN entry(first) = entry(i) FOR k = 1 TO 5: info$(first, k) = info$(i, k): NEXT k first = first + 1 END IF NEXT i nfiles = first - 1 LOCATE 6, 1: PRINT " " 'swap DO swaps = 0 FOR i = 1 TO nfiles - 1 IF entry(i).filename > entry(i + 1).filename THEN swaps = 1 SWAP entry(i), entry(i + 1) FOR k = 1 TO 5: SWAP info$(i, k), info$(i + 1, k): NEXT k END IF NEXT i LOOP UNTIL swaps = 0 FOR i = 1 TO nfiles sw$ = ".MUS" IF entry(i).strwds AND 1 THEN sw$ = sw$ + ".STR" ELSE sw$ = sw$ + " " IF entry(i).strwds AND 2 THEN sw$ = sw$ + ".WDS" ELSE sw$ = sw$ + " " IF entry(i).strwds AND 4 THEN sw$ = sw$ + ".PIC" ELSE sw$ = sw$ + " " fi$ = RTRIM$(entry(i).filename) fi$ = LEFT$(fi$, LEN(fi$) - 4) SELECT CASE format$ CASE "L" PRINT #2, USING " ### \ \ & &"; entry(i).blocks; fi$; sw$; info$(i, 1) FOR k = 2 TO 5: PRINT #2, SPACE$(40); info$(i, k): NEXT k PRINT #2, CASE "S" PRINT #2, USING " ### \ \ &"; entry(i).blocks; fi$; sw$ END SELECT NEXT i CLOSE 2 SUB ARKREADLINE (t$, line$) post = 29 line$ = LEFT$(t$, post - 1) t$ = MID$(t$, post + 1) END SUB SUB GETINFO (t$, inf$()) max = LEN(t$) FOR k = 1 TO 5: inf$(k) = "": NEXT k finalpost = 9 finalpost = finalpost + ASC(MID$(t$, 4, 1) + CHR$(0)) * 256 + ASC(MID$(t$, 3, 1) + CHR$(0)) finalpost = finalpost + ASC(MID$(t$, 6, 1) + CHR$(0)) * 256 + ASC(MID$(t$, 5, 1) + CHR$(0)) finalpost = finalpost + ASC(MID$(t$, 8, 1) + CHR$(0)) * 256 + ASC(MID$(t$, 7, 1) + CHR$(0)) IF MID$(t$, finalpost - 1, 1) = "O" THEN t$ = MID$(t$, finalpost) ELSE t$ = MID$(t$, 9) post = 0 FOR i = 1 TO 3 post = INSTR(post + 1, t$, "O") IF post = 0 THEN EXIT FOR NEXT i IF post = 0 THEN EXIT SUB t$ = MID$(t$, post + 1) END IF c64$ = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ" ibm$ = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[œ]^<Ä#|----||\\/\\//\#_#|/XO#|#+||&\ |#--|#|#/||/\\-/--||||---/\\//#-#|----||\\/\\//\#_#|/XO#|#+||&\ |#--|#|#/||/\\-/--||||---/\\//#" lin = 1 FOR i = 1 TO LEN(t$) c$ = "" x = ASC(MID$(t$, i, 1) + CHR$(0)) y = INSTR(c64$, CHR$(x)) IF y <> 0 THEN c$ = MID$(ibm$, y, 1) IF x = 34 THEN c$ = CHR$(34) IF x = 13 THEN c$ = "": lin = lin + 1: IF lin = 6 THEN EXIT FOR IF x = 0 THEN EXIT FOR inf$(lin) = inf$(lin) + c$ NEXT i END SUB SUB LNXREADLINE (t$, line$) post = 0 DO post = post + 1 LOOP UNTIL MID$(t$, post, 1) = CHR$(13) line$ = LEFT$(t$, post - 1) t$ = MID$(t$, post + 1) END SUB SUB READBLOCK (buf$) buf$ = SPACE$(254) GET #1, , buf$ END SUB