const inbuff         = $200
const freemem        = $0002
const timerInc       = $0006
const iobuffer       = $1C00
const NMACROS        = 7
const FALSE          = 0
const TRUE           = !FALSE
const LSB            = 0
const MSB            = 1
const ARPEGGIO       = 4 // In 16ths of a second
const MAX_CHAN_NOTES = 9
//
// 6522 VIA registers
//
struc t_VIA
    byte IORB       // I/O Register B
    byte IORA       // I/O Register A
    byte DDRB       // Data Direction Register B
    byte DDRA       // Data Direction Register A
    word T1C        // Timer 1 Count
    word T1L        // Timer 1 Latch
    word T2C        // Timer 2 Count
    byte SR         // Shift Register
    byte ACR        // Aux Control Register
    byte PCR        // Peripheral Control Register
    byte IFR        // Interrupt Flag Register
    byte IER        // Interrupt Enable Register
    byte IOA_noHS   // I/O Register A - no HandShake
end
const T1CH = T1C+1
//
// AY-3-8910 PSG registers
//
struc t_PSG
    word AFREQ      // A Frequency Period
    word BFREQ      // B Frequency Period
    word CFREQ      // C Frequency Period
    byte NGFREQ     // Noise Generator Frequency Period
    byte MIXER      // Enable=0/Disable=1 NG C(5) B(4) A(3) Tone C(2) B(1) A(0)
    byte AENVAMP    // A Envelope/Amplitude
    byte BENVAMP    // B Envelope/Amplitude
    byte CENVAMP    // C Envelope/Amplitude
    word ENVPERIOD  // Envelope Period
    byte ENVSHAPE   // Envelope Shape
end
//
// Sequence event
//
struc t_event
    byte deltatime  // Event delta time in 4.4 seconds
    byte percnote   // Percussion:7==0 ? Pitch:4-0 : Octave:6-4,Note:3-0
    byte perchanvol // Percussion      ? EnvDur:7-0           : Channel:7,Volume:3-0
end
//
// Octave Basis Frequencies (starting at MIDI note #12)
// Notes will be encoded as basis note (LSNibble) and octave (MSNibble))
//
word[12] mbOctave0 = 3900, 3681, 3474, 3279, 3095, 2922, 2758, 2603, 2457, 2319, 2189, 2066
//
// System variables.
//
word heap
//
// MockingBoard data.
//
word[] mbVIAs   // Treat this as an array of VIA ptrs
word   mbVIA1, mbVIA2
//
// Tone test sequence
//
asm toneTrack
include "test.seq"
end
//
// Write PSG Registers
//
asm psgWriteTone(pVIA, reg, freq, vol)#0
        LDA     ESTKL+3,X
        STA     TMPL
        LDA     ESTKH+3,X
        STA     TMPH
        LDY     #$01
        LDA     ESTKL+2,X
        LSR
        ADC     #$08
        STA     (TMP),Y
        DEY
        LDA     #$07
        STA     (TMP),Y
        LDA     #$04
        STA     (TMP),Y
        LDA     ESTKL,X
        INY
        STA     (TMP),Y
        DEY
        LDA     #$06
        STA     (TMP),Y
        LDA     #$04
        STA     (TMP),Y
        INX
        BNE     +
end
asm psgWriteWord(pVIA, reg, val)#0
        LDA     ESTKL+2,X
        STA     TMPL
        LDA     ESTKH+2,X
        STA     TMPH
+       LDY     #$01
        TYA
        CLC
        ADC     ESTKL+1,X
        STA     (TMP),Y
        DEY
        LDA     #$07
        STA     (TMP),Y
        LDA     #$04
        STA     (TMP),Y
        LDA     ESTKH,X
        INY
        STA     (TMP),Y
        DEY
        LDA     #$06
        STA     (TMP),Y
        LDA     #$04
        STA     (TMP),Y
        BNE     +
end
asm psgWrite(pVIA, reg, val)#0
        LDA     ESTKL+2,X
        STA     TMPL
        LDA     ESTKH+2,X
        STA     TMPH
+       LDY     #$01
        LDA     ESTKL+1,X
        STA     (TMP),Y
        DEY
        LDA     #$07
        STA     (TMP),Y
        LDA     #$04
        STA     (TMP),Y
        LDA     ESTKL,X
        INY
        STA     (TMP),Y
        DEY
        LDA     #$06
        STA     (TMP),Y
        LDA     #$04
        STA     (TMP),Y
        INX
        INX
        INX
        RTS
end
//
// MockingBoard IRQ handler
//
asm mbIRQ#0
        CLD
        BIT     $C404       ; CLEAR IRQ
        INC     $06         ; FLAG FOR PLASMA CODE
        CLC
        RTS
end
//
// CALL PRODOS
//
asm syscall(cmd, params)
        SEI
        LDA     ESTKL,X
        LDY     ESTKH,X
        STA     PARAMS
        STY     PARAMS+1
        INX
        LDA     ESTKL,X
        STA     CMD
        JSR     $BF00
CMD:    !BYTE   00
PARAMS: !WORD   0000
        LDY     #$00
        STA     ESTKL,X
        STY     ESTKH,X
        CLI
        RTS
end
//
// Utility routines
//
asm getStatus#1
        PHP
        PLA
        DEX
        STA     ESTKL,X
        LDA     #$00
        STA     ESTKH,X
        RTS
end
asm setStatus(stat)#0
        LDA     ESTKL,X
        INX
        PHA
        PLP
        RTS
end
asm disableInts#0
        SEI
        RTS
end
asm enableInts#0
        CLI
        RTS
end
asm putc#0
        LDA     ESTKL,X
        INX
        ORA     #$80
        JMP     $FDED
end
def putln#0
    putc($0D)
end
def puts(str)#0
    byte i

    for i = 1 to ^str
        putc(^(str+i))
    next
end
def puti(i)#0
    byte numstr[7]
    byte place, sign

    place = 6
    if i < 0
        sign = 1
        i    = -i
    else
        sign = 0
    fin
    while i >= 10
        numstr[place] = i % 10 + '0'
        i             = i / 10
        place--
    loop
    numstr[place] = i + '0'
    place--
    if sign
        numstr[place] = '-'
        place--
    fin
    numstr[place] = 6 - place
    puts(@numstr[place])
end
//
// Read PSG Register
//
//def mbReadP(pVIA, reg)
//    byte val
//
//    pVIA->IORA = reg
//    pVIA->IORB = $07
//    pVIA->IORB = $04
//    pVIA->DDRA = $00
//    pVIA->IORB = $05
//    val = pVIA->IORA
//    pVIA->IORB = $04
//    pVIA->DDRA = $FF
//    return val
//end
//
// MB interrupt install
//
def mbInstallIRQ#0
    byte params[4]

    params.0 = 2
    params.1 = 1
    params:2 = @mbIRQ
    syscall($40, @params)
end
def mbUninstallIRQ#0
    byte params[2]

    params.0 = 1
    params.1 = 1
    syscall($41, @params)
end
//
// Search slots for MockingBoard
//
def mbTicklePSG(pVIA)
    pVIA->IER  = $00
    pVIA->DDRB = $FF
    pVIA->DDRA = $FF
    pVIA->IORA = $00 // Reset MockingBoard
    if pVIA->IORA == $00
        pVIA->IORA = $04 // Inactive MockingBoard control lines
        if pVIA->IORA == $04
            //
            // At least we know we have some sort of R/W in the ROM
            // address space. Most likely a MockingBoard or John Bell
            // 6522 board. We will assume its a MockingBoard because
            // emulators fail the following PSG read test.
            //
            //psgWriteWord(pVIA, 2, $DA7E)
            //if mbReadP(pVIA, 2) == $7E and mbReadP(pVIA, 3) == $0A
                return TRUE
            //fin
        fin
    fin
    return FALSE
end
def mbSearch
    byte slot

    puts("\nSearching for MockingBoard..\n")
    for slot = 1 to 7
        if slot == 3 or slot == 6
            continue
        fin
        mbVIA1 = $C000 + (slot << 8)
        if mbTicklePSG(mbVIA1)
            puts("Slot "); puti(slot); puts(" looks interesting. ")
            mbVIA2 = mbVIA1 + $80
            if mbTicklePSG(mbVIA2)
               puts("Two PSGs found.\n")
            else
                mbVIA2 = 0
                puts("One PSG found.\n")
            fin
            return slot
        fin
    next
    putln
    return 0
end
def psgSetup(pVIA)
    psgWrite(pVIA,     MIXER,     $3F)   // Turn everything off
    psgWrite(pVIA,     AENVAMP,   $00)
    psgWrite(pVIA,     BENVAMP,   $00)
    psgWrite(pVIA,     CENVAMP,   $10)
    psgWrite(pVIA,     NGFREQ,    $01)
    psgWriteWord(pVIA, ENVPERIOD, $0001)
    psgWrite(pVIA,     ENVSHAPE,  $00)   // Single decay
    psgWriteWord(pVIA, AFREQ,     $0000) // Fast response to update
    psgWriteWord(pVIA, BFREQ,     $0000)
    psgWriteWord(pVIA, CFREQ,     $0000)
    psgWrite(pVIA,     MIXER,     $38)   // Tone on C, B, A
end
def mbSequence(track)
    word seqEvent, seqTime, eventTime, updateTime, period, n
    byte numNotes, note, volume, channel, i, overflow, cpuFlags
    byte indexA[2], indexB[2], indexC[2]
    byte noteA[2], noteB[2], noteC[2]
    word notes1[MAX_CHAN_NOTES], notes2[MAX_CHAN_NOTES]
    word notes[2]
    word periods1[MAX_CHAN_NOTES], periods2[MAX_CHAN_NOTES]
    word periods[2]

    //
    // Get the PSGs ready
    //
    psgSetup(mbVIA1)
    if mbVIA2; psgSetup(mbVIA2); fin
    //
    // Zero out active notes
    //
    indexA[0] = 0; indexA[1] = 0
    indexB[0] = 1; indexB[1] = 1
    indexC[0] = 2; indexC[1] = 2
    noteA[0]  = 0; noteA[1]  = 0
    noteB[0]  = 0; noteB[1]  = 0
    noteC[0]  = 0; noteC[1]  = 0
    for i = 0 to MAX_CHAN_NOTES-1; notes1[i] = 0; notes2[i] = 0; next
    notes[0] = @notes1
    notes[1] = @notes2
    for i = 0 to MAX_CHAN_NOTES-1; periods1[i] = 0; periods2[i] = 0; next
    periods[0] = @periods1
    periods[1] = @periods2
    //
    // Start sequencing
    //
    seqTime     = 0
    seqEvent    = track
    eventTime   = seqEvent->deltatime
    updateTime  = ARPEGGIO
    numNotes    = 0
    overflow    = 0
    //
    // Enable timer IRQ
    //
    cpuFlags = getStatus
    disableInts
    mbVIA1->IER = $7F       // Mask all interrupts
    //(@mbIRQ).3  = mbVIA1.1  // Relocate IRQ 6522 address
    //^timerInc   = 0         // Clear timer increment
    //mbInstallIRQ
    mbVIA1->ACR = $40       // Continuos T1 interrupts
    mbVIA1=>T1L = $F9C2     // 16 Ints/sec
    mbVIA1=>T1C = $F9C2     // 16 Ints/sec
    mbVIA1->IFR = $40       // Clear interrupt
    mbVIA1->IER = $C0       // Enable Timer1 interrupt
    //enableInts
    repeat
        //puts("seqTime = "); puti(seqTime); puts(" eventTime = "); puti(eventTime); putln
        while eventTime == seqTime
            note    = seqEvent->percnote
            if note & $80
                //
                // Note event
                //
                volume  = seqEvent->perchanvol
                channel = (volume & mbVIA2.LSB) >> 7 // Clever - mbVIA2.0 will be $80 if it exists
                if volume & $0F
                    //
                    // Note on
                    //
                    for i = 0 to MAX_CHAN_NOTES-1
                        //
                        // Look for available slot in active note table
                        //
                        if !notes[channel, i].LSB //or notes[channel, i] == note
                            break
                        fin
                    next
                    //
                    // Full note table, kick one out
                    //
                    if i == MAX_CHAN_NOTES
                        i = overflow
                        overflow = (overflow + 1) % MAX_CHAN_NOTES
                        //puts("Full note table on channel: "); puti(channel); putln
                    else
                        numNotes++
                    fin
                    notes[channel, i] = note | (volume << 8)
                    periods[channel, i] = mbOctave0[note & $0F] >> ((note >> 4) & $07)
                    //puts("Insert note ");puti((note>>4)&$7);putc(':');puti(note&$0F)
                    //puts(" in table[");puti(channel);putc(',');puti(i);puts("]\n")
                else
                    //
                    // Note off
                    //
                    for i = 0 to MAX_CHAN_NOTES-1
                        //
                        // Remove from active note table
                        //
                        if notes[channel, i].LSB == note
                            notes[channel, i] = 0
                            numNotes--
                            break
                        fin
                    next
                    //puts("Remove note ");puti((note>>4)&$7);putc(':');puti(note&$0F)
                    //puts(" from table[");puti(channel);putc(',');puti(i);puts("]\n")
                fin
                updateTime = seqTime
            else
                //
                // Percussion event
                //
                period = seqEvent->perchanvol
                if period
                    if (period & $80)
                        psgWrite(mbVIA1, MIXER,       $1C)   // NG on C, Tone on B, A
                        psgWrite(mbVIA1, CENVAMP,     $10)
                        psgWrite(mbVIA1, ENVSHAPE,   (note >> 4) & $04)
                        psgWrite(mbVIA1, NGFREQ,     (note >> 1) & $1F)
                        psgWrite(mbVIA1, ENVPERIOD+1, period & $7F)
                    elsif mbVIA2
                        psgWrite(mbVIA2, MIXER,       $1C)   // NG on C, Tone on B, A
                        psgWrite(mbVIA2, CENVAMP,     $10)
                        psgWrite(mbVIA2, ENVSHAPE,   (note >> 4) & $04)
                        psgWrite(mbVIA2, NGFREQ,     (note >> 1) & $1F)
                        psgWrite(mbVIA2, ENVPERIOD+1, period)
                    fin
                else
                    eventTime  = -1 // Exit out
                    seqEvent   = 0  // Signal end of track
                    break
                fin
            fin
            //
            // Next event
            //
            seqEvent  = seqEvent + t_event
            eventTime = seqEvent->deltatime + eventTime
        loop
        if updateTime <= seqTime
            //
            // Time slice active note tables (arpeggio)
            //
            for channel = 0 to 1
                //
                // Multiplex oscillator A
                //
                i = indexA[channel]
                repeat
                    i = (i + 3) % MAX_CHAN_NOTES
                    n = notes[channel, i]
                    if n // Non-zero volume
                        break
                    fin
                until i == indexA[channel]
                if n.LSB <> noteA[channel]
                    psgWriteTone(mbVIAs[channel], AFREQ, periods[channel, i], n.MSB)
                    noteA[channel]  = n.LSB
                    indexA[channel] = i
                    //puts("Start A note: ");puti(channel);putc(',');puti(i);putln
                fin
                //
                // Multiplex oscillator B
                //
                i = indexB[channel]
                repeat
                    i = (i + 3) % MAX_CHAN_NOTES
                    n = notes[channel, i]
                    if n // Non-zero volume
                        break
                    fin
                until i == indexB[channel]
                if n.LSB <> noteB[channel]
                    psgWriteTone(mbVIAs[channel], BFREQ, periods[channel, i], n.MSB)
                    noteB[channel]  = n.LSB
                    indexB[channel] = i
                    //puts("Start B note: ");puti(channel);putc(',');puti(i);putln
                fin
                //
                // Multiplex oscillator C
                //
                i = indexC[channel]
                repeat
                    i = (i + 3) % MAX_CHAN_NOTES
                    n = notes[channel, i]
                    if n // Non-zero volume
                        break
                    fin
                until i == indexC[channel]
                if n.LSB <> noteC[channel]
                    psgWrite(mbVIAs[channel],     MIXER,   $38)   // Tone on C, B, A
                    psgWriteTone(mbVIAs[channel], CFREQ,   periods[channel, i], n.MSB)
                    noteC[channel]  = n.LSB
                    indexC[channel] = i
                    //puts("Start C note: ");puti(channel);putc(',');puti(i);putln
                fin
            next
            updateTime = seqTime + ARPEGGIO - (numNotes >> 2)
        fin
        //
        // Increment time tick
        //
        //while !(^timerInc)
        //seqTime = seqTime + ^timerInc
        //^timerInc  = 0
        seqTime++
        while !(mbVIA1->IFR & $40) // Wait for T1 interrupt
            if ^$C000 > 127; eventTime = -1; break; fin
        loop
        mbVIA1->IFR = $40 // Clear interrupt
    until eventTime < 0
    psgWrite(mbVIA1, MIXER, $FF) // Turn everything off
    psgWrite(mbVIA1, AENVAMP, $00)
    psgWrite(mbVIA1, BENVAMP, $00)
    psgWrite(mbVIA1, CENVAMP, $00)
    mbVIA1->IER = $7F   // Mask all interrupts
    setStatus(cpuFlags))
    //mbUninstallIRQ
    if mbVIA2
        psgWrite(mbVIA2, MIXER, $FF)
        psgWrite(mbVIA2, CENVAMP, $00)
    fin
    return seqEvent
end
heap = *freemem
if mbSearch
    repeat
        mbSequence(@toneTrack)
    until ^$C000 > 127
    ^$C010
fin
done
