home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / crossplatform / converters / msdos / arklnx.bas < prev    next >
BASIC Source File  |  1993-09-25  |  6KB  |  239 lines
  1. defint a-z
  2.  
  3. declare sub getinfo (T$, INF$())
  4.  
  5. declare sub readblock (BUF$)
  6.  
  7. declare sub lnxreadline (T$, LINE$)
  8.  
  9. declare sub arkreadline (T$, LINE$)
  10.  
  11.  
  12.  
  13. option base 1
  14.  
  15.  
  16.  
  17. type ENTRYLINE
  18.  
  19.   FILENAME as string * 16
  20.  
  21.   BLOCKS as integer
  22.  
  23.   LASTBLOCK as integer
  24.  
  25.   STRWDS as integer
  26.  
  27. end type
  28.  
  29. ' STRWDS =  +1 STR +2 WDS +4 PIC      +128 MUS
  30.  
  31.  
  32.  
  33. cls
  34.  
  35. print ".ark/lnx (SIDS) VIEWER. iNPUT THE NAME OF A FILE."
  36.  
  37. input FILENAME$
  38.  
  39. FILENAME$ = ucase$(FILENAME$)
  40.  
  41. if right$(FILENAME$, 4) = ".lnx" or right$(FILENAME$, 4) = ".ark" then FILETYPE$ = right$(FILENAME$, 3): FILENAME$ = left$(FILENAME$, len(FILENAME$) - 4)
  42.  
  43. if FILENAME$ = "" or len(FILENAME$) > 8 or FILETYPE$ = "" then print "iNVALID FILENAME.": end
  44.  
  45.  
  46.  
  47. print : print "(s)HORT OR (l)ONG FORMAT ? ";
  48.  
  49. do: FORMAT$ = ucase$(inkey$): loop until FORMAT$ = "l" or FORMAT$ = "s"
  50.  
  51. print FORMAT$
  52.  
  53.  
  54.  
  55. open FILENAME$ + "." + FILETYPE$ for binary access read as 1
  56.  
  57. open FILENAME$ + "." + left$(FILETYPE$, 1) + FORMAT$ for output as 2
  58.  
  59.  
  60.  
  61. call readblock(T$)
  62.  
  63.  
  64.  
  65. select case FILETYPE$
  66.  
  67.   case "lnx"
  68.  
  69.     ZERO = 0
  70.  
  71.     POST = 0
  72.  
  73.     do
  74.  
  75.       POST = POST + 1
  76.  
  77.       if mid$(T$, POST, 1) = chr$(0) then ZERO = ZERO + 1 else ZERO = 0
  78.  
  79.       if POST = 255 then print "eRROR IN FILE": end
  80.  
  81.     loop until ZERO = 3
  82.  
  83.     do
  84.  
  85.       POST = POST + 1
  86.  
  87.     loop until mid$(T$, POST, 1) <> chr$(0)
  88.  
  89.     
  90.  
  91.     T$ = mid$(T$, POST + 1)
  92.  
  93.  
  94.  
  95.     call lnxreadline(T$, L$)
  96.  
  97.     NBLOCKS = val(L$)
  98.  
  99.     call lnxreadline(T$, L$)
  100.  
  101.     NFILES = val(L$)
  102.  
  103.   case "ark"
  104.  
  105.     NFILES = asc(T$)
  106.  
  107.  
  108.  
  109.     T$ = mid$(T$, 2)
  110.  
  111.  
  112.  
  113.     NBLOCKS = int((29 * NFILES + 1) / 254 + .999)
  114.  
  115. end select
  116.  
  117.  
  118.  
  119. for I = 1 to NBLOCKS - 1
  120.  
  121.   call readblock(BUF$)
  122.  
  123.   T$ = T$ + BUF$
  124.  
  125. next I
  126.  
  127.  
  128.  
  129. redim ENTRY(NFILES) as ENTRYLINE, INFO$(NFILES, 5), INF$(5)
  130.  
  131.  
  132.  
  133. for I = 1 to NFILES
  134.  
  135.   select case FILETYPE$
  136.  
  137.     case "lnx"
  138.  
  139.       call lnxreadline(T$, L$)
  140.  
  141.       for J = 1 to 16
  142.  
  143.         if mid$(L$, J, 1) = chr$(160) then mid$(L$, J, 1) = chr$(32)
  144.  
  145.       next J
  146.  
  147.       ENTRY(I).FILENAME = L$
  148.  
  149.       call lnxreadline(T$, L$)
  150.  
  151.       ENTRY(I).BLOCKS = val(L$)
  152.  
  153.       call lnxreadline(T$, L$)
  154.  
  155.       call lnxreadline(T$, L$)
  156.  
  157.       ENTRY(I).LASTBLOCK = val(L$)
  158.  
  159.     case "ark"
  160.  
  161.       call arkreadline(T$, L$)
  162.  
  163.       ENTRY(I).LASTBLOCK = asc(mid$(L$, 2, 1))
  164.  
  165.       for J = 3 to 18
  166.  
  167.         if mid$(L$, J, 1) = chr$(160) then mid$(L$, J, 1) = chr$(32)
  168.  
  169.       next J
  170.  
  171.       ENTRY(I).FILENAME = mid$(L$, 3, 16)
  172.  
  173.       ENTRY(I).BLOCKS = asc(mid$(L$, 28, 1))
  174.  
  175.   end select
  176.  
  177. next I
  178.  
  179.  
  180.  
  181.  
  182.  
  183. for I = 1 to NFILES
  184.  
  185.   T$ = ""
  186.  
  187.   for J = 1 to ENTRY(I).BLOCKS
  188.  
  189.   call readblock(BUF$)
  190.  
  191.   T$ = T$ + BUF$
  192.  
  193.   next J
  194.  
  195.   if right$(rtrim$(ENTRY(I).FILENAME), 4) = ".mus" then
  196.  
  197.   
  198.  
  199.     locate 6, 1: print using " ###"; NFILES - I
  200.  
  201.  
  202.  
  203.     if FORMAT$ = "l" then
  204.  
  205.       MAX = ENTRY(I).BLOCKS * 254 + ENTRY(I).LASTBLOCK - 256
  206.  
  207.       T$ = left$(T$, MAX)
  208.  
  209.       call getinfo(T$, INF$())
  210.  
  211.       for K = 1 to 5: INFO$(I, K) = INF$(K): next K
  212.  
  213.     end if
  214.  
  215.  
  216.  
  217.     FI$ = rtrim$(ENTRY(I).FILENAME)
  218.  
  219.     FI$ = left$(FI$, len(FI$) - 3)
  220.  
  221.     for J = 1 to NFILES
  222.  
  223.       if left$(ENTRY(J).FILENAME, len(FI$)) = FI$ then
  224.  
  225.         Z$ = right$(rtrim$(ENTRY(J).FILENAME), 4)
  226.  
  227.         Z = ENTRY(I).STRWDS or 128
  228.  
  229.         if Z$ = ".str" then Z = Z or 1
  230.  
  231.         if Z$ = ".wds" then Z = Z or 2
  232.  
  233.         if Z$ = ".pic" then Z = Z or 4
  234.  
  235.         ENTRY(I).STRWDS = Z
  236.  
  237.       end if
  238.  
  239.     next J
  240.  
  241.  
  242.  
  243.   end if
  244.  
  245. next I
  246.  
  247.  
  248.  
  249. close 1
  250.  
  251.  
  252.  
  253. FIRST = 1
  254.  
  255. for I = 1 to NFILES
  256.  
  257.   if ENTRY(I).STRWDS <> 0 then
  258.  
  259.     ENTRY(FIRST) = ENTRY(I)
  260.  
  261.     for K = 1 to 5: INFO$(FIRST, K) = INFO$(I, K): next K
  262.  
  263.     FIRST = FIRST + 1
  264.  
  265.   end if
  266.  
  267. next I
  268.  
  269. NFILES = FIRST - 1
  270.  
  271.  
  272.  
  273. locate 6, 1: print "    "
  274.  
  275.  
  276.  
  277. 'SWAP
  278.  
  279. do
  280.  
  281.   SWAPS = 0
  282.  
  283.   for I = 1 to NFILES - 1
  284.  
  285.     if ENTRY(I).FILENAME > ENTRY(I + 1).FILENAME then
  286.  
  287.       SWAPS = 1
  288.  
  289.       swap ENTRY(I), ENTRY(I + 1)
  290.  
  291.       for K = 1 to 5: swap INFO$(I, K), INFO$(I + 1, K): next K
  292.  
  293.     end if
  294.  
  295.   next I
  296.  
  297. loop until SWAPS = 0
  298.  
  299.  
  300.  
  301. for I = 1 to NFILES
  302.  
  303.     SW$ = ".mus"
  304.  
  305.     if ENTRY(I).STRWDS and 1 then SW$ = SW$ + ".str" else SW$ = SW$ + "    "
  306.  
  307.     if ENTRY(I).STRWDS and 2 then SW$ = SW$ + ".wds" else SW$ = SW$ + "    "
  308.  
  309.     if ENTRY(I).STRWDS and 4 then SW$ = SW$ + ".pic" else SW$ = SW$ + "    "
  310.  
  311.     FI$ = rtrim$(ENTRY(I).FILENAME)
  312.  
  313.     FI$ = left$(FI$, len(FI$) - 4)
  314.  
  315.     select case FORMAT$
  316.  
  317.       case "l"
  318.  
  319.         print #2, using " ###  \          \ &     &"; ENTRY(I).BLOCKS; FI$; SW$; INFO$(I, 1)
  320.  
  321.         for K = 2 to 5: print #2, space$(40); INFO$(I, K): next K
  322.  
  323.         print #2,
  324.  
  325.       case "s"
  326.  
  327.         print #2, using " ###  \          \ &"; ENTRY(I).BLOCKS; FI$; SW$
  328.  
  329.     end select
  330.  
  331. next I
  332.  
  333.  
  334.  
  335. close 2
  336.  
  337.  
  338.  
  339. sub arkreadline (T$, LINE$)
  340.  
  341.  
  342.  
  343. POST = 29
  344.  
  345. LINE$ = left$(T$, POST - 1)
  346.  
  347. T$ = mid$(T$, POST + 1)
  348.  
  349.  
  350.  
  351. end sub
  352.  
  353.  
  354.  
  355. sub getinfo (T$, INF$())
  356.  
  357.  
  358.  
  359. MAX = len(T$)
  360.  
  361.  
  362.  
  363. for K = 1 to 5: INF$(K) = "": next K
  364.  
  365. FINALPOST = 9
  366.  
  367. FINALPOST = FINALPOST + asc(mid$(T$, 4, 1) + chr$(0)) * 256 + asc(mid$(T$, 3, 1) + chr$(0))
  368.  
  369. FINALPOST = FINALPOST + asc(mid$(T$, 6, 1) + chr$(0)) * 256 + asc(mid$(T$, 5, 1) + chr$(0))
  370.  
  371. FINALPOST = FINALPOST + asc(mid$(T$, 8, 1) + chr$(0)) * 256 + asc(mid$(T$, 7, 1) + chr$(0))
  372.  
  373.  
  374.  
  375. if mid$(T$, FINALPOST - 1, 1) = "o" then
  376.  
  377.   T$ = mid$(T$, FINALPOST)
  378.  
  379. else
  380.  
  381.   T$ = mid$(T$, 9)
  382.  
  383.  
  384.  
  385.   POST = 0
  386.  
  387.   for I = 1 to 3
  388.  
  389.     POST = instr(POST + 1, T$, "o")
  390.  
  391.     if POST = 0 then exit for
  392.  
  393.   next I
  394.  
  395.   if POST = 0 then exit sub
  396.  
  397.  
  398.  
  399.   T$ = mid$(T$, POST + 1)
  400.  
  401. end if
  402.  
  403.  
  404.  
  405. C64$ = " !#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[\]^_{$60}ABCDEFGHIJKLMNOPQRSTUVWXYZ{$7b}{$7c}{$7d}{$7e}{$7f} {CBM-K}{CBM-I}{CBM-T}{CBM-@}{CBM-G}{CBM-+}{CBM-M}{CBM-POUND}{SHIFT-POUND}{CBM-N}{CBM-Q}{CBM-D}{CBM-Z}{CBM-S}{CBM-P}{CBM-A}{CBM-E}{CBM-R}{CBM-W}{CBM-H}{CBM-J}{CBM-L}{CBM-Y}{CBM-U}{CBM-O}{SHIFT-@}{CBM-F}{CBM-C}{CBM-X}{CBM-V}{CBM-B}{SHIFT-*}ABCDEFGHIJKLMNOPQRSTUVWXYZ{SHIFT-+}{CBM--}{SHIFT--}{$de}{CBM-*} {$e1}{$e2}{$e3}{$e4}{$e5}{$e6}{$e7}{$e8}{$e9}{$ea}{$eb}{$ec}{$ed}{$ee}{$ef}{$f0}{$f1}{$f2}{$f3}{$f4}{$f5}{$f6}{$f7}{$f8}{$f9}{$fa}{$fb}{$fc}{$fd}{$fe}~"
  406.  
  407. IBM$ = " !#$%&'()*+,-./0123456789:;<=>?@abcdefghijklmnopqrstuvwxyz[]^<D#{$7c}----{$7c}{$7c}\\/\\//\#_#{$7c}/xo#{$7c}#+{$7c}{$7c}&\ {$7c}#--{$7c}#{$7c}#/{$7c}{$7c}/\\-/--{$7c}{$7c}{$7c}{$7c}---/\\//#-#{$7c}----{$7c}{$7c}\\/\\//\#_#{$7c}/xo#{$7c}#+{$7c}{$7c}&\ {$7c}#--{$7c}#{$7c}#/{$7c}{$7c}/\\-/--{$7c}{$7c}{$7c}{$7c}---/\\//#"
  408.  
  409.  
  410.  
  411. LIN = 1
  412.  
  413.   for I = 1 to len(T$)
  414.  
  415.     C$ = ""
  416.  
  417.     X = asc(mid$(T$, I, 1) + chr$(0))
  418.  
  419.     Y = instr(C64$, chr$(X))
  420.  
  421.     if Y <> 0 then C$ = mid$(IBM$, Y, 1)
  422.  
  423.     if X = 34 then C$ = chr$(34)
  424.  
  425.     if X = 13 then C$ = "": LIN = LIN + 1: if LIN = 6 then exit for
  426.  
  427.     if X = 0 then exit for
  428.  
  429.     INF$(LIN) = INF$(LIN) + C$
  430.  
  431.   next I
  432.  
  433.  
  434.  
  435. end sub
  436.  
  437.  
  438.  
  439. sub lnxreadline (T$, LINE$)
  440.  
  441.  
  442.  
  443. POST = 0
  444.  
  445. do
  446.  
  447.   POST = POST + 1
  448.  
  449. loop until mid$(T$, POST, 1) = chr$(13)
  450.  
  451.  
  452.  
  453. LINE$ = left$(T$, POST - 1)
  454.  
  455. T$ = mid$(T$, POST + 1)
  456.  
  457.  
  458.  
  459. end sub
  460.  
  461.  
  462.  
  463. sub readblock (BUF$)
  464.  
  465.  
  466.  
  467. BUF$ = space$(254)
  468.  
  469. get #1, , BUF$
  470.  
  471.  
  472.  
  473. end sub
  474.  
  475.  
  476.  
  477.