Subversion Repositories NedoOS

        DEVICE ZXSPECTRUM128
        include "../_sdk/sys_h.asm"

shadplay=0
alasm=0;1
fixtoENV=1 ;10XX,20XX
hidearr=1
ts=1
pttfc=0;#55
PATS=48
SMPX=0
SMPY=2
SMPH=19;по WBUFTOP=#FFxx INPAGE опр-ет edsmp!
skipABC=1;иначе в PLAYER стрелка исчез
cl12345=1;очистка позиций возрастающими паттернами
bemol=1
tab=1
ply=0;компиляция с плейером
cmpilmnu=0|ply
frqrosh=1
linvol=0;1
mkvol=1-linvol
;gs=1
process=1
portres=1
goodpak=1 ;???in compiler
about=1
tstPT=0
savset=0
set=1
opcompl=0

ead=0x5925;#5965 ;место inv для прозр.ENV
SMPATR=(SMPY<<5)+#5820+SMPX
SMPBOT=(SMPH<<5)+SMPATR

YLIMIT=0x5f;#6F

PATVIEWLINES=11;9
PATVIEWTOPFROM=0x49c3;#5103
PATVIEWTOP=0x49a0;#49E0
PATVIEWTOPATTR=0x59bf;#59FF
PATTOPLINE=13;#F
PATTOPLINES=6;4
PATBOTTOMLINES=4

       IF gs
        INCLUDE "gsports.asm"
       ENDIF

BUF=0xc000-0x100-0x4a0;#6F60;#480+18zeros
CATfilt=BUF-#580 ;,#580 todo pg4/pg7
CATdos=BUF-#480 ;,#900
SPRAR=BUF+#4A0 ;size=8*4*8=256 bytes
BUFEND=SPRAR+256
BUFSTART=CATfilt

bf240=#7180;EDPOSssQ BUF(#240)

;FD=32765
;pg=#5B5C ;TODO kill
pg6=#10
pg4=#16
pg3=#14
pg7=#17

;pg7
_d000=#D000;scrollers

;CS:
kTRA='T'
kBEG='U'
kEND='I'
kCOP='Y'
kORD='L'
kEON='E'
kAON='A'

;no CS:
kA='a';'A'
kF='f';'F'
kY='y';'Y'
kU='u';'U'
kI='i';'I'
kT='t';'T'
kW='w';'W'
kKpos='k';'K'
kLpos='l';'L'
kR='r';'R'
kBEM=ssY;198
kK='k';'K'
kE='e';'E'
kIns=key_ins;201
kSmp=ssI;172
kOrn=ssU;197
kssA='~';226
kL=key_del;15
kssL='='
kHom=key_home;199
kEnd=key_end;200
kTab=key_ssright;6
kTabL=key_ssleft;7
kDelLn=key_backspace;12
kssE='>'
kssR='<'
kChip=key_tab;14

        org PROGSTART
main_begin
        ld sp,0x4000 ;не должен опускаться ниже 0x3b00! иначе возможна порча OS
        OS_HIDEFROMPARENT
        ld e,3+0x80 ;6912 + keep gfx pages
        OS_SETGFX ;e=0:EGA, e=2:MC, e=3:6912, e=6:text ;+SET FOCUS ;e=-1: disable gfx (out: e=old gfxmode)
       
        ;OS_GETMAINPAGES
;dehl=номера страниц в 0000,4000,8000,c000
        ;ld a,e
        ;ld (curpgshapes),a
        ;ld a,h
        ;ld (curpgpal),a
        ;ld a,l
        ;ld (curpgtemp),a

        ld hl,tpgs+16+1
        ld b,7
newpages0
        push bc
        push hl
        OS_NEWPAGE
        pop hl
        pop bc
        ld (hl),e
        inc hl
        djnz newpages0

        OS_GETMAINPAGES
;dehl=номера страниц в 0000,4000,8000,c000
        ld a,l
        ld (tpgs+16),a ;там inpage

        call setscrpg
        ld hl,0x4000
        ld de,0x4001
        ld bc,0x1aff
        ld (hl),l;0
        ldir
       
        ;call OUT6 ;там SIN
       
        ;ld iy,23610 ;TODO kill
       
        LD HL,Tfonscr
        ld DE,0
        CALL PRMENU
        call PRFONSCR
        LD HL,FONATRS
        ld DE,#5800
        ld B,3
        LDIR
        LD H,wassin/256
        CALL INPAGE
        CALL OUT7 ;???
        ;LD HL,PRESSED
        ;ld DE,#C000
        ;ld B,A
        ;LDIR ;copy player?
       
        LD HL,SPRAR
        ld A,127
MKAR0   LD IX,sprar
        RLCA
        LD B,8
MKAR1   LD C,(IX)
        INC IX
        LD D,(IX)
        INC IX
        LD E,0
        PUSH AF
MKAR2   SRL D
        RR E
        SCF
        RR C
        RRA
        jr C,MKAR2
        LD (HL),C
        INC L
        LD (HL),D
        INC L
        LD (HL),A
        INC L
        LD (HL),E
        POP AF
        INC L
        DJNZ MKAR1
        jr NZ,MKAR0
       
        CALL MHEXFNT
        LD HL,setup_5D3B
        LD DE,ink1
        LD B,3
        JR saG
sa      LD A,(HL)
        AND #38
        LD (DE),A
        INC DE
        INC HL
saG     LD A,(HL)
        RLA
        RLA
        RLA
        AND #38
        LD (DE),A
        INC DE
        DJNZ sa
        LD C,(HL)
        RL C
        SBC A,A
        AND 31
        LD (joy),A
        RL C
        SBC A,A
        LD (poion),A
        RL C
        SBC A,A
        AND 201
        LD (SHOLK),A
        RL C
        SBC A,A
        LD (playon),A
       ;LD A,(HL),(poion),A
        CALL SETCOLS ;EI
        LD A,pg7
        CALL MHEXFNTpg
        LD HL,TSMPSZ+1
        ld DE,TSMPSZ+2
        ld C,62
        LD (HL),L;1
        DEC L
        PUSH HL
        LD (HL),B
        LDIR
        POP HL
        LD DE,TORNSZ
        ld C,E;32
        LDIR
       ;LD DE,TPATSZ+1,H,D,L,B,(HL),63
       ;LD C,PATS-1
       ;LDIR
        LD A,63
        CALL FILLENS
        CALL CLPOS
        LD IX,TPATS
        LD A,pg6;#10
        LD HL,+(42-PATS)*#480 ;TODO what if >42 patterns?
        LD BC,3
        ld DE,#480
        JR MpA0
MpatADS LD H,#C1
MpA0    LD (IX),A
        ld (IX+1),L
        ld (IX+2),H
        ADD IX,BC
        add HL,DE
        jr NC,MpA0
        INC A
        CP #12
        jr NZ,$+3
         INC A
        CP #15
        jr NZ,MpatADS
        LD HL,TLINES
        ld D,L
        ld E,L
        ld C,18
        ld A,65
MTLIN   LD (HL),E
        INC L
        LD (HL),D
        INC L
        ex de,hl
        ADD HL,BC
        ex de,hl
        DEC A
        jr NZ,MTLIN
        LD DE,ORNS
        ld HL,TORNS
        ld C,64
        ld A,16
MTORN   LD (HL),E
        INC L
        LD (HL),D
        INC L
        ex de,hl
        ADD HL,BC
        ex de,hl
        DEC A
        jr NZ,MTORN
        ;INC A
        ;LD (#5C0A),A
        CALL CLORNSM
        CALL COPYFRQ
        CALL CLPATS
        CALL MKSCROL
       IF alasm
        CALL LOADASM
       ENDIF
       IF gs
        CALL INIGS
       ENDIF

       call swapimer

        LD HL,NLOOP
        PUSH HL
        JP EDPAT

swapimer
        di
        ld de,0x0038
        ld hl,oldimer
        ld bc,3
swapimer0
        ld a,(de)
        ldi ;[oldimer] -> [0x0038]
        dec hl
        ld (hl),a ;[0x0038] -> [oldimer]
        inc hl
        jp pe,swapimer0
        ei
        ret
oldimer
        jp on_int ;заменится на код из 0x0038
        jp 0x0038+3

setscrpg
        ld a,(user_scr0_high) ;ok
        SETPG16K
        ret

MHEXFNT
        LD A,pg4
MHEXFNTpg
        CALL OUTME
        XOR A
        LD DE,#F801
        ld H,D
        ld L,A
        ld (HL),A
        ld BC,#7FF
        PUSH HL
        LDIR
        POP DE
HFNT0   PUSH AF
        push AF
        RRCA
        RRCA
        RRCA
        RRCA
        LD C,#F0
        PUSH DE
        CALL PR1
        POP DE
        pop AF
        LD C,#F
        CALL PR1
        INC DE
        inc DE
        POP AF
        INC A
        jr NZ,HFNT0
        RET
PR1
        ;AND #F
        ;ADD A,#90
        ;DAA
        ;ADC A,#40
        ;DAA
        or 0xf0 ;TODO
        daa
        add a,0xa0
        adc a,0x40
poion=$+1
        LD B,0;при старте 0
        INC B
        DEC B
        jr Z,PR1np
        CP '0'
        jr NZ,$+4
PR1dot=$+1
        LD A,'.'
PR1np   ADD A,A
        add A,A
        LD L,A
        ADC A,FONT/512
        SUB L
        LD H,A
        ADD HL,HL
        LD B,6
        ex de,hl
PR10    LD A,(DE)
        AND C
        OR (HL)
        LD (HL),A
        INC E
        inc L
        DJNZ PR10
        ex de,hl
        RET
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; end init

OCT
        DB 4
SNGST
        DW #C000

        INCLUDE "ptconst.asm"
modC=ptmod

;3тут+4(STPAT0,COPYU,CMpores,TransPP)
AtoPAT
;HL,A на выходе не важны
;C надо сохранять для COPYU
AtoPnsJ JR AtoPns2
        CPL
        ADD A,PATS;48
AtoPns2 LD L,A
        ADD A,A
        ADD A,L
        LD L,A
        LD H,TPATS/256
        LD A,(HL)
        CALL OUTME
        INC L
        LD E,(HL)
        INC L
        LD D,(HL)
        RET
SWPAYPP
       ;LD C,A
        LD A,(AtoPnsJ)
        AND 2
        RRA
        CPL
       ;XOR C
        LD BC,#FFFD
       IF pttfc
        RES 2,A
       ENDIF
        OUT (C),A
sWPSNGPP
        LD HL,ayblock
       ;LD DE,ayblock2
        LD B,szayblock4
SWPAY0
        DUP 4
        LD A,(HL)
        INC H
        LD E,(HL)
        LD (HL),A
        DEC H
        LD (HL),E
        INC L
        EDUP
        DJNZ SWPAY0
        LD HL,AtoPnsJ
        LD A,(HL)
        XOR 24^46
        LD (HL),A
        RET
SWPSONG
        CALL sWPSNGPP
        RRA
        AND 1
        ADD A,'1'
        LD DE,0x1d08;#1D0B
        CALL PRADD
        LD A,(pat1)
        CPL
        ADD A,PATS;48
        CALL iPATq
        LD A,(pat2)
        CPL
        ADD A,PATS;48
        CALL iPAT2q
        LD HL,TPATSZ
        LD DE,TPATSZ+PATS-1
        LD B,PATS/2
SWPSNGL LD A,(DE)
        LD C,(HL)
        LD (HL),A
        LD A,C
        LD (DE),A
        INC L
        DEC E
        DJNZ SWPSNGL
        LD A,(EPAT)
        LD L,A
        LD A,(HL)
        LD (PATLEN),A
       ;LD A,(PATLEN)
        CALL IPATLQ
        JP PRPATUU
CHKTS
        LD A,(ts48)
        LD HL,tson
        CP 33 ;32=не TS
        SBC A,A ;#FF=не TS
        CP (HL)
        RET NZ
ONOFFTS
        LD HL,0x480b;#486B ;screen addr
        LD C,3
        CALL INVSYMS
        LD HL,tson
        LD A,(HL)
        CPL
        LD (HL),A
        OR A
        LD A,32
        jr Z,$+4
         LD A,48;PATS
        LD (ts48),A
        RET
ALLCHAN
        LD HL,0x4833;#4853 ;screen addr
        LD C,4
        CALL INVSYMS
        LD HL,chnall
        LD A,(HL)
        CPL
        LD (HL),A
        RET
;10
GETnADR
        LD A,B
        CALL AtoPAT
        LD A,C
        ADD A,A
        LD L,A
        LD H,TLINES/256
        LD A,(HL)
        INC L
        LD H,(HL)
        LD L,A
        ADD HL,DE
        RET
;2(PT2PATS,PT3PATS)
PATfrBUF
        PUSH AF
        push HL
        LD L,A
        ld H,TPATSZ/256
        DEC D
        LD (HL),D
        CALL aPATBUF
        POP HL
        pop AF
        RET
;2(CLPATS,clPAT)
CLPAT
        CALL KILLBUF
        LD HL,97
        LD (BUF+3),HL
        LD (BUF+8),HL
        LD (BUF+13),HL
aPATBUF CALL AtoPAT
        LD HL,BUF
        JR bUFLDIR
;2(COPYU,CMPP)
PATtoBUF
        CALL AtoPAT
        LD HL,BUF
        ex de,hl
bUFLDIR LD BC,#480
        LDIR
        JP OUT7
;3(CLPAT,PT2PATS,PT3PATS)
KILLBUF
        PUSH HL
        LD HL,BUF
        LD DE,BUF+1
        LD (HL),0
        LD BC,#47F
        LDIR
        POP HL
        RET
;2
GETnPAT
        LD A,(POS)
GETnPAA
LOOP=$+1
LENG=LOOP+1
        LD DE,#100
        INC A
        CP D
        jr NC,$+3
         LD E,A
        LD D,TPOSS/256
        LD A,(DE)
        ld (nPAT),A
        RET
;2(INCPOSU,ROLL)
ROLnxPO
        CALL GETnPAT ;(DE)->A->(nPAT)
        LD (EPAT),A
        LD B,E
        LD E,A
        INC D ;TPATSZ
        LD A,(DE)
        ld (PATLEN),A
        INC A
        LD C,A
        LD A,B
        ld (POS),A
        RET
;2(UPRnxPO,PRPAT)
ROLprPO
       ;LD A,(POS)
        LD DE,(LENG)
        DEC A
        CP E
        jr C,$+4
         LD A,E
         DEC A
        LD E,A
        LD D,TPOSS/256
        ex af,af'
       ;LD (POS),A
        LD A,(DE)
        LD E,A
        INC D
        RET
HLORN
ORN=$+1
        LD A,1
;6
HLOR3   ADD A,A
        ADD A,TORNS&0xff
        LD L,A
;1:CLORN (убить)
_orn    LD H,TORNS/256
        PUSH AF
        LD A,(HL)
        INC L
        LD H,(HL)
        ld L,A
        POP AF
        RET
FILLENS
        LD DE,TPATSZ+1
        LD BC,PATS-1
        LD H,D
        ld L,B
        LD (HL),A
        LDIR
        RET
DE2ATTR
        LD A,E
        RRCA
        RRCA
        RRCA
DA2ATTR LD H,A
        AND #E0
        OR D
        LD L,A
        ld A,H
        AND 3
        OR 88
        LD H,A
        RET
DE2SCR
        LD A,E
        AND 24
        OR 64
        LD H,A
        LD A,E
        AND 7
        RRA
        RRA
        RRA
        RRA
        ADD A,D
        LD L,A
        RET
DHL
        INC H
        LD A,H
        AND 7
        RET NZ
        LD A,L
        ADD A,32
        LD L,A
        RET C
        LD A,H
        SUB 8
        LD H,A
        RET
DDE
        INC D
        LD A,D
        AND 7
        RET NZ
        LD A,E
        ADD A,32
        LD E,A
        RET C
        LD A,D
        SUB 8
        LD D,A
        RET
SHOLK
        NOP
        LD HL,shlkR
        LD DE,#202
        CALL SHLK0
        LD DE,#406
        CALL SHLK0
        LD DE,#30B
SHLK0   LD BC,-3
        OUT (C),E
        LD B,#BF
        OUTI
        INC E
        DEC D
        jr NZ,SHLK0
        RET

shlkR
        DB 0,9,0,0,0,#10,0,1,0

        DB 1 ;number of options for DUMMY menu coords
DUMMY   DS 4;MENUCOORDS

WINDUM
        LD HL,DUMMY
WINDOW
        CALL WINmema
        LD (useadr),DE
        LD (optadr),HL
        DEC HL
        LD A,(HL)
        ld (options),A
        PUSH BC
        POP IX
        LD A,#B7
        ld (DOWNM),A
        CALL OUT4
        LD D,(IX)
        ld E,(IX+1)
        CALL DE2ATTR
        LD (WINATR),HL
        PUSH HL
        CALL DE2SCR
        LD (WINTOP),HL
        PUSH HL
        CALL WINMEM
        LD A,(IX)
        ld C,A
        ADD A,A
        add A,A
        add A,A
        LD (TSTXMIN),A
        ld A,C
        INC A
        ADD A,A
        DEC A
        LD (ADDX),A
        ld A,(IX+1)
        INC A
        LD (ADDY),A
        DEC A
        ADD A,A
        add A,A
        add A,A
        LD (TSTYMIN),A
        ld A,(IX+2)
        ADD A,A
        DEC A
        LD (PRMRGT),A
        INC A
        ADD A,A
        add A,A
        LD (TSTXMAX),A
        POP HL ;WINTOP
        LD A,(IX+3)
        PUSH AF
        ADD A,A
        add A,A
        add A,A
        LD (TSTYMAX),A
        POP AF
        SUB (IX+1)
        ADD A,A
        add A,A
        add A,A
        LD (RMKHGT),A
        DEC (IX+2)
        LD B,0
WIN0    ex af,af'
        PUSH HL
        LD (HL),B
        ld D,H
        ld E,L
        INC E
        LD A,(IX+2)
        SUB (IX)
        LD (WINWID),A
        ld C,A
        LDIR
        POP HL
        CALL DHL
        ex af,af'
        DEC A
        jr NZ,WIN0
        POP HL ;WINATR
        LD A,(IX+4)
        ex af,af'
        LD A,(IX+3)
        SUB (IX+1)
        LD B,0
WIN1    ex af,af'
        PUSH HL
        LD (HL),A
        ld D,H
        ld E,L
        INC E
WINWID=$+1
        LD C,0
        LDIR
        POP HL
        LD C,32
        ADD HL,BC
        ex af,af'
        DEC A
        jr NZ,WIN1
        LD A,(IX+2)
        INC (IX+2)
        SUB (IX)
        LD C,A
        ld B,0
        PUSH BC
        LD HL,(WINTOP)
        CALL FILM1
        call DHL
RMKHGT=$+1
        LD D,0
        DEC D
        LD B,D
        ld C,1
        CALL VERLIN
        LD B,D
        ld HL,(WINTOP)
        DEC B
        CALL DHL
        LD C,#80
        CALL VERLIN
        POP BC
FILM1   LD D,H
        ld E,L
        ld (HL),-1
        INC DE
        LDIR
        RET
VERLIN  LD (HL),C
        CALL DHL
        DJNZ $-4
        RET
;2
WINmema
        LD A,(options)
        ld (Oldopt),A
        PUSH HL
        LD HL,(optadr)
        ld (Oldoad),HL
        LD HL,(useadr)
        ld (Olduse),HL
        POP HL
        RET
WINMEM
WBUFTOP=$+1
        LD HL,winbuf
        PUSH HL
Oldopt=$+1
        LD (HL),0
        INC HL
Oldoad=$+1
        LD DE,0
        CALL WMEMPP
Olduse=$+1
        LD DE,0
        CALL WMEMPP
ADDY=$+1
ADDX=$+2
        LD DE,0
        CALL WMEMPP
        LD A,(PRMRGT)
        LD (HL),A
        INC HL
WINATR=$+1
        LD DE,0
        CALL WMEMPP
        LD A,(IX+2)
        SUB (IX)
        INC A
        LD (HL),A
        ld C,A
        INC HL
        LD A,(IX+3)
        SUB (IX+1)
        INC A
        LD (HL),A
        INC HL
        PUSH AF
        LD B,0
        ex de,hl
WMEM0   PUSH BC
        push HL
        LDIR
        POP HL
        LD C,32
        ADD HL,BC
        POP BC
        DEC A
        jr NZ,WMEM0
        POP AF
        DEC C
        ADD A,A
        add A,A
        add A,A
        ex de,hl
WINTOP=$+1
        LD DE,0
        CALL WMEMPP
        ex de,hl
WMEM1   ex af,af'
        PUSH HL
        push BC
        LDIR
        POP BC
        pop HL
        CALL DHL
        ex af,af'
        DEC A
        jr NZ,WMEM1
        ex de,hl
        POP DE
WMEMPP  LD (HL),E
        INC HL
        LD (HL),D
        INC HL
        LD (WBUFTOP),HL
        RET
CLOSWIN
       call setscrpg
        CALL OUT4
        LD HL,(WBUFTOP)
        DEC HL
        LD A,(HL)
        DEC HL
        LD L,(HL)
        ld H,A
        OR L
        RET Z
        LD (WBUFTOP),HL
        PUSH BC
        LD DE,options
        LDI
        LD DE,optadr
        LDI
        LDI
        LD DE,useadr
        LDI
        LDI
        LD DE,ADDY
        LDI
        LDI
        LD DE,PRMRGT
        LDI
        LD E,(HL)
        INC HL
        LD D,(HL)
        INC HL
        LD C,(HL)
        INC HL
        LD A,(HL)
        INC HL
        PUSH AF
        LD B,0
CLOS0   PUSH BC
        push DE
        LDIR
        ex de,hl
        POP HL
        LD C,32
        ADD HL,BC
        ex de,hl
        POP BC
        DEC A
        jr NZ,CLOS0
        POP AF
        DEC A
        ADD A,A
        add A,A
        add A,A
        DEC C
        LD E,(HL)
        INC HL
        LD D,(HL)
        INC HL
CLOS1   ex af,af'
        PUSH DE
        push BC
        LDIR
        POP BC
        pop DE
        CALL DDE
        ex af,af'
        DEC A
        jr NZ,CLOS1
        LD A,'0'
        ld (PR1dot),A
        CALL MHEXFNT
        LD A,'.'
        ld (PR1dot),A
        LD A,pg7;(filladr+1),A
        CALL MHEXFNTpg
        POP BC
         CALL TSTFIRH
        jr C,$-3
        RET
;6
WAITNOK
        CALL HALTER
        CALL ANYKEY
        CPL
        AND 31
        jr NZ,WAITNOK
        RET
LDKSAPP
        LD A,32
        LD (ts48),A
        CALL CLORNSM
        CALL BIGso
        CALL OUT3
        LD BC,0x2000;(#5CE8) ;length ;TODO!!!
        ld HL,#BFFF
        ld D,L
        ld E,L
        ADD HL,BC
        LDDR ;прижато к концу bfff
        INC DE
        ex de,hl
        LD DE,la000
        ld A,(HL)
        PUSH AF
        INC HL
KSAPP0  LD A,(HL)
KSAPP1  INC HL
        LD B,0
        SRL A
        jr C,KSAPPb0
        RRA
        jr C,KSAPPb1
        RRA
        LD C,A
        jr C,$+5
        LD B,A
        ld C,(HL)
        INC HL
        LD A,(HL)
        INC HL
KSAPP2  LD (DE),A
        PUSH HL
        LD A,(HL)
        ex af,af'
        LD H,D
        ld L,E
        INC DE
        JR KSAPP2G

KSAPPb1 SRL A
        LD C,(HL)
        jr NC,KSAPPn2
        LD C,A
        INC C
        LDIR
        JR KSAPP0

KSAPPb0 SRL A
        jr C,KSAPP01
        AND 7
        LD B,A
        DEC HL
        RLD
        RRA
        LD C,A
        LD A,B
KSAPPn2 LD B,A
        INC HL
        inc HL
        LD A,(HL)
        ex af,af'
        PUSH HL
        DEC HL
        LD A,E
        SUB (HL)
        LD L,A
        LD A,D
        SBC A,B
        LD B,0
        LD H,A
        INC BC
KSAPP2G INC BC
        inc BC
        LDIR
        POP HL
        ex af,af'
        JR KSAPP1
KSAPP01
        SRL A
        DEC A
        LD C,B
        DEC BC
        jr C,KSAPP2
        POP AF
        LD (DE),A
        LD HL,labc0
        LD DE,TPATSZ
        LD B,31
KSAlens LD A,(HL)
        DEC A
        LD (DE),A
        INC HL
        inc DE
        DJNZ KSAlens
        CALL STSMP
        LD HL,labdf
        LD A,(HL)
        ld (LOOP),A
        INC L
        LD DE,TTITLE
        LD C,25
        LDIR
        LD A,E
        ld (STtit),A
        LD A,7
        ld (STtitZ),A
        XOR A
        CALL STORN
        LD A,1
        ld (FRQn),A
        CALL OUT3
        LD HL,labf9
        LD DE,labc1
        LD B,96
        LDIR
        JR LDSTPGO
BIGso
        LD A,33
        LD HL,TSMPSZ+3
        LD DE,TSMPSZ+4
        LD (HL),A
        DEC A
        CALL BIGsoQ
        LD HL,TORNSZ+3
        LD DE,TORNSZ+4
        LD (HL),A
        XOR A
BIGsoQ  DEC L
        LD (HL),A
        LD BC,30
        LDIR
        RET
LDSTPP
        LD A,32
        LD (ts48),A
        CALL CLORNSM
        CALL BIGso
        INC A
        LD (FRQn),A
        LD A,(labc0)
        DEC A
       ;LD C,PATS-1
       ;LD DE,TPATSZ+1
       ;LD H,D,L,B
       ;LD (HL),A
       ;LDIR
        CALL FILLENS
        LD (PATLEN),A
        CALL STSMP
        LD A,TTITLE&0xff
        ld (STtit),A
        LD A,31
        ld (STtitZ),A
        LD A,LOOP/256
        CALL STORN
        CALL OUT3
LDSTPGO LD A,(labbf)
        ld (TEMPO),A
        LD A,(la99e)
        INC A
        LD (LENG),A
        LD HL,la79e
        LD DE,TPOSS
        LD A,E
LDSTpos DEC (HL)
        LDI
        INC HL
        DEC A
        jr NZ,LDSTpos
        LD HL,labc1
        LD DE,la000
        PUSH DE
        LD B,#5F
        LDIR
        POP HL
STPAT0  PUSH AF
        CALL OUT3
        POP AF
        PUSH AF
        LD DE,EDORbf
        LD BC,#240
        LDIR
        PUSH HL
        CALL AtoPAT
        LD HL,EDORbf
        PUSH DE
        POP IX
        LD B,64
STPAT1  PUSH BC
        INC DE
        inc DE
        inc DE
        PUSH IX
        LD (IX),C
        LD (IX+1),C
        LD (IX+2),C
        LD B,3
STPAT2  PUSH BC
        push DE
        XOR A
        LD (DE),A
        INC DE
        LD (DE),A
        INC DE
        INC DE
        LD (DE),A
        INC DE
        LD (DE),A
        ex de,hl
        EX (SP),HL
        ex de,hl
        CALL STPAPP
        POP DE
        INC DE
        POP BC
        DJNZ STPAT2
        POP IX
        LD C,18
        ADD IX,BC
        POP BC
        DJNZ STPAT1
        POP HL
        pop AF
        INC A
        AND 31
        jr NZ,STPAT0
STloop=$+2
        LD (LOOP),A
        LD (POS),A
STtit=$+1
        LD HL,TTITLE
STtitZ=$+1
        LD BC,31
        CALL STtitQ
        LD HL,TAUTHOR
        LD C,31
STtitQ  LD D,H
        LD E,L
        INC E
        LD (HL),32
        LDIR
        RET

STSMP   CALL OUT4
        LD HL,la000
        LD DE,_c000+256
        LD A,15
STSMP0  PUSH AF
        PUSH HL
        PUSH DE
        CALL STSMPP
        LD A,(IX+#60)
        LD H,(IX+#61)
        OR A
        jr Z,STSMPQ
        DEC A
        INC H
        LD L,A
        ADD A,H
        LD H,A
        LD A,D
        SUB SMPS/256
        ex de,hl
        ADD A,A
        LD L,A
        LD H,TSMPSZ/256
        LD (HL),E
        INC L
        LD (HL),D
STSMPQ  POP DE
        POP HL
        INC D
        LD BC,#82
        ADD HL,BC
        POP AF
        DEC A
        jr NZ,STSMP0
        RET

STSMPP  PUSH HL
        POP IX
        LD (STSMbse),HL
        ex de,hl
        LD B,32
STSMPP0 LD A,64
        SUB B
        ADD A,A
        LD (STSMix1),A
        INC A
        LD (STSMix2),A
        PUSH IX
STSMbse=$+2
        LD IX,0
STSMix1=$+2
        LD E,(IX)
STSMix2=$+2
        LD D,(IX+1)
        POP IX
        BIT 4,D
        RES 4,D
        ex de,hl
        CALL Z,NEGHL
        ex de,hl
        LD (HL),E
        INC L
        LD (HL),D
        INC L
        LD A,(IX+#20)
        ld E,A
        AND 31
        RL E
        jr NC,$+4
         LD A,#40
        RL E
        RLA
        RRCA
ksaON=$+1
        LD D,0
        DEC D
        INC D
        jr Z,$+8
         RL E
         jr C,$+4
          OR #20
        LD (HL),A
        INC L
        LD A,(IX)
        ld (HL),A
        INC L
        INC IX
        DJNZ STSMPP0
        INC L
        inc L
        LD (HL),96
        ex de,hl
        RET

STORN  LD (STloop),A
        LD A,(ksaON)
        LD HL,la9bf
        LD DE,ORNS+64
        OR A
        jr NZ,KSAORN
        LD A,15
STORN0  LD BC,32
        LDIR
        ex de,hl
        LD C,32
        ADD HL,BC
        ex de,hl
        DEC A
        jr NZ,STORN0
        RET

KSAORN  LD A,1
KSAORN0 PUSH AF
        LD BC,TORNSZ
        ADD A,A
        add A,C
        LD C,A
        LD A,(HL)
        ld (BC),A
        INC C
        INC HL
        LD A,(HL)
        INC A
        LD (BC),A
        INC HL
        LD BC,30
        LDIR
        ex de,hl
        LD C,34
        ADD HL,BC
        ex de,hl
        POP AF
        INC A
        AND 15
        jr NZ,KSAORN0
        RET

STPAPP  LD A,(HL)
        CP #10
        jr C,STEt
        CP #F0
        jr NC,STres
        AND 7
        ADD A,A
        add A,A
        LD B,A
        ADD A,A
        add A,B
        LD B,A
        LD A,(HL)
        LD C,8
        CP #78
        jr NC,STnot
        DEC C
        CP #70
        jr NC,STnot
        DEC C
        CP #68
        jr NC,STnot
        DEC C
        CP #60
        jr NC,STnot
        DEC C
        CP #50
        jr NC,STnot
        DEC C
        CP #48
        jr NC,STnot
        DEC C
        CP #40
        jr NC,STnot
        DEC C
        CP #38
        jr NC,STnot
        DEC C
        CP #30
        jr NC,STnot
        LD C,11
        CP #20
        jr NC,STnot
        DEC C
        CP #18
        jr NC,$+3
         DEC C
STnot   LD A,C
        ADD A,B
        INC A
        JR STPAPQ

STres   LD A,97
        JR $+3
STEt     XOR A
STPAPQ  LD (DE),A
        INC DE
        inc DE
        inc DE
        INC HL
        LD A,(HL)
        ld (DE),A
        INC DE
        inc HL
        AND #F
        jr Z,STEold
        CP #F
        jr Z,STorn
        LD C,A
        LD A,(ksaON)
        OR A
        jr Z,STnKSA
        LD A,C
        CP 3
        jr C,STglis
STnKSA  LD A,(HL)
        ld (IX+1),A
        INC HL
        RET

STEold  LD A,(ksaON)
        OR A
        LD A,(HL)
        INC HL
        RET Z
        AND #F0
        JR STgliQ

STorn   LD A,(HL)
        INC HL
STand=$+1
        AND -1
        JR STgliQ

STglis  LD C,A
        DEC DE
        LD A,(DE)
        AND #F0
        LD (DE),A
        LD A,C
        LD C,1
        DEC A
        jr NZ,$+3
         INC C
        LD A,(HL)
        OR A
        JP P,$+6
         NEG
        INC C
        DEC DE
        LD (DE),A
        DEC DE
        INC HL
        LD A,C
        AND 1
        ADD A,17
STgliQ  RRCA
        RRCA
        RRCA
        RRCA
        LD (DE),A
        RET

        align 512
FONT ;реально +256
tpgs
        ds 256
        INCBIN "f7400.bin"
FNTDEC
        INCBIN "digits.bin"
FNTNOTE=FNTDEC+512
        ;ORG $-72
        ;DS 72

;FNTNOTE+512
        ;DISPLAY "bufs ",$,"..7FXX=",#7F7D-$
        ;DS #7F81-$
        align 256
l5b00;=#6000;#5B00 глючит(Risk);CAT низя;длины треков при compile
                             ;<=128 треков(нет проверки!)
        ds 256
        align 256
;many
EDORbf;#7100;(64 for orn, 256? for sample) ;align 256
        ds 256;64
;2
;убить?
ARBUF;=#7D80
        ds 16 ;don't cross 256!
        ds ($&0xff00)+0xd0-$
TORNSZ;=#7DD0;ORNLP,END(32)
        ds 32 ;don't cross 256!
        align 256
TSMPSZ;=#7B00;SMPLP,END(64)
        ds 256
        align 256
TPOSS;=#7C00
        ds 256
;10
TPATSZ;=TPOSS+256;=0..63
        ds 256 ;all patterns
        align 256
;2(GO,AtoPAT)
;убить?
TPATS;=#7E00;pg,E,D
        ds 256
;5
;убить?
TLINES;=#7F00;L/2*18
        ds 65*2
        ds ($&0xff00)+0xd0-$ ;as in TORNSZ
;2+1
;убить
TORNS;=#7FD0;(32).TORNS=.TORNSZ
        ds 32

        align 256
CMbuf   DB -1 ;USED ORNS+SMPS
        DS 16+31
t1buf   DB -1,-1,-1,-1,0
TEDCURX
;NO CROSS sec!
        DISPLAY "TEDCURX=",$
        DB 6,7,8,9,12,13
        DB 16,20,21,22,23,26,27,28,29
        DB 32,36,37,38,39,42,43,44,45
        DB 48,52,53,54,55,58,59,60,61

sprar   DW #00BF,#401F,#600F,#7007,#7803,#6007,#401F,#00BF

on_int
        PUSH HL
        push DE
        push BC
        push AF
        call oldimer;RST 56 ;ei
        exx
        push bc
        push de
        push hl
        push ix
        push iy
        ex af,af'
        push af
        CALL MANAGE
        pop af
        ex af,af'
        pop iy
        pop ix
        pop hl
        pop de
        pop bc
        exx
        POP AF
        pop BC
        pop DE
        pop HL
        ;ei
        RET

SNGLEN
        DW 0

        align 256
TPROTR  DB "ProTracker 3.7 compilation of "
TTITLE
;NO CROSS sec!
        DISPLAY "TTITLE=",$
        DS 33,32
       IF linvol
        DB "By "
       ELSE
        DB "by "
       ENDIF
TAUTHOR DS 33,32
ts48=$-1

AUTO1   DB "----"
AUTO2   DB 0x7f,0x7f,0x7f,0x7f
LINESon DS PATVIEWLINES,#7F
NLOOP
        ;LD (IY+48),8
        CALL RESHALT
        LD HL,NLOOP
        PUSH HL
        jr Z,NLOONK
        CP kW;'W'
        JP Z,EDSONG
        SUB key_enter;13
        JP Z,PLSONG
        DEC A
        JP Z,EDPAT
NLOONK  CALL JPITEM
DOWNMER LD A,YLIMIT;#6F
        ld (DOWNM),A
        RET
FIRE
;NZ=y
;CALL cs_8026
;JNC fIREcs
        LD A,#7F
        IN A,(-2)
        RRA
fIREOK  DEC A
        jr NC,FIREYES
fIREcs  LD A,#FA
MOUSF   IN A,(#DF)
        RRA
        jr NC,FIREYES
        RRA
        jr C,fIREKJ
        LD A,(ITEM)
        CP DIVNO+1
        jr Z,fIREOK
fIREKJ  CALL KEMPJOY
        AND 16
        RET Z
FIREYES
       IF hidearr
        LD A,(ARROWt)
        DEC A
        RET Z ;нет
        LD A,0 ;NZ=да
        LD (ARROWt),A
       ENDIF
        RET
CANCEL
        LD A,#BF
checkmarginkeys ;a=0 ;out: NC=pressed
        IN A,(-2)
        RRA
        RET NC
CANCEL2 LD A,#FA
MOUSF2  IN A,(#DF)
        RRA
        RRA
        RET
;2
ANYKEY
         YIELD;HALT
         call MANAGE
        XOR A
        IN A,(-2)
        RET

isnotepressed
;nz=pressed
        LD A,0x81
         in a,(0xfe)
        CPL
        AND 0x1f
        ret nz;jr NZ,PLNOTE0 ;нажато что-то из 3 верхних рядов - держим ноту
        ;CALL cs_8020
         ld a,0x7f
         in a,(0xfe)
        CPL
        AND 0x1c
        ret nz;jr NZ,PLNOTE0 ;нажато что-то из BNM - держим ноту
        ;CALL cs_8026
         ld a,0xfe
         in a,(0xfe)
        CPL
        AND 0x1e
        ret
       
CLPOS
       IF 0==cl12345
        LD DE,TPOSS+1
        LD BC,255
        LD H,D
        ld L,B
        LD (HL),L
        LDIR
        RET
       ELSE
        LD HL,TPOSS
       LD BC,PATS*255+255
       LD (HL),L
       INC L
       DJNZ $-2
        LD D,H
        ld E,L
        INC E
        LD (HL),B
        LDIR
        RET
       ENDIF
       
       if 1==1
MOVD0A0
        LD (movd0a0),A
        CALL OUT7
        LD HL,la000
        ld (LDADR),HL
        LD DE,ld000
        ld BC,#2000
        LDIR
       endif
OUT3    LD A,pg3
        JR OUTME
OUT7    LD A,pg7
        JR OUTME
OUT6    LD A,pg6
        JR OUTME
OUT4    LD A,pg4
OUTME
        ;LD (pg),A
        PUSH BC
        ;LD BC,FD
        ;OUT (C),A
        ld ($+4),a
        ld a,(tpgs)
        SETPG32KHIGH
        POP BC
        RET

clQUIT
        QUIT

PRADDPP
        PUSH HL
        LD HL,(ADDY)
        ADD HL,DE
        ex de,hl
        POP HL
        RET

PRTXADDBUF
        LD HL,TXTBUF
PRTXADD CALL PRADDPP
PRTXT   LD A,(HL)
        INC HL
        CALL PR4X8
        INC D
        DJNZ PRTXT
        RET

PRMEMO  LD HL,T____
PRMENU
        CALL PRADDPP
PRMNU0  LD A,(HL)
        CP 6
        jr NZ,PRMNUN6
        INC HL
        LD D,(HL)
        INC HL
        LD E,(HL)
        INC HL
        CALL PRADDPP
        LD A,(HL)
PRMNUN6 PUSH AF
        CALL PR4X8
        INC HL
        LD A,D
        INC A
PRMRGT=$+1
        CP 62
        jr NZ,$+6
         LD A,(ADDX)
         INC E
        LD D,A
        POP AF
        RLA
        jr NC,PRMNU0
        RET
RESHALT
        ;RES 5,(IY+1)
        xor a
        ld (iykeyflag),a
HALTER
       CALL ARROW
HALTnAR
options=$+1
        LD DE,mains
        LD BC,(ARXY)
optadr=$+1
        LD HL,MENUCOO
OPTER0  INC D
        LD A,B
        CP (HL)
        INC HL
        JP C,OPTI3
        LD A,C
        CP (HL)
        JP C,OPTI3
        INC HL
        LD A,B
        CP (HL)
        INC HL
        JP NC,OPTI1
        LD A,C
        CP (HL)
        JP NC,OPTI1
        LD A,D
        DEC HL
        dec HL
        dec HL
        LD (ITEMADR),HL
        JR OPTQ
OPTI3   INC HL
        inc HL
OPTI1   INC HL
        DEC E
        JP NZ,OPTER0
        LD A,-1
OPTQ    LD (ITEM),A
ITEM=$+1
        LD A,-1
        INC A
        CALL NZ,OP_INV
        YIELD;HALT ;в этот момент у нас могут отобрать экран
         call MANAGE
        ld a,(user_scr0_low) ;ok
        ld hl,user_scr0_high
        cp (hl)
        jr nz,nolosefocus
        ;ld a,(focuslost)
        ;or a
        ;jr nz,losefocusq ;фокус уже был потерян
;а ARROW в этом случае не будет рисовать и запоминать позицию, и опции не будут больше инвертироваться и запоминать позицию
;когда получим фокус, перед первым рисованием сотрём старый курсор
        ld a,1
        jr losefocusq
nolosefocus
       CALL RE
filladr=$+1
        LD HL,0x0700 ;7=no fill
         ld a,h
         cp 7
fillpat=$+1
        LD A,#68
fillN=$+1
        LD C,1
        CALL nz,FILLPP
      LD A,7
      ld (#5810),A
      ld (#5890),A
      ld (#58B0),A
      LD (filladr+1),A ;disable fill
        xor a
losefocusq
        ld (focuslost),a
       CALL OUT6
        XOR A
NOPKA=$+1
        CP 0 ;fire
        ;di ;doesn't help
        CALL GETAYER
        ;ei
BIT5
        ;BIT 5,(IY+1)
        ld a,(iykeyflag)
        or a
        LD A,(iycurkey);(23560)
        RET
       
RE
        PUSH AF
        push BC
        push DE
        push HL
ARSCR=$+1
        LD DE,0
       inc d
       dec d
       jr z,RE_skip
        ld HL,ARBUF
        ld BC,#8FF
RE0     LDI
        LDI
        DEC DE
        dec DE
        CALL DDE
        DJNZ RE0
RE_skip
        POP HL
        pop DE
        pop BC
        pop AF
        RET
ARROW
        ld a,(focuslost)
        or a
        ret nz
ARXY=$+1
ARX=$+2
        LD HL,#7707
       IF hidearr
       LD BC,0
        LD ($-2),HL
        XOR A
        SBC HL,BC
        ADD HL,BC
        jr NZ,ARROWsT
       LD (ARSCR+1),A ;hide arrow
ARROWt=$+1
        LD A,0
        DEC A
        RET Z
ARROWsT
       LD (ARROWt),A
       ENDIF
        LD C,H
        ld A,L
        ;CALL 8880
        ld b,a
        and a
        rra
        scf
        rra
        and a
        rra
        xor b
        and 0xf8
        xor b
        ld h,a
        ld a,c
        rlca
        rlca
        rlca
        xor b
        and 0xc7
        xor b
        rlca
        rlca
        ld l,a
        ld a,c
        and 7
       
        LD (ARSCR),HL
        ex de,hl
        RRCA
        RRCA
        RRCA
        LD L,A
        ld H,SPRAR/256
        ld BC,ARBUF
ARR0
        LD A,(DE)
        ld (BC),A
        AND (HL)
        INC L
        OR (HL)
        INC L
        LD (DE),A
        INC C
        inc E
        LD A,(DE)
        ld (BC),A
        AND (HL)
        INC L
        OR (HL)
        INC L
        LD (DE),A
        INC C
        DEC E
        CALL DDE
        LD A,L
        AND 31
        jr NZ,ARR0
        RET

RIGHT   LD A,#DF
        IN A,(-2)
        RRA
        CALL C,KEMPJOY
        RRA
        RET NC
        LD A,(ARX)
       INC C
        ADD A,B
RIGHTU  jr NC,$+4
         LD A,-9
        CP -8
        jr NC,$-4
L14     LD (ARX),A
        RET
MOUSER  PUSH BC
        push HL
        LD HL,(ARXY)
        LD A,-5
        IN A,(#DF)
OLDX    LD E,0
        ld (OLDX+1),A
        SUB E
        JP P,MPX
        ADD A,H
        CCF
        CALL LEFTU
        JR MXQ
MPX     ADD A,H
        CALL RIGHTU
MXQ     LD A,-1
        IN A,(#DF)
OLDY    LD E,0
        ld (OLDY+1),A
        SUB E
        NEG
        JP P,MPY
        ADD A,L
        jr C,$+3
         XOR A
        SUB L
MPY     ADD A,L
        LD (ARXY),A
        POP HL
        pop BC
LEFT    LD A,#DF
        IN A,(-2)
        RRA
        RRA
        CALL C,KEMPJOY
        AND 2
        LD A,(ARX)
       jr Z,$+4
       INC C
        SUB B
LEFTU   jr NC,$+3
         XOR A
        JR L14
UP      LD A,#FB
        IN A,(-2)
        RRA
        CALL C,KEMPJOY
        AND 8
        RET Z
        LD A,(HL)
        SUB B
        jr C,$+6
         CP 4
         jr NC,$+4
        LD A,4
L27     LD (HL),A
        INC C
        RET
DOWN    LD A,#FE
        IN A,(-2)
        RRA
        CALL C,KEMPJOY
        AND 4
        RET Z
        LD A,#EF
        IN A,(-2)
        CPL
        AND 31
        RET NZ ;cs+0..6
        LD A,#F7
        IN A,(-2)
        CPL
        AND 31
        RET NZ ;cs+1..5
       LD A,#7F
       IN A,(-2)
       AND 2
       RET Z ;Ext
        LD A,(HL)
        ADD A,B
        JR L27
MANAGE
        GET_KEY
        or a
        jr z,on_int_nokey
        ld (iycurkey),a;23560
        ld hl,iykeyflag;23611
        set 5,(hl)
       cp key_redraw
       call z,setscrpg
on_int_nokey
        XOR A
        LD (NOPKA),A
        CALL FIRE
        LD A,9
        ld B,1
        jr Z,L2
L3      LD A,1
        DEC A
        jr NZ,L6
        CPL
        LD (NOPKA),A
;TIMER
managetimer=$+1
        LD A,9
        DEC A
        jr NZ,$+3
         INC A
        LD B,A
L2      LD (managetimer),A
        LD A,B
L6      LD (L3+1),A
SPEED   LD BC,#101
CALLER  CALL MOUSER
        CALL RIGHT
        LD HL,ARXY
        CALL UP
        CALL DOWN
DOWNM=$+1
        LD A,#6F
        CP (HL)
        CALL C,L27
        LD A,1
        DEC C
        jr Z,L9
        LD A,1
        RLCA
        LD ($-2),A
        RET NC
        LD A,(SPEED+2)
        INC A
        CP 7
        RET Z
L9      LD (SPEED+2),A
        RET
;5
KEMPJOY
        XOR A
        IN A,(31)
joy=$+1
        AND 0
        RET
;1
OP_INV
focuslost=$+1
        ld a,0
        or a
        ret nz
ITEMADR=$+1
        LD HL,0
        LD B,(HL)
        ld D,B
        INC HL
        LD C,(HL)
        INC HL
        LD A,(HL)
        CP -1
        jr NZ,$+3
         DEC B
        SUB B
        RRA
        RRA
        RRA
        PUSH AF
        SRL D
        srl D
        srl D
        LD A,C
        RLCA
        RLCA
        CALL DA2ATTR
        POP AF
        LD (fillN),A
        LD C,A
        LD A,(HL)
        ld (fillpat),A
        RRCA
        LD B,A
        RRCA
        RRCA
        XOR B
        AND #E0
        XOR B
        RRA
        SRL A
        LD (filladr),HL
FILLPP
        LD (HL),A
        ld D,H
        ld E,L
        INC E
        DEC C
        RET Z
        LD B,0
        LDIR
        RET
CURPRTXADD
        PUSH DE
        CALL PRTXADDBUF
        POP DE
        CALL PRADDPP
        LD HL,(TXTLEN)
        ld A,(TXTX)
        CP L
        RET Z
        ADD A,D
        LD D,A
        LD A,'_'
PR4X8
        PUSH HL
        push DE
        push BC
        push AF
        SRL D
        LD C,15
        jr C,$+4
         LD C,#F0
        CALL DE2SCR
        POP AF
        ADD A,A
        ADD A,A
        LD E,A
       ADC A,FONT/512
        SUB E
        SLA E
        RLA
        LD D,A
       DUP 5
        INC H
        LD A,(DE)
        XOR (HL)
        AND C
        XOR (HL)
        LD (HL),A
        INC E
       EDUP
        INC H
        LD A,(DE)
        XOR (HL)
        AND C
        XOR (HL)
        LD (HL),A
        POP BC
        pop DE
        pop HL
        RET
SSA
        LD BC,(CURY)
        CALL GETnADR
        call XPP2
        LD A,C
       ADD A,A
       add A,A
       add A,C
       add A,-2
        ADD A,L
        LD L,A
       jr NC,$+3
         INC H
       LD A,(HL)
        INC HL
        inc HL
        RLA
        LD DE,AUTO1
       CALL puthB
       OR A
        LD BC,AUTOSu
        PUSH BC
puthB   INC HL
        LD A,(HL)
        RRA
        RRA
        RRA
        RRA
        AND 31
       CALL puth
        LD A,(HL)
        AND 15
puth    ADD A,'0'
        CP ':'
        jr C,$+4
        ADD A,'A'-':' ;daa нельзя для 31
        LD (DE),A
        INC DE
        RET
NotOct
        CALL cs_8026
        LD A,(OCT)
        SBC A,8
        ADC A,7
        LD C,A
        LD A,D
        SUB 13
        jr C,nOssnot
        INC A
        LD D,A
        INC C
        DEC C
        jr Z,$+3
         DEC C
nOssnot LD A,C
        ADD A,A
        add A,C
        ADD A,A
        add A,A
        add A,D
        LD D,A
        RET
EDSMP
        XOR A
        LD (volA),A
        LD (volC),A
        CALL OUT4
        LD A,(smp)
        ADD A,SMPS/256
        LD H,A
        ld BC,256
        ld L,C
        LD (ESMPadr),HL
        LD DE,EDORbf
        LDIR
        LD BC,mEDSMP
        CALL WINDUM
        XOR A
        LD (EsTOP),A
        LD HL,tSMPKEY
        LD DE,#900+SMPH
        CALL PRMENU
        CALL PROCORN
        CALL PRSMP
        LD A,(smp)
        ADD A,A
        LD L,A
        ld H,TSMPSZ/256
        LD A,(HL)
        ld (EsLOOP),A
        ld B,A
        INC L
        LD A,(HL)
        SUB B
        LD (EsLEN),A
       PUSH HL
        XOR A
        LD (EsMflag),A
        ld (EsLIN),A
        CALL GsMRK56
EDSMP0
       CALL RESHALT
        CALL EsCHMRK
        CALL EsPRMRK ;долго
        CALL EDSMCUR
        CALL EDSMPKY
        LD A,(smp)
        ld (piaSMP),A
EsORN=$+1
        LD A,0
        ld (piaORN),A
        LD HL,TORNSZ
        ADD A,A
        add A,L
        LD L,A
        ld A,(HL)
        ld (piOLOOP),A
        INC L
        LD A,(HL)
        ld (piOEND),A
        LD BC,(EsLOOP)
        ld A,C
        ld (piSLOOP),A
        ADD A,B
        LD (piSEND),A
        CALL OUT4
        LD HL,EDORbf
ESMPadr=$+1
        LD DE,0
        LD BC,256
        LDIR
        CALL PIANO
        CALL TSTFIRE
        jr NC,EDSMP0
       CALL DOWNMER
       POP HL
SMPQU
        LD DE,(EsLOOP)
        LD A,D
        ld B,E
        JP ORNQ
EDTXT
        LD (TXTSCR),DE
        ld (TXTLEN),A
        push hl
EDTXw  ;LD A,#7F
        CALL ANYKEY
        RRA
        jr NC,EDTXw
        pop hl
        PUSH HL
        LD DE,TXTBUF
        ld (CURADR),DE
        ld BC,32
        LDIR
        XOR A
        LD (TXTX),A
TXTSCR=$+1
EDTX0   LD DE,0
TXTLEN=$+1
        LD B,0
       PUSH BC
       push DE
       CALL CURPRTXADD
        CALL RESHALT
        jr Z,$-3
       POP DE
       pop BC
       CALL PRTXADDBUF
        LD A,(iycurkey);(23560)
        ;CP 6 ;caps lock
        ;jr NZ,EDTXn6
        jr EDTXn6
        ;LD HL,#5C6A
        ;ld A,8
        ;XOR (HL)
        ;LD (HL),A
EDsholk CALL SHOLK
        JR EDTX0
EDTXn6  CP key_enter;13
        jr Z,EDTXQ
        CP key_left;12
        jr Z,EDTXdel
        CP key_backspace;8
        jr Z,EDTXdel
        CP key_right;9
        jr Z,EDTXrgt
        CP ' '
        jr C,EDTX0
EDTXrgt LD B,A
        ;RLA
        ;jr C,EDTX0
TXTX=$+1
        LD C,0
        ld A,(TXTLEN)
        INC C
        CP C
        jr C,EDTX0
        LD A,C
        ld (TXTX),A
CURADR=$+1
        LD HL,TXTBUF
        LD A,B
        CP key_right;9
        jr Z,$+3
         LD (HL),B
        INC HL
        LD (CURADR),HL
        LD A,(TXTLEN)
        ld C,A
        ld A,(TXTX)
        SUB C
        jr NZ,EDsholk
EDTXQIF=$+1
        CP 0
        jr Z,EDsholk
        LD A,(TXTLEN)
        ld B,A
        ld DE,(TXTSCR)
        CALL PRTXADDBUF
EDTXQ   LD HL,TXTBUF
        POP DE
        LD BC,(TXTLEN)
        ld B,0
        LDIR
        ;LD A,8
        ;ld (#5C6A),A ;caps lock
        RET
EDTXdel
        LD HL,TXTX
        ld B,(HL)
        DEC B
        JP M,EDTX0
        LD (HL),B
        ld HL,(CURADR)
        DEC HL
        CP key_left;8
        jr Z,$+4
         LD (HL),32
        LD (CURADR),HL
        JR EDsholk

cs_8020
;out: NC=break
        ld a,0x7f
        in a,(0xfe)
        rra
        ret c
cs_8026
;out: NC=caps shift
        ld a,0xfe
        in a,(0xfe)
        rra
        ret

ink1    DB #30
pap1    NOP
ink2    DB #38
pap2    NOP
bord    NOP

setup_5D3B
        DB 6
        DB 7
        DB %01010000;bord,bits
;D7=joy 0/1F
;D6=poion 0/FF
;D5=SHOLK 0/C9
;D4=playon 0/FF
;curite DB 2;NU

filename_5CDD
        db "filename"
fileext_5CE5
        db "ext"

;lb000=#B000;#1000<->COMFROM
;COMFROM
       ;DISP lb000
        INCLUDE "ptcmpv8.asm"
       ;ENT
;ENDC
        ;DISPLAY "COM/DECOM=",$-COMFROM

dotname_to_cpmname
;de -> hl
;out: de=pointer to termination character
        ;push hl ;buffer
       
        push de ;ASCIIZ string for parsing
        push hl ;Pointer to 11 byte buffer
        ld d,h
        ld e,l
        inc de
        ld [hl],' '
        ld bc,11-1
        ldir ;empty filename
        pop hl ;Pointer to 11 byte buffer
        pop de ;ASCIIZ string for parsing

        ld b,9
       
        ld a,(de)
        cp '.'
        jr nz,parse_filename0.
        ld (hl),a
        inc de
        ld a,(de)
        cp '.'
        jr nz,parse_filenameq_findterminator.
        inc hl
        ld (hl),a
        jr parse_filenameq_findterminator.
parse_filename0.
        ld a,[de]
        or a
        ret z ;jr z,parse_filenameq. ;no extension in string
        inc de
        cp '.'
        jr z,parse_filenamedot. ;можем уже быть на терминаторе
         ;cp 0x80
         ;jr nc,$+4
         ;or 0x20
        ld [hl],a
        inc hl
        djnz parse_filename0.
;9 bytes in filename, no dot (9th byte goes to extension)
;возможно, длинное имя, надо найти, что раньше - точка или терминатор
;можем уже быть на терминаторе или на точке
        dec hl
        ld [hl],' '
parse_filenamelongname0.
        ld a,[de]
        or a
        ret z ;jr z,parse_filenameq. ;a=0
        inc de
        cp '.'
        jr z,parse_filenameLONGnamedot. ;можем уже быть на терминаторе
        jr parse_filenamelongname0.
parse_filenamedot.
        inc hl
        djnz $-1 ;hl points to extension in FCB
        dec hl
parse_filenameLONGnamedot.
        ld a,[de] ;extension in string
        or a
        ret z ;jr z,parse_filenameq. ;a=0
         ;cp 0x80
         ;jr nc,$+4
         ;or 0x20
        ld [hl],a ;extension in FCB
        inc hl
        inc de
        ld a,[de] ;extension in string
        or a
        ret z ;jr z,parse_filenameq. ;a=0
         ;cp 0x80
         ;jr nc,$+4
         ;or 0x20
        ld [hl],a ;extension in FCB
        inc hl
        inc de
        ld a,[de] ;extension in string
        or a
        ret z ;jr z,parse_filenameq. ;a=0
         ;cp 0x80
         ;jr nc,$+4
         ;or 0x20
        ld [hl],a ;extension in FCB
parse_filenameq_findterminator.
        inc de
        ld a,[de]
        or a
        jr nz,parse_filenameq_findterminator.
;parse_filenameq. ;de на терминаторе
        ;pop hl ;buffer
        ret ;a=0

cpmname_to_dotname
;hl -> de
        push hl
        ld b,8
cpmname_to_dotname0
        ld a,(hl)
        cp ' '
        jr z,cpmname_to_dotname0q
        ld (de),a
        inc hl
        inc de
        djnz cpmname_to_dotname0
cpmname_to_dotname0q
        pop hl
        ld bc,8
        add hl,bc ;hl=pointer to ext
        ld a,(hl)
        cp ' '
        jr z,cpmname_to_dotnameq
        ld a,'.'
        ld (de),a
        inc de
        ld  c,3
        ldir
cpmname_to_dotnameq
        xor a
        ld (de),a
        ret

loaddir_filinfo
        push bc
        push de
        push hl        
        ld de,filinfo
        OS_READDIR
        pop hl
        pop de
        pop bc
        or a
         scf
        ret nz ;CY
        ld a,(filinfo+FILINFO_FNAME)
        or a
         scf
        ret z ;CY
        ld a,(filinfo+FILINFO_FNAME+1)
        or a
        ret nz ;not one dot ;NC
        ld a,(filinfo+FILINFO_FNAME)
        cp '.'
        ret z ;Z,NC ;one dot
        or a ;NZ,NC
        ret
emptypath
        db 0
filinfo
        ds FILINFO_sz
iycurkey;=23560
        db 0
iykeyflag;=23611
        db 0

TXTBUF;=23698
        ds 32
OOOO=TXTBUF;23698

        INCLUDE "ptmsg.asm"

        display "free in 0000: ",0x3f00-$
        ds 0x3f00-$ ;проверка на вшивость (в 0x4000 будет страница экрана)
        ds 0x8000-$

        INCLUDE "pt3d.asm"
        INCLUDE "pt5_371.asm"
        INCLUDE "pt6_371.asm"

        ;DISPLAY "FREE2=",plaer-$
        ;IF 0==((plaer-$)&0x8000)
        ;DS plaer-$
        ;ENDIF
        display "free in 8000: ",BUFSTART-$
        ds 0xc000-$
       
        include "ptinpage.asm"

main_end

        if gs==0
        savebin "pt.com",main_begin,main_end-main_begin
        else
        savebin "ptgs.com",main_begin,main_end-main_begin
        endif

        LABELSLIST "../../us/user.l"