// 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: [
flagword
nextword
ptrword
lenword
]

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)