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"