//   PlayFile.bcpl
//   Program to play files over Diablo port audio interface
//   L. Stewart  last modified:  December 29, 1979  9:04 PM

// To compile:
// Bcpl/F PlayFile.bcpl

// To Load:
// BLDR PlayFile ATmc LoadRam GP

manifest
   [
   PortOut = #177016
   ResetMask = #000000  // set to 0 to reset
   nbufs = 6
   ]

external                  //Incoming Procedures
   [
   LoadRam                //LoadRam package
   StartIO                  //OS
   Allocate
   GetFixed
   ReadBlock
   Endofs
   Closes
   Resets
   Gets
   ReadParam             //GP package
   SetupReadParam
   ]

external                  //Statics
   [
   sysZone                  //OS
   keys
   RamImage               //default Packed Ram Image
   ]

static
   [
   buflen = 2048
   pipe = 4
   buf
   oAcb
   pipecount = 0
   head = 0
   last = 0
   ds = 0
   AudioOn = false
   aStart
   ]

structure ACB: [
   flag	word
   next	word
   ptr	word
   len	word
   ]

let Main() be
   [
   let v = vec nbufs
   buf = v
   let v = vec nbufs
   oAcb = v
   if LoadRam(RamImage,false) ne 0 do abort
   for i = 0 to nbufs-1 do
      [
      buf!i = GetFixed(buflen)
      oAcb!i = Allocate(sysZone, 4, false, true)
      oAcb!i>>ACB.flag = -1   // mark idle
      oAcb!i>>ACB.ptr = buf!i
      ]
   // create free list
   head = oAcb!0
   for i = 1 to nbufs-1 do
      [
      oAcb!(i-1)>>ACB.next = oAcb!i
      ]
   last = oAcb!(pipe-1)
   SetupReadParam(0, 0, 0, 0)
   ds = ReadParam("IW", 0, 0, 0)     // command line filename
   // while Gets(keys) eq $z do PlayIt()
   PlayIt()

   Closes(ds)
   finish
   ]

and let PlayIt() be
   [
   let mybuf = nil
   let count = nil
   Resets(ds)
   pipecount = 0
   AudioOn = false
      [
      mybuf = GetAcb()
      count = ReadBlock(ds, mybuf>>ACB.ptr, buflen)
      mybuf>>ACB.len = count
      PlayThis(mybuf)
      if Endofs(ds) then break
      ] repeat
   ShutDown()
   ]

and let GetAcb() = valof
   [
   let v = nil
   while head>>ACB.flag eq 0 do v = v+1
   v = head
   head = v>>ACB.next
   resultis v
   ]

and let PlayThis(tbuf) be
   [
   tbuf>>ACB.flag = 0  // mark busy
   tbuf>>ACB.next = 0
   test pipecount ls pipe
     ifso [
      if pipecount eq 0 then aStart = tbuf
      last>>ACB.next = tbuf
      pipecount = pipecount + 1
      if pipecount eq pipe then
         [
         TurnOnAudio()
         AudioOn = true
         ]
      ]
     ifnot [
      if AudioEnqueue(tbuf, last) eq 0 then
         [
         last>>ACB.next = tbuf
         AudioStart(0, tbuf)
         ]
      ]
   last = tbuf
   ]

and let ShutDown() be
   [
   let v = head
   let j = 0
   if not AudioOn then TurnOnAudio()
   // scan down chain waiting for each to finish
   while v ne 0 do
      [
      while v>>ACB.flag eq 0 do j = j+1
      v = v>>ACB.next
      ]
   TurnOffAudio()
   ]

and let TurnOnAudio() be
   [
   SetBLV(RamImage!0)
   AudioInit()
   StartIO(#100000)
   AudioStart(0, aStart)
   ]

and let TurnOffAudio() be
   [
   AudioStart(0, 0)
   SetBLV(#177776)
   StartIO(#100000)
   Reset()
   ]

and let Reset() be
   [
   @PortOut =  ResetMask
   ]

and SetBLV(blv) = JmpRam(blv, #20)

and AudioInit() = JmpRam(0, #21)

and AudioStart(iacb, oacb) = JmpRam2(iacb, #22, oacb)

and AudioEnqueue(new, old) = JmpRam2(new, #23, old)

and JmpRam(value, adr) =
   //	[ JMPRAM; JMP 1,3 ]
   ( table [ #61010; #1401 ] )(value, adr)

and JmpRam2(value, adr, val2) =
   //[ STA 3,.+5; LDA 3,3,2; JMPRAM; LDA 3,.+2; JMP 1,3; 0 ]
   ( table [ #54405;#35003; #61010; #34402;#1401; 0 ] )(value, adr, val2)
(2048)\f1