extra/cuesheet/cuesheet.factor

   1 ! Copyright (C) 2013 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors ascii combinators io io.encodings.utf8 io.files
   5 io.streams.string kernel math.parser sequences splitting ;
   6
   7 IN: cuesheet
   8
   9 TUPLE: cuesheet catalog cdtextfile files flags remarks performer
  10 songwriter title ;
  11
  12 : <cuesheet> ( -- cuesheet )
  13     f f f f f f f f cuesheet boa ;
  14
  15 TUPLE: file name type tracks ;
  16
  17 : <file> ( name type -- file )
  18     f file boa ;
  19
  20 TUPLE: track number datatype title performer songwriter pregap
  21 indices isrc postgap ;
  22
  23 : <track> ( number datatype -- track )
  24     f f f f f f f track boa ;
  25
  26 TUPLE: index number duration ;
  27
  28 C: <index> index
  29
  30 ERROR: unknown-filetype filetype ;
  31
  32 : check-filetype ( filetype -- filetype )
  33     dup { "BINARY" "MOTOROLA" "AIFF" "WAVE" "MP3" } member?
  34     [ unknown-filetype ] unless ;
  35
  36 ERROR: unknown-flag flag ;
  37
  38 : check-flag ( flag -- flag )
  39     dup { "DCP" "4CH" "PRE" "SCMS" "DATA" } member?
  40     [ unknown-flag ] unless ;
  41
  42 : check-flags ( flags -- flags )
  43     dup [ check-flag drop ] each ;
  44
  45 ERROR: unknown-datatype datatype ;
  46
  47 : check-datatype ( datatype -- datatype )
  48     dup {
  49         "AUDIO" "CDG" "MODE1/2048" "MODE1/2352" "MODE2/2336"
  50         "MODE2/2352" "CDI/2336" "CDI/2352"
  51     } member? [ unknown-datatype ] unless ;
  52
  53 ERROR: unknown-syntax syntax ;
  54
  55 <PRIVATE
  56
  57 : trim-comments ( str -- str' )
  58     dup [ CHAR: ; = ] find drop [ head ] when* ;
  59
  60 : trim-quotes ( str -- str' )
  61     [ CHAR: " = ] trim ;
  62
  63 : last-track ( cuesheet -- cuesheet track )
  64     dup files>> last tracks>> last ;
  65
  66 : track-or-disc ( cuesheet -- cuesheet track/disc )
  67     dup files>> [ dup ] [ last tracks>> last ] if-empty ;
  68
  69 : parse-file ( cuesheet str -- cuesheet )
  70     " " split1-last [ trim-quotes ] [ check-filetype ] bi*
  71     <file> [ suffix ] curry change-files ;
  72
  73 : parse-flags ( cuesheet str -- cuesheet )
  74     check-flag [ suffix ] curry change-flags ;
  75
  76 : parse-index ( cuesheet str -- cuesheet )
  77     [ last-track ] [
  78         " " split1 [ string>number ] dip <index>
  79         [ suffix ] curry change-indices drop
  80     ] bi* ;
  81
  82 : parse-isrc ( cuesheet str -- cuesheet )
  83     [ last-track ] [ >>isrc drop ] bi* ;
  84
  85 : parse-performer ( cuesheet str -- cuesheet )
  86     [ track-or-disc ] [ trim-quotes >>performer drop ] bi* ;
  87
  88 : parse-postgap ( cuesheet str -- cuesheet )
  89     [ last-track ] [ >>postgap drop ] bi* ;
  90
  91 : parse-pregap ( cuesheet str -- cuesheet )
  92     [ last-track ] [ >>pregap drop ] bi* ;
  93
  94 : parse-remarks ( cuesheet str -- cuesheet )
  95     [ suffix ] curry change-remarks ;
  96
  97 : parse-songwriter ( cuesheet str -- cuesheet )
  98     [ track-or-disc ] [ trim-quotes >>songwriter drop ] bi* ;
  99
 100 : parse-title ( cuesheet str -- cuesheet )
 101     [ track-or-disc ] [ trim-quotes >>title drop ] bi* ;
 102
 103 : parse-track ( cuesheet str -- cuesheet )
 104     [ dup files>> last ] [
 105         " " split1 [ string>number ] [ check-datatype ] bi*
 106     ] bi* <track> [ suffix ] curry change-tracks drop ;
 107
 108 : parse-line ( cuesheet line -- cuesheet )
 109     trim-comments [ blank? ] trim " " split1 swap {
 110         { "CATALOG" [ >>catalog ] }
 111         { "CDTEXTFILE" [ >>cdtextfile ] }
 112         { "FILE" [ parse-file ] }
 113         { "FLAGS" [ parse-flags ] }
 114         { "INDEX" [ parse-index ] }
 115         { "ISRC" [ parse-isrc ] }
 116         { "PERFORMER" [ parse-performer ] }
 117         { "POSTGAP" [ parse-postgap ] }
 118         { "PREGAP" [ parse-pregap ] }
 119         { "REM" [ parse-remarks ] }
 120         { "SONGWRITER" [ parse-songwriter ] }
 121         { "TITLE" [ parse-title ] }
 122         { "TRACK" [ parse-track ] }
 123         { "" [ drop ] }
 124         [ unknown-syntax ]
 125     } case ;
 126
 127 PRIVATE>
 128
 129 : read-cuesheet ( -- cuesheet )
 130     <cuesheet> [ readln dup ] [ parse-line ] while drop ;
 131
 132 : file>cuesheet ( path -- cuesheet )
 133     utf8 [ read-cuesheet ] with-file-reader ;
 134
 135 : string>cuesheet ( str -- cuesheet )
 136     [ read-cuesheet ] with-string-reader ;