DEVICE ZXSPECTRUM128
include "../../_sdk/sys_h.asm"
EGA=1
if EGA
attrs=0x3800 ;0x600
attrs_sz=0x600
fieldwid=38
fieldhgt=23
else
attrs=0x5800
attrs_sz=0x300
fieldwid=30
fieldhgt=22
endif
STACK=0x4000
dangerattr1=#38+2 ;red
dangerattr2=#38+4 ;green
dangerattr3=#38+1 ;blue
scoreattr=dangerattr3
wallattr=dangerattr1
snakeattr=dangerattr2
rabbitattr=#40+#30 ;bright yellow
emptyattr=#38
snakecoordssize=fieldwid*fieldhgt*2;768*2
dir_r=key_right;cs8;#09
dir_l=key_left;cs5;#08
dir_u=key_up;cs7;#0b
dir_d=key_down;cs6;#0a
org PROGSTART
begin
ld sp,STACK
if EGA
ld e,0
else
ld e,3
endif
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_GETSCREENPAGES
;de=ёЄЁрэшЎ√ 0-ую ¤ъЁрэр (d=ёЄрЁ°р ), hl=ёЄЁрэшЎ√ 1-ую ¤ъЁрэр (h=ёЄрЁ°р )
if EGA
ld a,e
SETPG32KLOW
ld a,d
SETPG32KHIGH
else
ld a,d
SETPG16K
endif
call cls
ld hl,attrs
ld de,attrs+1
ld bc,attrs_sz-1
ld (hl),emptyattr
ldir
call prfield
ld hl,#0101
ld (snakecoords),hl
;ld bc,#0a1e
;call prrabbit
call genrabbit
gameloop
if EGA
ld bc,0*256+18
call calcscraddr
else
ld de,#4000+14
endif
ld hl,(curlength)
call prnum
call delay
GET_KEY
cp key_esc
jr z,quit
call getkey
call shrink
call proldheadastail
call move_grow ;bc=эют√х ъююЁфшэрЄ√ уюыют√
push bc
call collide_rabbit_startgrow
call collide_walls_self ;Z=collision
pop bc
jr z,gameover
call prhead
jp gameloop
gameover
ld hl,endtext
if EGA
ld bc,0x0b0f
else
ld bc,0x0b0b
endif
call prtext
gameoverloop
YIELD
GET_KEY
cp key_esc
jr nz,gameoverloop
quit
QUIT
rnd
;0..c-1
ld a,r
rnd0
sub c
jr nc,rnd0
add a,c
ret
collide_rabbit_startgrow
call getheadcoords
;call calcscraddr
call calcattraddr;_fromscr
;de=attraddr (head)
ld a,(de)
cp rabbitattr
ret nz
ld a,5
ld (curgrow),a
;call genrabbit
;ret
genrabbit
ld c,fieldhgt
call rnd
inc a
ld b,a
ld c,fieldwid
call rnd
inc a
ld c,a
;genrabbit, хёыш яюярыю эр їтюёЄ:
;call calcscraddr
call calcattraddr;_fromscr
;de=attraddr (rabbit)
ld a,(de)
cp emptyattr
jr nz,genrabbit
prrabbit
;bc=yx
ld a,rabbitattr
ld (curattr),a
;ld a,'Y'
;jp prcharxy
ld hl,tilerabbit
jp prtilexy
collide_walls_self
;out: Z=collision
call getheadcoords
;call calcscraddr
call calcattraddr;_fromscr
;de=attraddr (head)
ld a,(de)
cp dangerattr1
ret z
cp dangerattr2
ret
delay
ld b,5
delay0
push bc
YIELD
pop bc
djnz delay0
ret
getkey
cp dir_l
jr z,getkey_ok
cp dir_r
jr z,getkey_ok
cp dir_u
jr z,getkey_ok
cp dir_d
ret nz;jr z,getkey_ok
getkey_ok
ld (curdirection),a
ret
shrink
ld a,(curgrow)
or a
jr z,nogrow
dec a
ld (curgrow),a
ret;jr growq
nogrow
ld bc,(snakecoords)
call cltail
ld hl,snakecoords+2
ld de,snakecoords
ld bc,snakecoordssize-2
ldir
ld hl,(curlength)
dec hl
ld (curlength),hl
;growq
ret
getheadcoords
ld hl,(curlength) ;эх ёўшЄр уюыют√
add hl,hl
ld bc,snakecoords
add hl,bc
ld c,(hl)
inc hl
ld b,(hl)
inc hl
ret
move_grow
;out: bc=эют√х ъююЁфшэрЄ√ уюыют√
call getheadcoords
;bc=ёЄрЁ√х ъююЁфшэрЄ√ уюыют√
ld a,(curdirection)
dec c
cp dir_l
jr z,moveq
inc c
inc c
cp dir_r
jr z,moveq
dec c
inc b
cp dir_d
jr z,moveq
dec b
dec b
moveq
;bc=эют√х ъююЁфшэрЄ√ уюыют√
ld (hl),c
inc hl
ld (hl),b
ld hl,(curlength)
inc hl
ld (curlength),hl
ret
curgrow
db 7
curdirection
db dir_r
curlength
dw 0 ;эх ёўшЄр уюыют√
cls
if EGA
ld e,0
OS_CLS
else
ld hl,#4000
ld de,#4001
ld bc,#17ff
ld (hl),0;#ff
ldir
ld hl,#5800
ld de,#5801
ld (hl),emptyattr
ld bc,767
ldir
endif
ret
prfield
ld a,wallattr
ld (curattr),a
ld bc,#0000
ld e,fieldwid+2
call prfieldhor ;top
ld bc,256*(fieldhgt+1);#1700
ld e,fieldwid+2
call prfieldhor ;bottom
ld bc,#0100
ld e,fieldhgt
call prfieldver ;left
ld bc,#0100+(fieldwid+1);#011f
ld e,fieldhgt
;call prfieldver ;right
;ret
prfieldver
;bc=yx
;e=len
prfieldver0
;ld a,fieldmarginsymbol
;call prcharxy
ld hl,tilebrick
call prtilexy
inc b
dec e
jr nz,prfieldver0
ret
prfieldhor
;bc=yx
;e=len
prfieldhor0
;ld a,fieldmarginsymbol
;call prcharxy
ld hl,tilebrick
call prtilexy
inc c
dec e
jr nz,prfieldhor0
ret
proldheadastail
call getheadcoords
;bc=yx
ld a,snakeattr
ld (curattr),a
;ld a,'O'
;jp prcharxy
ld hl,tilesnake
jp prtilexy
prhead
;bc=yx
ld a,snakeattr
ld (curattr),a
;ld a,'O'
;jp prcharxy
ld hl,tilesnakehead
jp prtilexy
cltail
;bc=yx
ld a,emptyattr
ld (curattr),a
;ld a,' '
;jp prcharxy
ld hl,tileempty
jp prtilexy
prtext
;bc=ъююЁфшэрЄ√
;hl=text
ld a,emptyattr
ld (curattr),a
ld a,(hl)
or a
ret z
call prcharxy
inc hl
inc c
jr prtext
prnum
ld bc,1000
call prdig
ld bc,100
call prdig
ld bc,10
call prdig
ld bc,1
prdig
ld a,'0'-1
prdig0
inc a
or a
sbc hl,bc
jr nc,prdig0
add hl,bc
;push hl
;call prchar
;pop hl
;ret
prchar
;a=code
;de=screen
push de
push hl
call prcharin
pop hl
pop de
inc e
ret
calcscraddr
;bc=yx
;ьюцэю яюЁЄшЄ№ bc
if EGA
ex de,hl
ld a,c ;x
ld l,b ;y
ld h,0
ld b,h
ld c,l
add hl,hl
add hl,hl
add hl,bc ;*5
add hl,hl
add hl,hl
add hl,hl ;*40
add hl,hl
add hl,hl
add hl,hl
add a,l
ld l,a
ld a,h
adc a,0x80
ld h,a
ex de,hl
else
;de=#4000 + (y)+((y*32)&#ff+x)
ld a,b ;y
and #18
add a,#40
ld d,a
ld a,b ;y
add a,a ;*2
add a,a ;*4
add a,a ;*8
add a,a ;*16
add a,a ;*32
add a,c ;x
ld e,a
endif
ret
calcattraddr
;bc=yx
;эхы№ч яюЁЄшЄ№ bc
if EGA
;de=attrs + (y)/4+((y*64)&#ff+x)
ld a,b
rrca
rrca
ld d,a
and 0xc0
add a,c
ld e,a
sub c
xor d
add a,attrs/256
ld d,a ;de=attraddr
else
;de=#5800 + (y)/8+((y*32)&#ff+x)
ld a,b
rrca
rrca
rrca
ld d,a
and 0xe0
add a,c
ld e,a
sub c
xor d
add a,attrs/256;#58
ld d,a ;de=attraddr
endif
ret
prtilexy
;hl=tile
;bc=yx
push de
push bc
call calcscraddr
;push de
call prcharin_go
;pop de
pop bc
call calcattraddr;_fromscr
ld a,(curattr)
ld (de),a
pop de
ret
prcharxy
;a=code
;bc=yx
push de
push hl
push bc
push af
;jr $
call calcscraddr
pop af
;push de
call prcharin
;pop de
pop bc
call calcattraddr;_fromscr
curattr=$+1
ld a,0
ld (de),a
pop hl
pop de
ret
prcharin
if EGA
sub 32
ld l,a
ld h,0
add hl,hl
add hl,hl
add hl,hl
add hl,hl
add hl,hl
;ld bc,font-(32*32)
;add hl,bc
ld a,h
add a,font/256
ld h,a
prcharin_go1
ex de,hl
if 1==1
ld bc,40
push hl
push hl
dup 8
ld a,(de) ;font
ld (hl),a ;scr
inc de
add hl,bc
edup
pop hl
set 6,h
;ld d,font/256
dup 8
ld a,(de) ;font
ld (hl),a ;scr
inc de
add hl,bc
edup
pop hl
set 5,h
push hl
;ld d,font/256
dup 8
ld a,(de) ;font
ld (hl),a ;scr
inc de
add hl,bc
edup
pop hl
set 6,h
;ld d,font/256
dup 8
ld a,(de) ;font
ld (hl),a ;scr
inc de
add hl,bc
edup
else
ld bc,40-0x6000
dup 8
ld a,(de) ;font
inc de
ld (hl),a ;scr
set 6,h
ld a,(de) ;font
inc de
ld (hl),a ;scr
res 6,h
set 5,h
ld a,(de) ;font
inc de
ld (hl),a
set 6,h
ld a,(de) ;font
inc de
ld (hl),a ;scr
;res 6,h
;res 5,h
add hl,bc
edup
endif
ret
else
ld l,a
ld h,0
add hl,hl
add hl,hl
add hl,hl
ld bc,font-256;#3c00
add hl,bc
endif
if EGA
if 1==1
prcharin_go=prcharin_go1
else
prcharin_go
ex de,hl
ld bc,40
dup 8
ld a,(de) ;font
ld (hl),a ;scr
set 5,h
ld (hl),a
res 5,h
inc de
add hl,bc
edup
endif
else
prcharin_go
ld b,8
prchar0
ld a,(hl) ;font
ld (de),a ;scr
inc hl
inc d ;+256
djnz prchar0
endif
ret
macro cols data
_l=data/16
_r=data&15
db ((_r&8)<<4) + ((_r&7)<<3) + ((_l&8)<<3) + (_l&7)
endm
macro cols8 d0,d1,d2,d3,d4,d5,d6,d7
cols d0
cols d1
cols d2
cols d3
cols d4
cols d5
cols d6
cols d7
endm
tileempty
if EGA
ds 32
else
ds 8
endif
tilebrick
if EGA
cols8 #00,#22,#aa,#22,#00,#22,#2a,#22
cols8 #00,#20,#20,#20,#00,#22,#aa,#22
cols8 #00,#22,#2a,#22,#00,#22,#aa,#22
cols8 #00,#22,#aa,#22,#00,#20,#20,#20
else
db %00000000
db %11101111
db %00101000
db %11101111
db %00000000
db %11111110
db %10000010
db %11111110
endif
tilesnake
if EGA
cols8 #00,#00,#04,#4c,#4c,#4c,#04,#00
cols8 #00,#44,#cc,#cc,#cc,#cc,#cc,#44
cols8 #00,#40,#c4,#cc,#cc,#cc,#c4,#40
cols8 #00,#00,#00,#40,#40,#40,#00,#00
else
db %00000000
db %00111000
db %01000100
db %10000010
db %10000010
db %10000010
db %01000100
db %00111000
endif
tilesnakehead
if EGA
cols8 #00,#00,#04,#4c,#4c,#4c,#04,#00
cols8 #00,#44,#cc,#fc,#cc,#22,#cc,#44
cols8 #00,#40,#c4,#fc,#cc,#2c,#c4,#40
cols8 #00,#00,#00,#40,#40,#40,#00,#00
else
db %00000000
db %00111000
db %01000100
db %10101010
db %10000010
db %10111010
db %01000100
db %00111000
endif
tilerabbit
if EGA
cols8 #00,#77,#7f,#7f,#07,#07,#07,#00
cols8 #00,#00,#70,#70,#f7,#0f,#f2,#77
cols8 #00,#07,#7f,#7f,#f7,#07,#f7,#70
cols8 #00,#70,#70,#70,#00,#00,#00,#00
else
db %00000000
db %11000110
db %10101010
db %10101010
db %01101100
db %01010100
db %01101100
db %00111000
endif
endtext
db "GAME OVER!",0
oldtimer
dw 0
if EGA
align 256
font
incbin "fontgfx"
else
font
incbin "zx.fnt"
endif
snakecoords
;y,x (уюыютр т ъюэЎх)
;ds snakecoordssize
end
display "End=",end
;display "Free after end=",/d,#c000-end
display "Size ",/d,end-begin," bytes"
savebin "snake.com",begin,end-begin
;LABELSLIST "..\us\user.l"