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