rem Tangram
rem copyright Marc Gale (Xalthorn) 2002

rem #####################################################
gosub initialise
gosub mainloop
exit

rem #####################################################
label mainloop
 repeat
  for shape=1 to ms
   complete=0
   curpiece=1
   gosub resetpieces
   repeat
    gosub flipscreen
    clear window
    gosub drawshape
    gosub drawpieces
    gosub processinput
   until (complete=1)

   gosub flipscreen
   clear window
   gosub drawshape
   gosub drawpieces
   setdispbuf curbuf

   repeat
    joypad=peek("port1")
   until (joypad=0)

   poke "textalign","cc"
   setrgb 1,0,0,0
   for y=-2 to 2
    for x=-2 to 2
     text x,y,"Shape completed, well done"
     text x,y+20,"Press X for the next shape"
    next x
   next y
   setrgb 1,255,255,255
   text 0,0,"Shape completed, well done"
   text 0,20,"Press X for the next shape"

   repeat
    joypad=peek("port1")
   until (and(joypad,16384)>0)
  next shape
 until (1=2)
return

rem #####################################################
label processinput
 joypad=peek("port1")

 if and(joypad,16)>0 then
  if piecey(curpiece)>-256 then
   piecey(curpiece)=piecey(curpiece)-2
  fi
 fi

 if and(joypad,32)>0 then
  if piecex(curpiece)<320 then
   piecex(curpiece)=piecex(curpiece)+2
  fi
 fi

 if and(joypad,64)>0 then
  if piecey(curpiece)<256 then
   piecey(curpiece)=piecey(curpiece)+2
  fi
 fi

 if and(joypad,128)>0 then
  if piecex(curpiece)>-320 then
   piecex(curpiece)=piecex(curpiece)-2
  fi
 fi

 if and(joypad,1024)>0 then
  piecer(curpiece)=piecer(curpiece)-1
  if piecer(curpiece)<0 then
   piecer(curpiece)=piecer(curpiece)+360
  fi
 fi

 if and(joypad,2048)>0 then
  piecer(curpiece)=piecer(curpiece)+1
  if piecer(curpiece)>360 then
   piecer(curpiece)=piecer(curpiece)-360
  fi
 fi

 if and(joypad,32768)>0 then
  curpiece=curpiece-1
  if curpiece=0 then curpiece=7 fi
  repeat
   jp=peek("port1")
  until (and(jp,32768)=0)
 fi

 if and(joypad,8192)>0 then
  curpiece=curpiece+1
  if curpiece=8 then curpiece=1 fi
  repeat
   jp=peek("port1")
  until (and(jp,8192)=0)
 fi

 if and(joypad,16384)>0 then
  gosub checkpiece
 fi
return

rem #####################################################
label checkpiece
 correct=1

 if abs(piecex(curpiece)-shapex(shape,curpiece))>15 then
  correct=0
 fi

 if abs(piecey(curpiece)-shapey(shape,curpiece))>15 then
  correct=0
 fi

 if abs(piecer(curpiece)-shaper(shape,curpiece))>10 then
  correct=0
 fi

 if correct=1 then
  piecex(curpiece)=shapex(shape,curpiece)
  piecey(curpiece)=shapey(shape,curpiece)
  piecer(curpiece)=shaper(shape,curpiece)
  gosub checkdone
 fi
return

rem #####################################################
label checkdone
 done=1
 for a=1 to 7
  if piecex(a)<>shapex(shape,a) then
   done=0
  fi
  if piecey(a)<>shapey(shape,a) then
   done=0
  fi
  if piecer(a)<>shaper(shape,a) then
   done=0
  fi
 next a
 if done=1 then complete=1 fi
return

rem #####################################################
label resetpieces
 restore piecestart
 for a=1 to 7
  read piecer(a)
  read piecex(a)
  read piecey(a)
 next a
return

rem #####################################################
label drawpiece
 if np=3 then
  setrgb 1,r1,g1,b1
  fill triangle x(1),y(1) to x(2),y(2) to x(3),y(3)
  setrgb 1,r2,g2,b2
  triangle x(1),y(1) to x(2),y(2) to x(3),y(3)
 else
  setrgb 1,r1,g1,b1
  fill triangle x(1),y(1) to x(2),y(2) to x(3),y(3)
  fill triangle x(3),y(3) to x(4),y(4) to x(1),y(1)
  setrgb 1,r2,g2,b2
  line x(1),y(1) to x(2),y(2)
  line to x(3),y(3)
  line to x(4),y(4)
  line to x(1),y(1)
 fi
 if a=curpiece then
  circle x(3),y(3),10
 fi
return

rem #####################################################
label drawpieces
 for a=1 to 7
  r1=200:g1=100:b1=100
  r2=200:g2=0:b2=0
  angle=piecer(a)
  for b=1 to 4
   x(b)=basex(a,b)
   y(b)=basey(a,b)
   xx=x(b)*cosines(angle)-y(b)*sines(angle)
   yy=x(b)*sines(angle)+y(b)*cosines(angle)
   x(b)=xx+piecex(a)
   y(b)=yy+piecey(a)
  next b
  np=basep(a)
  gosub drawpiece
 next a

 a=curpiece
 r1=200:g1=0:b1=0
 r2=200:g2=0:b2=0
 angle=piecer(a)
 for b=1 to 4
  x(b)=basex(a,b)
  y(b)=basey(a,b)
  xx=x(b)*cosines(angle)-y(b)*sines(angle)
  yy=x(b)*sines(angle)+y(b)*cosines(angle)
  x(b)=xx+piecex(a)
  y(b)=yy+piecey(a)
 next b
 np=basep(a)
 gosub drawpiece
return

rem #####################################################
label drawshape
 for a=1 to 7
  if a=curpiece then
   r1=0:g1=0:b1=200
   r2=0:g2=0:b2=100
  else
   r1=100:g1=100:b1=200
   r2=0:g2=0:b2=100
  fi
  angle=shaper(shape,a)
  for b=1 to 4
   x(b)=basex(a,b)
   y(b)=basey(a,b)
   xx=x(b)*cosines(angle)-y(b)*sines(angle)
   yy=x(b)*sines(angle)+y(b)*cosines(angle)
   x(b)=xx+shapex(shape,a)
   y(b)=yy+shapey(shape,a)
  next b
  np=basep(a)
  gosub drawpiece
 next a

 r1=0:g1=0:b1=200
 r2=0:g2=0:b2=100
 a=curpiece
 angle=shaper(shape,a)
 for b=1 to 4
  x(b)=basex(a,b)
  y(b)=basey(a,b)
  xx=x(b)*cosines(angle)-y(b)*sines(angle)
  yy=x(b)*sines(angle)+y(b)*cosines(angle)
  x(b)=xx+shapex(shape,a)
  y(b)=yy+shapey(shape,a)
 next b
 np=basep(a)
 gosub drawpiece
return

rem #####################################################
label flipscreen
 setdispbuf curbuf 
 curbuf=1-curbuf
 setdrawbuf curbuf
return

rem #####################################################
label initialise
 open window 640,512
 curbuf=0
 window origin "cc"
 setrgb 0,50,100,50

 sc=30
 dim basep(7)
 dim basex(7,4)
 dim basey(7,4)
 dim piecer(7)
 dim piecex(7)
 dim piecey(7)
 restore piecedata
 for a=1 to 7
  read basep(a)
  for b=1 to basep(a)
   read x,y
   basex(a,b)=x*sc
   basey(a,b)=y*sc
  next b
 next a

 dim x(4),y(4)

 ms=5
 dim shaper(ms,7)
 dim shapex(ms,7)
 dim shapey(ms,7)
 restore shapedata
 for a=1 to ms
  for b=1 to 7
   read shaper(a,b)
   read x,y
   shapex(a,b)=x*sc
   shapey(a,b)=y*sc
  next b
 next a

 dim cosines(720)
 dim sines(720)
 for angle=0 to 720
  cosines(angle)=cos(angle*(pi/180))
  sines(angle)=sin(angle*(pi/180))
 next angle
return

label piecedata
data 3,-2,4,-2,-4,2,0
data 3,-4,2,0,-2,4,2
data 4,-3,-1,1,-1,3,1,-1,1
data 3,-2,-1,2,-1,0,1
data 4,-2,0,0,-2,2,0,0,2
data 3,-3,-1,1,-1,1,3
data 3,-1,0,1,-2,1,2

label shapedata
rem square
data 0,-2,0,0,0,2,0,-1,-3,0,0,-1
data 0,2,0,0,3,-3,0,3,2

rem rocket
data 0,0,2
data 270,0,-2
data 0,1,7
data 180,-2,7
data 0,0,-6
data 90,1,5
data 180,-1,-4

rem swan
data 45,-1,3,180,-3.6,0.7,90,0.2,-5.4
data 270,2.2,-6.3,0,1.2,-2.4
data 45,1.85,1.6,0,2.25,-0.4

rem man
data 270,0,-2.5,315,-2.6,0.9,45,-5.44,2.3
data 315,0,-5.25,0,0,3.1,270,-1.7,-7
data 315,-1,5.5

rem boat
data 0,0,-2,0,2,0,0,-3,3,0,0,3
data 45,-4.6,0.6,225,0.6,-4.8
data 225,-3.9,-1.5

label piecestart
data 0,-250,-30
data 0,-190,180
data 0,-200,-220
data 0,30,-220
data 0,250,170
data 0,280,-220
data 0,280,0

