#include "library/aquariusfillram.bas"
#include "library/minivadersldir32b.bas"
#include "library/mc1000screen.bas"
#include "library/mc1000cls.bas"
#include "library/mc1000vpokechr.bas"
#include "library/charmap_solitario_mc1000.bas"
#include "library/mc1000rnd.bas"
#include "library/mc1000delayb.bas"
#include "library/mc1000keymapupdate.bas"
#include "library/decuint2stradr.bas"
#include "library/binubyte2stradr.bas"
#include "library/mc1000keymapinv.bas"

'- solitario - jun'05,oct'12 - paulo silva - rev 20120831103509
'- based on a zxspectrum version for the csscgc2011 competition, hosted by mojon twins
'- based on the msx version for the karoshi's msxbasic competition at winter'06

dim p1,p2,s1,s2,vl as integer
dim rseed as uinteger
dim ee0,ee1,ee2,ee3 as uinteger

dim i,x,y,ch,se,sl,pf,gv,pa,je,ka,cn,tf,tt as integer
dim px,py,ox,oy,dx,dy,sx,sy,x1,y1,x2,y2 as integer
dim mx,my as float
dim timecount as integer
dim a(7,7) as integer
dim t(10) as long
''dim u$(10):dim r$(10) '- ?????
dim stick, button1 as ubyte
dim debug as ubyte
debug=1

dim tflp1 as uinteger
sub mc1000vpprintpk(tloc1 as uinteger,tchm1 as uinteger,ttex1 as uinteger,tlng1 as uinteger)
  for tflp1=0 to tlng1-1
    mc1000vpokechr(tloc1+tflp1,peek(ttex1+tflp1),tchm1)
    next

  end sub

mc1000screen(154)
mc1000cls(0)

'-----------------------------------------------------------------------
'gamestartup: '----- game system startup -----
'-----  some game arrays
dim h$(10)
h$(0)="PORCOROSSO":h$(1)="TOTORO":h$(2)="CHIHIRO":h$(3)="HEIDI":h$(4)="KONAN"
h$(5)="GHIBLI":h$(6)="MONONOKE":h$(7)="NAUSICAA":h$(8)="LUPIN":h$(9)="UNKNOWN"

dim qa(9) as ubyte => {2,2,3,4,4,4,5,5,7,9}
dim qb(9) as ubyte => {108,128,119,104,106,111,105,117,141,112}

'?
'for i=0 to 9
'  let t(i)=(qa(i)*72000)+(qb(i)*60)
''  let r$(i)=str$(qa(i))
'  next
''for i=0 to 9
''  let u$(i)=chr$(int(t(i)/36000)mod 2+48)+chr$(int(t(i)/3600)mod 10+48)+chr$(39)
''  let u$(i)=u$(i)+chr$(int(t(i)/600)mod 6+48)+chr$(int(t(i)/60)mod 10+48)+chr$(34)
''  next

gametitle: '----- game title --------------
mc1000cls(0)  'cls

if debug<>0 then
for ee0=0 to 5
  for ee1=0 to 15
    mc1000vpokechr((ee0+1)*32+ee1+15,ee0*16+ee1,@charmap01-128)
    next:next
end if

timecount=0

mc1000vpprintpk((12*32+3),@charmap01-128,@text02,23)        'print at 12,3;"BY PAULO SILVA, '05,'11"
mc1000vpprintpk((21*32+3),@charmap01-128,@text03,14)        'print at 21,3;"PUSH SPACE KEY"
mc1000vpprintpk((14*32+0),@charmap01-344,@text04,192)       '-384'

gametitledelay:
eb0=mc1000keymapinv(1) bor mc1000keymapinv(2) bor (mc1000keymapinv(4) bor mc1000keymapinv(8))
eb0=mc1000keymapinv(16) bor mc1000keymapinv(32) bor (mc1000keymapinv(64) bor mc1000keymapinv(128)) bor eb0
if eb0<>0 then:goto gameplay:end if

timecount=timecount+1
mc1000delayb(20)
if timecount<600 then: goto gametitledelay:end if

scoretable: '----- score table -------------
mc1000cls(0)
timecount=0

'- corrigir
'print at 9,4;"HISCORES     REST TIME"
mc1000vpprintpk((9*32+4),@charmap01-128,@text05,8)
mc1000vpprintpk((9*32+17),@charmap01-128,@text05+8,4)
mc1000vpprintpk((9*32+22),@charmap01-128,@text05+12,4)

'if ch=1 then:mc1000vpokechr(0,33,@charmap01-128):end if '?

scoretabledelay:
let i=int(timecount/15)-1
if i>=0 and i<10 then:
   mc1000vpprintpk(((i+11)*32+4),@charmap01-128,@texthisc01+(i*12),12) 'print at i+11,4;h$(i)
   mc1000vpprintpk(((i+11)*32+17),@charmap01-128,@text03,5)            'print at i+11,17;r$(i)
   mc1000vpprintpk(((i+11)*32+22),@charmap01-128,@text03,5)            'print at i+11,22;u$(i)
  end if

timecount=timecount+1
mc1000delayb(20)

'if inkey$<>"" or timecount>=600 then: goto gametitle:end if
eb0=mc1000keymapinv(1) bor mc1000keymapinv(2) bor (mc1000keymapinv(4) bor mc1000keymapinv(8))
eb0=mc1000keymapinv(16) bor mc1000keymapinv(32) bor (mc1000keymapinv(64) bor mc1000keymapinv(128)) bor eb0
if eb0<>0 or timecount>=600 then:goto gametitle:end if

goto scoretabledelay

gameplay:
mc1000cls(0)
timecount=0

'if ch=1 then:mc1000vpokechr(0,33,@charmap01-128):end if  '?

drawingbackground:
sx=6:sy=6
vp=sx+(sy*32)

for y=0 to 3:mc1000vpprintpk(((y+sy-1)*32+sx+3),@charmap01-336,@text05+16,7):next
for y=4 to 10:mc1000vpprintpk(((y+sy-1)*32+sx-1),@charmap01-336,@text05+16,15):next
for y=11 to 14:mc1000vpprintpk(((y+sy-1)*32+sx+3),@charmap01-336,@text05+16,7):next

mc1000vpprintpk((5*32+22),@charmap01-128,@text08,4)    'print at 5,22;"TIME":
mc1000vpprintpk((8*32+22),@charmap01-128,@text08+4,4)  'print at 8,22;"REST"

gosub restartboard
px=3:py=3:ox=3:oy=3:se=0:sl=0:pf=0
gosub arraytodisplay
gosub restartboard
let pf=1
gosub arraytodisplay
gv=0:pa=32:je=0
timecount=0:tt=timecount
gosub displaytimer
x1=0:y1=0:x2=6:y2=6:kprs=0

gameloop:
mc1000delayb(20)

stick=(mc1000keymapinv(128) band 4)/4 bor (mc1000keymapinv(8) band 4)/2 bor (mc1000keymapinv(2) band 1)*4 bor (mc1000keymapinv(16) band 1)*8 '- wsad   '- considerar joysticks

if je=1 and stick=0 then:let je=0:end if
if je=0 and stick<>0 then:
  gosub cursormotion
  end if

'- cursor
mc1000vpprintpk( ((sy+(py*2))*32)+sx+(px*2)-33 ,@charmap01-320,@text01a,3) 'print at sy+(py*2)-1,sx+(px*2)-1;"\C\D\E"
mc1000vpokechr( ((sy+(py*2))*32)+sx+(px*2)-1 ,7,@charmap01+32)             'print at sy+(py*2),sx+(px*2)-1;"\F"
mc1000vpokechr( ((sy+(py*2))*32)+sx+(px*2)+1 ,8,@charmap01+32)             'print at sy+(py*2),sx+(px*2)+1;"\G"
mc1000vpprintpk( ((sy+(py*2))*32)+sx+(px*2)+31 ,@charmap01-280,@text01a,3) 'print at sy+(py*2)+1,sx+(px*2)-1;"\H\I\J"

'rem --- updating time display --- :let sq=sti(0) -?
qq=tt:tt=timecount
if (int(qq/60))<>(int(tt/60)) then:gosub displaytimer:end if

button1=(mc1000keymapinv(32) band 2)/2
if button1<>0 and se=0 then:     'if inkey$=" " and se=0 then:
  let se=1:gosub refreshandcheck
  end if
if button1=0 and se=0 then:     'if inkey$<>" " then:
  let se=0
  end if

'- procurar equivalente para 'esc'
'if inkey$=chr$(27) then:goto scorewrite:end if

if gv=1 then gosub gameover:goto scorewrite:end if

timecount=timecount+1
goto gameloop
'
refreshandcheck:   '- some display refresh and check? ---
if sl=0 and a(px,py)=1 then:
  a(px,py)=2:ox=px:oy=py:sl=1
  mc1000vpokechr(((py*2)+sy)*32+((px*2)+sx),7,@charmap01)  'print at (py*2)+sy,(px*2)+sx;ink 6;paper 5;bright 1;"\B"
  return
  end if
if sl=1 and a(px,py)=2 then:
  a(px,py)=1:ox=px:oy=py:sl=0
  mc1000vpokechr(((py*2)+sy)*32+((px*2)+sx),code("Z"),@charmap01-128)  'print at (py*2)+sy,(px*2)+sx;ink 2;paper 5;bright 1;"\B"
  return
  end if
dx=abs(px-ox):dy=abs(py-oy)
mx=(ox+px)/2:my=(oy+py)/2
zz=((dx=0 and dy=2) and (a(mx,my)=1)) or ((dx=2 and dy=0) and (a(mx,my)=1))
if sl=1 and a(px,py)=0 then:
  if zz then:
    a(mx,my)=0:a(ox,oy)=0:a(px,py)=1:sl=0
    mc1000vpokechr(((my*2)+sy)*32+((mx*2)+sx),0,@charmap01)    'print at (my*2)+sy,(mx*2)+sx;ink 0;paper 5;bright 1;"\A"
    mc1000vpokechr(((oy*2)+sy)*32+((ox*2)+sx),0,@charmap01)    'print at (oy*2)+sy,(ox*2)+sx;ink 0;paper 5;bright 1;"\A"
    mc1000vpokechr(((py*2)+sy)*32+((px*2)+sx),1,@charmap01)    'print at (py*2)+sy,(px*2)+sx;ink 2;paper 5;bright 1;"\B"
    let pa=pa-1
    gosub checkpossiblemotions
    gosub displaytimer
    end if
  end if
return

gameover: '- game over - some delay before writing name --------------------------
timecount=0

mc1000vpprintpk((18*32+22),@charmap01-128,@text01+32,7)  'print at 18,22;"NO MORE"
mc1000vpprintpk((19*32+22),@charmap01-128,@text01+40,5)  'print at 19,22;"MOVES!"

gameoverdelay:
timecount=timecount+1
if timecount<200 then
  goto gameoverdelay
  end if
return

restartboard:  '- restarting the board array values (i must check if its true) -------------------------
for y=0 to 6:for x=0 to 6
  a(x,y)=1
  next:next
for y=5 to 8:for x=5 to 8
  a((x mod 7),(y mod 7))=3
  next:next
a(3,3)=0:return

arraytodisplay: '- i forgot what this does --- transfers array pieces to display? -------------------------------
for y=0 to 6:for x=0 to 6
  if a(x,y)<3 then:
    mc1000vpokechr(((y*2)+sy)*32+((x*2)+sx),5,@charmap01)    'print at (y*2)+sy,(x*2)+sx;ink 0;paper 5;bright 1;"\A" :'- <- verificar udg,ink,paper,bright
    end if
  if a(x,y)<3 and pf=1 then:
    if a(x,y)=0 then:
      mc1000vpokechr(((y*2)+sy)*32+((x*2)+sx),5,@charmap01)'      'print at (y*2)+sy,(x*2)+sx;ink 0;paper 5;bright 1;"\A"
      end if
    if a(x,y)=1 then:
      mc1000vpokechr(((y*2)+sy)*32+((x*2)+sx),6,@charmap01)      'print at (y*2)+sy,(x*2)+sx;ink 2;paper 5;bright 1;"\B"
      end if
    if a(x,y)>1 then:
      mc1000vpokechr(((y*2)+sy)*32+((x*2)+sx),7,@charmap01)      'print at (y*2)+sy,(x*2)+sx;ink 6;paper 5;bright 1;"\B"
      end if
    end if
  next:next

return

cursormotion: '- cursor motion -----------------------------------------
je=1
stick=(mc1000keymapinv(128) band 4)/4 bor (mc1000keymapinv(8) band 4)/2 bor (mc1000keymapinv(2) band 1)*4 bor (mc1000keymapinv(16) band 1)*8 '- wsad '- considerar joysticks

'- mostrar binário do teclado

verifystickvalue:
erasecursor:
mc1000vpprintpk( ((sy+(py*2))*32)+sx+(px*2)-33 ,@charmap01-336,@texterasecursor01,3)    'print at sy+(py*2)-1,sx+(px*2)-1;"   "
mc1000vpokechr( ((sy+(py*2))*32)+sx+(px*2)-1 ,code("."),@charmap01-336)                 'print at sy+(py*2),sx+(px*2)-1;" "
mc1000vpokechr( ((sy+(py*2))*32)+sx+(px*2)+1 ,code("."),@charmap01-336)                 'print at sy+(py*2),sx+(px*2)+1;" "
mc1000vpprintpk( ((sy+(py*2))*32)+sx+(px*2)+31 ,@charmap01-336,@texterasecursor01+5,3)  'print at sy+(py*2)+1,sx+(px*2)-1;"   ";

'- corrigir
'if debug=1 then:print at 1,1;"PX:";px;",PY:";py;" ":end if : pause 1: rem <- debug -----

kprs=0    '- <---
if kprs=0 and stick=1 then: kprs=1:py=py-1:end if
if kprs=0 and stick=2 then: kprs=1:py=py+1:end if
if kprs=0 and stick=4 then: kprs=1:px=px-1:end if
if kprs=0 and stick=8 then: kprs=1:px=px+1:end if
'if kprs<>0 and stick=0 then:kprs=0:end if :'- <--???? manter?

if px<x1 then:px=x2:end if
if px>x2 then:px=x1:end if
if py<y1 then:py=y2:end if
if py>y2 then:py=y1:end if

y1=0:y2=6:x1=0:x2=6
if px<2 then:x1=0:x2=6:y1=2:y2=4:end if
if px>4 then:x1=0:x2=6:y1=2:y2=4:end if
if py<2 then:y1=0:y2=6:x1=2:x2=4:end if
if py>4 then:y1=0:y2=6:x1=2:x2=4:end if

'if debug=1 then:print at 1,1;"PX:";px;",PY:";py;" ":end if : rem <- debug -----
if debug=1 then:
  'print at 1,1;"PX:";px;",PY:";py;" ":
  mc1000vpprintpk((1*32+1),@charmap01-128,@textdebug02,@textdebug03-@textdebug02)
  mc1000vpokechr((1*32+4),48+(px mod 10),@charmap01-128)
  mc1000vpokechr((1*32+9),48+(py mod 10),@charmap01-128)
  end if

'if debug=1 then:print at 2,1;"SX:";sx;",SY:";sy;" ":end if : rem <- debug -----
if debug=1 then:
  'print at 1,1;"SX:";sx;",SY:";sy;" ":
  mc1000vpprintpk((2*32+1),@charmap01-128,@textdebug03,@textdebug04-@textdebug03)
  mc1000vpokechr((2*32+4),48+(sx mod 10),@charmap01-128)
  mc1000vpokechr((2*32+9),48+(sy mod 10),@charmap01-128)
  end if

'if debug=1 then:print at 3,1;"OX:";ox;",OY:";oy;" ":end if : rem <- debug -----
if debug=1 then:
  'print at 1,1;"OX:";ox;",OY:";oy;" ":
  mc1000vpprintpk((3*32+1),@charmap01-128,@textdebug04,@textdebug05-@textdebug04)
  mc1000vpokechr((3*32+4),48+(ox mod 10),@charmap01-128)
  mc1000vpokechr((3*32+9),48+(oy mod 10),@charmap01-128)
  end if

'if debug=1 then:print at 1,11;"X1:";x1;",Y1:";y1;" ":end if : rem <- debug -----
if debug=1 then:
  'print at 1,1;"X1:";x1;",Y1:";y1;" ":
  mc1000vpprintpk((1*32+11),@charmap01-128,@textdebug05,@textdebug06-@textdebug05)
  mc1000vpokechr((1*32+14),48+(x1 mod 10),@charmap01-128)
  mc1000vpokechr((1*32+19),48+(y1 mod 10),@charmap01-128)
  end if

'if debug=1 then:print at 2,11;"X2:";x2;",Y2:";y2;" ":end if : rem <- debug -----
if debug=1 then:
  'print at 1,1;"X2:";x2;",Y2:";y2;" ":
  mc1000vpprintpk((2*32+11),@charmap01-128,@textdebug06,@textdebug07-@textdebug06)
  mc1000vpokechr((2*32+14),48+(x2 mod 10),@charmap01-128)
  mc1000vpokechr((2*32+19),48+(y2 mod 10),@charmap01-128)
  end if

'if debug=1 then:print at 3,11;stick;"  ":end if : rem <- debug -----
  'decuint2stradr(px,@decuibuffer01)
  'mc1000vpprintpk((1*32+1),@charmap01-128,@decuibuffer01,5)

return

checkpossiblemotions:  '- checking for possible motions ---------------------------------
if ch=1 then:return:end if
let ck=0

mc1000vpprintpk((19*32+22),@charmap01-128,@text01+48,7)   'print at 19,22;"WAIT..."

for x=2 to 4:for y=0 to 4
  let v1=a(x,y)*4+a(x,y+1)*2+a(x,y+2)
  let v2=a(y,x)*4+a(y+1,x)*2+a(y+2,x)
  if v1=3 or v1=6 or v2=3 or v2=6 then:let ck=ck+1:end if
  next:next
for x=5 to 8:
  let xm=x mod 7
  let v1=a(x,2)*4+a(x,3)*2+a(x,4)
  let v2=a(2,x)*4+a(3,x)*2+a(4,x)
  if v1=3 or v1=6 or v2=3 or v2=6 then:ck=ck+1:end if
  next
if ck=0 then:let gv=1:end if

'if debug=1 then: print at 0,0;"CK:";ck;",GV:";gv;".": end if: rem -> debug!

'rem ck=at least possible motions, gv=game over on
'print at 19,22;"       "
return

displaytimer: '- displaying timer ----------------------------------- corrigir
qq=tt
tt=timecount
''k$=chr$(int(tt/36000)mod 2+48)+chr$(int(tt/3600)mod 10+48)+chr$(39)
''k$=k$+chr$(int(tt/600)mod 6+48)+chr$(int(tt/60)mod 10+48)+chr$(34)
''print at 6,23;k$
''print at 9,23;str$(pa);" "
return

scorewrite: '----- score write ------------------------------------
'mc1000cls(1)
timecount=0
''l$=""
'if ch=1 then:print at 0,0;"!":end if
let tf=tt+(pa*72000)
'rem if cn=0 then:goto scoretable:end if
''print at 9,4;"YOUR NAME:"
'
textinput: '- text input loop ---------------------------------
''k$=inkey$
''kl=len(k$)
''ka=code(k$)
''if ka>31 and ka<96 and len(l$)<10 then:let l$=l$+k$:end if
''if ka>95 and ka<127 and len(l$)<10 then:let l$=l$+chr$(code(k$)-32):end if
'
''if (ka=8 or ka=29) and len(l$)>0 then
''  'let l$=left$(l$,len(l$)-1)
''  let l$=l$(to len(l$)-1)
''  end if

if ka=13 then:goto 5200:end if

'print at 11,4;l$;"   ":
'print at 20,4;"TIME:";29-int(peek(uinteger,timecount)/60);"  "

'rem putsprite 0,(28+len(l$)*8,84),7,0 <- substituir por 8 udgs - ??????
'ink 1:paper 5:bright 1
'print at sy+(py*2)-1,sx+(px*2)-1;"\C\D\E":print at sy+(py*2),sx+(px*2)-1;"\F"
'print at sy+(py*2),sx+(px*2)+1;"\G":print at sy+(py*2)+1,sx+(px*2)-1;"\H\I\J"
'ink 0:paper 7:bright 0

'if timecount<1790 then:goto textinput:end if

'- finding hiscore hole for current score -
5200:
iq=10
for i=9 to 0 step -1
if tf<t(i) then:let iq=iq-1:end if
next
if iq>9 then:goto scoretable:end if

'- moving worst scores down
movingworstscoresdown:
5300:
''for i=8 to iq step -1:let h$(i+1)=h$(i):let u$(i+1)=u$(i):let t(i+1)=t(i):let r$(i+1)=r$(i):next i
''h$(iq)=l$:let t(iq)=tf:let r$(iq)=str$(pa)
''u$(iq)=chr$(int(t(iq)/36000)mod 2+48)
''u$(iq)=u$(iq)+chr$(int(t(iq)/3600)mod 10+48)+chr$(39)
''u$(iq)=u$(iq)+chr$(int(t(iq)/600)mod 6+48)
''u$(iq)=u$(iq)+chr$(int(t(iq)/60)mod 10+48)
''u$(iq)=u$(iq)+chr$(34)
goto scoretable

'----- end of game -------------


'showcharacters:
'mc1000vpokechr(5,34,@charmap01-128)
'for ee0=0 to 7
'  for ee1=0 to 15
'    mc1000vpokechr((ee0+4)*32+ee1+15,ee0*16+ee1,@charmap01-128)
'    next:next

do:loop

'----- strings -------------
goto text99
textdectmp:
asm
  defb "12345678"
  end asm

text01:
text02:
asm
  defb "BY PAULO SILVA, '05,'18"
  end asm
text03:
asm
  defb "PUSH SPACE KEY"
  end asm
text04:
asm
  defb "00000000000101000000000010000000"
  defb "00011100000100010000000000000000"
  defb "00010001110101011011011010111000"
  defb "00011101010101010001010010101000"
  defb "00000101010101010111010010101000"
  defb "00011101110101011111010010111000"
  end asm
text05:
asm
  defb "HISCORESRESTTIME................."
  end asm
text06:
asm
  defb "NO MORE MOVES...WAIT............."
  end asm
text01a:
text07:
asm
  defb "012..."
  end asm
text08:
asm
  defb "TIMEREST"
  end asm
text09:


textbinout01:
asm
  defb "01234567"
  end asm
texthisc01:
asm
  defb "PORCOROSSO.."
  defb "TOTORO......"
  defb "CHIHIRO....."
  defb "HEIDI......."
  defb "KONAN......."
  defb "GHIBLI......"
  defb "MONONOKE...."
  defb "NAUSICAA...."
  defb "LUPIN......."
  defb "UNKNOWN....."
  end asm
texterasecursor01:
asm
  defb "........  "
  defb "ABCDEFGH"
  end asm

textdebug01:
asm
  defb "DEBUG"
  end asm
textdebug02:
asm
  defb "PX: ,PY: "
  end asm
textdebug03:
asm
  defb "SX: ,SY: "
  end asm
textdebug04:
asm
  defb "OX: ,OY: "
  end asm
textdebug05:
asm
  defb "X1:0,Y1:0"
  end asm
textdebug06:
asm
  defb "X2:0,Y2:0"
  end asm
textdebug07:


decuibuffer01:
asm
  defb "12345"
  end asm
text99:
