MONICO 1 ? "Прямое управление ЯЗС5/2" 3 gosub 2000 : gosub 4000 : call irqdis 5 rem Поиск ячейки (только для холодного старта) 7 ? "Поиск ячейки..." 9 data $3F,$3F,$3F,$3F,$00,$00,$00,$00,$3F,$3F,$3F,$3F,$00,$00,$00,$00 10 for s = 1 to 6 15 o% = s * 16 + $c080 : f = 1 : restore rem poke o% + 15, $FF : poke o%, 0 : o = peek(o%) ' строка сбросит статус флагов IRQ, но ещё остаются значения на порту внешних устройств 20 for o = 0 to 15 50 read k 60 if peek(o% + o) <> k then f = 0 70 next o 80 if f = 1 then 200 90 next s 100 input "Укажите слот (1..6) - "; s 110 if s < 1 or s > 6 then stop 190 rem Начало построения экрана 200 normal : home 210 ? "Слот " s " "; : s% = s * 16 + $c080 220 inverse : ? "Ravodin & ... (C) 2016" : ? : normal 230 vtab 5 : htab 8 240 ? "Период En ПА ФЛ НЧ СЧ ВЧ" : ? 250 ribbon=1 : for g = 0 to 4 : ? "Канал "g : ? : next g 260 vtab 19 : htab 18 : ribbon=7 270 ? "Им Дл F1 F2 F3" : ? 280 ribbon=1 : ? "Канал 5Ш" : ? : ? "Канал 6Ш" 290 vtab 27 : ? "Таймер прерываний "; 295 *lD+1:!=s%+7!: call setirq 300 rem Программирование таймеров 310 poke s% + 3, $36 + $00 320 poke s% + 3, $36 + $40 330 poke s% + 3, $36 + $80 340 poke s% + 7, $36 + $00 350 poke s% + 7, $36 + $40 360 poke s% + 7, $36 + $80 370 poke s% +15, $00 380 dim g%(6), c(4) 390 for c = 0 to 4 : cg% = c : c(cg%) = 65534 : gosub 5000 : next c 400 cg% = 0 : cb% = 5 : irqcnt = 7980 : gosub 6000 500 rem Вывод меню 502 limb% = 5 : if cg% > 4 then limb% = 4 504 if cb% = 8 and cg% <= 4 then 508 506 if cb% > limb% then cb% = limb% 508 if cg% = 7 then cb% = 8 510 poke $D3, cb% 520 for g = 0 to 4 530 vtab g * 2 + 7 : htab 9 540 *$D4:!$7474!: 545 if cg% = g then *$D4:!$7202!: 550 *$D0:!=c(g)!: call wdoutcl : htab 16 560 poke $D0, g%(g) : call btoutc5 570 next g 600 vtab 21 : htab 19 610 *$D4:!$7474!: 615 if cg% = 5 then *$D4:!$7202!: 620 poke $D0, g%(5) : call btoutc4 630 vtab 23 : htab 19 640 *$D4:!$7474!: 645 if cg% = 6 then *$D4:!$7202!: 650 poke $D0, g%(6) : call btoutc4 660 vtab 27 : htab 24 : *$D4:!$7474!: 670 if cg% = 7 then *$D4:!$7202!: 680 *$D0:!=irqcnt!: call wdoutcl 700 rem Вывод комментария по пункту меню 710 htab 1 : vtab 31 : poke 50,$72 720 if cg% > 4 then 780 730 ? "Тон-канал "cg%-0": "; 740 ribbon=6 750 if cb% <= 5 then ? descr$(cb%); : goto 890 760 f = int(1021429 / c(cg%)) 770 if f >= 1000 then ? f / 1000 " КГц"; : goto 890 775 ? f " Гц"; : goto 890 780 if cg% = 7 then 840 790 ? "Шум-канал "cg%-5": "; 800 ribbon=6 810 if cg% = 5 then ? descr5$(cb%); 820 if cg% = 6 then ? descr6$(cb%); 830 goto 890 840 ? "IRQ: "; : ribbon=6 : ? int(7980 / irqcnt) " Гц"; 890 ? chr$(29+128) 1000 rem Обработка нажатий клавиш 1005 rem IRQ можно разрешить только на время этой паузы, т.к. при выводе на экран и, возможно, других операциях бейсик и дос могут щёлкать контроллером памяти, меняя тем самым актуальный вектор обработчика IRQ 1010 call irqen : wait $C000,$80,$00 : call irqdis : key% = peek($C000) - 128 : poke $C010,0 1020 if key% = 8 then 1100 1030 if key% = 21 then 1130 1040 if key% = 25 then 1160 1050 if key% = 26 then 1180 1060 if key% = 13 then 1200 1070 if key% = 32 then 1300 1080 if key% = 27 then 1900 1090 goto 1010 1100 if cb% = 8 then cb% = 0 : goto 500 1110 if cb% < limb% then cb% = cb% + 1 : goto 500 1115 if cg% <= 4 then cb% = 8 : goto 500 1120 cb% = 0 : goto 500 1130 if cb% = 0 then cb% = 8 : goto 500 1140 if cb% = 8 then cb% = limb% : goto 500 1150 cb% = cb% - 1 : goto 500 1160 if cg% = 0 then cg% = 7 : goto 500 1170 cg% = cg% - 1 : goto 500 1180 if cg% = 7 then cg% = 0 : goto 500 1190 cg% = cg% + 1 : goto 500 1200 if cb% = 8 then 1500 1210 goto 1310 1300 if cb% = 8 then 1600 1310 poke $D0, cb% 1320 poke $D4, g%(cg%) : call btxor : g%(cg%) = peek($D4) 1330 poke s% + cg% + 8, g%(cg%) 1340 goto 500 1500 if cg% <= 4 then 1540 1510 irqcnt = irqcnt * 2 : if irqcnt >= 65535 then irqcnt = 65534 1520 gosub 6000 : goto 500 1540 c(cg%) = c(cg%) * 2 : if c(cg%) >= 65535 then c(cg%) = 65534 1550 gosub 5000 : goto 500 1600 if cg% <= 4 then 1640 1610 irqcnt = irqcnt / 2 : if irqcnt < 2 then irqcnt = 2 1620 gosub 6000 : goto 500 1640 c(cg%) = c(cg%) / 2 : if c(cg%) < 2 then c(cg%) = 2 1650 gosub 5000 : goto 500 1900 home : stop 2000 *$6000: 2010 !wdoutcl:ldy $D4 2020 ! lda $D3 2030 ! cmp #8 2040 ! bcc l2 2050 ! ldy $D5 2060 !l2: sty 50 2100 !wordout:lda $D1 2110 ! jsr byteout 2120 ! lda $D0 2130 !byteout:pha 2140 ! lsr 2150 ! lsr 2160 ! lsr 2170 ! lsr 2180 ! jsr digout 2190 ! pla 2200 ! and #$F 2210 !digout: ora #$B0 2220 ! cmp #$BA 2230 ! bcc cout 2240 ! adc #$06 2250 !cout: jmp ($36) 2300 !btoutc4:ldx #4 2310 ! asl $D0 2320 ! $2C 2330 !btoutc5:ldx #5 2340 ! lda $D0 2350 ! asl 2360 ! asl 2370 !btout: asl 2380 ! pha 2390 ! bcc l1 2400 ! ldy #$D8 2410 ! $2C 2420 !l1: ldy #$AE 2430 ! lda $D4 2440 ! cpx $D3 2450 ! bne l3 2460 ! lda $D5 2470 !l3: sta 50 2480 ! tya 2490 ! jsr cout 2500 ! clc 2510 ! lda $24 2515 ! adc #4 2520 ! sta $24 2530 ! pla 2540 ! dex 2550 ! bpl btout 2560 ! rts 2800 !btxor: ldx $D0 2810 ! lda $D4 2820 ! eor l9,x 2830 ! sta $D4 2840 ! rts 2850 !l9: $010204081020 2900 !d0clr: lda $D0 2910 ! and #$FE 2920 ! sta $D0 2930 ! rts 3000 !setirq: lda $28 3010 ! clc 3020 ! adc $24 3030 ! sta lA+1 3040 ! adc #2 3050 ! sta lB+1 3060 ! lda $29 3070 ! sta lA+2 3080 ! sta lB+2 3090 rem Очень корявое решение, прокатит только для девятки и только того бейсика, под который я это всё писал !!! 3100 ! sta $C083 3110 ! lda #>IRQPROC 3120 ! sta $FFFE 3130 ! lda # 2 then o% = o% + 1 5010 *$D0:!=c(cg%)!: call d0clr 5020 poke o%, peek($D0) : poke o%, peek($D1) 5030 c(cg%) = peek($D1) * 256 + peek($D0) 5040 return 6000 *$D0:!=irqcnt!: call d0clr 6010 o% = 6 + s% 6020 poke o%, peek($D0) : poke o%, peek($D1) 6030 irqcnt = peek($D1) * 256 + peek($D0) 6040 return NOMONICO SAVE ЯЗС_ДЕМО