; оверлейная часть, располагается в стр.1
; обычно работает по адресам 100000
; но может и с 40000 работать
; при этом в окне1 - стр4 TSN Файл.

; переходы в основную часть
; LOAOUT - выход из Load
; LOAERR - выход из Load при ошибке

; Некоторые вещи должны быть строго перемещаемыми, несмотря ни на что,
; как бы ни хотелось соптимизировать
; ───────────────────────────────────────────────────────────────────────────
.la 100000

E36BLP = 300    ; блок параметров емт 36

; структура блока параметров канала
P.TMPT=0        ; (1) счётчик тиков = темп
P.TPSV=1        ; (1) текущий фрагмент громкости в сэмпле
P.TPSN=2        ; (1) текущий фрагмент шума в сэмпле
P.TPST=3        ; (1) текущий фрагмент тона в сэмпле
P.ASMP=4        ; (2) адрес текущего сэмпла
P.BCYV=6        ; (1) начальный фрагмент зацикливания громкости в сэмпле
P.BCYN=7        ; (1) начальный фрагмент зацикливания шума в сэмпле
P.BCYT=10       ; (1) начальный фрагмент зацикливания тона в сэмпле
P.ECYV=11       ; (1) конечный фрагмент зацикливания громкости в сэмпле
P.ECYN=12       ; (1) конечный фрагмент зацикливания шума в сэмпле
P.ECYT=13       ; (1) конечный фрагмент зацикливания тона в сэмпле
P.TSLV=14       ; (1) длительность звучания текущего фрагмента громкости
P.TSLN=15       ; (1) длительность звучания текущего фрагмента шума
P.DVLV=16       ; (2) приращение при плавном изменении громкости
P.CVLV=20       ; (2) текущее значение громкости в ст.байте
P.RVLV=22       ; (2) конечное значение громкости в ст.байте
P.DVLN=24       ; (2) приращение при плавном изменении шума
P.CVLN=26       ; (2) текущее значение шума в ст.байте
P.RVLN=30       ; (2) конечное значение шума в ст.байте
P.DVLT=32       ; (4) приращение при плавном изменении тона
P.CVLT=36       ; (4) текущее значение тона в ст.слове
P.PAUS=42       ; (1) флаг: 0 - нота, ^0 - пауза
P.NOTN=43       ; (1) номер текущей ноты
P.TSLT=44       ; (1) длительность звучания текущего фрагмента тона
P.VPFM=45       ; (1) форма волнового пакета
P.NDLT=46       ; (1) длительность звучания первого фрагмента
P.VOLP=47       ; (1) признак волпака (<0 - волпак, >=0 - нет)
P.RVLT=50       ; (2) конечное значение тона
P.ACHN=52       ; (2) адрес в голосе текущего паттерна
P.ENCN=54       ; (1) текущее количество пустых нот
P.ENNR=55       ; (1) количество пустых нот
P.VPER=56       ; (1) период волнового пакета
P.VVAL=57       ; (1) приращение громкости
P.L1FR=60       ; (2) текущая длительность звучания первого фрагмента
; константы в блоках параметров канала, у каждого канала - своя константа
P.CNOC=62       ; (1) 0,2,4  ; адрес регистра тона
P.CNMT=63       ; (1) 1,2,4  ; маска тона в миксере
P.CNMN=64       ; (1) 10,20,40   ; маска шума в миксере
P.CNOA=65       ; (1) 10,11,12   ; адрес регистра амплитуды
; если сместить константы в конец, начинаются необъяснимые искажения звука. почему, так и не выяснено.


; регистры AY
Y.CLKA=0
Y.CLKB=2
Y.CLKC=4
Y.NOIS=6
Y.MIXR=7
Y.AMPA=10
Y.AMPB=11
Y.AMPC=12
Y.PERD=13
Y.VPCK=15

AYLEN=16    ; длина области данных регистров AY
CHPLN=70    ; длина области данных канала




SLNMWN:         mov     #40000, FILADR
                mov     #T$ETSN, SLEXT
; Вывод окна запроса имени файла
SLNMS:          call    @#DRWWNH    ; Нарисовать окно с рамкой с тенью
                                    ; Входные параметры:
                .word   45022       ; Слово - адрес экрана
                .byte   4           ; Байт - высота в символах
                .byte   20          ; Байт - ширина в символах
                .byte   252         ; Байт - маска цвета фона
                .byte   377         ; Байт - инверсная маска цвета символов
                mov     #46424, R1
                mov     #T$NAME, R0
                call    @#OUTSTR    ; Вывод строки.
                                    ; Вход: R0 - адрес строки, R1 - адрес экрана
                mov     #FILNME, R3
                mov     R3, FNBBGN
                mov     R3, FNBEND
                add     #10, FNBEND
                mov     #46436, R0
                tst     @#177662
; ───────────────────────────────────────────────────────────────────────────
; ввод имени файла
5$:             call    SLCRS
1$:             tstb    @#177660
                bpl     1$
                mov     @#177662, R1
                movb    R1, (R3)
                cmpb    R1, #12
                beq     12$
                cmpb    R1, #3
                beq     3$
                cmpb    R1, #30
                beq     30$
                sub     #40, R1
                bmi     1$
                cmp     R3, FNBEND
                bhis    1$
                call    SLCRS
                call    @#DRWCHW    ; Вход: R0 - адрес вывода
                                    ;       R1 - код
                inc     R3
                tst     (R0)+
                br      5$
; ───────────────────────────────────────────────────────────────────────────
; BS - удаление последнего введённого символа
30$:            cmp     R3, FNBBGN
                blos    1$
                call    SLCRS
                tst     -(R0)
                clrb    -(R3)
                call    SLBSP
                br      5$
; ───────────────────────────────────────────────────────────────────────────
; Enter - конец ввода
12$:            movb    #'., (R3)+
                mov     SLEXT, R4
                movb    (R4)+, (R3)+
                movb    (R4)+, (R3)+
                movb    (R4)+, (R3)+
4$:             clrb    (R3)+
                cmpb    R3, #FILNME+20
                blo     4$
                mov     #FILCMD, R0
; в это место внедряется перехватчик. 6 слов.
ANDHCK:         movb    (R4)+, 26(R0)
                movb    (R4)+, 27(R0)
                emt     115
                return
; ESC - отмена ввода
3$:             tst     (SP)+   ; при загрузке ничего не делать за вызовом, сразу выход
                br      SLL1$   ; при сохранении - не важно.
; ───────────────────────────────────────────────────────────────────────────

; Загрузка TSN файла
LOATSN:         mov     #1, FILCMD
                call    SLNMWN
                mov     #16000, @#NPAGE
                bcs     2$
                mov     #LOAOUT, -(SP)  ; выводим на экран данные нового TSN
                ; тут нужно именно так, потому что в конце RESWND устанавливается
                ; страница из NPAGE
                br      SLL1$
; ───────────────────────────────────────────────────────────────────────────
2$:             mov     #LOAERR, -(SP)  ; очищаем неудачно прочитанное
                br      BEEPS$
; ───────────────────────────────────────────────────────────────────────────
; Сохранение SND файла
SAVSND:         mov     #T$ESND, SLEXT
                call    SLNMS
                br      0SSND$
; Сохранение TSN файла
SAVTSN:         clr     FILCMD
                mov     #40000, FILLEN
                call    SLNMWN
0SSND$:         bcc     SLL1$

BEEPS$:         mov     #600, R0
1$:             bis     #100, @#177716
                mov     #100, R1
                sob     R1, .
                bic     #100, @#177716
                mov     #140, R1
                sob     R1, .
                sob     R0, 1$
SLL1$:          jmp     @#RESWND        ; Восстановление области экрана из буфера
; курсор
SLCRS:          mov     R0, -(SP)
                mov     #10, R5
                mov     @#BGCOLR, R2
                com     R2
1$:             xor     R2,(R0)
                add     #100, R0
                sob     R5, 1$
                mov     (SP)+, R0
                return
; закраска цветом фона
SLBSP:          mov     R0, -(SP)
                mov     #10, R5
2$:             mov     @#BGCOLR, (R0)
                add     #100, R0
                sob     R5, 2$
                mov     (SP)+, R0
                return

; ---------------------------------------------------------------------------
; подпрограммы опций
; ---------------------------------------------------------------------------
; меню опций и текст для опций
C$OPTS:         .asciz "OPTIONS"
                .even
                .word   0
T$OP2:          .asciz  "OLD"
                .asciz  "NEW"
T$OPTS:         .ascii  "WINDOWS OPEN SPEED:"
O$WOSP:         .ascii  "0000"<1>
                .ascii  <204>"EQUALIZER MODE:"
O$EQMD:         .ascii  "NEW"<1><1>
                .asciz  <225>"OK"
                .even
                .word   47652
                .byte   6
                .byte   125
                .word   M$OPT1
                .word   0
                .word   50652
                .byte   6
                .byte   125
                .word   M$OPT2
                .word   0
                .word   52652
                .byte   6
                .byte   252
                .word   D$CANC
                .word   0
                .word   0
; ───────────────────────────────────────────────────────────────────────────

OVLOPT:         call    @#DRWWNH    ; Нарисовать окно с рамкой с тенью
                                    ; Входные параметры:
                .word   46702       ; Слово - адрес экрана, бит 15 - флаг, не сохранять содержимое под окном
                .byte   6           ; Байт - высота в символах
                .byte   34          ; Байт - ширина в символах
                .byte   125         ; Байт - маска цвета фона
                .byte   0           ; Байт - инверсная маска цвета символов
                mov     #46726, R1
                mov     #C$OPTS, R0
                call    @#OUTSTR    ; Вывод строки.
                                    ; Вход: R0 - адрес строки, R1 - адрес экрана
                ; сформируем значение опции 1
                mov     @#OPT$WS, R3
                mov     #D10BUF, R4
                call    @#S3164     ; преобразование числа в десятичную строку
                mov     #O$WOSP, R2
                tst     (R4)+
                add     #"00, (R4)
                movb    (R4)+, (R2)+
                movb    (R4)+, (R2)+
                add     #"00, (R4)
                movb    (R4)+, (R2)+
                movb    (R4)+, (R2)+
                ; сформируем значение опции 2
                mov     #O$EQMD, R2
                mov     #T$OP2, R1
                tst     @#OPT$EQ
                beq     21$
                bit     (R1)+, (R1)+
21$:            movb    (R1)+, (R2)+
                movb    (R1)+, (R2)+
                movb    (R1)+, (R2)+
                mov     #47704, R1
                mov     #T$OPTS, R0
                mov     #16000, @#NPAGE ; стр.5->окно0, стр.4->окно1
                jmp     @#OUTSTR    ; Вывод строки.
                                    ; Вход: R0 - адрес строки, R1 - адрес экрана

OOPTCT:         mov     #0, @#BGCOLR
                mov     #52525, @#COLMSK
                return
; задаём новую задержку
M$OPT1:         call    OOPTCT
                call    NUMBED
                bcs     1$
                tst     R1
                bne     2$
                inc     R1  ; 0 быть не должен ни в коем случае
2$:             mov     R1, @#OPT$WS
1$:             return

; выбираем тип эквалайзера
M$OPT2:         mov     #O$EQMD, R2
                mov     #T$OP2, R1
                mov     #OPT$EQ, R0
                tst     (R0)
                beq     1$
                clr     (R0)
                br      2$
1$:             inc     (R0)
                bit     (R1)+, (R1)+
2$:             mov     R1, R0
                movb    (R1)+, (R2)+
                movb    (R1)+, (R2)+
                movb    (R1)+, (R2)+
                mov     #50752, R1
                mov     #3, R3
                call    OOPTCT
                jmp     @#STROUT

; редактор числа.
NUMBED:         mov     #D10BUF+2, R3
                mov     R3, FNBBGN
                mov     R3, FNBEND
                add     #4, FNBEND
                mov     #47752,R0   ; адрес экрана
                clr     R4          ; флаг, чтобы стереть старое число, если нажали цифру
                tst     @#177662
; ───────────────────────────────────────────────────────────────────────────
; редактирование существующей строки
; если нажали цифру самой первой - всё старое стереть.
4$:             call    SLCRS
1$:             tstb    @#177660
                bpl     1$
                mov     @#177662, R1
                cmpb    R1, #12
                beq     12$
                cmpb    R1, #3
                beq     3$
                cmpb    R1, #30
                beq     30$
                cmpb    R1, #10
                beq     10$
                cmpb    R1, #31
                beq     31$
                cmp     R1, #'0
                blo     1$
                cmp     R1, #'9
                bhi     1$
                tst     R4          ; нажали цифру самой первой кнопкой?
                bne     6$          ; уже нет
                mov     R3, R4      ; да - сотрём старое число.
                mov     R0, -(SP)
7$:             clrb    (R4)+
                ; тут ещё на экране стереть надо
                call    SLBSP
                tst     (R0)+
                cmp     R4, FNBEND
                blo     7$
                mov     (SP)+, R0
                movb    R1, (R3)
                br      9$
6$:             movb    R1, (R3)
                cmp     R3, FNBEND
                bhis    1$
                call    SLCRS
9$:             sub     #40, R1
                call    SLBSP
                call    @#DRWCHW    ; Вход: R0 - адрес вывода
                                    ;   R1 - код
5$:             tst     (R0)+
                inc     R3
                br      4$
; стрелка влево
10$:            mov     R3, R4      ; флаг, значение не важно, главное чтоб не 0
                cmp     R3, FNBBGN
                blos    1$
                call    SLCRS
                tst     -(R0)
                dec     R3
                br      4$
; стрелка вправо
31$:            mov     R3, R4      ; флаг, значение не важно, главное чтоб не 0
                tstb    (R3)
                beq     1$
                cmp     R3, FNBEND
                bhis    1$
                call    SLCRS
                br      5$
; ───────────────────────────────────────────────────────────────────────────
; BS - удаление последнего введённого символа
30$:            cmp     R3, FNBBGN
                blos    1$
                call    SLCRS
                tst     -(R0)
                clrb    -(R3)
                call    SLBSP
                br      4$
; ───────────────────────────────────────────────────────────────────────────
; Enter - конец ввода
12$:            call    SLCRS
                ; тут надо преобразовать строку в число обратно.
                mov     #4, R5
                mov     #D10BUF+2, R3
                clr     R1
2$:             movb    (R3)+, R0
                beq     8$
                sub     #60, R0
                asl     R1
                mov     R1, R4
                asl     R1
                asl     R1
                add     R4, R1
                add     R0, R1
                sob     R5, 2$
8$:             clc
                return
3$:             call    SLCRS
                sec
                return

; ───────────────────────────────────────────────────────────────────────────
; меню "Compile"
COMPIL:         call    @#DRWWNH    ; Нарисовать окно с рамкой с тенью
                                    ; Входные параметры:
                                    ; R0 - адрес в буфере, если бит 15 адреса экрана ==0
                .word   45030       ; Слово - адрес экрана
                .byte   4           ; Байт - высота в символах
                .byte   22          ; Байт - ширина в символах
                .byte   252         ; Байт - маска цвета фона
                .byte   0           ; Байт - инверсная маска цвета символов
                mov     #T$CMPS, R0
                mov     #46432, R1
                call    @#OUTSTR    ; Вывод строки.
                                    ; Вход: R0 - адрес строки, R1 - адрес экрана
                mov     #4000, @#177716 ; стр.1->окно0, стр.1->окно1
                sub     #40000, PC      ; перекидываемся из окна 1 в окно 0
                mov     #6000, @#177716 ; стр.1->окно0, стр.4->окно1
                call    CMPLS$
                mov     #4000, @#177716 ; стр.1->окно0, стр.1->окно1
                add     #40000, PC      ; перекидываемся из окна 0 в окно 1
                mov     #14000, @#177716    ; стр.5->окно0, стр.1->окно1
                mov     #110000, R0     ; 50000, откуда начинается компиляция
                mov     #ADATA, R1  ; начало области данных(мелодии) в модуле воспроизведения
1$:             movb    (R0)+, (R1)+
                sob     R5, 1$
                mov     #SNDPLY, R0 ; модуль воспроизведения скомпилированного SND
                sub     R0, R1
                mov     R1, FILLEN
                mov     R0, FILADR
                clr     FILCMD
                mov     #T$TSTS, R0
                mov     #46432, R1
                call    @#OUTSTR    ; Вывод строки.
                                    ; Вход: R0 - адрес строки, R1 - адрес экрана
                tst     @#177662
                call    @#PLAY      ; запускаем модуль воспроизведения на тестирование
                mov     #T$SAVS, R0
                mov     #46432, R1
                call    @#OUTSTR    ; Вывод строки.
                                    ; Вход: R0 - адрес строки, R1 - адрес экрана
                tst     @#177662
2$:             tstb    @#177660
                bpl     2$
                call    @#RESWND    ; Восстановление области экрана из буфера
                movb    @#177662, R0
                bicb    #240, R0
                cmpb    R0,#'N
                bne     3$
                return
3$:             jmp     SAVSND
; ───────────────────────────────────────────────────────────────────────────

FNBBGN:         .word   0
FNBEND:         .word   0

T$NAME:         .asciz  "NAME:"
                .even
                .word   0
T$ETSN:         .ascii  "TSN"
                .byte   4
                .byte   4
T$ESND:         .ascii  "SND"
                .byte   5
                .byte   1
                .even
; блок параметров файловой операции
SLEXT:          .word   0       ; расширение обрабатываемого файла
FILCMD:         .word   0
FILADR:         .word   0
FILLEN:         .word   0
FILNME:         .blkb   50

; ███████████████ S U B R O U T I N E ███████████████████████████████████████
; Процедура компиляции
; должна быть перемещаемой. никакой абсолютной адресации, внутри,
; и никакой относительной - наружу
; работает в странице 0, в странице 1 - tsn файл
; рабочая область - с адреса 50000 и до 100000

CMPLS$:         clr     MAXSMP
                mov     #50000, R0      ; очищаем рабочую область
                mov     #14000, R2
1$:             clr     (R0)+
                sob     R2, 1$

                mov     #135000, R0     ; начало цепочки разделов
                mov     @#134776, R1    ; количество разделов в цепочке разделов
                inc     R1              ; отсчёт с нуля вёлся
2$:             clr     R3
                bisb    (R0)+, R3       ; номер раздела
                movb    #377, 51000(R3) ; помечаем, какие разделы из имеющихся используются.
                movb    #377, 52000(R3)
                inc     R0              ; пропустим высоту
                sob     R1, 2$          ; и так по всем разделам
                mov     #400, R1        ; длина цепочки разделов - 256.
                clr     R3
                mov     #51000, R2      ; теперь в этом массиве
4$:             tstb    (R2)
                beq     3$
                movb    R3, (R2)        ; получим номер раздела.
                inc     R3
3$:             inc     R2
                sob     R1, 4$

                mov     #53000, R0      ; тут будет цепочка перенумерованных разделов
                mov     #135000, R1     ; начало цепочки разделов
                mov     @#134776, R2    ; количество разделов в цепочке разделов
                inc     R2
5$:             clr     R4
                bisb    (R1)+, R4
                movb    51000(R4), (R0)+ ; номер раздела
                movb    (R1)+, (R0)+    ; высота из оригинальной цепочки
                sob     R2, 5$
                com     (R0)+           ; признак конца цепочки разделов

                asl     R3              ; максимальный номер раздела
                mov     R3, R4
                asl     R3
                add     R3, R4          ; умножаем на 6
                mov     R0, -(SP)       ; тут будет массив смещений до каналов
                add     R0, R4
                mov     R4, -(SP)       ; тут будут сами данные каналов

                mov     #400, R5        ; по всем разделам
                mov     #52000, R3
7$:             tstb    (R3)+           ; ищем используемый
                beq     6$
                mov     R3, -(SP)       ; нашли
                mov     R5, -(SP)
                bic     #177400, R3     ; вот его номер
                asl     R3
                asl     R3              ; умноженный на 4
                mov     132774(R3), R5  ; это адрес начала раздела в массиве разделов
                call    CODCHN          ; кодируем канал A
                call    CODCHN          ; кодируем канал B
                call    CODCHN          ; кодируем канал C
                mov     (SP)+, R5
                mov     (SP)+, R3
6$:             dec     R5
                bne     7$

                mov     (SP)+, R1       ; начало данных
                mov     (SP), R0        ; начало массива смещений
                mov     R0, R5
8$:             mov     (R0), R2
                mov     R2, R3
                sub     R5, R2
                mov     R2, (R0)+
                mov     (R0), R2
                mov     R2, -(SP)
                sub     R3, R2
                mov     R2, (R0)+
                sub     (SP)+, (R0)+
                cmp     R0, R1          ; формируем смещения из адресов
                blo     8$

                mov     (SP)+, R1       ; начало массива смещений
                mov     R4, -(SP)       ; конец данных
                mov     #136000, R2     ; массив сэмплов
                mov     MAXSMP, R3      ; берём максимальный найденный номер сэмпла
                inc     R3
                mov     #50006, R5      ; начало массива сэмплов в кодированной мелодии
10$:            mov     #40, R4
9$:             mov     (R2)+, (R5)+
                sob     R4, 9$
                sob     R3, 10$         ; копируем все нужные сэмплы
                .addr   R4, TRDMRK
                mov     #20, R3
11$:            movb    (R4)+, (R5)+    ; копируем метку
                sob     R3, 11$
                mov     R5, R4
                sub     #50000, R4
                mov     R4, @#50002     ; начало цепочки разделов
                sub     #53000, R1
                add     R1, R4
                mov     R4, @#50004     ; начало таблицы смещений до нотных массивов
                ; перемещаем на место всё накодированное
                mov     #53000, R1
                mov     (SP)+, R4
12$:            mov     (R1)+, (R5)+
                cmp     R1, R4
                blo     12$

                mov     R5, R4
13$:            clr     (R4)+           ; подчищаем за собой
                tst     R4
                bpl     13$
                mov     @#134772, @#50000 ; темп
                sub     #50000, R5      ; это размер данных без модуля воспроизведения
                return
; End of function CMPLS$


; ███████████████ S U B R O U T I N E ███████████████████████████████████████


Z01266:         clr     R2
2$:             movb    (R5), R1        ; берём ноту
                bic     #177600, R1
                cmpb    R1, #176        ; она тоже отсутствует?
                bne     1$              ; нет
                inc     R2              ; да - считаем
                bit     (R5)+, (R5)+    ; двигаемся к следующей ноте
                cmpb    R2, #134        ; максимально подряд можно закодировать 134 пустых ноты
                blo     2$              ; пока можем - считаем

1$:             add     #241, R2        ; закодируем
                cmpb    R2, Z01324      ; прошлое значение какое было?
                beq     3$              ; такое же
                movb    R2, Z01324      ; сохраним новое, оно всё равно не используется
3$:             return
; End of function Z01266


; ███████████████ S U B R O U T I N E ███████████████████████████████████████
; кодируем канал.
; Вход:  R5 - адрес начала раздела в массиве разделов
;       R0 - адрес в будущем массиве смещений до каналов
;       R4 - адрес массива данных канала

CODCHN:         mov     R4, (R0)+   ; запомним адрес начала в массиве смещений
                clr     Z01324

5$:             movb    (R5)+, R1   ; берём номер ноты
                cmpb    R1, #377    ; конец раздела?
                bne     1$          ; нет ещё
                add     #3, R5      ; да - переходим к следующему каналу
                movb    R1, (R4)+   ; признак конца раздела
                return
; ───────────────────────────────────────────────────────────────────────────

1$:             mov     R1, R2      ; значение запомним
                bic     #177600, R1 ; получим ноту
                bne     2$          ; не пауза
                ; пауза
7$:             add     #3, R5      ; пропускаем все остальные параметры
11$:            movb    R1, -(SP)   ; ноту запомним
                call    Z01266      ; посчитаем отсутствующие ноты
                bne     3$
                cmp     R4, -2(R0)
                bne     4$
3$:             movb    R2, (R4)+
4$:             movb    (SP)+, (R4)+
                br      5$
; ───────────────────────────────────────────────────────────────────────────

2$:             cmpb    R1, #176    ; нота отсутствует?
                bne     6$          ; нет
                mov     #376, R1    ; код отсутствия ноты
                br      7$          ; идём обрабатывать
; ───────────────────────────────────────────────────────────────────────────

6$:             movb    (R5)+, R1   ; нота есть, берём её атрибуты
                bpl     8$          ; переходим, если отсутствует volume
                tstb    R2          ; volume есть, а у V параметр есть?
                bmi     9$          ; нету
                movb    1(R5), R3   ; есть - берём
                bic     #177760, R3
                add     #201, R3    ; кодируем длительность ноты
                movb    R3, (R4)+

9$:             bit     #100, R1    ; форма пакета?
                bne     10$         ; отсутствует
                movb    (R5), R3    ; есть - берём параметры
                bic     #177760, R3
                add     #161, R3    ; кодируем громкость
                movb    R3, (R4)+

10$:            call    CODSMP      ; Кодируем номер сэмпла.
                movb    R2, R1
                bic     #177600, R1 ; обратно номер ноты тут получим
                tst     (R5)+
                br      11$         ; идём обрабатывать
; ───────────────────────────────────────────────────────────────────────────

8$:             bit     #100, R1    ; volume отсутствует, а форма пакета?
                bne     12$         ; тоже отсутствует
                movb    (R5), R3    ; присутствует - берём параметр
                bic     #177760, R3
                add     #221, R3    ; кодируем форму пакета
                movb    R3, LASTVP  ; запомним
12$:            tstb    R2          ; у V параметр есть?
                bmi     13$         ; нету
                movb    1(R5), LASTPR ; есть - запомним
13$:            movb    LASTVP, (R4)+ ; кодируем волпак
                movb    LASTPR, (R4)+ ; и его период
                br      10$
; End of function CODCHN


; ███████████████ S U B R O U T I N E ███████████████████████████████████████

; Кодируем номер сэмпла.
CODSMP:         bit     #40, R1     ; смотрим атрибут, номер сэмпла есть?
                bne     2$          ; нету - выходим
                movb    (R5), R1    ; есть - получим
                asr     R1
                asr     R1
                asr     R1
                asr     R1
                bic     #177760, R1 ; вот номер используемого сэмпла
                cmp     R1, MAXSMP  ; сравним с максимальным
                blo     1$          ; меньше - пропустим
                mov     R1, MAXSMP  ; больше-равно - зафиксируем новый максимум
1$:             add     #141, R1    ; вот его код в мелодии
                movb    R1, (R4)+   ; сохраним
2$:             return
; End of function CODSMP

; ───────────────────────────────────────────────────────────────────────────
MAXSMP:         .word   0   ; максимальный найденный номер сэмпла
Z01324:         .word   0   ; код пустых нот. не используется
LASTVP:         .byte   0   ; последний используемый волновой пакет
LASTPR:         .byte   0   ; последний используемый период волнового пакета

TRDMRK:         .ascii "SONG BY ROCK MON"
                .even
; ───────────────────────────────────────────────────────────────────────────
T$CMPS:         .asciz "COMPILE THE SONG"
                .even
                .word 0
T$TSTS:         .asciz " TEST THE SONG  "
                .even
                .word 0
T$SAVS:         .asciz " SAVE THE SONG? "
                .even
                .word 0
; ───────────────────────────────────────────────────────────────────────────

; ███████████████████████████████████████████████████████████████████████████
; ███████████████ ПЕРЕХВАТЧИКИ ВВОДА/ВЫВОДА █████████████████████████████████
; ███████████████████████████████████████████████████████████████████████████

; тут будут располагаться перехватчики. Я хотел было их отдельно сделать,
; но места в нужных местах катастрофически не хватает. А тут - полно.

; код от HACK до IOTRAP нужен всего один раз, и его можно перебросить в конец.
HACK:           mtps    #340
                mov     #177777, @#177660   ; Запретим прерывания от клавиатуры
                mov     #42000, @#177662    ; Выкл таймер, экран 0, палитра 11
                mov     #4000, @#177716     ; стр.1->окно0, стр.1->окно1
                sub     #40000, PC          ; перекидываемся из окна 1 в окно 0
                mov     #6000, @#177716     ; стр.1->окно0, стр.4->окно1
                mov     #100000, R2
                mov     #20000, R1
                ; опознаём ксидос.
                cmp     @#114,#54400
                bne     4$
                cmp     @#112,@#114
                beq     12$
                ; тут нужно сделать проверку на андос/мкдос,
                ; и если обнаружено - делать перехватчик, иначе - не нужно.
4$:             .addr   R5, OWERDT
                cmp     @#120004,#100000+315. ; это мкдос?
                blo     10$                 ; нет. или версия не та
                clr     (R5)+               ; переменные мкдос - флаги для ячеек 120124 и 120125
                mov     #120124,(R5)+       ; 120124 - флаг автоперезаписи 0 - вкл., 120125 - флаг предудаления 0 - вкл.
                mov     #120074,(R5)+       ; ячейка перехвата вывода сообщений на экран, для запрета вывода адрес команды 207
                mov     #E36BLP+26,(R5)+    ; ячейка, в которую помещается адрес для каталога
                br      9$

10$:            CMP     @#120170,#100000+310. ; это андос?
                BLO     12$                 ; нет. или версия не та
                MOV     #"PP,(R5)+          ; переменные андос - флаги для ячеек 120140 и 120141
                MOV     #120140,(R5)+       ; 120140 - флаг автоперезаписи 'P' - вкл., 120141 - текущий режим автоперезаписи 'P' - вкл.
                MOV     #120150,(R5)+       ; ячейка перехвата вывода сообщений на экран, для запрета вывода адрес команды 207
                MOV     #120152,(R5)+       ; ячейка, в которую помещается адрес для каталога

                ; 1. внедряем перехватчик
9$:             mov     #240, @#ANDHK1
                .addr   R5, BGARR0          ; Адаптатор под ANDOS/MKDOS
                .addr   R4, ANDHCK
                mov     #BGARR1 - BGARR0, R0
5$:             movb    (R5)+, (R4)+
                sob     R0, 5$
                ; 2. копируем страницу 4 в страницу 3, чтобы сделать культурный выход из программы
                ; примечание: культурный выход ещё не реализован.
2$:             mov     #6000, @#177716     ; стр.1->окно0, стр.4->окно1
                mov     (R2), R0
                mov     #5400, @#177716     ; стр.1->окно0, стр.3->окно1
                mov     R0, (R2)+           ; копируем содержимое стр.4 в стр.3
                sob     R1, 2$
                br      1$

12$:            ; предполагаем, что это ксидос.
                ; 2. копируем страницу 6 в страницу 3, чтобы сделать культурный выход из программы
3$:             mov     #7400, @#177716     ; стр.1->окно0, стр.6->окно1
                mov     (R2), R0
                mov     #5400, @#177716     ; стр.1->окно0, стр.3->окно1
                mov     R0, (R2)+           ; копируем содержимое стр.6 в стр.3
                sob     R1, 3$

                ; 3. инициализируем нотную страницу
1$:             mov     #6000, @#177716     ; стр.1->окно0, стр.4->окно1
                call    @#INITSN
                call    @#INISAM
                mov     #4, KILSC$          ; подменяем Reset на IOT в модуле воспроизведения
                jmp     @#ENDHCK            ; запускаем рок монитор.

; хак, часть1 - вызывальщик. 6 слов
BGARR0:         jmp     @#IOTRAP            ; перебрасывается на своё место,
                nop                         ; поэтому адресация 37
                nop
                nop
                return
BGARR1:

; хак, часть2 - обработчик
; вход: R0 - блок параметров rockmonitora.
IOTRAP:         movb    #4, @#52
                cmpb    FILNME, #'.         ; если имя начинается с точки, то ошибка.
                bne     1$                  ; ANDOS/MKDOS  не обрабатывают такие ситуации
                sec                         ; хотя можно было бы вызывать файлер, но не получается.
                return

1$:             clr     FILNME+20           ; делаем конец имени файла
                mov     #E36BLP, R1         ; адрес блока параметров emt 36
                mov     (R0)+, R5           ; команда emt 36
                tstb    R5
                bne     5$
                mov     #200, R5            ; если 0, то 200
5$:             add     #2, R5              ; если 1, то 3
                mov     R5, (R1)+           ; формируем андосную команду
                mov     (R0)+, R5           ; реальный адрес массива
                bpl     6$                  ; <0 - snd, >0 - tsn
                mov     #240, KILSC$        ; прибиваем IOT в модуле воспроизведения
                sub     #40000, R5
                mov     #1000, -(SP)        ; Адрес, помещаемый в каталог. Используется при исполнении EMT36 с кодом операции 202
                mov     #5400, R4           ; стр.1->окно0, стр.3->окно1
                br      7$
; ───────────────────────────────────────────────────────────────────────────

6$:             mov     #45400, R4          ; стр.4->окно0, стр.3->окно1
                mov     R5, -(SP)           ; Адрес, помещаемый в каталог. Используется при исполнении EMT36 с кодом операции 202
7$:             mov     R5, (R1)+           ; адрес массива
                mov     (R0)+, (R1)+        ; его длина
                mov     R1, R2
                mov     #10, R3
4$:             mov     #20040, (R2)+
                sob     R3, 4$
9$:             movb    (R0)+, R5           ; скопируем имя
                beq     8$
                movb    R5, (R1)+
                br      9$
; ───────────────────────────────────────────────────────────────────────────

8$:             ; перебрасываем сам модуль туда, где он не будет мешаться
                ; !!!следить, чтобы не превышало размера 1000-STACKH
                ; на входе R4 - страницы для 177716
                ; на входе R5 - Адрес, помещаемый в каталог.
                mov     (SP)+, R5
                mov     #STACKH+IOBLKE-IOBLKB, R1
                mov     #IOBLKE-IOBLKB, R0
                mov     #IOBLKE, R2
3$:             movb    -(R2), -(R1)
                sob     R0, 3$
                jmp     (R1)        ; и запускаем

IOBLKB:         mov     R4, @#177716
                mov     R5, @DIRADR         ; Адрес, помещаемый в каталог.
                mov     #E36BLP, R1         ; адрес блока параметров
                mfps    -(SP)
                mtps    #340
                MOV     @SCREEN,-(SP)
                MOV     @OWERWR,-(SP)
                MOV     #100256,@SCREEN
                MOV     OWERDT,@OWERWR
                call    @#120002            ; выполняем дисковую операцию
                MOV     (SP)+,@OWERWR
                MOV     (SP)+,@SCREEN
                mtps    (SP)+               ; не слишком ли много стека будет? может 370 перекроет?
                clc
                movb    @#E36BLP+1, @#52    ; результат выполнения на своё место
                beq     10$
                sec
10$:            mov     #14000, @#177716    ; стр.5->окно0, стр.1->окно1
                mov     #4, @#KILSC$        ; восстанавливаем IOT в модуле воспроизведения
                return
OWERDT:         .word   0
OWERWR:         .word   0
SCREEN:         .word   0
DIRADR:         .word   0
IOBLKE:
; !!! недостатки: 1. автоперезапись файла.
; 2. очень сложно сделать хоть что-то, чтобы вывести на экран сообщения ОС

; ███████████████████████████████████████████████████████████████████████████
; ███████████████ МОДУЛЬ ВОСПРОИЗВЕДЕНИЯ ████████████████████████████████████
; ███████████████████████████████████████████████████████████████████████████

; Модуль воспроизведения скомпилированного SND
SNDPLY:         mov     #102, @#100
                mov     #2, @#102
                mov     #RMPAL1, @#177662

PLAY:           call    INITPL      ; вызов на просто воспроизведение из меню PLAY
LOOP$:          call    PLAY$
                wait
                tstb    @#177660
                bpl     LOOP$
KILSC$:         nop
                br      mute
; ───────────────────────────────────────────────────────────────────────────
                jmp     INITPL

; ███████████████ S U B R O U T I N E ███████████████████████████████████████


PLAY$:          mov     R0, -(SP)
                mov     R1, -(SP)
                mov     R2, -(SP)
                mov     R3, -(SP)
                mov     R4, -(SP)
                mov     R5, -(SP)
                call    EXPNOT      ; формируем квант данных для передачи в AY
                add     #15, R3
                mov     #363, R2
                mov     #177714, R5 ; и заполняем регистры AY
1$:             mov     R2, (R5)
                movb    -(R3), R0
                comb    R0
                movb    R0, (R5)
                incb    R2
                bmi     1$
                mov     (SP)+,R5
                mov     (SP)+,R4
                mov     (SP)+,R3
                mov     (SP)+,R2
                mov     (SP)+,R1
                mov     (SP)+,R0
                return


; ███████████████ S U B R O U T I N E ███████████████████████████████████████

; деление
; вход:  R1 - делимое
;        R2 - делитель
; выход: R1 - целая часть
;        R3 - остаток
; портит R0
DIVDE$:         clr     R3
                mov     #16., R0
2$:             asl     R1
                rol     R3
                cmp     R3, R2
                blo     1$
                sub     R2, R3
                inc     R1
1$:             sob     R0, 2$
                bic     #140000, R1
                tst     R4
RET1$:          return

; глушение AY занесением данных в регистры.
MUTE:           mov     #177714, R5
                mov     #362, (R5) ; волпак
                clrb    (R5)
                mov     #370, (R5) ; микшер
                clrb    (R5)
                return

; ───────────────────────────────────────────────────────────────────────────
; чтение очередной ноты в канале
; R5 - адрес блока параметров канала
; R4 - адрес в массиве нот канала
; остальные регистры - рабочие

GETNOT:         movb    (PC)+, (R5)     ; темп на место
TEMP:           .word   6
                decb    P.ENCN(R5)      ; пустые ноты в канале закончились?
                bpl     RET1$           ; нет ещё - продолжаем звучать прошлой нотой
NEXT3$:         mov     P.ACHN(R5), R4  ; текущий адрес нот в канале
                clrb    P.VOLP(R5)      ; волпака пока нет
NEXT2$:         movb    P.NDLT(R5), P.L1FR(R5) ; обновляем длительность звучания первого фрагмента
NEXT1$:         movb    (R4)+, R1       ; берём очередной байт
                cmpb    R1, (PC)+       ; конец раздела?
ENDPTN:         .word   377
                bne     0NXT1$          ; нет
LOOP1$:         mov     CURATR, R0      ; да - текущий адрес в таблице разделов
                tstb    (R0)            ; номер следующего раздела
                bpl     0NXT2$          ; разделы закончились? нет - переход
                mov     (PC)+, (PC)+    ; да - тогда - начнём сначала
BGNATR:         .word   0               ; начало списка разделов
CURATR:         .word   0               ; текущий адрес в таблице разделов
                br      LOOP1$
; ───────────────────────────────────────────────────────────────────────────
; переход к следующему разделу из таблицы
0NXT2$:         clr     R1
                bisb    (R0)+, R1       ; номер нового раздела
                movb    (R0)+, HEIGHT   ; и высота нового раздела
                mov     R0, CURATR      ; адрес в таблице разделов сохраним на месте
                asl     R1              ; ┐
                mov     R1, R0          ; │ умножаем номер раздела на 6
                asl     R1              ; │
                add     R1, R0          ; ┘
                mov     (PC)+, R1       ; адрес начала смещений до нотных массивов
BGNONA:         .word   0               ; начало таблицы смещений до нотных массивов
                add     R1, R0
                add     (R0)+, R1
                mov     R1, P.ACHN(R5)  ; адрес голоса A
                add     (R0)+, R1
                mov     R1, CHPLN+P.ACHN(R5)    ; адрес голоса B
                add     (R0), R1
                mov     R1, CHPLN+CHPLN+P.ACHN(R5) ; адрес голоса C
                br      NEXT3$
; ───────────────────────────────────────────────────────────────────────────
; обработка следующей ноты раздела.
0NXT1$:         mov     R5, R3
                tstb    R1              ; пауза?
                beq     0PAUS$          ; да - обработать
                cmpb    #376, R1        ; отсутствует нота?
                bne     1$
                ; обработка отсутствия ноты
                clr     P.L1FR(R5)
                br      0NXT4$
; ───────────────────────────────────────────────────────────────────────────

1$:             decb    R1              ; смотрим, что за нота
                cmpb    R1, #140        ; Это просто нота?
                bhis    2$              ; нет
                ; обработка нот.
                add     (PC)+, R1       ; корректируем высоту тона
HEIGHT:         .word   0               ; высота проигрыша всего раздела
                movb    R1, P.NOTN(R5)
                inc     R3
                movb    #-1, (R3)+      ; P.TPSV
                mov     #-1, (R3)       ; P.TPSN, P.TPST
                clrb    P.PAUS(R5)      ; сбрасываем флаг паузы
                br      0NXT3$
; ───────────────────────────────────────────────────────────────────────────

2$:             mov     R1, R0
                bic     #177760, R1     ; сделаем тут значение переменной
                cmpb    R0, #160
                bhis    3$
                ; обработка номеров сэмплов
                swab    R1              ; ┐
                asr     R1              ; │ умножим номер сэмпла на 100
                asr     R1              ; ┘
                add     (PC)+, R1       ; прибавим адрес начала сэмплов
BGNASA:         .word   0               ; это начало сэмплов
                bit     (R3)+, (R3)+
                mov     R1, (R3)+       ; адрес сэмпла -> P.ASMP(R5)
                movb    (R1)+, (R3)+    ; начало зацикливания для громкости -> P.BCYV(R5)
                movb    7(R1), (R3)+    ; начало зацикливания для шума -> P.BCYN(R5)
                movb    1(R1), (R3)+    ; начало зацикливания для тона -> P.BCYT(R5)
                movb    (R1)+, (R3)+    ; конец зацикливания для громкости -> P.ECYV(R5)
                movb    7(R1), (R3)+    ; конец зацикливания для шума -> P.ECYN(R5)
                movb    1(R1), (R3)     ; конец зацикливания для тона -> P.ECYT(R5)
                bicb    #200, (R3)      ; bic #100000, P.ECYN(R5)
                br      NEXT1$
; ───────────────────────────────────────────────────────────────────────────

3$:             tstb    R0
                bmi     4$
                ; обработка громкостей
                mov     #17, R2
                sub     R1, R2
                movb    R2, P.VVAL(R5)  ; громкость - это 17 - value
                br      NEXT1$
; ───────────────────────────────────────────────────────────────────────────

4$:             cmpb    R0, #220
                bhis    5$
                ; обработка длительностей ноты
                asl     R1
                movb    R1, P.NDLT(R5)
                movb    R1, P.L1FR(R5)
                br      NEXT1$
; ───────────────────────────────────────────────────────────────────────────

5$:             cmpb    R0, #240
                bhis    6$
                ; обработка формы пакета
                movb    (R4)+, P.VPER(R5)   ; период пакета
                movb    R0, P.VOLP(R5)      ; если волпак, то должен быть <0
                mov     #362, @#177714
                comb    R1
                movb    R1, @#177714        ; устанавливаем форму пакета
                br      NEXT1$
; ───────────────────────────────────────────────────────────────────────────

6$:             sub     #240, R0
                movb    R0, P.ENNR(R5)      ; количество пустых нот
                br      NEXT1$
; ───────────────────────────────────────────────────────────────────────────
; обработка паузы
0PAUS$:         clr     P.L1FR(R5)
                tstb    P.PAUS(R5)          ; пауза есть?
                bne     0NXT4$              ; да
                decb    P.PAUS(R5)          ; нет - установим признак паузы
                inc     R3
                movb    P.ECYV(R5), (R3)+   ; P.ECYV(R5) -> P.TPSV(R5)
                movb    P.ECYN(R5), (R3)+   ; P.ECYN(R5) -> P.TPSN(R5)
                movb    P.ECYT(R5), (R3)+   ; P.ECYT(R5) -> P.TPST(R5)
0NXT3$:         clr     P.TSLV(R5)
                clrb    P.TSLT(R5)
0NXT4$:         mov     R4, P.ACHN(R5)
                movb    P.ENNR(R5), P.ENCN(R5)
                return

; ███████████████ S U B R O U T I N E ███████████████████████████████████████

; Вход: R0 - номер текущего фрагмента в сэмпле 0..14
; Выход: R4 - маска
;       R0 - смещение до фрагмента в сэмпле
;       R3 - адрес начала сэмпла
GETMSK:         mov     #1, R4
                mov     R0, R3
                beq     1$
2$:             asl     R4
                sob     R3, 2$
1$:
GETASM:         mov     P.ASMP(R5), R3
                add     R3, R0
                return
; End of function GETMSK

; ███████████████ S U B R O U T I N E ███████████████████████████████████████

; работа с длительностями звучания, сюда попадает длит*16
; результат:
; 0 ->0; 1 ->1; 2 ->5; 3 ->9; N ->(N*4-3)
SETDLT:         asr     R2
                asr     R2
                beq     1$
                sub     #3, R2
1$:             add     P.L1FR(R5), R2
                return

; ███████████████ S U B R O U T I N E ███████████████████████████████████████

; вход: R0 - маска для миксера.
;       R3 - маска тона / шума в сэмпле
;       R4 - бит в маске для текущего фрагмента сэмпла
;       R2 - длительность * 16 текущего фрагмента
;       R1 - громкость текущего фрагмента
SETMXR:         bicb    R0, AYREG+Y.MIXR
                bit     R4, R3
                bne     1$
                bisb    R0, AYREG+Y.MIXR
1$:             call    SETDLT

                movb    R1, P.RVLV+1(R5)
                tst     R3              ; огибающую изменять плавно?
                bmi     2$
                movb    R1, P.CVLV+1(R5)    ; нет
                return
; ───────────────────────────────────────────────────────────────────────────

2$:             movb    P.CVLV+1(R5), R0    ; да - плавное изменение
                clr     R4
                sub     R0, R1
                bpl     3$
                neg     R1
                inc     R4
3$:             swab    R1
                call    DIVDE$      ; деление
                                    ; вход:  R1 - делимое
                                    ;        R2 - делитель
                                    ; выход: R1 - целая часть
                                    ;        R3 - остаток
                beq     4$
                neg     R1
4$:             mov     R1, P.DVLV(R5)
                return

; ███████████████ S U B R O U T I N E ███████████████████████████████████████

; Вход: за командой - смещение в блоке параметров.
; 1 - для громкости
; 2 - для шума
; 3 - для тона
; выход: R0 - номер текущего фрагмента в сэмпле 0..13.
GETFRS:         mov     (R3)+, R4
                add     R5, R4
                incb    (R4)        ; увеличиваем текущий фрагмент громкости/шума/тона в сэмпле
                movb    (R4), R0    ; вот его значение
                tstb    P.PAUS(R5)  ; пауза?
                bne     1$          ; да
                cmpb    R0, 10(R4)  ; нет - достигли конца зацикливания?
                blos    1$          ; нет ещё
                movb    5(R4), R0   ; да - берём начальный фрагмент
                movb    R0, (R4)    ; и его в позицию текущего
1$:             cmpb    R0, #13.    ; конец сэмпла?
                blo     2$          ; нет.
                decb    (R4)        ; да - не дадим выйти за пределы.
2$:             rts     R3

; ───────────────────────────────────────────────────────────────────────────
                .ascii "*CAROLINE*"
                .even

; ███████████████ S U B R O U T I N E ███████████████████████████████████████

; формируем квант данных для передачи в AY
EXPNOT:         .addr   R5, VARPRT
                clrb    AYREG+Y.VPCK
                call    2(PC)
                mov     PC, -(SP)
                decb    (R5)        ; тики кончились?
                bgt     0$          ; нет ещё - звучим текущую ноту
                call    GETNOT      ; да - берём новую ноту
0$:             decb    P.TSLV(R5)  ; текущий фрагмент громкости отзвучал?
                bpl     1$          ; нет ещё - продолжаем
                ; достаём из сэмпла новую громкость и её длительность
                clr     P.DVLV(R5)
                jsr     R3, GETFRS  ; получим номер текущего фрагмента в сэмпле
                .word   P.TPSV      ; для громкости
                blo     2$          ; переход, если номер текущего фрагмента в сэмпле < 13. ?
                clr     P.CVLV(R5)  ; если >= 13.
                br      1$
; ───────────────────────────────────────────────────────────────────────────

2$:             call    GETMSK
                clr     R1
                bisb    46(R0), R1  ; значение текущего фрагмента громкости
                mov     R1, R2
                bic     #360, R1    ; значение громкости
                bic     R1, R2      ; длительность фрагмента громкости * 16.
                mov     4(R3), R3   ; маска в огибающей громкости
                movb    P.CNMT(R5), R0 ; маска в микшере для громкости
                call    SETMXR
                movb    R2, P.TSLV(R5)

1$:             decb    P.TSLN(R5)  ; текущий фрагмент шума отзвучал?
                bpl     3$          ; нет ещё - продолжаем
                ; достаём из сэмпла новый уровень шума и его длительность
                clr     P.DVLN(R5)
                jsr     R3, GETFRS  ; получим номер текущего фрагмента в сэмпле
                .word   P.TPSN      ; для шума
                bhis    3$          ; переход, если номер текущего фрагмента в сэмпле >= 13.
                call    GETMSK      ; если номер текущего фрагмента в сэмпле < 13.
                clr     R1
                bisb    63(R0), R1  ; значение текущего фрагмента шума
                mov     R1, R2
                bic     #340, R1    ; значение громкости
                bic     R1, R2      ; длительность фрагмента шума * 16.
                bit     12(R3), R4  ; бит длительности, который не полез в байт есть?
                beq     4$          ; нету
                add     #20, R2     ; есть - поместим на место - это младший бит был.
4$:             mov     6(R3), R3   ; маска в огибающей шума
                movb    P.CNMN(R5), R0 ; маска в микшере для шума
                add     #P.DVLN-P.DVLV, R5
                call    SETMXR      ; то же самое, только для шума.
                sub     #P.DVLN-P.DVLV, R5
                movb    R2, P.TSLN(R5)

3$:             decb    P.TSLT(R5)  ; текущий фрагмент тона отзвучал?
                bpl     5$          ; нет ещё - продолжаем
                ; достаём из сэмпла новый тон и его длительность
                clr     P.DVLT(R5)
                clr     P.DVLT+2(R5)
                jsr     R3, GETFRS  ; получим номер текущего фрагмента в сэмпле
                .word   P.TPST      ; для тона
                bhis    5$          ; переход, если номер текущего фрагмента в сэмпле >= 13.
                asl     R0          ; если номер текущего фрагмента в сэмпле < 13.
                call    GETASM      ; в R3 адрес сэмпла, он ещё пригодится
                                    ; в R0 смещение до фрагмента
                mov     14(R0), R2  ; значение фрагмента огибающей тона
                mov     R2, R4
                mov     #2000, R0
                bic     #176000, R4 ; значение тона
                bit     R0, R2      ; минус?
                beq     6$
                bis     #176000, R4 ; да
6$:             movb    P.NOTN(R5), R1
                asl     R0
                bit     R0, R2      ; изменение в полутонах?
                beq     7$          ; нет
                add     R4, R1      ; да - просто прибавим
                bmi     8$          ; и проконтролируем
                cmp     #140, R1    ; чтоб не вылезло
                bhi     7$
                mov     #137, R1    ; за пределы
                br      7$
; ───────────────────────────────────────────────────────────────────────────

8$:             clr     R1
7$:             asl     R1
                add     PC, R1
                add     (PC)+, R1
                .word   @NTCLKP+2
                mov     (R1), R1    ; получим частоту
                bit     R0, R2      ; снова проверим: изменение в полутонах?
                bne     9$          ; да пойдём туда
                sub     R4, R1      ; отнимем значение от частоты
                bpl     9$
                clr     R1
9$:             swab    R2
                bic     #177417, R2 ; получим длительность * 16
                call    SETDLT
                movb    R2, P.TSLT(R5)
                mov     R1, P.RVLT(R5)
                tst     2(R3)       ; ноту менять плавно?
                bmi     10$
                mov     R1, P.CVLT+2(R5)    ; нет
                br      5$
; ───────────────────────────────────────────────────────────────────────────

10$:            clr     R4          ; плавное изменение ноты
                sub     P.CVLT+2(R5), R1
                bpl     11$
                neg     R1
                inc     R4
11$:            call    DIVDE$      ; деление
                                    ; вход:  R1 - делимое
                                    ;        R2 - делитель
                                    ; выход: R1 - целая часть
                                    ;        R3 - остаток
                beq     12$
                neg     R1
                dec     R1
12$:            mov     R1, P.DVLT+2(R5)
                mov     #10, R0
                clr     R1
14$:            asl     R1
                asl     R3
                cmp     R3, R2
                blo     13$
                sub     R2, R3
                inc     R1
13$:            sob     R0, 14$
                tst     R4
                beq     15$
                neg     R1
15$:            movb    R1, P.DVLT+1(R5)
                ; заполняем регистры AY
5$:             .addr   R3, AYREG   ; начало снимка памяти для сопра
                mov     R5, R0
                add     #P.DVLV, R0
                add     (R0)+, (R0)+    ; P.CVLV += P.DVLV, прибавляем к текущей амплитуде значение для плавного изменения
                mov     R0, R2          ; P.RVLV
                tstb    P.TSLV(R5)      ; а надо ли плавно изменять?
                bne     16$
                mov     (R0), -(R0)     ; P.CVLV = P.RVLV, нет - сразу подставляем конечный результат

16$:            movb    P.CNOA(R5), R4  ; смещение до регистра амплитуды
                add     R3, R4          ; адрес регистра амплитуды
                movb    P.CVLV+1(R5), R1 ; текущее значение громкости
                tstb    P.VOLP(R5)      ; волпак есть?
                bpl     17$             ; нет
                tstb    R1              ; что там с амплитудой?
                beq     20$             ; нету
                movb    #20, (R4)       ; ставим признак волпака
                bisb    P.CNMN(R5), Y.MIXR(R3)  ; запрещаем шум - вот этого в оригинале нету. И это единственное различие
                movb    P.VPER(R5), Y.PERD(R3)
                br      19$
; ───────────────────────────────────────────────────────────────────────────

17$:            movb    P.VVAL(R5), R0  ; приращение громкости
                sub     R0, R1
                bpl     20$
                clr     R1
20$:            movb    R1, (R4)        ; формируем амплитуду в канале
19$:            tst     (R2)+           ; P.DVLN
                add     (R2)+, (R2)+    ; P.CVLN += P.DVLN, прибавляем к текущему шуму значение для плавного изменения
                tstb    P.TSLN(R5)      ; а надо ли плавно изменять?
                bne     21$
                mov     (R2), -(R2)     ; P.CVLN = P.RVLN, нет - сразу подставляем конечный результат
21$:            bitb    P.CNMN(R5), Y.MIXR(R3)  ; шум запрещён?
                bne     22$             ; да - пропускаем
                movb    P.CVLN+1(R5), Y.NOIS(R3)

22$:            mov     R5, R2
                add     #P.CVLT, R2     ; P.CVLT
                add     P.DVLT(R5), (R2)+   ; P.CVLT += P.DVLT
                adc     (R2)
                add     P.DVLT+2(R5), (R2)
                tstb    P.TSLT(R5)      ; а надо ли плавно изменять?
                bne     23$
                mov     P.RVLT(R5), (R2)    ; нет - сразу подставляем конечный результат
23$:            movb    P.CNOC(R5), R4  ; смещение до регистра тона
                add     R3, R4          ; адрес регистра тона
                mov     (R2), (R4)      ; формируем тон
LGONX:          clr     P.L1FR(R5)
                add     #CHPLN, R5
                return


; ███████████████ S U B R O U T I N E ███████████████████████████████████████

INITPL:         reset
                movb    #377, AYREG+Y.MIXR  ; глушим всё
                .addr   R0, ADATA       ; начало области темпа и смещений
                mov     R0, R4
                mov     (R0)+, R5
                movb    R5, TEMP
                mov     (R0)+, R5
                add     R4, R5
                mov     R5, BGNATR      ; это начало
                mov     R5, CURATR      ; списка разделов
                mov     (R0)+, R5
                add     R4, R5
                mov     R5, BGNONA      ; начало таблицы смещений до нотных массивов
                mov     R0, BGNASA      ; начало сэмплов
                .addr   R5, VARPRT
                .addr   R4, ENDPTN
                call    2(PC)
                mov     PC, -(SP)
                clr     (R5)
                mov     R0, P.ASMP(R5)
                mov     R4, P.ACHN(R5)
                clr     P.ENCN(R5)
                mov     #20, P.VVAL(R5)
                br      LGONX

; ───────────────────────────────────────────────────────────────────────────
; таблица нот
NTCLKP:         .word 7370, 7020, 6540, 6200, 5730, 5450, 5210, 4760, 4540, 4340, 4130, 3740
                .word 3574, 3410, 3260, 3100, 2754, 2624, 2504, 2370, 2260, 2160, 2054, 1760
                .word 1676, 1604, 1530, 1440, 1366, 1312, 1242, 1174, 1130, 1070, 1026, 770
                .word 737, 702, 654, 620, 573, 545, 521, 476, 454, 434, 413, 374
                .word 357, 341, 326, 310, 275, 262, 250, 237, 226, 216, 205, 176
                .word 167, 160, 153, 144, 136, 131, 124, 117, 113, 107, 102, 77
                .word 73, 70, 65, 62, 57, 54, 52, 47, 45, 43, 41, 37
                .word 35, 34, 32, 31, 27, 26, 25, 23, 22, 21, 20, 17
; три блока по 70 байтов на канал
VARPRT:         .word   177400,177777,0,7417,7417,7417
                .blkb   46  ; блок параметров канала A
                .byte   Y.CLKA, 1, 10, Y.AMPA, 0, 0 ; константы в блоке параметров
                .word   177400,177777,0,7417,7417,7417
                .blkb   46  ; блок параметров канала B
                .byte   Y.CLKB, 2, 20, Y.AMPB, 0, 0 ; константы в блоке параметров
                .word   177400,177777,0,7417,7417,7417
                .blkb   46  ; блок параметров канала C
                .byte   Y.CLKC, 4, 40, Y.AMPC, 0, 0 ; константы в блоке параметров

; область регистров AY 016 штук
AYREG:          .blkb   AYLEN
; начало области данных(мелодии) в массиве переменных
ADATA:          .word   0


                .END

