DEVICE ZXSPECTRUM128
include "settings.asm"
music=0
NTEXPGS=0
;curpg=0x5b5c
pgtmp=#04
;tcos=#5B00
imer=#7F7F
INTSTACK=imer
imstackbegin=imer&0xff00
distbuf=#7C00 ;#300 ;ID,texx,dist
page 0
ORG #6000;,0
begin
jp init
IF doublescr
SETPG
LD (curpg),A
curscr=$+1
OR 0
LD BC,#7FFD
OUT (C),A
RET
ENDIF
INCLUDE "WCTRL.ASM"
;переменные рендера (обновляются в начале рендера)
curXx
curx DB #80
curX DB #0
curYy
cury DB #80
curY DB #0
curxy DW 0
curyx DW 0
curYX DW 0
curangle
DW tsin
demobegin
IF demoplay
INCBIN "demorec*"
ELSE
DB %00111111 ;all keys released
ENDIF
align 256
tlogd2sca
IF scale64
IF scale64 == 3
INCBIN "logd2sc3"
ELSE
INCBIN "logd2sc2"
ENDIF
ELSE
INCBIN "logd2sc_"
ENDIF
tsqr2
INCBIN "sqr2int"
tlogd
INCBIN "logd"
tcorrlogd
INCBIN "corlogd_"
ORG $-256
DUP 256
DB {$+(scrtopx*8)}&0xff
EDUP
IF lores
ORG $-256
_=$
DUP 128
DB {_}&0xff
_=_+2
EDUP
DS 128
ENDIF
tcos
DS 256
tlogcos
INCBIN "pluslcos"
tda
INCBIN "da"
ORG $-256
DUP 256
DB 0xff&({$}+128)
EDUP
ORG $-256
DUP 256
DB 0xff&({$+(scrtopx*8)})
EDUP
IF lores
ORG $-256
_=$
DUP 128
DB {_}&0xff
_=_+2
EDUP
DS 128
ENDIF
tctg
INCBIN "plusctg"
tsin
INCBIN "sin"
cursprites
DS 256
DISPLAY "tables end=",$
tscalesw3
incbin "scalesw3"
;DS #8000-$
ds imstackbegin-$
ds imer-$
include "int.asm"
;DS ((IMER/256+1)<<8)-$
;ds (IMER&0xff00)-$
ds 0x8000-$ ;ORG #8000
imvec
DS 257,imer&0xff
INCLUDE "zxloop.asm"
INCLUDE "WSCAN10.asm"
INCLUDE "WREND.asm"
include "beeper.asm"
include "beeper_sfxdata.asm"
badmonstexture
db 0xc0,0xff
align 256
t1x
db 255
dup 255
db (255*2/($&0xff)+1)/2
edup
include "anims.asm"
include "savestate.asm"
DISPLAY "48K PROG END=",$
ORG distbuf
include "recmap.asm"
DS distbuf+#300-$
;;;;;
ORG scrbuf
GO
;xor a
;out (0xfe),a
DI
LD HL,WAStcos
LD DE,tcos
PUSH DE
LD BC,256
LDIR
POP HL
REtcos0
DUP 2;4
SRA (HL)
EDUP
INC L
jr nz,REtcos0
;IF music
; CALL #8000 ;init mus
;ENDIF
LD HL,imvec
LD DE,imvec+1
LD (HL),imer/256
LD B,E,C,L
LD A,H
LDIR
LD I,A
IM 2
EI
HALT
LD HL,-2
ADD HL,SP
LD (clscrbufsp),HL
LD (eorfillsp),HL
ld hl,ZXLOOP
push hl
LD BC,#FBDF
IN A,(C)
LD (mouseoldx),A
JP RECMAP ;->ZXLOOP
display "ZXLOOP=",ZXLOOP
WASMAP
IF invmap;atm
INCBIN "mapatm.E"
ELSE
INCBIN "map48.E"
ENDIF
szMAP=$-WASMAP
WAStcos
INCBIN "cos"
init
if mouse
call initmouse
endif
;prepare 48K block
DI ;IY
LD HL,#5800
LD DE,#5801
LD BC,767
LD (HL),L
LDIR
call gettexpg
if doublescr
LD A,0x10+pgtmp
call SETPG
call gettexpg
LD A,0x10
call SETPG
endif
LD IY,23610
EI
JP GO
gettexpg
LD HL,waswalls;#C000
call copyscrcolumns
;LD DE,#4000
;LD BC,#1800
;LDIR
LD DE,#C000+0x80;maxscale+1
LD HY,d;0xc0;#FE
;4 upper textures = #09A6
;4 lower textures = #0AAC
LD HL,#4000
CALL GETTEX
CALL GETTEX
CALL GETTEX
CALL GETTEX
push de
LD HL,waswalls+0x800;#C000
call copyscrcolumns
pop de
LD HL,0x4000;#4800
CALL GETTEX
CALL GETTEX
CALL GETTEX
CALL GETTEX
push de
LD HL,waswalls+0x1000;#C000
call copyscrcolumns
pop de
LD HL,0x4000;#5000
CALL GETTEX
CALL GETTEX
CALL GETTEX
CALL GETTEX
;PUSH DE
;LD BC,#7FFD
;LD A,pgtmp|#10
;OUT (C),A
;jr $ ;walls: de=d7e6 (e862 12 шт)
;LD HL,wasgoods;#DB00
;call copyscrcolumns
;LD DE,#4000
;LD BC,#1800
;LDIR
;LD BC,#7FFD
;LD A,#10
;OUT (C),A
;POP DE
LD HL,#4808
CALL GETSPR
LD HL,#4818
CALL GETSPR
LD HL,#5008
CALL GETSPR
LD HL,#5018
CALL GETSPR
;jr $ ;walls: с оптимизацией de=e152 (e2b4 12 шт) (f158 12 шт+2 спрайта без оптимизации)
;jr $ ;пак 7: с оптимизацией de=ec70[ebdf] (f4c8 12 шт)
;jr $ ;пак 3: с оптимизацией de=e1e4[de70]
;jr $ ;пак 2: с оптимизацией de=f070[f6cd]
;jr $ ;пак 1: с оптимизацией de=efdf[ef76, без оптимизации f256]
if 1
;исправляем переполнения адресов текстур (адреса в ПЗУ заменяем на 0xc080, а для спрайтов на badmonstexture)
ld h,0xc0
fixtexoverflow0
ld l,0x40
fixtexoverflow1
ld e,(hl)
inc h
ld d,(hl)
bit 7,d
jr nz,$+5 ;не в ПЗУ
badaddrpatch=$+1
ld de,0xc080
ld (hl),d
dec h
ld (hl),e
inc l
jp p,fixtexoverflow1
inc h
inc h
ld de,badmonstexture
ld a,h
cp 0xc0+(2*12)
jr c,$+6
ld (badaddrpatch),de
cp 0xc0+(2*16)
jr nz,fixtexoverflow0
endif
;составляем таблицу масштабирования
ld hl,tscalesw3
ld c,0
ld b,64
initscales0
ld e,(hl)
inc hl
ld d,(hl)
inc hl
push hl
ld l,c
push bc
ld b,d
ld c,e ;adder 8.8
;надо из 0040...0400 сделать 78..00 до начала(0x80 -08..-80) = 0x80 - adder*32
;надо из 0040...0400 сделать 78..04 в начале (0x80 -08..-7c) = 0x80 - adder*31
;...
;надо из 0040...0400 сделать 87..f4 (0x80 +07..+74)
;надо из 0040...0400 сделать 88..f8 в конце (0x80 +08..+78)
dup 5
sla e
rl d
edup
xor a
sub e
ld e,a
ld a,0x80
sbc a,d
ld d,a ;0x80 - adder*32
ld h,0xc0
ld (hl),0 ;зачем? при d виснет из-за спрайтов
inc h
initscales1
ex de,hl
add hl,bc
ex de,hl
ld (hl),d ;Ys=(Y/32-1)*sc
inc h
jr nz,initscales1
pop bc
inc c
pop hl
djnz initscales0
LD H,#C1
INIRETAB0 ;
LD L,0
LD B,maxscale+1
INIRETAB1 ;
LD A,(HL)
CP 128-(scrhgtpix/2)
jr nc,$+4
LD A,128-(scrhgtpix/2)
CP 128+(scrhgtpix/2);-1
jr c,$+4
;LD A,128+(scrhgtpix/2)-1 ;видно линию внизу от переполн-й
LD A,0xff&(dropline-(scrbuf+(scrhgtpix/2)-128))
ADD A,+(0xff&scrbuf)+(scrhgtpix/2)-128
LD (HL),A
INC L
DJNZ INIRETAB1
INC H
LD A,H
INC A ;#C0XX,#FFXX не трогаем
jr nz,INIRETAB0
LD HL,#FF00
LD DE,#FF01
LD BC,maxscale
LD (HL),1
LDIR
ret
if mouse
initmouse
ei
halt
;задержка, чтобы мышка успевала опознаваться - min 2500 тактов для Evo (компа с 280к тактов быстродействия)
LD B,75
prosirtime
LD DE,(0) ;20 тактов
DJNZ prosirtime ;13 тактов
ld a, 0x90
out (0x7F), a
out (0x5F), a
ld bc, 0x0FFDF
in h, (c)
ld b, 0x0FB
in l, (c)
dec b
in a, (c)
cp l
ret nz ;jr nz, @detected
cp h
ret nz ;jr z, @comeon
LD A,0xaf ;xor a
LD (mouseon),A
;ld hl,0x18+(256*readmousejr) ;"jr"
;ld (readmouse_patch),hl
ret
endif
copyscrcolumns
ld c,0x40
call copyscrcolumns_third
ld c,0x48
call copyscrcolumns_third
ld c,0x50
;call copyscrcolumns_third
copyscrcolumns_third
xor a
copyscrcolumns0
ld e,a
ld d,c;0x40
ld b,0x40
copyscrcolumn1
ld a,(hl)
inc hl
ld (de),a
inc d
ld a,d
and 7
jr nz,copyscrcolumn1_continue
ld a,e
sub -32
ld e,a
sbc a,a
and -8
add a,d
ld d,a
copyscrcolumn1_continue
djnz copyscrcolumn1
inc e
ld a,e
and 0x1f
jr nz,copyscrcolumns0
ret
GETTEX
IF scale64
LD LY,#40
ELSE
LD LY,#80
ENDIF
LD BC,#0880 ;B=width/8, C=#80(mask)
GETTEX00 ;
PUSH BC
GETTEX0 CALL GETTEXLINE
INC LY
IF scale64 == 0
INC LY
ENDIF
RRC C
jr nc,GETTEX0
INC L
POP BC
DJNZ GETTEX00
inc hy,hy;DEC HY,HY
RET
GETSPR
IF scale64
LD LY,#40
ELSE
LD LY,#80
ENDIF
LD BC,#0880 ;B=width/8, C=#80(mask)
GETSPR00 ;
PUSH BC
GETSPR0 CALL GETSPRLINE
INC LY
IF scale64 == 0
INC LY
ENDIF
RRC C
jr nc,GETSPR0
INC L
POP BC
DJNZ GETSPR00
inc hy,hy;DEC HY,HY
RET
GETTEXLINE
PUSH HL
if 0
push hl
ld a,h
or 6
ld h,a
ld a,l
add a,0xe0
ld l,a
ld (hl),0xff ;патчим предпоследнюю линию текстуры цветом пола
pop hl
endif
GETTEXRETRY ;
LD (gettexDE),DE ;linelength addr
POP HL
PUSH HL
LD (IY),E
IF scale64 == 0
LD (IY+1),E
ENDIF
INC HY
LD (IY),D
IF scale64 == 0
LD (IY+1),D
ENDIF
DEC HY
INC E
jr nz,GETTEXniD
GETTEXiD INC D
LD E,0x80;maxscale+1
ld a,d
cp 0xc0+(2*16)
jr c,GETTEXRETRY
ld e,0x40 ;дальше нет таблиц адресов
JR GETTEXRETRY
GETTEXniD ;
LD LX,0;C ;bit
LD HX,17 ;17-pixels
LD B,62 ;62..1 -> 1..62
GETTEX1 ;
CALL DHL
LD A,(HL)
AND C
CP LX
LD LX,A
jr z,GETTEXN
LD A,HX
OR A
jr z,GETTEXN ;can't add more pixels
LD A,tscale/256+63
SUB B
LD (DE),A
DEC HX ;17-pixels
INC E ;todo check before write
jr z,GETTEXiD
GETTEXN ;
DJNZ GETTEX1
LD A,HX ;17-pixels
ADD A,A
ADD A,A
ADD A,A
SUB HX ;(17-pixels)*7
ADD A,DWJP&0xff
gettexDE=$+1
LD (0),A
if 1
;сравнение с предыдущими столбцами
push de
push iy
ld hl,(gettexDE)
GETTEX_cmpnext
ld a,ly
cp 0x40 ;ниже этого tscales
jr nz,GETTEX_cmpgo
ld a,hy
cp 0xc0
jr z,GETTEX_endcmp
ld ly,0x7f
dec hy,hy
GETTEX_cmpgo
dec ly
ld e,(iy)
inc hy
ld d,(iy)
dec hy
ld a,17+1
sub hx ;17+1-(17-pixels)
ld b,a ;=1+pixels (min=2 из-за линии пола)
GETTEX_cmp1
ld a,(de)
cp (hl)
jr nz,GETTEX_cmpnext
inc hl
inc de
djnz GETTEX_cmp1
;поставить ссылку на прошлую копию
ld e,(iy)
inc hy
ld d,(iy)
pop iy
pop af;de
LD (IY),e
INC HY
LD (IY),d
DEC HY
ld de,(gettexDE) ;откатить DE
jr GETTEX_endcmpq
GETTEX_endcmp
pop iy
pop de
GETTEX_endcmpq
endif
POP HL
RET
GETSPRLINE
PUSH HL
GETSPRRETRY ;
POP HL
PUSH HL
LD (IY),E
IF scale64 == 0
LD (IY+1),E
ENDIF
INC HY
LD (IY),D
IF scale64 == 0
LD (IY+1),D
ENDIF
DEC HY
LD A,H
OR 6
LD H,A
LD A,L
ADD A,#E0
LD L,A ;line 62
LD HX,1
GETSPR1 ;
CALL FIND10
jr nc,GETSPRQ ;end of column
LD A,HX
CPL
LD (DE),A ;Y
INC E
jr z,GETSPRiD
CALL FIND1HEIGHT
LD A,HX
CPL
LD (DE),A ;Y2
INC E
jr z,GETSPRiD
CALL FIND0HEIGHT
LD A,HX
CPL
LD (DE),A ;Y3
INC E
jr z,GETSPRiD
JR GETSPR1
GETSPRQ
LD A,#C0
LD (DE),A
INC E
jr nz,GETSPRniD
GETSPRiD INC D
LD E,0x80;maxscale+1
ld a,d
cp 0xc0+(2*16)
jr c,GETSPRRETRY
ld e,0x40 ;дальше нет таблиц адресов
JR GETSPRRETRY
GETSPRniD ;
LD A,#FF
LD (DE),A
INC E
jr nz,$+5
INC D
LD E,maxscale+1
POP HL
RET
maxVhgt=10;16?
;HX=V
;HL=mask
FIND10
LD A,HX
CP 63
RET Z ;CY=0: end of column
CALL GETPIXEL
RET C ;CY=1: pixel
CALL UHL
INC HX ;V
JR FIND10
FIND1HEIGHT
;LD LX,HX ;oldV
LD B,0
F1H0 CALL GETPIXEL
RET NC ;transparent
RET Z ;0
CALL UHL
INC HX ;V
INC B
LD A,B
CP maxVhgt
jr c,F1H0
RET
FIND0HEIGHT
;LD LX,HX ;oldV
LD B,0
F0H0 CALL GETPIXEL
RET NC ;transparent
RET NZ ;1
CALL UHL
INC HX ;V
INC B
LD A,B
CP maxVhgt
jr c,F0H0
RET
GETPIXEL
LD A,HX
CP 63
RET Z ;CY=0: transparent
LD A,(HL)
AND C
RET NZ ;CY=0: transparent
RES 3,L
LD A,(HL)
AND C
SET 3,L
SCF ;CY=1: pixel (Z)
RET
UHL
LD A,H
DEC H
AND 7
RET NZ
LD A,L
SUB #20
LD L,A
RET C
LD A,H
ADD A,8
LD H,A
RET
;endall
DS #C000-$
if 0
;ORG #C000
IF scale64
IF scale64 == 3
INCBIN "tscale3"
ELSE
INCBIN "tscale2"
ENDIF
ELSE
INCBIN "tscale"
ENDIF
endif
;hicode_begin
;ds 0x10000-0x1800-0x0800-$ ;0xс040..7f содержит таблицы адресов текстуры (16 текстур?)
ds 0x10000-0x1800-0x1000-$ ;0xс040..7f содержит таблицы адресов текстуры (16 текстур?)
waswalls
incbin "walls.bin";INCBIN "walls_bw",0x1800
wasgoods
incbin "goods.bin";INCBIN "goods_bw",0x1800
;hicode_end
end
page pgtmp
org 0xc000
hicode_begin
ds 0x10000-0x1800-0x1000-$
;waswalls
incbin "walls2.bin";INCBIN "walls_bw",0x1800
;wasgoods
incbin "goods2.bin";INCBIN "goods_bw",0x1800
hicode_end
page 0
savebin "code.c",begin,end-begin
page pgtmp
savebin "hicode.c",hicode_begin,hicode_end-hicode_begin
LABELSLIST "../../../us/user.l",1