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
OS_HIDEFROMPARENT
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
ld hl,attrs
ld de,attrs+1
ld bc,attrs_sz-1
ld (hl),emptyattr
ldir
call redraw
ld hl,#0101
ld (snakecoords),hl
;ld bc,#0a1e
;call prrabbit
call genrabbit
gameloop
call setpgs_scr
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
cp key_redraw
push af
call z,redrawall
pop af
;a=key
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
redrawall
call redraw
call prsnake
call getheadcoords
call prhead
rabbitxy=$+1
ld bc,0
jp prrabbit
redraw
call setpgs_scr
call cls
jp prfield
setpgs_scr
ld a,(user_scr0_low) ;ok
SETPG32KLOW
ld a,(user_scr0_high) ;ok
SETPG32KHIGH
ret
redrawgameover
call redrawall
gameover
ld hl,endtext
if EGA
ld bc,0x0b0f
else
ld bc,0x0b0b
endif
call prtext
gameoverloop
YIELD
GET_KEY
cp key_redraw
jr z,redrawgameover
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
ld (rabbitxy),bc
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
prsnake
ld hl,snakecoords
ld bc,(curlength)
prsnake0
push bc
push hl
ld c,(hl)
inc hl
ld b,(hl)
call prtailelement
pop hl
pop bc
inc hl
cpi
jp pe,prsnake0
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
prtailelement
;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"