# MPLSParser.tcl (c) r0lZ 2014 - 2023
# This file is part of BD3D2MK3D.  All rights reserved.
# (c) 2012-2023 r0lZ - Open source
#
# Code to parse a BD MPLS file,
# with some additional utilities.
# Version 2017.01.18
#
# MPLS 3D extensions: See http://forum.doom9.org/showthread.php?t=171140

###############################################################################
# Main parser procedures
###############################################################################

# Main MPLS parser entry point.
#
# data: content of the MPLS file
# filename: used only to add the MPLS file name in the output
# skip_2d: returns an error if the playlist is a 2D playlist
#
# Result: A single string upon error,
# or a list of name and value pairs.
# Some values are sub-lists of names and values pairs.
# Global structure:
#
# mpls_filename 00001.mpls
# is3d true
# num_angles 3
# pi_list_count 3
# pi_list {list of play items - See MplsParsePlayitem for details}
# total_duration 256080824
# base_view_flag 0
# num_video 1
# video_streams {list of video streams - See MplsParseStream for details}
# num_audio 4
# audio_streams {list of audio streams - See MplsParseStream for details}
# num_pg 7
# pg_streams {list of subtitle streams - See MplsParseStream for details}
# num_ig 0
# num_secondary_audio 0
# num_secondary_video 0
# num_pip_pg 0
# chapters {list of chapter times}
# mvc_streams {list of MVC video streams - See MplsParseStream for details}
# planes3d {list of 3D-plane numbers, in the same order than the subtitle streams}
# mvc_files {list of the M2TS IDs containing the MVC streams, including the angles}
proc MplsParseMpls {data filename {skip_2d true}} {
	set output {}
	lappend output mpls_filename [file tail $filename]

	# parse header
	if {[string range $data 0 3] != "MPLS"} {
		return [list "Invalid MPLS identifier"]
	}
# 	if {[string range $data 0 7] == "MPLS0300"} {
# 		return [list "UHD BD not yet supported"]
# 	}
	binary scan $data @8H8H8H8@56H2 list_pos mark_pos ext_pos flags
	foreach i {list_pos mark_pos ext_pos flags} {
		set $i [expr [subst 0x\$$i]]
	}
	set base_view_flag [expr ($flags & 0x10) / 0x10]

	set is3d false
	if {$ext_pos == 0} {
		set ext_length 0
		if {$skip_2d} {
			return [list "Not a 3D playlist"]
		}
	} else {
		set pos $ext_pos
		binary scan $data @${pos}H8 ext_length
		set ext_length [expr 0x$ext_length]
		if {$ext_length == 0} {
			if {$skip_2d} {
				return [list "Not a 3D playlist"]
			}
		} else {
			incr pos 4
			binary scan $data @${pos}H14H2 pad num_entries
			set num_entries [expr 0x$num_entries]
			incr pos 8
			set is3d false
			for {set ii 0} {$ii < $num_entries} {incr ii} {
				binary scan $data @${pos}H4H4 id1 id2
				foreach i {id1 id2} {
					set $i [expr [subst 0x\$$i]]
				}
				if {$id1 == 2 && $id2 == 2} {
					set is3d true
					break
				}
				incr pos 12
			}
		}
	}
	if {! $is3d && $skip_2d} {
		return [list "Not a 3D playlist"]
	}
	lappend output is3d $is3d

	# parse PlayItem list
	binary scan $data @${list_pos}H12H4 dummy pi_list_count
	set pi_list_count [expr 0x$pi_list_count]

	set total_duration 0

	set pipos [expr $list_pos + 10]
	set streams [MplsParsePlayitem1Streams $data $pipos]

	foreach {var val} $streams {
		set pi(0,$var) $val
		#puts "pi(0,$var) = $val"
	}
	set pi_list {}
	set max_num_angles 0
	for {set ii 0} {$ii < $pi_list_count} {incr ii} {
		set r [MplsParsePlayitem $data $pipos]
		set len [lindex $r 0]
		set pidata [lindex $r 1]
		lappend pi_list $pidata
		foreach {var val} $pidata {
			set pi($ii,$var) $val
			#puts "pi($ii,$var) = $val"
		}
		if {$pi($ii,num_angles) > $max_num_angles} {
			set max_num_angles $pi($ii,num_angles)
		}
		incr pipos [expr $len + 2]
		incr total_duration $pi($ii,duration)
	}
	lappend output num_angles $max_num_angles
	lappend output pi_list_count $pi_list_count
	lappend output pi_list $pi_list

	lappend output total_duration $total_duration
	if {$is3d} {
		lappend output base_view_flag $base_view_flag
	}
	set output [concat $output $streams]

	# parse playlist marks
	set marks [MplsParseMarks $data $mark_pos pi]
	lappend output chapters $marks

	# Parse extensions
	if {$ext_pos > 0} {
		lappend output mvc_streams [MplsParseMVCStreams $data $ext_pos $pi(0,num_video)]
		lappend output planes3d    [MplsParse3Dplanes   $data $ext_pos $pi(0,num_video) $pi(0,num_pg)]
		lappend output mvc_files   [MplsParseMVCFiles   $data $ext_pos]
	}

	return $output
}

# Get streams from the first play item of the MPLS
#
# data: content of the MPLS file
# pos: position of the beginning of the Play Items in data
#
# Result: The list of the video, audio, PG and MVC streams from the first PlayItem
# See MplsParseStream for details
proc MplsParsePlayitem1Streams {data pos} {
	incr pos 11
	binary scan $data @${pos}H4 bits
	set bits [expr 0x$bits]
	set is_multi_angle [expr ($bits & 0x16) / 16]
	incr pos 23
	if {$is_multi_angle} {
		binary scan $data @${pos}H2 num_angles
		set num_angles [expr 0x$num_angles]
		incr pos [expr (($num_angles -1) * 10) + 2]
	}
	incr pos 4
	binary scan $data @${pos}H2H2H2H2H2H2H2 num_video num_audio num_pg num_ig \
			num_secondary_audio num_secondary_video num_pip_pg
	foreach i {num_video num_audio num_pg num_ig num_secondary_audio num_secondary_video num_pip_pg} {
		set $i [expr [subst 0x\$$i]]
	}
	incr pos 12

	set streams {}

	lappend streams num_video $num_video video_streams
	set s {}
	for {set ii 0} {$ii < $num_video} {incr ii} {
		set r [MplsParseStream $data $pos]
		set pos [lindex $r 0]
		lappend s [lindex $r 1]
	}
	lappend streams $s

	lappend streams num_audio $num_audio audio_streams
	set s {}
	for {set ii 0} {$ii < $num_audio} {incr ii} {
		set r [MplsParseStream $data $pos]
		set pos [lindex $r 0]
		lappend s [lindex $r 1]
	}
	lappend streams $s

	lappend streams num_pg $num_pg pg_streams
	set s {}
	for {set ii 0} {$ii < $num_pg} {incr ii} {
		set r [MplsParseStream $data $pos]
		set pos [lindex $r 0]
		lappend s [lindex $r 1]
	}
	lappend streams $s

	lappend streams num_ig $num_ig num_secondary_audio $num_secondary_audio \
			num_secondary_video $num_secondary_video num_pip_pg $num_pip_pg

	return $streams
}

# Get the description of the Play Items of the MPLS, without the streams
#
# data: content of the MPLS file
# pos: position of the beginning of the Play Items in data
#
# Result: pi_list: A list of descriptions of the Play Items of the MPLS.
# Each description is a list of name and value pairs:
# clip_id 00345
# num_angles 3
# angle_clip_ids {00350 00359}	;# This list is empty if num_angles == 0
# in_time 524280
# out_time 1321951
# duration 797671
proc MplsParsePlayitem {data pos} {
	binary scan $data @${pos}H4 len
	set len [expr 0x$len]
	incr pos 2
	set clip_id [string range $data $pos [expr $pos+4]]
	incr pos 9
	binary scan $data @${pos}H4H2H8H8 bits stc_id in_time out_time
	foreach i {bits stc_id in_time out_time} {
		set $i [expr [subst 0x\$$i]]
	}
	set duration [expr $out_time - $in_time]
	set is_multi_angle [expr ($bits & 0x16) / 16]
	incr pos 23
	set angle_clip_ids {}
	if {$is_multi_angle} {
		binary scan $data @${pos}H2 num_angles
		incr pos
		set num_angles [expr 0x$num_angles]
		# skip reserved, is_different_audio, is_seamless_angle_change
		incr pos
		for {set ii 1} {$ii < $num_angles} {incr ii} {
			# angle clip_id
			lappend angle_clip_ids [string range $data $pos [expr $pos+4]]
			incr pos 10
		}
	} else {
		set num_angles 0
	}
	return [list $len [list clip_id $clip_id num_angles $num_angles angle_clip_ids $angle_clip_ids \
			in_time $in_time out_time $out_time duration $duration]]
}

# Get the description of a single stream from a PlayItem
#
# data: content of the MPLS file
# pos: position of the beginning of the Stream within the Play Item in data
#
# Result: stream: A list of name and value pairs describing the stream.
# The content of the list is different for each stream type.
#
# Video stream:
# stream_type 1
# pid 4113
# coding_type 27
# format 6
# rate 1
#
# Audio stream:
# stream_type 1
# pid 4352
# coding_type 134
# format 6
# rate 1
# lang eng
#
# PG stream:
# stream_type 1
# pid 4608
# coding_type 144
# lang eng
#
# MVC stream:
# stream_type 2
# pid 4114
# coding_type 32
# format 6
# rate 1
# num_planes 32
# NOTE: For MVC streams, use MplsParseMVCStreams instead of this function!
#
# Note: the IG, secondary_audio, secondary_video and pip_pg streams are nnot handled.
proc MplsParseStream {data pos} {
	set out {}
	incr pos
	binary scan $data @${pos}H2 stream_type
	set stream_type [expr 0x$stream_type]
	lappend out stream_type $stream_type
	incr pos
	switch $stream_type {
		1 {
			binary scan $data @${pos}H4 pid
			set pid [expr 0x$pid]
			lappend out pid $pid
		}
		2 - 4 {
			binary scan $data @${pos}H2H2H4 subpath_id subclip_id pid
			foreach i {subpath_id subclip_id pid} {
				set $i [expr [subst 0x\$$i]]
			}
			lappend out subpath_id $subpath_id subclip_id $subclip_id pid $pid
		}
		3 {
			binary scan $data @${pos}H2H4 subpath_id pid
			foreach i {subpath_id pid} {
				set $i [expr [subst 0x\$$i]]
			}
			lappend out subpath_id $subpath_id pid $pid
		}
		default {
			puts stderr "Unrecognized stream type $stream_type"
		}
	}
	incr pos 8

	# parse stream attributes

	binary scan $data @${pos}H2H2 len2 coding_type
	set len2 [expr 0x$len2]
	set coding_type [expr 0x$coding_type]
	lappend out coding_type $coding_type
	incr pos 2

	switch $coding_type {
		1 - 2 - 27 - 32 - 234 - 36 {
			binary scan $data @${pos}H4 tmp
			set format [expr (0x$tmp & 0xF000) / 0x1000]
			set rate   [expr (0x$tmp & 0x0F00) / 0x0100]
			lappend out format $format rate $rate
			incr pos 4
		}
		3 - 4 - 128 - 129 - 130 - 131 - 132 - 133 - 134 {
			binary scan $data @${pos}H4 tmp
			set format [expr (0x$tmp & 0xF000) / 0x1000]
			set rate   [expr (0x$tmp & 0x0F00) / 0x0100]
			incr pos
			set lang [string range $data $pos [expr $pos+2]]
			if {$lang == "\000\000\000"} {set lang "und"}
			lappend out format $format rate $rate lang $lang
			incr pos 3
		}
		144 - 145 {
			set lang [string range $data $pos [expr $pos+2]]
			if {$lang == "\000\000\000"} {set lang "und"}
			lappend out lang $lang
			incr pos 4
		}
		146 {
			binary scan $data @${pos}H2 char_code
			set char_code [expr 0x$char_code]
			incr pos
			set lang [string range $data $pos [expr $pos+2]]
			if {$lang == "\000\000\000"} {set lang "und"}
			lappend out char_code $char_code lang $lang
			incr pos 3
		}
		default {
			puts stderr "Unrecognized stream coding type $coding_type"
			incr pos 4
		}
	}
	return [list $pos $out]
}

# Get the chapter points of a MPLS file.
#
# data: content of the MPLS file
# pos: position of the beginning of the Marks in data
# piarray: Array of the PlayItems from the MPLS file (pi_data converted to array
#          in the form piarray(PlayItemNumber,value_name)
#
# Result: The list of times of all chapter points.
# Note: the marks are converted to absolute time, starting at 0:00:00.000
# and are given in ticks at 45000 hertz.
proc MplsParseMarks {data pos piarray} {
	upvar $piarray pi

	# length, number of marks
	binary scan $data @${pos}H8H4 mark_length mark_count
	set mark_count [expr 0x$mark_count]
	#puts "At pos $pos: mark_length 0x$mark_length, mark_count $mark_count"
	incr pos 6
	set marks {}
	for {set ii 0} {$ii < $mark_count} {incr ii} {
		binary scan $data @${pos}H2H2H4H8H4H8 mark_id mark_type play_item_ref time entry_es_pid duration
		foreach i {mark_id mark_type play_item_ref time entry_es_pid duration} {
			set $i [expr [subst 0x\$$i]]
			#puts "mark $ii: $i = [expr [subst 0x\$$i]]"
		}
		if {$mark_id == 0 && $mark_type == 1} {
			set abs_time [expr $time - $pi($play_item_ref,in_time)]
			for {set i 0} {$i < $play_item_ref} {incr i} {
				incr abs_time $pi($i,duration)
			}
			lappend marks $abs_time
		}
		incr pos 14
	}
	return $marks
}

# Get 3D plane numbers from the MPLS
#
# data: content of the MPLS file
# extensions_start_address: position of the extensions in data
# num_video: number of video streams (NOT including the MVC streams)
# num_pg: number of PG streams in the MPLS
#
# Result:
# list of num_pg 3D-plane numbers.
# Note: The 3D_plane number is replaced by the list of the 2 PG_stream_PIDs for 2P stereo mode.
# BUG: The bottom aligned and Top aligned modes are currently not handled!
proc MplsParse3Dplanes {data extensions_start_address num_video num_pg} {
	if {$extensions_start_address == 0} {
		return ""
	}
	set data [string range $data $extensions_start_address end]
	binary scan $data @0H8 length
	set length [expr 0x$length]
	if {$length == 0} {
		return ""
	}
	set ext_pos 4

	binary scan $data @${ext_pos}H14H2 pad num_entries
	set num_entries [expr 0x$num_entries]
	incr ext_pos 8

	set planes {}

	for {set ii 0} {$ii < $num_entries} {incr ii} {
		binary scan $data @${ext_pos}H4H4H8 id1 id2 pos
		foreach i {id1 id2 pos} {
			set $i [expr [subst 0x\$$i]]
		}
		if {$id1 == 2 && $id2 == 1} {
			set offset 0
			binary scan $data @${pos}H4 ext_len
			set ext_len [expr 0x$ext_len]
			incr pos 4
			incr offset 2

			for {set ii 0} {$ii < $num_video} {incr ii} {
				incr pos 18
				incr offset 18
			}
			set maxplanes [expr ($ext_len - $offset) / 2]
			if {$num_pg < $maxplanes} {
				set maxplanes $num_pg
			}
			set planes {}
			for {set ii 0} {$ii < $maxplanes} {incr ii} {
				binary scan $data @${pos}H2H2 plane_num plane_type
				set plane_num  [expr 0x$plane_num]
				set plane_type [expr 0x$plane_type]
				incr pos 2
				switch $plane_type {
					0 {
						lappend planes $plane_num
					}
					1 {
						# pg is bottom aligned
						# TODO: BUG: How many bytes to skip?
						binary scan $data @${pos}H2 length
						incr pos
						incr pos $length
					}
					2 {
						# pg is top aligned
						# TODO: BUG: How many bytes to skip?
						binary scan $data @${pos}H2 length
						incr pos
						incr pos $length
					}
					4 {
						# 2P stereo mode
						# TODO: Verify
						binary scan $data @${pos}H2H2H2H2H4H8H2H2H2H2H4H8 \
								length1 type1 subpath_id1 subclip_entry_id1 stream_pid1 reserved \
								length2 type2 subpath_id2 subclip_entry_id2 stream_pid2 reserved
						foreach i {length1 type1 subpath_id1 subclip_entry_id1 stream_pid1 \
								   length2 type2 subpath_id2 subclip_entry_id2 stream_pid2} {
							set $i [expr [subst 0x\$$i]]
						}
						lappend planes [list $stream_pid1 $stream_pid2]
						incr pos 20
					}
				}
			}
			break
		}
		incr ext_pos 12
	}
	return $planes
}

# Get the description of the MVC streams from a PlayItem
#
# data: content of the MPLS file
# pos: position of the beginning of the Stream within the Play Item in data
#
# Result: streams: A list of lists of name and value pairs describing the MVC streams.
#
# Content of a single MVC stream:
# stream_type 2
# pid 4114
# coding_type 32
# format 6
# rate 1
# num_planes 32
proc MplsParseMVCStreams {data extensions_start_address num_video} {
	if {$extensions_start_address == 0} {
		return ""
	}
	set data [string range $data $extensions_start_address end]
	binary scan $data @0H8 length
	set length [expr 0x$length]
	if {$length == 0} {
		return ""
	}
	set ext_pos 4

	binary scan $data @${ext_pos}H14H2 pad num_entries
	set num_entries [expr 0x$num_entries]
	incr ext_pos 8

	set streams {}

	for {set ii 0} {$ii < $num_entries} {incr ii} {
		binary scan $data @${ext_pos}H4H4H8 id1 id2 pos
		foreach i {id1 id2 pos} {
			set $i [expr [subst 0x\$$i]]
		}
		if {$id1 == 2 && $id2 == 1} {
			set offset 0
			binary scan $data @${pos}H4 ext_len
			set ext_len [expr 0x$ext_len]
			incr pos 4
			for {set ii 0} {$ii < $num_video} {incr ii} {
				set stream {}
				binary scan $data @${pos}H2H2H2H2H4H8H2H2H2H6H2H2 str_len stream_type subpath_id \
						subclip_entry_id pid reserved attr_len coding_type \
						video_format_framerate reserved reserved num_planes
				foreach i {str_len stream_type subpath_id \
						subclip_entry_id pid reserved attr_len coding_type \
						video_format_framerate reserved reserved num_planes} {
					set $i [expr [subst 0x\$$i]]
				}
				set format [expr ($video_format_framerate & 0xF0) / 0x10]
				set rate   [expr  $video_format_framerate & 0x0F]

				foreach i {stream_type pid coding_type format rate num_planes} {
					lappend stream $i [subst \$$i]
				}
				lappend streams $stream
				incr pos 18
			}
			break
		}
		incr ext_pos 12
	}
	return $streams
}

# Get the IDs of the M2TS files containing the MVC streams from the MPLS
#
# data: content of the MPLS file
# extensions_start_address: position of the extensions in data
# num_video: number of video streams (NOT including the MVC streams)
#
# Result:
# list of M2TS_file_IDs
# Note: Currently, this function is implemented using a very basic algorithm:
# it searches for the M2TS string in the MVC extension, and get the 5 numbers preceeding them.
# That means that the M2TS IDs are returned in the order they are found, with the angle M2TS
# in the middle of the 'normal" M2TS.
proc MplsParseMVCFiles {data extensions_start_address} {
	if {$extensions_start_address == 0} {
		return ""
	}
	set data [string range $data $extensions_start_address end]
	binary scan $data @0H8 length
	set length [expr 0x$length]
	if {$length == 0} {
		return ""
	}
	set ext_pos 4

	binary scan $data @${ext_pos}H14H2 pad num_entries
	set num_entries [expr 0x$num_entries]
	incr ext_pos 8

	set files {}

	for {set ii 0} {$ii < $num_entries} {incr ii} {
		binary scan $data @${ext_pos}H4H4H8 id1 id2 pos
		foreach i {id1 id2 pos} {
			set $i [expr [subst 0x\$$i]]
		}
		if {$id1 == 2 && $id2 == 2} {
			# Cheap parsing: returns only the file names of the MPLS files
			# (For multi-angle files, returns all angles, in this order:
			# part1, part2_angle1, part2_angle2, part2_angle3, part3)
			binary scan $data @${pos}H8 ext_len
			set ext_len [expr 0x$ext_len]
			set data [string range $data [expr $pos+4] [expr $pos+4+$ext_len]]
			set idx [string first "M2TS" $data]
			while {$idx > 4} {
				lappend files [string range $data [expr $idx-5] [expr $idx-1]]
				incr idx 3
				set idx [string first "M2TS" $data $idx]
			}
			break
		}
		incr ext_pos 12
	}
	return $files
}

# Extract the list of the M2TS files for a specific angle of the specified MPLS ID.
#
# mpls_id: The ID of the MPLS to extract the list of M2TS files from.
# angle: The angle for which the M2TS files must be extracted.
#
# Result:
# List of MPLS IDs, in the correct order.
# Note: if angle <= 1 or angle > number_of_angles, returns angle 1.
proc GetM2TSList {mpls_id {angle 1} {2D_mode false}} {
	set m2ts_list {}
	if {$2D_mode} {
		array set pl $::playlists2d($mpls_id)
	} else {
		array set pl $::playlists($mpls_id)
	}
	foreach playitem $pl(pi_list) {
		array set pi $playitem
		if {$angle <= 1} {
			lappend m2ts_list $pi(clip_id)
		} elseif {$pi(num_angles) >= $angle} {
			lappend m2ts_list [lindex $pi(angle_clip_ids) [expr $angle-2]]
		} else {
			lappend m2ts_list $pi(clip_id)
		}
	}
	return $m2ts_list
}


###############################################################################
# Procedures to format the MPLS info to human readable form
###############################################################################

array set ::codec_map {
	1   "MPEG1"
	2   "MPEG2"
	3   "MPEG1"
	4   "MPEG2"
	27  "AVC"
	32  "MVC"
	36  "HEVC"
	128 "LPCM"
	129 "AC3"
	130 "DTS"
	131 "TrueHD"
	132 "AC3+"
	133 "DTS-HD"
	134 "DTS-HD-Master"
	144 "PGS"
	145 "IGS"
	146 "TextSub"
	234 "VC1"
}

array set ::codec_map_tsmuxer {
	1   "V_MPEG-1"
	2   "V_MPEG-2"
	3   "A_MPEG-1"
	4   "A_MPEG-2"
	27  "V_MPEG4/ISO/AVC"
	32  "V_MPEG4/ISO/MVC"
	128 "A_LPCM"
	129 "A_AC3"
	130 "A_DTS"
	131 "A_AC3"
	132 "A_AC3"
	133 "A_DTS"
	134 "A_DTS"
	144 "S_HDMV/PGS"
	145 "S_HDMV/PGS"
	146 "S_TEXT/UTF8"
	234 "V_MS/VFW/WVC1"
}

array set ::video_format_map {
	1 "480i"
	2 "576i"
	3 "480p"
	4 "1080i"
	5 "720p"
	6 "1080p"
	7 "576p"
	8 "UHD"
}

array set ::video_rate_map {
	1 "23.976"
	2 "24"
	3 "25"
	4 "29.97"
	6 "50"
	7 "59.94"
}

array set ::video_rate_map_exact {
	1 24000/1001
	2 24
	3 25
	4 30000/1001
	6 50
	7 60000/1001
}

array set ::video_rate_map_symbolic {
	1 "ntsc_film"
	2 "film"
	3 "pal_film"
	4 "ntsc_video"
	6 "pal_double"
	7 "ntsc_double"
}

array set ::audio_format_map {
	1 "Mono"
	3 "Stereo"
	6 "Multi-channel"
	12 "Stereo/Multi-channel"
}

array set ::audio_rate_map {
	1 "48"
	4 "96"
	5 "192"
	12 "48/192"
	14 "48/96"
}

array set ::text_char_code_map {
	1 utf-8
	2 utf-16-be
	3 shiftjis
	4 euc-kr
	5 gb18030-20001
	6 cn-gb
	7 big5
}

# Returns the global description of the MPLS
#
# mplsfile: mpls_id of the MPLS to display
# playitemslist: list of PlayItems from the playlist, or $playlist(pi_list)
# numchapters: number of chapters in the MPLS, or [llength $playlist(chapters)]
# is3d: the 3D flag, or $playlist(is3d)
#
# Result:
# For a mono-angle 3D MPLS, a single string in the form:
# 00001.mpls, 1:34:50, 16 chapters, 00344+00345+00346.ssif
# For a multi-angle 3D MPLS, several lines in the form:
# 00001.mpls, 1:34:50, 16 chapters, 00344+00345+00346.ssif, Angle 1
# 00001.mpls, 1:34:50, 16 chapters, 00344+00350+00346.ssif, Angle 2
# 00001.mpls, 1:34:50, 16 chapters, 00344+00359+00346.ssif, Angle 3
# For a 2D MPLS, sunstitute .ssif with .m2ts
proc HrPlayItemList {mplsfile playitemslist numchapters is3d} {
	set numangles 1
	set totalduration 0
	foreach playitem $playitemslist {
		array set pi $playitem
		if {$pi(num_angles) > $numangles} {
			set numangles $pi(num_angles)
		}
		incr totalduration $pi(duration)
	}
	set output {}
	set start_output "[file rootname [file tail $mplsfile]].mpls, [Ticks2hrTime $totalduration 0], [format %2d $numchapters] chapters, "
	for {set angle 1} {$angle <= $numangles} {incr angle} {
		set l {}
		foreach playitem $playitemslist {
			array set pi $playitem
			if {$angle <= 1} {
				lappend l $pi(clip_id)
			} elseif {$pi(num_angles) >= $angle} {
				lappend l [lindex $pi(angle_clip_ids) [expr $angle-2]]
			} else {
				lappend l $pi(clip_id)
			}
			incr totalduration $pi(duration)
		}
		if {$is3d} {
			set str "$start_output[join $l +].ssif"
		} else {
			set str "$start_output[join $l +].m2ts"
		}
		if {$numangles > 1} {
			append str ", Angle $angle"
		}
		lappend output $str
	}
	return $output
}

# Returns the descriptions of the streams of a MPLS
#
# mplsinfo: the list returned by MplsParseMpls
#
# Result:
# For a 3D MPLS, a multi-line string string in the form:
# Video   : Und, AVC, 1080p, 23.976 fps, left-eye
# Video   : Und, MVC, 1080p, 23.976 fps, right-eye (32 3D-Planes)
# Audio   : Eng, DTS-HD-Master, Multi-channel, 48 Khz
# Audio   : Fra, DTS-HD-Master, Multi-channel, 48 Khz
# Subtitle: Eng, PGS, 3D-Plane #1
# Subtitle: Fra, PGS, 3D-Plane #2
# Subtitle: Eng, PGS, 3D-Plane undefined
# Subtitle: Eng, PGS, 3D-Plane n/a (2P stereo: streams 1234 & 1235)
# Subtitle: Spa, TextSub, 3D-Plane #3, char code: utf-8
#
# For a 3D MPLS, omit the MVC stream and the 3D-Plane data
proc HrStreams {mplsinfo {with_pid false}} {
	array set a $mplsinfo
	set output ""
	if {$a(is3d)} {
		foreach s $a(video_streams) {
			if {$with_pid} {
				array set as $s
				append output "$as(pid) "
			}
			append output [HrStream $s $a(base_view_flag)]\n
		}
		foreach s $a(mvc_streams) {
			if {$with_pid} {
				array set as $s
				append output "$as(pid) "
			}
			append output [HrStream $s [expr 1 - $a(base_view_flag)]]\n
		}
	} else {
		foreach s $a(video_streams) {
			if {$with_pid} {
				array set as $s
				append output "$as(pid) "
			}
			append output [HrStream $s -1]\n
		}
	}
	foreach s $a(audio_streams) {
		if {$with_pid} {
			array set as $s
			append output "$as(pid) "
		}
		append output [HrStream $s]\n
	}
	if {$a(is3d)} {
		set i 0
		foreach s $a(pg_streams) {
			if {$with_pid} {
				array set as $s
				append output "$as(pid) "
			}
			append output [HrStream $s [lindex $a(planes3d) $i]]\n
			incr i
		}
	} else {
		foreach s $a(pg_streams) {
			if {$with_pid} {
				array set as $s
				append output "$as(pid) "
			}
			append output [HrStream $s ""]\n
		}
	}
	return [string trim $output \n]
}

# Returns the descriptions of a single stream
#
# stream: the list containing the stream data
# arg: depends of the stream type
#  - for video stream, args must be the base_view_flag
#  - for subtitle stream, args must be the 3D-plane number
#    (or the list of the 2 stream_IDs for 2P stereo mode)
#  - args is ignored for an audio stream
#
# Result:
# A single string as returned by HrStreams.
# See HrStreams for more info.
proc HrStream {stream args} {
	set arg [lindex $args 0]
	array set s $stream
	set out ""
	switch $s(coding_type) {
		1 - 2 - 27 - 32 - 36 - 234 {
			append out "Video   :  Und  $::codec_map($s(coding_type)), $::video_format_map($s(format)), $::video_rate_map($s(rate)) fps"
			if {($s(coding_type) == 27 || $s(coding_type) == 32)} {
				if {$arg == 0} {
					append out ", left-eye"
				} elseif {$arg == 1} {
					append out ", right-eye"
				}
			}
			if {$s(coding_type) == 32} {
				append out " ($s(num_planes) 3D-Planes)"
			}
		}
		3 - 4 - 128 - 129 - 130 - 131 - 132 - 133 - 134 {
			append out "Audio   :  [string totitle $s(lang)]  $::codec_map($s(coding_type)), $::audio_format_map($s(format)), $::audio_rate_map($s(rate)) Khz"
		}
		144 - 145 - 146 {
			append out "Subtitle:  [string totitle $s(lang)]  $::codec_map($s(coding_type))"
			if {$arg != ""} {
				if {$arg == 255} {
					set tmp "undefined"
				} elseif {$arg > 31} {
					set tmp "n/a (2P stereo: streams [join $arg { & }])"
				} else {
					set tmp "$arg"
				}
				append out ", 3D-plane: $tmp"
			}
			if {$s(coding_type) == 146} {
				if {[info exists ::text_char_code_map($s(char_code))]} {
					append out ", char code: $::text_char_code_map($s(char_code))"
				} else {
					append out ", char code: $s(char_code)"
				}
			}
		}
		default {
			append out "Stream ?:  Unrecognized coding type $s(coding_type)"
		}
	}
	return $out
}


# Returns the description of the chapter poits
#
# chapters: list of chapter times
#
# Result:
# A string in the form 0:00:00.000, 0:07:12.014, 0:12:51.520
proc HrChapterPoints {chapters} {
	set out {}
	foreach c $chapters {
		lappend out [Ticks2hrTime $c]
	}
	return $out
}

# Converts a time in ticks at 45000 hertz to a human readable time
#
# ticks: the time to convert in 45000th of a second.
# decimals: the number of decimals to display.
#   Use 0 for no decimals, or -1 for an unlimited number of decimals (infinite precision).
# floor: when true, returns the time rounded to the lower integer or floating point
#   (suitable for MkvMerge chapters), and when false, retuns the time rounded to
#   the closest integer or floating point.
# delay_ms: Additional delay in ms to add to the output time
proc Ticks2hrTime {ticks {decimals 3} {floor true} {delay_ms 0}} {
	set hr_time [expr ($ticks / 45000.0) + ($delay_ms / 1000.0)]
	if {$floor} {
		# tsMuxeR rounding
		if {$decimals == 0} {
			set hr_secs [expr round(floor($hr_time))]
			return [string trim [clock format $hr_secs -gmt 1 -format "%k:%M:%S"]]
		} elseif {$decimals > 0} {
			set hr_secs [expr round(floor($hr_time))]
			set rounder 1[string repeat 0 $decimals].0
			set remainder [string range [expr round(floor(($hr_time - $hr_secs) * $rounder)) / $rounder]00000000000000000000 1 [expr $decimals+1]]	;# tsMuxeR rounding
			return [string trim [clock format $hr_secs -gmt 1 -format "%k:%M:%S"]$remainder]
		} else {
			set hr_secs [expr round(floor($hr_time))]
			set remainder [string range [expr $hr_time - $hr_secs] 1 end]
			return [string trim [clock format $hr_secs -gmt 1 -format "%k:%M:%S"]$remainder]
		}
	} else {
		# rounding to nearest value
		if {$decimals == 0} {
			set hr_secs [expr round($hr_time)]
			return [string trim [clock format $hr_secs -gmt 1 -format "%k:%M:%S"]]
		} elseif {$decimals > 0} {
			set hr_secs [expr round(floor($hr_time))]
			set rounder 1[string repeat 0 $decimals].0
			set remainder [string range [expr round(($hr_time - $hr_secs) * $rounder) / $rounder]00000000000000000000 1 [expr $decimals+1]]	;# more precise method
			return [string trim [clock format $hr_secs -gmt 1 -format "%k:%M:%S"]$remainder]
		} else {
			set hr_secs [expr round(floor($hr_time))]
			set remainder [string range [expr $hr_time - $hr_secs] 1 end]
			return [string trim [clock format $hr_secs -gmt 1 -format "%k:%M:%S"]$remainder]
		}
	}
}

###############################################################################
# Procedures to parse quickly the whole blu-ray disc
###############################################################################

# Get all (3D) playlists from a specfic directory
#
# dir: input directory
# verbose: prints information on why a playlist is skipped to stdout
# skip_2d: get only the 3D playlists
#
# Result:
# All 3D playlists (except the 2D playlists if $skip_2d) are stored in the
# global array ::playlists(), indexed by the MPLS_ID (aka file name without path
# and extension).
# Returns the list of all MPLS_IDs that have been stored in ::playlists()
proc Get3Dplaylists {dir {verbose false} {skip_2d true}} {
	set mplsfiles [lsort [glob -nocomplain $dir/*.mpls]]
	set numfiles [llength $mplsfiles]

	unset -nocomplain ::playlists
	set all_playlists {}
	set progress 0
	foreach f $mplsfiles {
		incr progress
		catch {Progress $progress $numfiles 0}
		set fh [open $f r]
		if {$fh == ""} {
			puts stderr "Can't open file \"[file tail $f]\""
			bell
			continue
		}
		fconfigure $fh -encoding binary -translation binary
		if {[catch {set data [read $fh]} err]} {
			StatusMsg "[file tail $f] ERROR: This playlist cannot be parsed: $err" false 1
			bell
			continue
		}
		close $fh
		set mplsinfo [MplsParseMpls $data $f $skip_2d]
		if {[llength $mplsinfo] <= 1} {
			if {$verbose} {
				puts "[file tail $f] skipped: [lindex $mplsinfo 0]"
			}
		} else {
			array set a $mplsinfo
			if { ! $a(is3d)} {
				if {$verbose} {
					puts "[file tail $f] ([Ticks2hrTime $a(total_duration)]) skipped: Not a 3D playlist"
				}
			} else {
				if {$a(total_duration) < 45000} {
					if {$verbose} {
						puts "[file tail $f] ([Ticks2hrTime $a(total_duration)]) skipped: duration < 1 second ($a(total_duration) ticks)"
					}
				} else {
					set pln [file rootname [file tail $f]]
					set ::playlists($pln) $mplsinfo
					lappend all_playlists $pln
				}
			}
		}
	}
	return $all_playlists
}

# Get all 2D playlists (without the 3D playlists)
#
# dir: input directory
# verbose: prints information on why a playlist is skipped to stdout
#
# Result:
# All 2D playlists are stored in the global array ::playlists2d(),
# indexed by the MPLS_ID (aka file name without path and extension).
# Returns the list of all MPLS_IDs that have been stored in ::playlists2d()
proc Get2Dplaylists {dir {verbose false}} {
	set mplsfiles [lsort [glob -nocomplain $dir/*.mpls]]
	set numfiles [llength $mplsfiles]

	unset -nocomplain ::playlists2d
	set all_playlists {}
	set progress 0
	foreach f $mplsfiles {
		incr progress
		catch {Progress $progress $numfiles 0}
		set fh [open $f r]
		if {$fh == ""} {
			puts stderr "Can't open file \"[file tail $f]\""
		}
		fconfigure $fh -encoding binary -translation binary
		set data [read $fh]
		close $fh
		set mplsinfo [MplsParseMpls $data $f false]
		if {[llength $mplsinfo] <= 1} {
			if {$verbose} {
				puts "[file tail $f] skipped: [lindex $mplsinfo 0]"
			}
		} else {
			array set a $mplsinfo
			if {$a(is3d)} {
				if {$verbose} {
					puts "[file tail $f] ([Ticks2hrTime $a(total_duration)]) skipped: Not a 2D playlist"
				}
			} else {
				if {$a(total_duration) < 45000} {
					if {$verbose} {
						puts "[file tail $f] ([Ticks2hrTime $a(total_duration)]) skipped: duration < 1 second ($a(total_duration) ticks)"
					}
				} else {
					set pln [file rootname [file tail $f]]
					set ::playlists2d($pln) $mplsinfo
					lappend all_playlists $pln
				}
			}
		}
	}
	return $all_playlists
}

# Returns a new list of playlists, without the playlists matching the given characteristics.
#
# all_playlists: The list of all MPLS_IDs (as returned by Get3Dplaylists)
# verbose: prints information on why a playlist is skipped to stdout
# skip_minimum_duration: Skip the playlists shorter than this number of seconds
# skip_repeating_menus: Skip the playlists containing PlayItems repeated MORE than this number of times.
# skip_subsets: Skip the single-PlayItem playlists that are subsets of longer multi-PlayItems playlists.
# skip_dupes: Skip the playlists that are duplicate of other playlists.
# (Skip_dupes tries to return the "best" playlist, when there are some differences in the chapters or 3D-planes.)
proc FilterPlaylists {all_playlists {verbose false} {skip_minimum_duration 10} \
			{skip_repeating_menus 1} {skip_subsets true} {skip_dupes true} {2D_mode false}} {
	set useful_playlists $all_playlists
	set mindur [expr $skip_minimum_duration * 45000]

	# remove playlists shorter than N seconds
	if {$skip_minimum_duration > 0} {
		foreach playlistnum $useful_playlists {
			if {$2D_mode} {
				array set pl $::playlists2d($playlistnum)
			} else {
				array set pl $::playlists($playlistnum)
			}
			if {$pl(total_duration) < $mindur} {
				if {$verbose} {
					puts "$playlistnum.mpls ([Ticks2hrTime $pl(total_duration)]) skipped: Duration < minimum duration ($skip_minimum_duration seconds)"
				}
				set idx [lsearch $useful_playlists $playlistnum]
				set useful_playlists [lreplace $useful_playlists $idx $idx]
			}
		}
	}

	# remove repeating menus
	if {$skip_repeating_menus > 0} {
		foreach playlistnum $useful_playlists {
			if {$2D_mode} {
				array set pl $::playlists2d($playlistnum)
			} else {
				array set pl $::playlists($playlistnum)
			}
			if {$pl(pi_list_count) > 1} {
				foreach pi_list $pl(pi_list) {
					array set ls $pi_list
					set ssif $ls(clip_id)
					if {[info exists dupes($ssif)]} {
						incr dupes($ssif)
						if {$dupes($ssif) > $skip_repeating_menus} {
							if {$verbose} {
								puts "$playlistnum.mpls ([Ticks2hrTime $pl(total_duration)]) skipped: $ssif.m2ts repeated more than $skip_repeating_menus times"
							}
							set idx [lsearch $useful_playlists $playlistnum]
							set useful_playlists [lreplace $useful_playlists $idx $idx]
							break
						}
					} else {
						set dupes($ssif) 1
					}
				}
				unset -nocomplain dupes ssiflist
			}
		}
	}

	# remove playlists that are subsets of other playlists
	if {$skip_subsets} {
		set multi_ssifs  {}
		set single_playlists {}
		foreach playlistnum $useful_playlists {
			if {$2D_mode} {
				array set pl $::playlists2d($playlistnum)
			} else {
				array set pl $::playlists($playlistnum)
			}
			set multi false
			if {$pl(pi_list_count) > 1} {
				set multi true
				foreach pi_list $pl(pi_list) {
					array set ls $pi_list
					if {[lsearch $multi_ssifs $ls(clip_id)] == -1} {
						lappend multi_ssifs $ls(clip_id)
					}
					if {$ls(num_angles) > 1} {
						set multi_ssifs [concat $multi_ssifs $ls(angle_clip_ids)]
					}
				}
			} else {
				array set ls [lindex $pl(pi_list) 0]
				if {$ls(num_angles) > 1} {
					set multi_ssifs [concat $multi_ssifs $ls(angle_clip_ids)]
				}
			}
			if {! $multi} {
				lappend single_playlists $playlistnum
			}
		}
		foreach playlistnum $single_playlists {
			if {$2D_mode} {
				array set pl $::playlists2d($playlistnum)
			} else {
				array set pl $::playlists($playlistnum)
			}
			array set ls [lindex $pl(pi_list) 0]
			if {[lsearch $multi_ssifs $ls(clip_id)] >= 0} {
				if {$verbose} {
					puts "$playlistnum.mpls ([Ticks2hrTime $pl(total_duration)]) skipped: $ls(clip_id).m2ts is a subset of a longer or multiangle playlist"
				}
				set idx [lsearch $useful_playlists $playlistnum]
				set useful_playlists [lreplace $useful_playlists $idx $idx]
			}
		}
	}

	if {$skip_dupes} {
		foreach playlistnum $useful_playlists {
			if {$2D_mode} {
				array set pl $::playlists2d($playlistnum)
			} else {
				array set pl $::playlists($playlistnum)
			}
			set ssif_ids {}
			foreach pi_list $pl(pi_list) {
				array set ls $pi_list
				lappend ssif_ids $ls(clip_id)
			}
			lappend all_lists($ssif_ids) $playlistnum
		}
		foreach al [array names all_lists *] {
			if {[llength $all_lists($al)] > 1} {
				set removed true
				set processed {}
				while {$removed} {
					set removed false
					set len [llength $all_lists($al)]
					for {set first 0} {$first < [expr $len-1]} {incr first} {
						for {set second [expr $first+1]} {$second < $len} {incr second} {
							set pl1 [lindex $all_lists($al) $first]
							set pl2 [lindex $all_lists($al) $second]
							set pair [list $pl1 $pl2]
							if {[lsearch $processed $pair] >= 0} {
								continue
							}
							lappend processed $pair
							set r [WorstPlaylist $pl1 $pl2 $2D_mode]
							set remove [lindex $r 0]
							set why    [lindex $r 1]
							if {$remove != ""} {
								if {$verbose} {
									if {$2D_mode} {
										array set removepl $::playlists2d($remove)
									} else {
										array set removepl $::playlists($remove)
									}
									puts "$remove.mpls ([Ticks2hrTime $removepl(total_duration)]) skipped: $why"
								}
								set idx [lsearch $useful_playlists $remove]
								set useful_playlists [lreplace $useful_playlists $idx $idx]
								set idx [lsearch $all_lists($al) $remove]
								set all_lists($al) [lreplace $all_lists($al) $idx $idx]
								set removed true
								break
							}
						}
						if {$removed} break
					}
				}
			}
		}

		unset -nocomplain all_lists
	}
	# Remove playlists without audio
	set playlists $useful_playlists
	set useful_playlists {}
	foreach playlistnum $playlists {
		if {$2D_mode} {
			array set pl $::playlists2d($playlistnum)
		} else {
			array set pl $::playlists($playlistnum)
		}
		if {$pl(num_audio) == 0} {
			if {$verbose} {
				puts "$playlistnum.mpls ([Ticks2hrTime $pl(total_duration)]) skipped: No audio stream"
			}
		} else {
			lappend useful_playlists $playlistnum
		}
	}

	return $useful_playlists
}

# Function called by FilterPlaylists to return the playlist to remove from a pair of identical playlists.
# The function checks the streams, the angles, the chapter numbers and the 3D-planes.
#
# plid1 and plid2L the MPLS_IDs of the 2 MPLS to compare.
#
# Returns an empty string if the two MPLS must be kept.  Otherwise, returns the MPLS_IF of the MPLS to remove.
proc WorstPlaylist {plid1 plid2 {2D_mode false}} {
	if {$2D_mode} {
		array set pl1 $::playlists2d($plid1)
		array set pl2 $::playlists2d($plid2)
	} else {
		array set pl1 $::playlists($plid1)
		array set pl2 $::playlists($plid2)
	}

	set streampids1 {}
	foreach stream $pl1(audio_streams) {
		array set as $stream
		lappend streampids1 $as(pid)
	}
	set streampids1 [lsort $streampids1]
	set streampids2 {}
	foreach stream $pl2(audio_streams) {
		array set as $stream
		lappend streampids2 $as(pid)
	}
	set streampids2 [lsort $streampids2]
	if {$streampids1 != $streampids2} {
		return [list "" "Not same audio streams"]
	}

	set streampids1 {}
	foreach stream $pl1(pg_streams) {
		array set as $stream
		lappend streampids1 $as(pid)
	}
	set streampids1 [lsort $streampids1]
	set streampids2 {}
	foreach stream $pl2(pg_streams) {
		array set as $stream
		lappend streampids2 $as(pid)
	}
	set streampids2 [lsort $streampids2]
	if {$streampids1 != $streampids2} {
		return [list "" "Not same PG streams"]
	}

	set angleids1 {}
	foreach pi_list $pl1(pi_list) {
		array set ls $pi_list
		lappend angleids1 $ls(angle_clip_ids)
	}
	set angleids2 {}
	foreach pi_list $pl2(pi_list) {
		array set ls $pi_list
		lappend angleids2 $ls(angle_clip_ids)
	}
	if {$angleids1 != $angleids2} {
		return [list "" "Not same angles"]
	}

	set numchapters1 $pl1(chapters)
	set numchapters2 $pl2(chapters)
	if {$numchapters1 > $numchapters2} {
		return [list $plid2 "Identical to $plid1.mpls but with less chapters"]
	} elseif {$numchapters1 < $numchapters2} {
		return [list $plid1 "Identical to $plid2.mpls but with less chapters"]
	}

	set planes3d1 {}
	set planes3d2 {}
	catch {set planes3d1 [lsort -dictionary $pl1(planes3d)]}
	catch {set planes3d2 [lsort -dictionary $pl2(planes3d)]}
	if {$planes3d1 != $planes3d2} {
		set planes3d1 [string map {255 ""} $planes3d1]
		set planes3d2 [string map {255 ""} $planes3d2]
		if {[llength $planes3d1] > [llength $planes3d2]} {
			return [list $plid2 "Identical to $plid1.mpls but with less 3D-planes"]
		} elseif {[llength $planes3d1] < [llength $planes3d2]} {
			return [list $plid1 "Identical to $plid2.mpls but with less 3D-planes"]
		}
	}

	return [list $plid2 "Strictly identical to $plid1.mpls"]
}

# Returns the ID of the longest playlist in a list of playlists.
#
# playlists: the list of MPLS_IDs as returned by Get3Dplaylists or FilterPlaylists
#
# Result: Returns the MPLS_ID of the longest playlist in the list.
# If there are several playlists of the same duration, the first one is returned.
#
# Note: Works best with the list of playlists returned by FilterPlaylists with
# the skip_repeating_menus and skip_dupes options.
proc GetLongerPlaylist {playlists {2D_mode false}} {
	set longerplaylist -1
	set longerduration -1
	foreach playlistnum $playlists {
		if {$2D_mode} {
			array set pl $::playlists2d($playlistnum)
		} else {
			array set pl $::playlists($playlistnum)
		}
		if {$pl(total_duration) > $longerduration} {
			set longerplaylist $playlistnum
			set longerduration $pl(total_duration)
		}
	}
	return $longerplaylist
}
