Paste: id3 parser in joy

(* id3lib.joy *) 

"seqlib" libload . (* for reverse *)

LIBRA

	_id3lib == true ;

HIDE

	(* helper functions *)
	open-read == "r" fopen ;
	seek-end == 2 fseek pop ; (* pop off the 'false' *)
	synchsafe == 0 [ [ 7 bitlshift ] dip bitor ] fold ;
	from-take == [drop] dip take ;
	chars-string == "" swap [swap cons] step reverse ;
	intlist-to-string == [0 = not] filter [chr] map chars-string ;

	(* constants *)
	v1-tag-place == -128 ;
	tag-header-ident-length == 3 ;
	v2-tag-header-length == 10 ;
	v2-tag-header-version-length == 2 ;
	v2-tag-header-flags-length == 1 ;
	v2-tag-header-size-length == 4 ;
	frame-header-length == 10 ;
	frame-id-length == 4 ;
	frame-size-length == 4 ;
	frame-flags-length == 2 ;

	(* file-type indicators *)
	v1-tag-header == ['T 'A 'G] ;
	v2-tag-header == ['I 'D '3] ;
	
	(* v2 functions *)
	read-ident == tag-header-ident-length fread ;
	read-version == v2-tag-header-version-length fread ;
	read-flags == v2-tag-header-flags-length fread ;
	read-size == v2-tag-header-size-length fread ;

	(* v1 functions *)
	read-title == 30 fread intlist-to-string ;
	read-artist == 30 fread intlist-to-string ;
	read-album == 30 fread intlist-to-string ;
	read-year == 4 fread intlist-to-string ;
	read-comment == 30 fread intlist-to-string ;
	read-genre == 1 fread ;
	(* ... n -- seq *)
	mklist == [] swap [cons] times ;

	(* quotations *)
	read-header == [[read-ident]
			[read-version]
			[read-flags]
			[read-size]] ;
	frame-header-quot == 
		[frame-header-length take]
		[[0 frame-id-length from-take]
		 [4 frame-size-length from-take]
		 [8 frame-flags-length from-take]] ;
	v1-data == [[read-title]
		    [read-artist]
		    [read-album]
		    [read-year]
		    [read-comment]
		    [read-genre]] ;

	(* fobj frsize -- fobj fsz all-data *)
	read-id3-data == dup [fread] dip swap ;

	(* seq -- seq frame-header *)
	read-frame-header == 
		frame-header-quot
		construct
		3 mklist ;

	(* x -- [x] *)
	quote == [] cons ;

	(* seq frame-header -- new-seq frame-header *)
	drop-header == [10 drop] dip ;

	(* seq header -- seq header frsz *)
	extract-frame-size == dup rest first synchsafe ;

	(* seq at -- seq1 seq2 *)
	split-at == dupd dup [take] dip swap [drop] dip ;

	(* data frame sz -- data *)
	read-frame-data == [split-at] dip cons 2 take reverse ;

	(* data frame sz -- new-data frame *)
	drop-frame-data == quote [drop] concat dip ;

	(* int-seq-seq -- char-seq-seq *)
	to-char-list == [[chr] map] map ;

	(* frame is, e.g. [ [TALB] [data] ] *)
	(* fsz all-data -- fsz rest-data frame *)
	read-frame == 
		read-frame-header 
		drop-header
		extract-frame-size swap (* sz data fsz frame *)
		read-frame-data 
		to-char-list
		[chars-string] map ;

	(* [[seq]] -- [[seq]] *)
	map-chars-to-strings ==
		[[chars-string] map] map ;

	(* filename -- header *)
	id3v2-header ==
		open-read dup (* fobj fobj *)
		[dup] (* save the file onto the temp stack *)
		read-header
		construct (* run 4 quotations *)
		4 mklist (* cons them up *)	
		3 at synchsafe read-id3-data
		[fclose] dipd ;

IN

	(* filename -- t/f *)
	is-id3v1 == 
		open-read (* fobj *)
		[v1-tag-place seek-end] (* fobj *)
		[tag-header-ident-length fread] (* fobj arr *)
		cleave 
		v1-tag-header equal (* arr header *)
		[fclose] dip ;

	(* fobj -- [v1-data] *)
	read-v1-data == open-read
		v1-tag-place 3 + seek-end
		[dup]
		v1-data
		construct
		6 mklist
		[fclose] dip ;

	(* filename -- t/f *)
	is-id3v2 ==
		open-read dup (* fobj fobj *)
		tag-header-ident-length fread
		v2-tag-header equal
		[fclose] dip ;

	(* sz data -- frames *)
	read-v2-frames == id3v2-header []
		[[[small] [first 0 =] cleave or] dip swap]
		[popd popd] (* remove extra crap and sz *)
		[[read-frame] dip cons]
		tailrec .