unmaintained/id3/id3.factor

   1 ! Copyright (C) 2007 Adam Wendt.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: arrays combinators io io.binary io.files io.paths
   5 io.encodings.utf16 kernel math math.parser namespaces sequences
   6 splitting strings assocs unicode.categories io.encodings.binary ;
   7
   8 IN: id3
   9
  10 TUPLE: tag header frames ;
  11 C: <tag> tag
  12
  13 TUPLE: header version revision flags size extended-header ;
  14 C: <header> header
  15
  16 TUPLE: frame id size flags data ;
  17 C: <frame> frame
  18
  19 TUPLE: extended-header size flags update crc restrictions ;
  20 C: <extended-header> extended-header
  21
  22 : debug-stream ( msg -- )
  23 !  global [ . flush ] bind ;
  24   drop ;
  25
  26 : >hexstring ( str -- hex )
  27   >array [ >hex 2 CHAR: 0 pad-left ] map concat ;
  28
  29 : good-frame-id? ( id -- ? )
  30   [ [ LETTER? ] keep digit? or ] all? ;
  31
  32 ! 4 byte syncsafe integer (28 effective bits)
  33 : >syncsafe ( seq -- int )
  34   0 [ >r 7 shift r> bitor ] reduce ;
  35
  36 : read-size ( -- size )
  37   4 read >syncsafe ;
  38
  39 : read-frame-id ( -- id )
  40   4 read ;
  41
  42 : read-frame-flags ( -- flags )
  43   2 read ;
  44
  45 : read-frame-size ( -- size )
  46   4 read be> ;
  47
  48 : text-frame? ( id -- ? )
  49   "T" head? ;
  50
  51 : read-text ( size -- text )
  52   read1 swap 1 - read swap 1 = [ decode-utf16 ] [ ] if
  53   "\0" ?tail drop ; ! remove null terminator
  54
  55 : read-popm ( size -- popm )
  56   read-text ;
  57
  58 : read-frame-data ( id size -- data )
  59   swap
  60   {
  61     { [ dup text-frame? ] [ drop read-text ] }
  62     { [ "POPM" = ] [ read-popm ] }
  63     { [ t ] [ read ] }
  64   } cond ;
  65
  66 : (read-frame) ( id -- frame )
  67   read-frame-size read-frame-flags 2over read-frame-data <frame> ;
  68
  69 : read-frame ( -- frame/f )
  70   read-frame-id dup good-frame-id? [ (read-frame) ] [ drop f ] if ;
  71
  72 : (read-frames) ( vector -- frames )
  73   read-frame [ over push (read-frames) ] when* ;
  74
  75 : read-frames ( -- frames )
  76   V{ } clone (read-frames) ;
  77
  78 : read-eh-flags ( -- flags )
  79   read1 read le> ;
  80
  81 : read-eh-data ( size -- data )
  82   6 - read ;
  83
  84 : read-crc ( flags -- crc )
  85   5 bit? [ read1 read >syncsafe ] [ f ] if ;
  86
  87 : tag-is-update? ( flags -- ? )
  88   6 bit? dup [ read1 drop ] [ ] if ;
  89
  90 : (read-tag-restrictions) ( -- restrictions )
  91   read1 dup read le> ;
  92
  93 : read-tag-restrictions ( flags -- restrictions/f )
  94   4 bit? [ (read-tag-restrictions) ] [ f ] if ;
  95
  96 : (read-extended-header) ( -- extended-header )
  97   read-size read-eh-flags dup tag-is-update? over dup
  98   read-crc swap read-tag-restrictions <extended-header> ;
  99
 100 : read-extended-header ( flags -- extended-header/f )
 101   6 bit? [ (read-extended-header) ] [ f ] if ;
 102
 103 : read-header ( version -- header )
 104   read1 read1 read-size over read-extended-header <header> ;
 105
 106 : (read-id3v2) ( version -- tag )
 107   read-header read-frames <tag> ;
 108
 109 : supported-version? ( version -- ? )
 110     { 3 4 } member? ;
 111
 112 : read-id3v2 ( -- tag/f )
 113   read1 dup supported-version?
 114   [ (read-id3v2) ] [ drop f ] if ;
 115
 116 : id3v2? ( -- ? )
 117   3 read "ID3" sequence= ;
 118
 119 : read-tag ( stream -- tag/f )
 120   id3v2? [ read-id3v2 ] [ f ] if ;
 121
 122 : id3v2 ( filename -- tag/f )
 123   binary [ read-tag ] with-file-reader ;
 124
 125 : file? ( path -- ? )
 126   stat 3drop not ;
 127
 128 : files ( paths -- files )
 129   [ file? ] subset ;
 130
 131 : mp3? ( path -- ? )
 132   ".mp3" tail? ;
 133
 134 : mp3s ( paths -- mp3s )
 135   [ mp3? ] subset ;
 136
 137 : id3? ( file -- ? )
 138   binary [ id3v2? ] with-file-reader ;
 139
 140 : id3s ( files -- id3s )
 141   [ id3? ] subset ;
 142