'- bugs:
'-   - snake tail isnt getting erased
'-   - game ends unexpectedly

#include "library/ballyastrocadeheader.bas"
#include "library/smsrnd.bas"
#include "library/smsdelay.bas"
#include "library/charmapballyastrocade4x6_64x36x2wdefbasm_snake.bas"
#include "library/ballyastrocadeldir40b.bas"
#include "library/pacmanfillram.bas"

'-------------------------------------------------------------------------------
'----- variables
dim eee as uinteger at $4F10
dim seed as uinteger at $4F12
dim ee0 as uinteger at $4F14
dim ee1 as uinteger at $4F16
dim ee2 as uinteger at $4F18
dim ee3 as uinteger at $4F1A
dim eex as uinteger at $4F1C
dim eey as uinteger at $4F1E
dim ee1x as uinteger at $4F20
dim ee1y as uinteger at $4F22
dim ee1q as uinteger at $4F24
dim eelp as uinteger at $4F26
dim rompos as uinteger at $4F28
dim snkln as uinteger at $4F2A
dim snklndc as uinteger at $4F2C
dim eesd as uinteger at $4F2E
dim xntz as uinteger at $4F30
dim yntz as uinteger at $4F32
dim keybbf as ubyte at $4F07
dim gameover as ubyte at $4F08
dim xdir as byte at $4F09
dim ydir as byte at $4F0A
dim xpos as byte at $4F0B
dim ypos as byte at $4F0C
dim ccur as ubyte at $4F0D
dim colisn as ubyte at $4F0E
dim keyband as ubyte at $4F0F

'-------------------------------------------------------------------------------
'----- routines
sub ballyastrocadeputchar4x6(txp1 as uinteger,typ1 as uinteger,tch1 as uinteger,tad1 as uinteger):
  ballyastrocadeldir40b($4000+typ1*240+txp1,tad1+tch1*6,6)
  end sub
sub ballyastrocadescreenmode(tvl1 as ubyte):
  out $08,tvl1
  end sub
sub ballyastrocadeborderandpaletteoffset(tbc1 as ubyte,tof1 as ubyte):
  out $09, ((tbc1 band 3)*64) bor (tof1 band 63)
  end sub
sub ballyastrocadepalette(tid1 as uinteger,tvl1 as ubyte):
  out (tid1 band 7),tvl1
  end sub
sub ballyastrocadewritetext(txp2 as uinteger,typ2 as uinteger,txloc2 as uinteger,tlen2 as uinteger,tad2 as uinteger):
  dim twrt2 as uinteger at $4F00
  for twrt2=0 to tlen2-1
    ballyastrocadeputchar4x6(txp2+twrt2,typ2,peek(txloc2+twrt2),tad2)
    next
  end sub
function peekmap(txp1 as uinteger,typ1 as uinteger) as ubyte
  return peek($4000+(typ1*240)+txp1)
  end function
sub clearscreen()
  for ee0=0 to 47
    pacmanfillram($4000+ee0*80,%10011001,40)
    pacmanfillram($4000+40+ee0*80,%01100110,40)
    next
  end sub

'-------------------------------------------------------------------------------
'----- init palette

pacmanfillram($4000,$00,$F00)
ballyastrocadescreenmode(%00101100)  '- 00xxxxb? = background color  ; 00=clear ???, 01=blue, 10=yellow, 11=red ; Does this depend on the palatte??? ; xx101100b = set right/left palette ???
ballyastrocadepalette(3,$02):ballyastrocadepalette(7,$02) '05 '02
ballyastrocadepalette(2,$73):ballyastrocadepalette(6,$73) 'BC '73
ballyastrocadepalette(1,$7C):ballyastrocadepalette(5,$7C) 'B3 '7C
ballyastrocadepalette(0,$06):ballyastrocadepalette(4,$06) '01 '06

ballyastrocadeborderandpaletteoffset(0,0)

'-------------------------------------------------------------------------------
'----- main game loop
loopmain:
'----- cls
clearscreen()

'----- writing title
ballyastrocadewritetext(1,11,@text01,@text01end-@text01,@charmap01-96)
ballyastrocadewritetext(1,12,@text02,@text02end-@text02,@charmap01-96)
ballyastrocadewritetext(1,14,@text03,@text03end-@text03,@charmap01-96)

'-------------------------------------------------------------------------------
'----- keyboard loop
looptitlekbchk:
keyband=((in($10)) bor (in($11))) band 31
'keyband=peek($E600) 'band %00011101
if keyband=0 then:
  goto looptitlekbchk
  end if

gameover=0

''-------------------------------------------------------------------------------
''----- cls
clearscreen()

'-------------------------------------------------------------------------------
'- variables
colisn=0:snklndc=12
ccur=0:colisn=0
snkln=4:snklndc=12:rompos=0
xpos=8:ypos=12
xdir=1:ydir=0

'-------------------------------------------------------------------------------
'- random
eesd=smsrnd(eesd):xntz=(eesd mod 40)
eesd=smsrnd(eesd):yntz=(eesd mod 16)

'-------------------------------------------------------------------------------
'- clean map?
for ee1x=$4F40 to $4FEF
  poke ee1x,0
  next
for ee1x=$4F40 to $4FEF
  poke ee1x,code("A")
  next

'-------------------------------------------------------------------------------
'----- game loop
loopgame:

keybbf=(in($10)) bor (in($11))
if (keybbf band 1)<>0 and (xdir<>0) then:xdir= 0:ydir=-1:end if
if (keybbf band 2)<>0 and (xdir<>0) then:xdir= 0:ydir= 1:end if
if (keybbf band 4)<>0 and (ydir<>0) then:xdir=-1:ydir= 0:end if
if (keybbf band 8)<>0 and (ydir<>0) then:xdir= 1:ydir= 0:end if

eesd=smsrnd(eesd bxor keybbf)
xpos=xpos+xdir
ypos=ypos+ydir

if (xpos=xntz) and (ypos=yntz) then:
  eesd=smsrnd(eesd):xntz=(eesd mod 40)
  eesd=smsrnd(eesd):yntz=(eesd mod 16)
  snkln=snkln+1
  end if

if ypos<0 then:ypos=15:end if
if xpos<0 then:xpos=39:end if
if ypos>15 then:ypos=0:end if
if xpos>39 then:xpos=0:end if

'----- movimento da cobra
for eelp=$4F40 to $4FEF step 2
  poke uinteger eelp,peek(uinteger,eelp+2)
  next
poke $4FF0,xpos:poke $4FF1,ypos

'----- draw head and tail of the snake, and the pokes are not working?
ccur=(ccur+1)band 15

'pokemap(peek($EFFE-(snkln*2)),peek($EFFF-(snkln*2)),code("B"),$C000)
ballyastrocadeputchar4x6(peek($CEFE-(snkln*2))+2,peek($CEFF-(snkln*2)),$20,@charmap01-96)

'- replace with random, and check collision
ballyastrocadeputchar4x6(xntz+2,yntz,32,@charmap01-96)
if peekmap(xpos+2,ypos)<$20 then:
  gameover=1
  end if
ballyastrocadeputchar4x6(xntz+2,yntz,ccur+97,@charmap01-96)
'
''pokemap(xpos,ypos,code("C"),$C000)
ballyastrocadeputchar4x6(xpos+2,ypos,ccur+16,@charmap01-96)
'
smsdelay(2000)

  if gameover=0 then
    goto loopgame
    end if

for ee1x=1 to 50
  smsdelay(2000)
  next

  goto loopmain
'-------------------------------------------------------------------------------
do:loop
'-------------------------------------------------------------------------------
text01:
asm
  defb " JUST ANOTHER SNAKE GAME "
  end asm
text01end:
text02:
asm
  defb " PAULO SILVA, '13-'18 "
  end asm
text02end:
text03:
asm
  defb " PUSH ANY KEY "
  end asm
text03end:
'-------------------------------------------------------------------------------
