rem Date: Oct. 25, 2006
rem Title: projectile
rem Author: acelepage
rem coding challenge: maths game
 
if check display mode (1024,768,32)
  set display mode 1024,768,32
else
  if check display mode (800,600,32)
    set display mode 800,600,32
  else
    end
  endif
endif
sync on
sync rate 60
backdrop on
color backdrop 0
hide mouse
dim player(2)
dim x(2)
dim hutx#(2)
dim color(2)
dim angle(2)
dim power(2)
dim score(2)
dim scoreboard(2)
dim direction#(2)
dim mountain#(500,2)
dim adjust#(2)
x(1)=20
x(2)=700
hutx#(1)=400.0:hutx#(2)=-200.0
score(1)=0:score(2)=0
screenx=1024
centerx=screenx/2
ground=3
boom=4
mountain=5
wind=rnd(99)-50
skyback=10
instruct=12
scoreboard(1)=13:scoreboard(2)=14
lava=15
color(1)=rgb(255,0,0):color(2)=rgb(0,255,0)
direction#(1)=-1.0:direction#(2)=1.0
gravity#=.1
bomb=3
plane#=110.0
for i=1 to 3
  make light i
  set spot light i,90.0,120.0
  set light range i,100.0
  color light i,rgb(255,0,0)
  hide light i
next i
for i=4 to 5
  make light i
  set spot light i,60.0,120.0
  set light range i,100.0
next i
gosub draw_ground
gosub make_boom
gosub make_mountain
gosub make_hut_boom
position light 0,0.0,80.0,600.0
set light range 0,1000
return_value$=title_page(centerx)
gameplay=val(left$(return_value$,1))
playsound=val(right$(return_value$,1))
if playsound
  for i=1 to 3
    make_sound(i)
  next i
endif
if gameplay=3 then end
for y#=500.0 to 75.0 step -1.0
  position camera 100.0,y#,600.0
  point camera 100.0,y#,0.0
  sync
next y#
show mouse
quit=0
player=1
while quit=0
  wind=wind+(rnd(40)-20)
  if wind<-50 then wind=-50
  if wind>50 then wind=50
  if (gameplay=2) or (gameplay=1 and player=1)
    value#=projectile(player,angle(player),power(player),wind,centerx,instruct)
  endif
  if (gameplay=1 and player=2) or (gameplay=0)
    value#=computer(adjust#(player),angle(player),power(player))
  endif
  instruct=0
  gosub fire_bomb
  if collide
    if playsound then stop sound 1
    x#=x#-vectorx#*direction#(player)
    if y#<get ground height(1,x#,plane#) then y#=get ground height(1,x#,plane#)
    if y#<0.0 then y#=0.0
  endif
  adjust#(player)=(hutx#(3-player)-x#)*direction#(3-player)
  hide object bomb
  player=3-player
  if x# > hutx#(player)-20.0 and x# < hutx#(player)+20.0
    inc score(3-player)
    update_score(3-player,score(3-player))
    gosub explode_hut
    wind=rnd(99)-50
  else
    explode_bomb(x#,y#,boom,plane#,player,playsound)
  endif
  if score(3-player)=10 then quit=1
endwhile
player=3-player
xlast#=hutx#(player)+70.0*direction#(player)
ylast#=10.0
zlast#=plane#+200.0
while not escapekey()
  x#=camera position x()
  y#=camera position y()
  z#=camera position z()
  movex#=(x#-xlast#)/100.0
  movey#=(y#-ylast#)/100.0
  movez#=(z#-zlast#)/100.0
  position camera x#-movex#,y#-movey#,z#-movez#
  sync
endwhile
end
fire_bomb:
  angle(player)=int(value#/256)
  power(player)=value#-angle(player)*256
  x#=hutx#(player)
  y#=20.0
  vectorx#=cos(angle(player))*power(player)/10.0
  vectory#=sin(angle(player))*power(player)/10.0
  position object bomb,x#,y#,0.0
  show object bomb
  collide=0
  volume=100
  if playsound then play sound 1
  while not collide
    x#=x#+vectorx#*direction#(player)-wind/50.0
    y#=y#+vectory#
    vectory#=vectory#-gravity#
    position object bomb,x#,y#,plane#
    sync
    if y#<0.0 then collide=1
    if x#<200.0 and x#>0.0 and y#<get ground height(1,x#,plane#)
      collide=1
      mountainy#=get matrix height(1,int(x#/10),int(plane#/10))
      set matrix height 1,int(x#/10),int(plane#/10),mountainy#-5.0
      update matrix 1
    endif
    if playsound then set sound volume 1,volume
    dec volume
    if volume<0 then volume=0
  endwhile
return
draw_ground:
  make matrix 2,2000.0,1000.0,10,10
  create bitmap 1,4,4
  ink rgb(170,126,0),0:line 1,1,4,1
  ink rgb(180,136,0),0:line 1,2,4,2
  ink rgb(190,146,0),0:line 1,3,4,3
  ink rgb(200,156,0),0:line 1,4,4,4
  get image ground,1,1,4,4,1
  set current bitmap 0
  prepare matrix texture 2,ground,1,1
  set matrix texture 2,1,1
  position matrix 2,-800.0,0.5,-400.0
  update matrix 2
  make object plain skyback,2000,1000
  create bitmap 2,400,200
  for i=1 to 100
    color=rnd(255)
    ink rgb(color,color,color),0
    dot rnd(400)+1,rnd(200)+1
  next i
  ink rgb(255,255,255),0
  get image skyback,1,1,400,200,1
  delete bitmap 2
  texture object skyback,skyback
  yrotate object skyback,180.0
  position object skyback,0.0,500.0,-500.0
  for i=1 to 2
    make object cube i,20
    set object i,1,1,1,1,1,1
    color object i,color(i)
    set current bitmap 1
    ink color(i),0
    box 1,1,4,4
    get image i,1,1,4,4,1
    set current bitmap 0
    texture object i,i
    position object i,hutx#(i),10.0,plane#
    make object cylinder 11,20
    scale object 11,10,100,10
    make mesh from object 1,11
    delete object 11
    make object box scoreboard(i),40,10,1
    add limb scoreboard(i),1,1
    offset limb scoreboard(i),1,-18.0,-10.0,-2.0
    add limb scoreboard(i),2,1
    offset limb scoreboard(i),2,18.0,-10.0,-2.0
    delete mesh 1
    position object scoreboard(i),hutx#(i)+70.0*direction#(i),10.0,plane#+150.0
    position light i+3,hutx#(i)+70.0*direction#(i),10.0,plane#+200.0
    point light i+3,hutx#(i)+70.0*direction#(i),10.0,plane#+150.0
    update_score(i,score(i))
  next i
  make object sphere bomb,5
  color object bomb,rgb(192,192,192)
  hide object bomb
return
make_boom:
  make object sphere boom,50
  color object boom,rgb(255,0,0)
  ghost object on boom
  hide object boom
return
make_mountain:
  make matrix 1,200.0,200.0,20,20
  for i=1 to 10
    for j=1 to 10
      height#=(i-1)*(j-1)*2.0
      set matrix height 1,i,j,height#
      set matrix height 1,21-i,j,height#
      set matrix height 1,21-i,21-j,height#
      set matrix height 1,i,21-j,height#
    next j
  next i
  position matrix 1,0.0,0.0,0.0
  create bitmap 1,20,20
  for i=1 to 400
    g=rnd(128)+127
    r=g/2
    b=g/4
    ink rgb(r,g,b),0
    dot (i mod 9)+1,int((i-1)/9)+1
  next i
  get image mountain,1,1,20,20,1
  delete bitmap 1
  set current bitmap 0
  prepare matrix texture 1,mountain,2,2
  set matrix texture 1,1,1
  update matrix 1
return
make_hut_boom:
  for i=5 to 9
    make object box i,20.0,20.0,2.0
    hide object i
  next i
  yrotate object 6,90.0
  yrotate object 8,90.0
  xrotate object 9,90.0
return
explode_hut:
  for i=5 to 9
    texture object i,player
    show object i
  next i
  position object 5,hutx#(player),10.0,plane#+10.0
  position object 6,hutx#(player)+10.0,0.0,plane#
  position object 7,hutx#(player),10.0,plane#-10.0
  position object 8,hutx#(player)-10.0,20.0,plane#
  position object 9,hutx#(player),20.0,plane#
  hide object player
  position object boom,hutx#(player),0.0,plane#
  show object boom
  up#=3.0
  volume#=100.0
  if score(3-player)=10
    bigboom=2
  else
    bigboom=1
  endif
  if playsound then play sound 3
  for i=100 to 400 step 2
    scale object boom,i*bigboom,i*bigboom,i*bigboom
    fade object boom,int((400-i)/3)
    position object 5,object position x(5),object position y(5)+up#,object position z(5)+2.0
    position object 6,object position x(6)+2.0*direction#(player),object position y(6)+up#,object position z(6)
    position object 7,object position x(7),object position y(7)+up#,object position z(7)-2.0
    position object 8,object position x(8)-2.0*direction#(player),object position y(8)+up#,object position z(8)
    position object 9,object position x(9),object position y(9)+up#*2,object position z(9)
    rotate object 5,object angle x(5)+5.0,object angle y(5)+4.0,object angle z(5)+3.0
    rotate object 6,object angle x(6)+3.0,object angle y(6)+4.0,object angle z(6)+5.0
    rotate object 7,object angle x(7)+2.0,object angle y(7)+5.0,object angle z(7)+3.0
    rotate object 8,object angle x(8)+5.0,object angle y(8)+2.0,object angle z(8)+4.0
    rotate object 9,object angle x(9)+5.0,object angle y(9)+5.0,object angle z(9)+5.0
    if i>300 and bigboom=2
      xrotate object scoreboard(player),(i-300)*0.9
      position object scoreboard(player),object position x(scoreboard(player)),(400-i)*0.1+1.0,plane#+150.0+(i-300)*0.1
    endif
    sync
    up#=up#-gravity#/2
    if playsound then set sound volume 3,int(volume#)
    volume#=volume#-0.5
    if volume#<0.0 then volume#=0.0
  next i
  for i=5 to 9
    hide object i
  next i
  show object player
return
function update_score(player,score)
  create bitmap 2,80,20
  ink rgb(0,0,255),0
  box 1,1,80,20
  ink rgb(255,255,255),0
  set text font "courier"
  set text size 16
  set cursor 7,2
  print "HITS= ";score
  get image scoreboard(player),1,1,80,20,3
  delete bitmap 2
  texture object scoreboard(player),scoreboard(player)
endfunction
function explode_bomb(x#,y#,boom,plane#,player,playsound)
  position object boom,x#,y#,plane#
  position light 1,x#,y#+30.0,plane#+50.0
  point light 1,x#,y#,plane#
  position light 2,x#,y#,plane#+30.0
  point light 2,x#,y#,plane#
  position light 3,x#,y#,plane#
  point light 3,object position x(player),object position y(player),object position z(player)
  show light 1:show light 2:show light 3
  show object boom
  volume=100
  if playsound then play sound 2
  for i=1 to 200 step 2
    scale object boom,i,i*2,i
    fade object boom,100-i/2
    color light 1,rgb(201-i,0,0):color light 2,rgb(201-i,0,0):color light 3,rgb(201-i,0,0)
    sync
    if playsound then set sound volume 2,volume
    dec volume
    if volume<0 then volume=0
  next i
  hide object boom
  hide light 1:hide light 2:hide light 3
endfunction
function projectile(player,angle,power,wind,centerx,instruct)
  fire=0
  while not fire
    ink rgb(255,255,255),0
    if wind<0
      direction=-1
      tp=centerx+wind
      box centerx+wind,9,centerx,15
    else
      direction=1
      tp=centerx
      box centerx,9,centerx+wind,15
    endif
    for i=1 to 10
      line centerx+wind+(10-i)*direction,12-i,centerx+wind+(10-i)*direction,12+i
    next i
    set text size 16
    set text to normal
    set text font "arial"
    set cursor tp,26
    wind$=right$("0"+str$(wind),2)
    print "Wind: ";left$(wind$,1);".";right$(wind$,1)
    ink rgb(0,0,255),0
    line x(player),100,x(player),190
    line x(player),190,x(player)+90,190
    yoffset=sin(angle)*90
    xoffset=cos(angle)*90
    xp1=cos(angle+135)*10
    yp1=sin(angle+135)*10
    xp2=cos(angle+225)*10
    yp2=sin(angle+225)*10
    line x(player),190,x(player)+xoffset,190-yoffset
    line x(player)+xoffset,190-yoffset,x(player)+xoffset+xp1,190-yoffset-yp1
    line x(player)+xoffset,190-yoffset,x(player)+xoffset+xp2,190-yoffset-yp2
    ink rgb(128,128,128),0
    box x(player)-5,200,x(player)+95,220
    ink 0,0
    line x(player)+angle,203,x(player)+angle,217
    ink rgb(255,0,0),0
    box x(player)+102,200,x(player)+138,220
    box x(player)+100,202,x(player)+140,218
    ink rgb(0,255,0),0
    box x(player)+100,190-power,x(player)+140,195
    ink rgb(255,255,255),0
    for i=1 to 5
      ink rgb(0,255,0),0
      line x(player)+140-i,190-power-i,x(player)+135,190-power-i
      ink 0,0
      line x(player)+140-i,190-power+i,x(player)+135,190-power+i
      line x(player)+angle-i/2,218-i,x(player)+angle+i/2,218-i
    next i
    ink rgb(255,255,255),0
    for i=0 to 95 step 5
      xlim=x(player)+150
      xpos=xlim+int(i mod 10)-10
      line xpos,i+90,xlim,i+90
      if i<95 then line x(player)+i,223,x(player)+i,223+int(i mod 10)+5
    next i
    if instruct>0
      instructions(instruct)
    endif
    set text size 16
    set text font "arial"
    set text to bold
    text x(player)+104,202,"FIRE"
    set text font "arial"
    set text size 20
    set text to normal
    text x(player)+10,80,"Angle: "+str$(angle)+""
    text x(player)+100,60,"Power: "+left$(str$(power),len(str$(power))-1)+"."+right$(str$(power),1)
    sync
    if mouseclick()=1
      if mousex()>=x(player) and mousex()<=x(player)+90 and mousey()>=200 and mousey()<=220
        angle=abs(mousex()-x(player))
      endif
      if mousex()>=x(player)+100 and mousex()<=x(player)+140 and mousey()>=100 and mousey()<=200
        power=200-mousey()
      endif
      if mousex()>=x(player)+100 and mousex()<=x(player)+140 and mousey()>=200 and mousey()<=220
        if ready=1 then fire=1
      endif
    endif
    if mouseclick()=0
      if mousex()>=x(player)+100 and mousex()<=x(player)+140 and mousey()>=200 and mousey()<=220
        ready=1
      else
        ready=0
      endif
    endif
  endwhile
  return_value#=angle*256+power
endfunction return_value#
function computer(adjust#,angle,power)
  if angle=0 or power=0
    angle=55
    power=75
  else
    if adjust#>200.0
      inc angle
      inc power
    else
      if adjust#>0.0
        inc angle
        dec power
      else
        dec angle
        inc power
      endif
    endif
 endif
  return_value#=angle*256+power
endfunction return_value#
function make_sound(number)
  format as dword
  channels as dword
  sampleRate as dword
  adr as dword
  chunkSize as dword
  sampleSize as dword
  dword7 as dword
  format = 1
  channels = 1
  sampleRate = 22050
  sampleSize = 16
  chunkSize = (int(sampleSize / 8.0+0.5))*channels
  adr = sampleRate*chunkSize
  dword7 = 0
  select number
    case 1
      length=2000
      wave#=0.0
      increment#=1.0
      gain#=-0.01
      amplitude=65535
      decay=0
      speed=sampleRate
    endcase
    case 2
      length=500
      wave#=0.0
      increment#=2.0
      gain#=0.001
      amplitude=65000
      decay=1
      speed=6000
    endcase
    case 3
      length=2000
      wave#=0.0
      increment#=-1.0
      gain#=0.0
      amplitude=65000
      decay=500
      speed=8000
    endcase
  endselect
  samples = length*sampleRate/1000
  size = samples*int(sampleSize/8.0+0.5) + 28
  make memblock 1, size
  write memblock dword 1, 0, format
  write memblock dword 1, 4, channels
  write memblock dword 1, 8, sampleRate
  write memblock dword 1, 12, adr
  write memblock dword 1, 16, chunkSize
  write memblock dword 1, 20, sampleSize
  write memblock dword 1, 24, dword7
  pos = 28
  out as word
  for i = 1 to samples
      out = sin(wave#)*amplitude
      write memblock word 1, pos, out
      inc pos, 2
      wave#=wave#+increment#
      if wave#>360.0
        wave#=wave#-360.0
        increment#=increment#-gain#
      endif
      amplitude=amplitude-decay
  next i
  make sound from memblock number,1
  delete memblock 1
  set sound speed number,speed
endfunction
function title_page(centerx)
  set image colorkey 0,0,0
  make object box 11,40.0,7.0,1.0
  create bitmap 2,100,15
  ink rgb(255,255,255),0
  set text font "courier"
  set text size 12
  set text to bold
  text 0,0,"Projectile"
  get image 11,1,1,100,15,1
  delete bitmap 2
  texture object 11,11
  set object texture 11,2,1
  set object transparency 11,1
  position camera 100.0,500.0,600.0
  point camera 100.0,500.0,0.0
  for i#=-500.0 to 600.0 step 5
    position object 11,95.0,500.0,i#
    sync
  next i
  delete image 11
  delete object 11
  set text size 40
  set text font "arial"
  text centerx-300,200,"A) 2 players"
  text centerx-300,240,"B) 1 player"
  text centerx-300,280,"C) 0 players"
  sync
  answer=-1
  while answer=-1
    i$=inkey$()
    if i$="a" or i$="A" then answer=2
    if i$="b" or i$="B" then answer=1
    if i$="c" or i$="C" then answer=0
  endwhile
  while inkey$()<>""
  endwhile
  text centerx-300,200,"Sound? (Y/N)"
  sync
  playsound=-1
  while playsound=-1
    i$=inkey$()
    if i$="y" or i$="Y" then playsound=1
    if i$="n" or i$="N" then playsound=0
  endwhile
  return_value$=str$(answer)+str$(playsound)
endfunction return_value$
function instructions(instruct)
  ink rgb(0,0,192),0
  box 200,600,800,700
  ink rgb(0,0,128),0
  box 210,610,790,690
  ink rgb(255,255,255),0
  set text font "arial"
  set text size 14
  text 220,615, "Object: hit and destroy your opponent"
  text 220,630, "Play: Use mouse to select firing angle and firing power to send projectile over the hill and hit your opponent"
  text 220,645, "    Click and drag arrow in gray bar to select angle"
  text 220,660, "    Click and drag arrow in green bar to select power"
  text 220,675, "    Click on red FIRE button to fire projectile"
endfunction