Patch title: Release 94 bulk changes
Abstract:
File: /pliant/linux/multimedia/mpegdemux.pli
Key:
    Removed line
    Added line
   
# http://hccc.ee.ccu.edu.tw/document/atm/audiov.htm

module "/pliant/language/unsafe.pli"
module "/pliant/language/stream.pli"
module "/pliant/util/pml/io.pli"
module "/pliant/language/type/misc/blob.pli"
module "/pliant/admin/file.pli"


function pick s n -> v
  arg_rw Stream s ; arg Int n ; arg Str v
  v := ""
  var Str pos := s query "seek"
  while v:len<n and not s:atend
    s raw_read addressof:(var Char c) 1
    v += c
  s configure "seek "+pos

function forward s n
  arg_rw Stream s ; arg Int n
  for (var Int i) 1 n
    s raw_read addressof:(var Char c) 1

method s pos -> p
  arg_rw Stream s ; arg Intn p
  (s query "seek") parse p

function mpeg_display filename
  arg Str filename
  (var Stream mux) open filename+".mpeg" in+safe
  (var Stream video) open filename+".mpv" in+safe
  (var Stream audio) open filename+".mp2" in+safe
  while not mux:atend
    var Intn pos := mux pos
    console (string (cast pos Int) "radix 16") " "
    if (pick mux 16)=(pick video 16)
      var Int count := 0
      while (pick mux 1)=(pick video 1)
        count += 1 ; forward mux 1 ; forward video 1
      console "video " count
    eif (pick mux 16)=(pick audio 16)
      var Int count := 0
      while (pick mux 1)=(pick audio 1)
        count += 1 ; forward mux 1 ; forward audio 1
      console "audio " count
    else
      var Int count := 0
      while (pick mux 16)<>(pick video 16) and (pick mux 16)<>(pick audio 16) and ((pick mux 3)<>"[0][0]"+character:1 or count=0)
        mux raw_read addressof:(var uInt8 byte) 1
        console " " (string (cast byte Int) "radix 16")
        count += 1
      console " -> " count
    console eol


constant trace false

function mpeg_demux filename path -> status
  arg Str filename path ; arg ExtendedStatus status
  for (var Int i) 0 255
    file_delete path+(string i "radix 16")
  (var Stream s) open filename in+safe
  var Float ts := 0
  var Stream d
  while not s:atend
    if trace
      (s query "seek") parse (var Int offset)
    s raw_read addressof:(var uInt32_hi code) uInt32_hi:size
    if trace
      console (string offset "radix 16") " " (string (cast code uInt) "radix 16") " "
    if code=1BAh
      var (Array uInt8 10) header
      s raw_read addressof:header 10
      if trace
        console "MA" (header:0 .and. 0C0h)\40h " "
        console "MB" (header:0 .and. 4)\4 " "
        console "MC" (header:2 .and. 4)\4 " "
        console "MD" (header:4 .and. 4)\4 " "
        console "ME" (header:5 .and. 1)\1 " "
        console "MF" (header:8 .and. 2)\2 " "
        console "MG" (header:8 .and. 1)\1 " "
      var Int stuff := header:9 .and. 7
      if trace
        console "S" stuff " "
      for (var Int i) 1 stuff
        s raw_read addressof:(var Byte drop) 1
      var uInt ts1
      ts1 := ((header:0 .and. 18h)\8)*2^30
      ts1 += ((header:0 .and. 3)\1)*2^28
      ts1 += ((header:1 .and. 0FFh)\1)*2^20
      ts1 += ((header:2 .and. 0F8h)\8)*2^15
      ts1 += ((header:2 .and. 3)\1)*2^13
      ts1 += ((header:3 .and. 0FFh)\1)*2^5
      ts1 += ((header:4 .and. 0F8h)\8)*2^0
      var uInt ts2
      ts2 := ((header:4 .and. 3)\1)*2^7
      ts2 += ((header:5 .and. 0FEh)\2)*2^0
      ts := ts1/90000+ts2/27000000
      if trace
        console "TS" (string ts "fixed 3") " "
      var uInt mr
      mr := ((header:6 .and. 0FFh)\1)*2^14
      mr += ((header:7 .and. 0FFh)\1)*2^6
      mr += ((header:8 .and. 0FCh)\4)*2^0
      var Float bps := mr*50*8
      if trace
        console "BPS" (string bps "fixed 0") " "
    eif code=1BBh or code=1BEh
      s raw_read addressof:(var uInt16_hi total) uInt16_hi:size
      for (var Int i) 1 total
        s raw_read addressof:(var Byte drop) 1
    eif code=1B9h
      void
    eif code>=1C0h and code<=1F0h
      s raw_read addressof:(var uInt16_hi total) uInt16_hi:size
      for (var Int i) 1 2
        s raw_read addressof:(var Byte drop) 1
      s raw_read addressof:(var uInt8 extra) 1
      for (var Int i) 1 extra
        s raw_read addressof:(var Byte drop) 1
      if d:name<>path+(string code-100h "radix 16")
        d open path+(string code-100h "radix 16") append
      raw_copy s d total-3-extra total-3-extra
    else
      console "incorrect code " (string (cast code uInt) "radix 16") " at offset " (s query "seek") eol
      return failure
    if trace
      console eol
  status := success


# http://danjean.developpez.com/video/mpeg-elementary-stream/

function mpeg_demux2 filename path options -> status
  arg Str filename path options ; arg ExtendedStatus status
  constant trace2 false
  var CBool multiplexed := options option "multiplexed"
  (var Array:Int counter) size := 8192
  (var Array:CBool started) size := 8192
  (var Array:Stream streams) size := 8192
  (var Array:Float timestamps) size := 8192
  for (var Int i) 0 8191
    counter i := undefined
    started i := false
    timestamps i := undefined
  var Address buffer := memory_allocate 184+Int:size null
  (var Stream s) open filename in+safe
  var Int offset := options option "seek" Intn
  if offset<>undefined
    s configure "seek "+string:offset
    part align
      if not s:atend
        var Int available := (cast s:stream_read_stop Int).-.(cast s:stream_read_cur Int)
        var Int offset2 := 0
        while offset2<available
          if (s:stream_read_cur map uInt8 offset2)<>47h
            s raw_read addressof:(var uInt8 drop_byte) 1
            restart align
          offset2 += 188
  var Int total := 0 ; var DateTime start := datetime ; var Int selected := -1
  while not s:atend
    # console "+"
    s raw_read addressof:(var uInt32_hi code) uInt32_hi:size
    var Int sync := (code .and. 0FF000000h)\2^24
    var CBool err := (code .and. 00800000h)<>0
    var CBool pusi := (code .and. 00400000h)<>0
    var CBool prio := (code .and. 00200000h)<>0
    var Int pid := (code .and. 1FFF00h)\2^8
    var Int tfc := (code .and. C0h)\2^6
    var Int afc := (code .and. 30h)\2^4
    var Int cc := code .and. 0Fh
    var Pointer:Stream d :> streams pid
    if d=failure
      var Str target := path+string:pid
      if pid=(options option "audio" Int)
        target := options option "audio_file" Str
      if pid=(options option "video" Int)
        target := options option "video_file" Str
      d open target out+safe
    if trace2
      var CBool trace3 := trace2 and pusi # (pusi or afc<>1)
    else
      constant trace3 false
    if trace3
      if ((s query "seek") parse (var Intn at))
        at -= 4
        console "src " at " ("(string (cast at uInt) "radix 16") "h)"
    if sync<>47h
      console "incorrect code " (string (cast code uInt) "radix 16") " at offset " (s query "seek") eol
    if counter:pid<>undefined and cc<>counter:pid
      console "out of sync counter (pid " pid ")" eol
    counter pid := (cc+1)%16
    if trace3
      # console " code " (string (cast code uInt) "radix 16")
      console " : "
      console pid (shunt err " error" "")+(shunt prio" prio" "")+(shunt tfc<>0 " tfc "+string:tfc "")+(shunt afc<>1 " afc "+string:afc "")
      var Intn at := (file_query d:name standard) size
      console " dest " at " ("(string (cast at uInt) "radix 16") "h)"
    var Int skip := 0
    if trace3
      var Str extra := ""
    if afc<>1
      s raw_read addressof:(var uInt8 count) 1
      if trace3
        extra += "drop "+string:(cast count Int)+":"
      for (var Int i) 1 count
        s raw_read addressof:(var uInt8 drop) 1
        # d raw_write addressof:(var uInt8 drop) 1
        if trace3
          extra += " "+(right (string (cast drop Int) "radix 16") 2 "0")
      skip += 1+count
      if trace3
        extra += "[lf]" # " (keep "+(string 184-skip)+")[lf]"
    if pusi
      s raw_read addressof:(var uInt8 pusiv) 1
      if trace3
        console " pusi " (cast pusiv Int)
      if false
        if pusiv>0 and pusiv<=183
          raw_copy s d pusiv pusiv
        skip += 1+pusiv
      else
        skip += 1
    if not started:pid and pusi
      for (var Int i) 0 pusiv-1
        s raw_read addressof:(var uInt8 pusiv) 1
      skip += pusiv ; pusiv := 0
      started pid := true
    if not started:pid
      s raw_read buffer 184-skip
    eif skip>=184
      void
    eif pusi
      s raw_read buffer 184-skip
      if pusiv<>0
        if multiplexed
          (var Blob b) map buffer pusiv ; d oraw b
        else
          d raw_write buffer pusiv
        if pid%100=selected
          total += pusiv
      var Int restart
      if (buffer map uInt8 pusiv)=0 and (buffer map uInt8 pusiv+1)=1
        # I don't know why some bytes at the beginning of the new block must be skiped
        restart := pusiv+8+(buffer map uInt8 pusiv+7)
        if multiplexed and restart>=pusiv+8+uInt32_hi:size
          var uInt ts32 := (buffer translate Byte 9) map uInt32_hi
          var Float ts := ts32/90000
          if ts>timestamps:pid or timestamps:pid=undefined
            d oraw ts
            timestamps pid := ts
          # console pid " = " (string ts "fixed 2") eol
          if pid%100=selected
            console pid " " (string (cast code uInt) "radix 16") ":"
            for (var Int i) pusiv restart-1
              console " " (right string:(cast (buffer map uInt8 i) Int) 3 " ")
            var Int was
            var Float seconds := datetime:seconds-start:seconds
            console " -> " ts-was "  (" (string 8.0*total/seconds/1024 "fixed 0") " kbps)" eol
            was := ts32 # ; total := 0
            if seconds>30
              total := 0 ; start := datetime
      else
        restart := pusiv
      if restart<184-skip
        if multiplexed
          (var Blob b) map (buffer translate Byte restart) 184-skip-restart ; d oraw b
        else
          d raw_write (buffer translate Byte restart) 184-skip-restart
        if pid%100=selected
          total += 184-skip-restart
    else
      if multiplexed
        (var Blob b) size := 184-skip
        s raw_read b:content b:size
        d oraw b
      else
        raw_copy s d 184-skip 184-skip
      if pid%100=selected
        total += 184-skip
    d flush anytime
    if trace3
      console eol extra
  memory_free buffer
  status := success

     
 
export mpeg_display mpeg_demux mpeg_demux2