open window 640,512
U=16:D=64:L=128:R=32:X=16384:SQ=32768:TRI=4096:CIR=8192
R1=2048:R2=512:ST=8:L2=256:L1=1024:SEL=1

goto main

label new_screen
 setdrawbuf buf
 buf=1-buf
 setdispbuf buf

 setrgb 1,10,10,10
 setrgb 2,60,60,60
 setrgb 3,10,10,10
 gtriangle  0,  0 to 0,512 to 640,0
 setrgb 1,60,60,60
 gtriangle 640,512 to 0,512 to 640,0
return

label draw_status
'###- LIVE BAT -###
 setrgb 1,50,200-p(6,1)*10,50
 rect 48,500,148,490
 fill rect 48,500,48+p(7,1),490

 setrgb 1,80-p(6,2)*3,80-p(6,2)*3,30
 rect 198,500,298,490
 fill rect 198,500,198+p(7,2),490

 setrgb 1,50,50,200
 rect 348,500,448,490
 fill rect 348,500,348+p(7,3),490

 setrgb 1,200,200,50
 rect 497,500,597,490
 fill rect 497,500,497+p(7,4),490
return

label drive
 if p=1 k=peek("port1")
 if p=2 k=peek("port2")
 if p>=CPU then
  if p(7,p)>0 gosub CPU:goto CPU_in
  k=0
 fi

 if CPD=CN   goto game_over
 if p(7,p)<0 goto game_over

'###-ACCLERATION-###
 ss = 10+(abs(p(4,p))*5)

 p(4,p)=p(4,p) + and(k,X)/(X*ss) - and(k,SQ)/(SQ*ss)
 p(4,p)=max(p(4,p),-1) : p(4,p)=min(p(4,p),2)

 if p(4,p)>0 p(4,p)=p(4,p)-.009
 if p(4,p)<0 p(4,p)=p(4,p)+.008

'###-STEER-###
 ab=p(4,p)
 p(3,p)=p(3,p)+and(k,R)/R*ab-and(k,L)/L*ab
 p(3,p)=mod(p(3,p)+360,360)

'###-CANON ANGLE-###
 p(5,p)=p(5,p)+and(k,R)/R*ab-and(k,L)/L*ab
 p(5,p)=p(5,p)+and(k,R1)/(R1/3)-and(k,L1)/(L1/3)
 p(5,p)=mod(p(5,p)+360,360)

'###-SHOT-###
 if and(k,CIR)>0 p(6,p)=p(6,p)+.3

 if (and(k,CIR)<>CIR and p(6,p)>3)or(p(6,p)>15) then
  gosub new_shot
  p(6,p)=0
 endif

label CPU_in
'###-VERTICAL   VELOCITY-###
 p(1,p)=p(1,p) - p(4,p)*si(p(3,p))
'###-HORICONTAL VELOCITY-###
 p(2,p)=p(2,p) + p(4,p)*co(p(3,p))

 if p(7,p)>0 then
  if p(1,p) >640 p(1,p) = 1
  if p(1,p) <0   p(1,p) = 639

  if p(2,p) >512 p(2,p) = 1
  if p(2,p) <0   p(2,p) = 511
 endif
'###-RESET-###
 if k=ST gosub paused
 if k=SEL goto main
return


label new_shot
 if shot>=max_shot shot=0
 shot=shot+1

 s(1,shot) = p(1,p)-20*si(p(5,p)):rem X POS
 s(2,shot) = p(2,p)+20*co(p(5,p)):rem Y POS
 s(3,shot) = p(6,p)              :rem ACCLERATION
 s(4,shot) = p(5,p)              :rem ANGLE
return

label CPU
 k=0

 if p(7,p)<0 gosub DEAD
 if int(ran(20))=2 gosub search
'###-CHANGE ANGLE-###
 if p(3,p)<p(8,p) then
  p(3,p) = p(3,p) + p(4,p)*.5
 else
  p(3,p) = p(3,p) - p(4,p)*.5
 endif

 if p(5,p)<p(8,p) p(5,p) = p(5,p) + 3
 if p(5,p)>p(8,p) p(5,p) = p(5,p) - 3

 if p(5,p)<p(8,p)+2 and p(5,p)>p(8,p)-2 then
  if p(10,p)<=0 gosub new_shot
  p(10,p) = 50
 endif

 p(10,p) = p(10,p) - 1

'###-CHANGE SPEED-###
 if p(4,p)<p(9,p) then
  p(4,p)=p(4,p)+ .01
 else
  p(4,p)=p(4,p)-.008
 endif

 p(3,p)=mod(p(3,p)+360,360)
 p(5,p)=mod(p(5,p)+360,360)
return

label search
 PT=p(11,p) :rem WHICH PLAYER IS THE TARGET(1,2,3 or 4)

'###-ANGLE-###
 if abs(p(1,PT)-p(1,p))>80 then

  if p(2,PT)+40<p(2,p) then
    if p(1,PT)<p(1,p) p(8,p)=120
    if p(1,PT)>p(1,p) p(8,p)=225

   elsif p(2,PT)-40>p(2,p) then
    if p(1,PT)<p(1,p) p(8,p)= 45
    if p(1,PT)>p(1,p) p(8,p)=315

   else
    if p(1,PT)<p(1,p) p(8,p)= 90
    if p(1,PT)>p(1,p) p(8,p)=270

   endif
  else
   if p(1,PT)<p(1,p) p(8,p)=180
   if p(1,PT)>p(1,p) p(8,p)=360
 endif
'###-SPEED-###
 if abs(p(1,PT)-p(1,p))>140 or abs(p(2,PT)-p(2,p))>140 then
  p(9,p)=2 : p(6,p)=9
 else
  p(9,p)=.8: p(6,p)=4
 endif

'###-CHANGE TARGET-###
 if p(10,p)>40 then
  if p=2 then
   p(11,p)=1
   if abs(p(1,3)-p(1,p))>80 and p(7,3)>0 p(11,p)=3
   if abs(p(1,4)-p(1,p))>80 and p(7,4)>0 p(11,p)=4
  endif
  if p>2 then
   if abs(p(1,1)-p(1,p))>80 and p(7,1)>0 p(11,p)=1
   if abs(p(1,2)-p(1,p))>80 and p(7,2)>0 p(11,p)=2
  endif
 endif
return

label DEAD
 restore DEAD
 for arg=1 to 10
  read p(arg,p)
  data -100,-100,0,0,0,0,0,0,0,0,0
 next
 CPD=CPD+1
return

label explosives
 b=0:repeat:b=b+1

  if s(3,b) > 0 then
   s(3,b) = s(3,b) - .06

 on gamemode goto 1,2

1 if s(1,b) > 640 s(1,b) = 1
  if s(1,b) < 0   s(1,b) = 639
  if s(2,b) > 512 s(2,b) = 1
  if s(2,b) < 0   s(2,b) = 511
  goto 0

2 if s(1,b) > 640 goto 22
  if s(1,b) < 0   goto 22
  if s(2,b) > 512 goto 22
  if s(2,b) < 0   goto 22
  goto 0

22 s(4,b) = s(4,b) - 90
   s(4,b) = mod(s(4,b)+360,360)
0  rem DO NOTHING =)

  if s(5,b)>0 s(5,b)=s(5,b)-.1

  WS=-s(3,b)*si(s(4,b))
  VS= s(3,b)*co(s(4,b))

  s(1,b) = s(1,b) + WS
  s(2,b) = s(2,b) + VS
'###-SHOT COLLISION-###
  gosub check_shot_col

  setrgb 1,200,200,100
  line s(1,b),s(2,b),s(1,b)+WS,s(2,b)+VS

  endif
'###-EXPLOSIONS-###
  if s(3,b)<.2 and s(3,b)<>0 then
    s(3,b)=0
    ex(1,b)=s(1,b)
    ex(2,b)=s(2,b)
    ex(3,b)=30+ran(15)
  endif

  if ex(3,b) > 0 then
   gosub draw_explo
   gosub check_collision
  endif
 until(b=max_shot)
return

label check_shot_col
 p=0:repeat:p=p+1
'###- X AREA -###
 if (s(1,b)>px(1,p) and s(1,b)<px(3,p)) or (s(1,b)<px(1,p) and s(1,b)>px(3,p)) then
'###- Y AREA -###
 if (s(2,b)>py(1,p) and s(2,b)<py(3,p)) or (s(2,b)<py(1,p) and s(2,b)>py(3,p)) then
   s(3,b) = .1
 endif:endif
 until(p=pln)
return

label check_collision
 p=0:repeat:p=p+1

 if abs(ex(1,b)-p(1,p))<25 and abs(ex(2,b)-p(2,p))<25 then
   p(7,p) = p(7,p) - ex(3,b)*.05
 endif

 until(p=pln)
return

label draw_explo
 ex(3,b)=ex(3,b)-2
 ea=0

 setrgb 1,ex(3,b)*10,ex(3,b)*3,0
 setrgb 2,ex(3,b)*10,ex(3,b)*8,0
 setrgb 3,ex(3,b)*10,ex(3,b)*8,0

 repeat:ea=ea+60
 gtriangle ex(1,b),ex(2,b) to ex(1,b)+ex(3,b)*si(ea),ex(2,b)+ex(3,b)*co(ea) to ex(1,b)+ex(3,b)*si(ea+60),ex(2,b)+ex(3,b)*co(ea+60)
 until(ea=360)
return

label draw
'CANON TRIS
 n=(pn-4)*3:repeat:n=n+1
  px(n,p)=p(1,p)+(x(n)*co(p(5,p))-y(n)*si(p(5,p)))
  py(n,p)=p(2,p)+(x(n)*si(p(5,p))+y(n)*co(p(5,p)))
 until(n=pn*3)
'TANK TRIS
 n=0:repeat:n=n+1
  px(n,p)=p(1,p)+(x(n)*co(p(3,p))-y(n)*si(p(3,p)))
  py(n,p)=p(2,p)+(x(n)*si(p(3,p))+y(n)*co(p(3,p)))
 until(n=(pn-4)*3)

'### DRAW TANK ###
 n=1:repeat
  setrgb 1,pc(n,p),pc(n+1,p),pc(n+2,p)

  fill triangle px(n,p),py(n,p) to px(n+1,p),py(n+1,p) to px(n+2,p),py(n+2,p)

  n=n+3
 until(n>=pn*3)
return

'#################
'# SETUP & MENUS #
'#################
label setup
 pn=8:       rem POLYS/VEHICLE
 size=.6
 max_shot=5
 pln=4

 dim x(pn*3),y(pn*3),px(pn*3,pln),py(pn*3,pln)
 dim si(720),co(720),p(11,pln),s(10,max_shot)
 dim ex(6,max_shot),pc(pn*3,pln)


 title$="T|A|N|K|S"
 help$="X      - ACCLERATE\nSQUARE - BRAKE/REVERSE\n"
 help$=help$+"R1/L1  - MOVE CANON\nSTART  - PAUSE\n\n"
 help$=help$+"HOLD THE CIRCLE BUTTON TO ACCLERATE\n"
 help$=help$+"YOUR SHOT"
 about$="T|A|N|K|S coded by Tappi with help\n"
 about$=about$+"from the forums at yabasic.co.uk"
 greetN = 3
 dim greet$(greetN)

 restore setup

 for g=1 to greetN
  read greet$(g)
 next

 for b=0 to 720
  si(b)=sin(b/180*pi)
  co(b)=cos(b/180*pi)
 next

 gosub vehicle
data "Hallo","du",""
return

label init_game
'p(arg,player)
' arguments:
'1 = X POSITION
'2 = Y POSITION
'3 = ANGLE
'4 = ACCLERATION
'5 = CANON ANGLE
'6 = SHOT ACCLERATION
'7 = DAMAGE

 restore init_game

 for p=1 to pln
  for arg=1 to 10:p(arg,p)=0:next
 next

 for p=CPU to pln
  p(1,p)=p*60 : p(2,p) = 100
  p(7,p)=100  : p(5,p) = 290
  p(10,p)=10  : p(11,p)= 1
 next


 for arg=1 to 7
  read p(arg,1)
  data 400,450,180,0,180,0,100
 next

 for arg=1 to 7
  read p(arg,2)
  data 500,450,180,0,180,0,100
 next

 for b=1 to max_shot
  ex(3,b) =0
  s(3,b)  =0
 next

 CPD=0
return


label vehicle
 restore vehicle

 for n=1 to pn*3
  read x(n),y(n)
  x(n) = x(n)*size
  y(n) = y(n)*size
 next

 restore v_colour

 for p=1 to pln
 for n=1 to pn*3
  read pc(n,p)
 next:next

rem  3 COORDINATES PER TRI     ---1--- ---2--- --3---
rem  -X- -Y- -X- -Y- -X- -Y- | -X- -Y- -X- -Y- -X- -Y-
rem  "BODY"
data  20, 30,-20, 30,-20,-30,   20, 30, 20,-30,-20,-30
rem  FRONT
data  20, 30, 17, 42,-17, 42,   20, 30,-20, 30,-17, 42
rem  CANON
data  15,-10,-15,-10,-15, 10,  -15, 10, 15, 10, 15,-10
data   5,-10, -5,-10, -5, 45,    5, 45, -5, 45,  5,-10

return

label v_colour

rem  -R-|-G-|-B-  -R-|-G-|-B-
data  10,100, 10,  10,100, 10
data  20, 70, 20,  20, 70, 20
data   0, 60,  0,   0, 60,  0
data  10, 90, 10,  10, 90, 10
'PLAYER 2
data 110,100, 10, 110,100, 10
data  90, 80, 10,  90, 80, 10
data  80, 70, 10,  80, 70, 10
data  80, 80, 30,  80, 80, 30
'PLAYER 3
data  50, 50,150,  50, 50,150
data  50, 50,130,  50, 50,130
data  10, 10, 80,  10, 10, 80
data  30, 30,100,  30, 30,100
'PLAYER 4
data 150,150, 50, 150,150, 50
data 140,140, 50, 140,140, 50
data 120,120, 60, 120,120, 60
data 100, 90, 10, 100, 90, 10

label T_logo
 A=0:B=0:C=0

 while(C<200 and k=0)

 k=peek("port1")

 restore T_logo

 setdrawbuf buf: buf=1-buf:setdispbuf buf
 clear window

 if B>200 and C<1 A=A+4
 if B<204         B=B+4
 if A>200         C=C+1

 LL=(204-B)/2

 setrgb 1,B-A,B-A,B-A
 fill rect 210-LL,190-LL,430+LL,310+LL

 setrgb 1,0,A-C,A/2-C/2
 text 211,300, "coded by tappi","lc"

 for RT=0 to 23
  read RD
  fill rect 215+RT*8.7,200,215+RD+(RT*8.7)-LL/5,285
 next


 rem EAN CODE
 data 5,4,5,5,4,5,3,4,2,3,3,5
 data 3,4,3,4,2,3,2,3,4,2,4,3
 wend
return

label pad_menu
 k=peek("port1")

 if and(k,D)>0 and P=0 then:P=1:ms=ms+1:fi
 if and(k,U)>0 and P=0 then:P=1:ms=ms-1:fi

 ms=min(3,ms) : ms=max(1,ms)

 if and(k,X)>0 and P=0 then:P=1:md=ms+MD:fi

 if k=0 P=0

 on md gosub bats,start,help,about,norm,boun,retu,oneP,twoP,retu
return


label norm
 restore norm
 data "1 PLAYER","2 PLAYER","BACK"
 MD=7:gamemode=1:goto 011


label boun
 restore boun
 data "1 PLAYER","2 PLAYER","BACK"
 MD=7:gamemode=2:goto 011

label retu
 MD=1:md=0:ms=0:return

label oneP
 CPU=2:CN=3
 MD=5:md=0:return

label twoP
 CPU=3:CN=2
 MD=5:md=0:return

label start
 MD=4
 restore start
 data "CLASSIC-MODE","BOUNCE-MODE","BACK"
 goto 011

label bats
 MD=1
 restore bats
 data "START","HELP","ABOUT"

011 m=0
 repeat:m=m+1
  dim m$(m)
  read m$(m)

  setrgb 1,90,90,90 : setrgb 2,50,50,50 : setrgb 3,50,50,50
  if m=ms setrgb 1,130,130,130

  B=m*60
  mz=mz+.1
  A=5*sin(mz)

  if m<>ms A=0

  gtriangle 250-A,200+B-A to 250-A,250+B+A to 390-A,250+B-A
  setrgb 2,90,90,90
  if m=ms setrgb 2,130,130,130
  gtriangle 250-A,200+B-A to 390-A,200+B+A to 390-A,250+B-A

  setrgb 1,10,10,10
  text 320,210+B, m$(m),"ct"
 until(m=3)
return

label draw_titlescreen
 B=len(title$)*11

 setrgb 1,90,90,90
 setrgb 2,50,50,50
 setrgb 3,50,50,50

 gtriangle 320-B,100 to 320-B,200 to 320+B,200
 setrgb 2,90,90,90
 gtriangle 320-B,100 to 320+B,100 to 320+B,200

 setrgb 1,120,120,120
 text 323,155,title$,"cc"
 setrgb 1,70,70,70
 text 320,158,title$,"cc"

return

label help
  setrgb 1,160,160,160
  text 145,248, "HELP","lc"
  line 100,262,540,262 : line 130,230,130,400
  text 145,388, help$,"lc"

  if k<>0 and P=0 then P=1:md=0:fi
  ms=2
return

label about
  setrgb 1,160,160,160
  text 145,248, "INFO","lc"
  line 100,262,540,262 : line 130,230,130,400
  text 145,298, about$,"lc"

  greet = greet + .04:greet=mod(greet,greetN)
  text 145,328, "Greetings to","lc"
  setrgb 1,0,0,0
  text 145,358, greet$(greet)
  if k<>0 and P=0 then P=1:md=0:fi
  ms=3
return

label menu
 MD=1:md=0:ms=0:mx=0

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

 repeat

 gosub new_screen
 gosub draw_titlescreen
 gosub pad_menu

 until(MD=5)
return
'===========================================
label main
 gosub T_logo
 gosub setup
 gosub menu
 gosub init_game
 gosub start_game

label loop
 gosub new_screen
 gosub draw_status
 gosub explosives
 p=0:repeat:p=p+1
  gosub drive
  gosub draw
  if p(7,p)<0 gosub DEAD
 until(p=pln)
goto loop


label game_over
 repeat:until(peek("port1")=0)
 setdrawbuf buf

 for TX=-1 to 1 : for TY = -1 to 1
  setrgb 1,150,150,150
  text 320+TX*2,250-TY*2,"GAME OVER","cc"
  setrgb 1,100,100,100
  text 320+TX*2,450-TY*2,"Press START","cc"
 next:next

 setrgb 1,0,0,0
 text 320,250, "GAME OVER","cc"
 text 320,450, "Press START","cc"

 setdispbuf buf
 repeat:until(peek("port1")=ST) 
goto main

label paused
 repeat:until(peek("port1")=0)
 setdrawbuf buf

 for TX=-1 to 1 : for TY = -1 to 1
  setrgb 1,220,220,220
  text 320+TX*2,250-TY*2,"PAUSE","cc"
  setrgb 1,200,220,200
  text 320+TX*2,450-TY*2,"Press START","cc"
 next:next

 setrgb 1,0,0,0
 text 320,250, "PAUSE","cc"
 text 320,450, "Press START","cc"

 setdispbuf buf
 repeat:until(peek("port1")=ST) 
 repeat:until(peek("port1")=0)

return

label start_game
 count=4
 repeat:count=count-.06
  gosub new_screen
  gosub draw_status

 p=0:repeat:p=p+1
  gosub draw
 until(p=pln)

 for TX = -1 to 1 : for TY = -1 to 1
  setrgb 1,140,140,140
  text 320+TX*2,250-TY*2, "GET READY","cc"
  setrgb 1, 50,150, 50
  text 400+TX*2,400-TY*2, "PLAYER 1","cc"
  setrgb 1, 90, 90,  0
  text 500+TX*2,400-TY*2, "PLAYER 2","cc"
  setrgb 1, 80, 80, 80
  text 320+TX*2,290-TY*2, str$(int(count)),"cc"
 next:next

 setrgb 1,0,0,0
 text 320,250, "GET READY","cc"
 text 400,400, "PLAYER 1","cc"
 text 500,400, "PLAYER 2","cc"
 text 320,290, str$(int(count)),"cc"

 until(count<1)
return