'- h7n9
'- Paulo Silva, 2016 (colecovision version), 2015 (sms version)

#include "library/cvboot.bas"
#include "library/smsvdp.bas"
#include "library/smsfilvrm.bas"
#include "library/smsldirvm.bas"
#include "library/smsvpoke.bas"
#include "library/smsvpeek.bas"
#include "library/smsrnd.bas"
#include "library/cvjoypad.bas"
#include "library/smsdelay.bas"
#include "library/cvsoundio.bas"

goto start:
#include "library/map01.zxi"
#include "library/charmap01.zxi"
#include "library/sprites01.zxi"
start:

dim seed as uinteger at $7010
dim jacum as uinteger at $7012
dim x0 as uinteger at $7014
dim y0 as uinteger at $7016
dim xl as uinteger at $7018
dim yl as uinteger at $701A
dim ltyq as uinteger at $701C
dim ltxq as uinteger at $701E
dim xp as integer at $7020
dim yp as integer at $7022
dim vl as integer at $7024

dim debug as ubyte at $7026
dim tlq1 as ubyte at $7027
dim v0 as ubyte at $7028
dim cn0 as ubyte at $7029
dim cn1 as ubyte at $702A
dim cn2 as ubyte at $702B
dim kr as ubyte at $702C
dim kg as ubyte at $702D
dim kb as ubyte at $702E
dim er as ubyte at $702F
dim eg as ubyte at $7030
dim eb as ubyte at $7031
dim tlb1 as byte at $7032
dim xs as byte at $7033
dim ys as byte at $7034
dim ds as byte at $7035
dim fs as byte at $7036
dim boolbf as ubyte at $7037



'-------------------------------

start01:

'screen1,2
smsvdp(0,$00):smsvdp(1,$E2) '- screen1,2
smsvdp(2,$06):smsvdp(3,$80):smsvdp(4,$00)
smsvdp(5,$36):smsvdp(6,$07)

' msxcolor(3,5,1) ----????
smsvdp(7,$31) 'smsvdp(7,F*16+4) '- ink*16+border - color(3,?,1)

'- clear vram
smsfilvrm($0000,$00,$4000) 

'- copy tiles to vram
smsldirvm($0000,@sprites01,256)
smsldirvm($0000+256,@charmap01,2048-256)
smsldirvm($2000,@attr9918mode0v01,32)

'- cls
smsfilvrm($1800,$20,768)

'-------------------------------






'-------------------------------
'- display characters, delete later
'for x0=0 to 255
'  smsvpoke($1800+x0,x0)
'  next
'-------------------------------




'do:loop

debug=0
seed=520



'--------------------------------------

sub sg1000putchar(tx1 as uinteger,ty1 as uinteger,tch1 as ubyte)
  smsvpoke($1800+(tx1*1)+(ty1*32),tch1)
  end sub

sub sg1000writetext(tx2 as uinteger,ty2 as uinteger,ttx2 as uinteger,tle2 as uinteger)
  smsldirvm($1800+ty2*32+tx2,ttx2,tle2)
  end sub

sub puttilesprite1(txp9 as uinteger,typ9 as uinteger,tid9 as uinteger,tdr9 as uinteger):
  smsldirvm($1800+typ9*32+txp9,@tiles01+(tdr9*12),3)
  smsldirvm($1800+typ9*32+txp9+32,@tiles01+3+(tdr9*12),3)
  smsldirvm($1800+typ9*32+txp9+64,@tiles01+6+(tdr9*12)+(tid9*3),3)
  end sub

sub puttilesprite2(txp9 as ubyte,typ9 as ubyte,tid9 as ubyte,tat9 as ubyte ):
  smsldirvm($1800+typ9*32+txp9,@tiles02+(tid9*4),2)
  smsldirvm($1800+typ9*32+txp9+32,@tiles02+2+(tid9*4),2)
  smsvpoke($2003,tat9)
  end sub

sub vpoketiles(txp1 as uinteger,typ1 as uinteger,tvl1 as ubyte):
  tlq1=128
  for tlb1=0 to 7
    if (tlq1 band tvl1)<>0 then:
       seed=smsrnd(seed)
       sg1000putchar((txp1*16)+(tlb1*2),(typ1*2),128+(seed band 127))
       seed=smsrnd(seed)
       sg1000putchar((txp1*16)+(tlb1*2)+1,(typ1*2),128+(seed band 127))
       seed=smsrnd(seed)
       sg1000putchar((txp1*16)+(tlb1*2),(typ1*2)+1,128+(seed band 127))
       seed=smsrnd(seed)
       sg1000putchar((txp1*16)+(tlb1*2)+1,(typ1*2)+1,128+(seed band 127))
       end if
     tlq1=tlq1/2
     next
   end sub

'- bug somewhere
sub drawdoor(txq1 as uinteger,tyq1 as uinteger,txq2 as uinteger,tyq2 as uinteger,tatq as ubyte):
  smsldirvm($200C,tatq,4)
  for ltyq=tyq1 to tyq2
    for ltxq=txq1 to txq2
      seed=smsrnd(seed)
      sg1000putchar(ltxq,ltyq,96+(seed band 31))      
      next:next
  end sub

sub drawdoorrdmatt(txq1 as uinteger,tyq1 as uinteger,txq2 as uinteger,tyq2 as uinteger,tadr as uinteger):
  for ltyq=tyq1 to tyq2
    for ltxq=txq1 to txq2
'      vl=(128+int(rnd*160))band 255
'      vpokechrattr((ltyq*32)+ltxq,vl,@charmap01,peek(tadr+int(rnd*4)))

      '????????
      seed=smsrnd(seed)
      sg1000putchar(ltxq,ltyq,96+(seed band 31))      
      '????????

      next:next
  end sub

function attrpoint(txp2 as uinteger,typ2 as uinteger) as ubyte:
  return smsvpeek($1800+(typ2*32+txp2))
  end function

function attrpointb(txp2 as uinteger,typ2 as uinteger) as ubyte:
  return (smsvpeek($1800+(typ2*32+txp2))) band %11111000
  end function

'--------------------------------------

'smsfilvrm($0000,$69,$4000)





'do

title:


'- cls
smsfilvrm($1800,$20,768)

gosub displaytitle01

'pause 0
do
paus0a:
  boolbf=(cvjoypad1a() bxor $4F) bor (cvjoypad2a() bxor $4F)
  boolbf=boolbf bor ((cvjoypad1b() bxor $4F) bor (cvjoypad2b() bxor $4F))
  if (boolbf band $4F) <>0 then  :goto paus0aend:end if
loop
paus0aend:

'------------
gameplay:

'paper 6:border 0:ink 0:bright 1

'- cls
smsfilvrm($1800,$20,768)

xp=4:yp=4:xs=16:ys=12:ds=0:fs=0
kr=0:kg=0:kb=0:er=0:eg=0:eb=0

gosub displaymap01
puttilesprite1(xs,ys,fs,ds)

do
while (er+(eg*2)+(eb*4))<>7:

jacum=( (cvjoypad1a() bxor $F) bor ( cvjoypad2a() bxor $F) )band $F


'-left
if ((jacum band 8)<>0) and ((attrpointb(xs-1,ys)=32 and attrpointb(xs-1,ys+2)=32) or xs=0) then:
  puttilesprite1(xs,ys,0,2)
  xs=xs-1:ds=1:fs=fs bxor 1
  if xs<0 then:xs=29:xp=xp-1:gosub displaymap01:end if
  puttilesprite1(xs,ys,fs,ds)
  end if

'-right
if ((jacum band 2)<>0) and ((attrpointb(xs+3,ys)=32 and attrpointb(xs+3,ys+2)=32 ) or xs=29) then:
  puttilesprite1(xs,ys,0,2)
  xs=xs+1:ds=0:fs=fs bxor 1
  if xs>29 then:xs=0:xp=xp+1:gosub displaymap01:end if
  puttilesprite1(xs,ys,fs,ds)
  end if

'-up
if ((jacum band 1)<>0) and ((attrpointb(xs,ys-1)=32 and attrpointb(xs+2,ys-1)=32) or ys=0) then:
  puttilesprite1(xs,ys,0,2)
  ys=ys-1:fs=fs bxor 1
  if ys<0 then:ys=21:yp=yp-1:gosub displaymap01:end if
  puttilesprite1(xs,ys,fs,ds)
  end if

'-down
if ((jacum band 4)<>0) and ((attrpointb(xs,ys+3)=32 and attrpointb(xs+2,ys+3)=32 ) or ys=21) then:
  puttilesprite1(xs,ys,0,2)
  ys=ys+1:fs=fs bxor 1
  if ys>21 then:ys=0:yp=yp+1:gosub displaymap01:end if
  puttilesprite1(xs,ys,fs,ds)
  end if

if int((xs+1)/2)=8 and int((ys+1)/2)=6 then
  if xp=0 and yp=0 then:kg=1:puttilesprite1(15,11,2,0):puttilesprite1(xs,ys,fs,ds):end if: '- green key
  if xp=7 and yp=0 then:er=1:puttilesprite1(15,11,2,0):puttilesprite1(xs,ys,fs,ds):end if: '- red egg
  if xp=4 and yp=1 then:kb=1:puttilesprite1(15,11,2,0):puttilesprite1(xs,ys,fs,ds):end if: '- blue key
  if xp=3 and yp=7 then:eb=1:puttilesprite1(15,11,2,0):puttilesprite1(xs,ys,fs,ds):end if: '- blue egg
  if xp=4 and yp=6 then:kr=1:puttilesprite1(15,11,2,0):puttilesprite1(xs,ys,fs,ds):end if: '- red key
  if xp=7 and yp=7 then:eg=1:puttilesprite1(15,11,2,0):puttilesprite1(xs,ys,fs,ds):end if: '- green egg
  end if

asm
  halt
  halt
  halt
  end asm

''print at 3,1;attrpoint(xs-1,ys);"   "

'if (er+(eg*2)+(eb*4))<>7 then:loop:end if

end while

'pause 200

loop

do:loop

'--------------------------------------

displaymap01:

'- cls
smsfilvrm($1800,$20,768)

for y0=0 to 11:for x0=0 to 1
  v0=peek(@map01+(xp*2)+x0+(y0*16)+(yp*192))
  vpoketiles(x0,y0,v0)
  next:next

if debug=1 then:
'  print at 1,1;xp
'  print at 2,1;yp
  end if

if (xp=0 and yp=0) and kg=0 then:puttilesprite2(15,11,1,$3B):end if: '- green key
if (xp=7 and yp=0) and er=0 then:puttilesprite2(15,11,0,$8B):end if: '- red egg
if (xp=4 and yp=1) and kb=0 then:puttilesprite2(15,11,1,$5B):end if: '- blue key
if (xp=3 and yp=7) and eb=0 then:puttilesprite2(15,11,0,$5B):end if: '- blue egg
if (xp=4 and yp=6) and kr=0 then:puttilesprite2(15,11,1,$8B):end if: '- red key
if (xp=7 and yp=7) and eg=0 then:puttilesprite2(15,11,0,$3B):end if: '- green egg

if (xp=4 and yp=4) and kb=0 then:drawdoorrdmatt(1,22,30,22,@rnblu):end if: '- blue door
if (xp=6 and yp=1) and kr=0 then:drawdoorrdmatt(30,1,30,22,@rnred):end if: '- red door
if (xp=5 and yp=7) and kg=0 then:drawdoorrdmatt(30,1,30,22,@rngre):end if: '- green door

'''if (xp=4 and yp=4) and kb=0 then:drawdoor(1,22,30,22,%01001111):end if: '- blue door
'''if (xp=6 and yp=1) and kr=0 then:drawdoor(30,1,30,22,%01010111):end if: '- red door
'''if (xp=5 and yp=7) and kg=0 then:drawdoor(30,1,30,22,%01100111):end if: '- green door

'''print at 3,1;attrpoint(xs-1,ys)

return

'-------------------------------

displaytitle01:

'- cls
smsfilvrm($1800,$20,768)

for y0=0 to 11:for x0=0 to 1
  vpoketiles(x0,y0,255)
  next:next

sg1000writetext(2,19,@text01,@text01end-@text01) 'print at 19,2;" H7N9 "
sg1000writetext(2,20,@text02,@text02end-@text02) 'print at 20,2;" PAULO SILVA, 2015 "
sg1000writetext(2,22,@text03,@text03end-@text03) 'print at 22,2;" PUSH ANY KEY "

'puttilesprite1( 2,2,0,0)  '-apagar
'puttilesprite1( 6,2,1,0)  '-apagar
'puttilesprite1(10,2,0,1)  '-apagar
'puttilesprite1(14,2,1,1)  '-apagar
'puttilesprite1(18,2,0,2)  '-apagar
'puttilesprite2( 2,6,0,$1F)  '-apagar
'puttilesprite2( 6,6,1,$5B)  '-apagar

return

'-------------------------------

do:loop

'-------------------------------

text01:
asm
  defb " H7N9 "
  end asm
text01end:
text02:
asm
  defb " PAULO SILVA, '16,'15 "
  end asm
text02end:
text03:
asm
  defb " PUSH ANY BUTTON "
  end asm
text03end:

'-------------------------------

tiles01:
asm
  defb $00,$01,$02
  defb $03,$04,$05
  defb $06,$07,$08

  defb $09,$0A,$0B

  defb $0C,$0D,$0E
  defb $0F,$10,$11
  defb $12,$13,$14

  defb $15,$16,$17

  defb $20,$20,$20
  defb $20,$20,$20
  defb $20,$20,$20
  end asm

tiles02:
asm
  defb $18,$19
  defb $1A,$1B

  defb $1C,$1D
  defb $1E,$1F
  end asm

'-------------------------------

rnatr:
rnred:
asm
  defb $16,$E6,$18,$F8
  end asm
rngre:
asm
  defb $1C,$EC,$12,$F2
  end asm
rnblu:
asm
  defb $14,$E4,$15,$F5
  end asm

'--------------------------------------

