'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'
'          -= Defence Command (3rd re-write) =-
'           ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~
'           -= Coded by shockwave (c) 2001 =-
'            ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~
'
'                   -= Controls:- =-
'                    ~ ~~~~~~~~~~ ~
'
'             * D-pad - move cursor.
'             * (X) Fire when you are locked on.
'             * Start - Pause game.
'
'
'-= With thanks to Marc Gale (Xalthorn) and Jacob Busby =-
'           -= And Jomorrow For playtesting =-
'            ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~
' Thank you to Doctor aka Christopher Rankine for moral
'                        support.
'
'Sorry if the new guys have trouble following the listing,
'I am experimenting to see if GOTO is faster than GOSUB =)
'
' This  will be my last game for a while as I got really
' bored with it towards the end, I feel like doing a few
' demos now. Contact www.yabasic.co.uk to find the best
' Yabasic resources available anywhere! Join thier forum
' if you want to talk to me. :o)
' 
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'######################################################
'## Pre-game setup this needs to be set before play: ##
'######################################################
goto setup

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

label outer

if title=1 goto title_screen
label tout
goto startgame
label startout
gosub reset_game

label gameon
mm=mm+.1
gosub buffer
gosub control
gosub missiles
gosub sparks
gosub score
gosub explosion
if shield >=0 goto gameon
goto endgame
label endout
goto outer
'---------------------------------------------------------
'#########################################################
'## These subroutines are called with the Gosub routine ##
'#########################################################
label explosion
if explstate<=0 return
setrgb 1,explstate,explstate,explstate
for a=1 to particles
 fill rect expx(a)-ran(4),expy(a)-ran(4) to expx(a)+ran(4),expy(a)+ran(4)
expx(a)=expx(a)+expxd(a)
expy(a)=expy(a)+expyd(a)
next a
explstate=explstate-5
return

label sparks
'>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<
'>> Spark particle drawing sub <<
'>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<
for a=1 to sparks
if spc(a)>0 then
 setrgb 1,spc(a),spc(a),100
 spc(a)=spc(a)-25
 fill rect spx(a)-ran(6),spy(a)-ran(6) to spx(a)+ran(6),spy(a)+ran(6)
 spy(a)=spy(a)+spyd(a)
 spx(a)=spx(a)+spxd(a)
 if spc(a)<0 spc(a)=0
fi
next a
return


label missiles
'>>>>>>><<<<<<<<<<
'>> Missile Sub <<
'>>>>>>>>>><<<<<<<
for a=1 to maxmissiles
if misss(a)<>0 then
if missy(a)>110 then
setrgb 1,ran(250),ran(250),0
fill triangle missx(a)-4,missy(a)-32 to missx(a)+4,missy(a)-32 to missx(a),missy(a)-32-ran(45)
fi
setrgb 1,155,155,255
fill rectangle missx(a)-2,missy(a) to missx(a)+2,missy(a)-30
fill rectangle missx(a)-5,missy(a)-26 to missx(a)+5,missy(a)-29
fill triangle missx(a)-2,missy(a) to missx(a)+2,missy(a) to missx(a),missy(a)+4
fi

missy(a)=missy(a)+difspd
if lockon=a ypos=ypos+difspd
if lockon=a and missy(a)>100 ypos=ypos+(missy(a)/100)
if missy(a)>100 missy(a)=missy(a)+(missy(a)/100)
if missy(a)>410 then 
if misss(a)>0 then
red=red+1200
grn=grn+650
blu=blu+100
for l=1 to particles
 expx(l)=missx(a)
 expy(l)=missy(a)-10
 expxd(l)=-10+ran(20)
 expyd(l)=0-ran(10)
next l
explstate=255
fi
difspd=difspd+.0025
if difspd>1 difspd=1
missy(a)=missy(a)-520
missx(a)=20+ran(600)
if misss(a)>0 shield=shield-ran(7)
misss(a)=1
fi
next a
return

label score
'>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<
'>> Update scores + repair shield <<
'>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<
if shield<100 shield=shield+.005
setrgb 1,255,100,200
text 40,480,"Score  : "+str$(score)
text 40,500,"Shield : "+str$(int(shield))+"%"
return

label control
c=peek("port1")
'>>>>>>>>>>>>>>>>><<<<
'>>Check for lockon <<
'>>>>>>>>>>>>>>><<<<<<
lockon=0
lck=0
for a=1 to maxmissiles
if misss(a)>=1 then
if missx(a)>xpos-30 and missx(a)<xpos+30 and missy(a)>ypos-30 and missy(a)<ypos+30 then
 lck=5+5*sin(mm)
 lockon=a
fi
fi
next a
'>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<
'>> Player cursor drawing and movement <<
'>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<
   setrgb 1,20,20,30
   line 0,ypos to 640,ypos
   line xpos,0 to xpos,512
   setrgb 1,40,40,150
   if lck>0 setrgb 1,140,40,50
   triangle xpos-20-lck,ypos-20-lck to xpos-10-lck,ypos-20-lck to xpos-20-lck,ypos-10-lck
   triangle xpos+20+lck,ypos-20-lck to xpos+10+lck,ypos-20-lck to xpos+20+lck,ypos-10-lck
   triangle xpos-20-lck,ypos+20+lck to xpos-10-lck,ypos+20+lck to xpos-20-lck,ypos+10+lck
   triangle xpos+20+lck,ypos+20+lck to xpos+10+lck,ypos+20+lck to xpos+20+lck,ypos+10+lck

    if and(c,16)<>0 ym=ym-.2
    if and(c,64)<>0 ym=ym+.2
    if and(c,32)<>0 xm=xm+.2
    if and(c,128)<>0 xm=xm-.2
'pause:
  if and(c,8)<>0 then
rtmp=red
gtmp=grn
btmp=blu
    repeat
gosub buffer
setrgb 1,155,155,255
text 250,200,"-=GAME PAUSED=-"
    until (peek("port1")<>8 and peek("port1")<>0)
red=rtmp
grn=gtmp
blu=btmp

  fi
    if and(c,16384)<>0 then
    if ypos>398 and ypos<405 and shield<100 shield=shield+.02
     blu=blu+ran(10)+5
     if lockon>0 then
       bx=missx(lockon)
       for a=missy(lockon) to 520 step 30
        bx2=(bx-ran(15))
        bx2=bx2-((bx2-390)/10)
        setrgb 1,5,5,255
        fill triangle bx-5,a to bx+5,a to bx2,a+30
        fill triangle bx,a to bx2+5,a+30 to bx2-5,a+30
        setrgb 1,255,255,255
        fill triangle bx-2,a to bx+2,a to bx2,a+30
        fill triangle bx,a to bx2+2,a+30 to bx2-2,a+30
        bx=bx2
       next a
red=red+5
grn=grn+5
blu=blu+10

for l=1 to sparks
 if spc(l)=0 then
blu=blu+4
red=red+3
grn=grn+2

 spc(l)=255
 spx(l)=missx(lockon)
 spy(l)=missy(lockon)
 spxd(l)=-2+ran(4)
 spyd(l)=-6+ran(5)
 l=sparks+1
 fi
next l
score=score+1
 misss(lockon)=misss(lockon)+1
 if misss(lockon)=30 then
score=score+40
red=red+400
grn=grn+300
blu=blu+200
for l=1 to particles
 expx(l)=missx(lockon)
 expy(l)=missy(lockon)
 expxd(l)=-10+ran(20)
 expyd(l)=-10+ran(20)
next l
explstate=255
  misss(lockon)=0
 fi
     fi
    fi

      if c=0 or c=16384 then
        if ym<0 ym=ym+.2
        if ym>0 ym=ym-.2
        if xm<0 xm=xm+.2
        if xm>0 xm=xm-.2
       fi

       if xm>.2 or xm<-.2 xpos=xpos+xm
       if ym>.2 or ym<-.2 ypos=ypos+ym

        if xpos>640 or xpos<0 xm=0
        if ypos>512 or ypos<0 ym=0

      if xpos<0 xpos=0
      if xpos>640 xpos=640
        if ypos<0 ypos=0
        if ypos>512 ypos=512

    setrgb 1,shield/3,shield/3,shield
    fill rect 0,400-ran(4) to 640,400+ran(4)
    setrgb 1,shield*2,shield*2,shield*3
    fill rect 0,400-ran(1) to 640,400+ran(1)

return

label buffer
'>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<
'>> Double buffer, light effects and landscape <<
'>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<
  setdrawbuf dw
  dw=1-dw
  setdispbuf dw

   setrgb 1,20+red,0+grn,0+blu
   setrgb 2,20+red,5+grn,0+blu
   setrgb 3,0+red,0+grn,20+blu

   gtriangle 0,0 to 640,512 to 0,512
   setrgb 3,10+red,0+grn,0+blu
   gtriangle 0,0 to 640,512 to 640,0

   if blu>0 blu=blu-(blu/3)
   if grn>0 grn=grn-(grn/3)
   if red>0 red=red-(red/3)

   setrgb 1,2,3,1
   setrgb 2,2+red,35+grn,2+blu
   setrgb 3,2+red,35+grn,2+blu
   gtriangle 0,450 to 640,512 to 0,512
   setrgb 3,2,3,1
   gtriangle 0,450 to 640,512 to 640,450
   setrgb 1,55,55,155
   for a=1 to 20
   fill rect starx(a)-ran(1),stary(a)-ran(1) to starx(a)+1,stary(a)+ran(1)
   next a
   x=0
   setrgb 1,6,6,15
   for a=1 to 20
      fill rectangle x,buildings(a) to x+27,512
      x=x+32
   next a
   x=0
   setrgb 1,3,3,10
   for a=1 to 20
      fill rectangle x,buildings(a)+2 to x+22,512
      x=x+32
   next a

return


'################################
'## Set Variables for new game ##
'################################
label reset_game
xpos=320 : rem player cursor x position.
ypos=256 : rem player cursor Y position.
red=0
grn=0
blu=0
shield=100
score=0
ypos=-50

for a=1 to maxmissiles
 missx(a)=20+ran(600)
 missy(a)=ypos
 misss(a)=1
 ypos=ypos-20
next a
for a=1 to sparks
 spx(a)=0
 spy(a)=0
 spc(a)=0
spxd(a)=0
spyd(a)=0
next a

for a=1 to particles
 expx(a)=0
 expy(a)=0
 expxd(a)=0
 expyd(a)=0
next a
explstate=0

difspd=.3
ypos=256
return

'---------------------------------------------------------
'#########################################################
'## The folowing parts are called with Gotos which is a ##
'## little experiment to see if the program will run a  ##
'## bit faster if I use GOTO as opposed to the nicer    ##
'## GOSUB comand.                                       ##
'#########################################################
label startgame
 for b=1 to 255 step .5
  gosub buffer
'if b<255 then
  setrgb 1,255-b,255-b,255-b
  text 120,100,"DEFENCE COMMAND STAND BY INCOMING THREAT!"
  setrgb 1,255-b,155-b,155-b
  text 130,120,"DESTROY ALL INCOMING NUCLEAR MISSILES!"
  text 70,140,"WE ARE EVACUATING THE CITY! WE'RE DEPENDING ON YOU!"
  setrgb 1,155-b,255-b,255-b
  text 130,390,"POWERING UP BEAM WEAPON AND DEFENCES!!"
'fi
  if peek("port1")<>0 b=b+5
 next b
goto startout

label endgame
  e$=STR$(score)+" CITIZENS MANAGED TO EVACUATE SUCCESSFULLY"

 for b=1 to 1000
 red=red+6
  gosub buffer
  setrgb 1,b,b,b
  text (640-(len(e$)*10))/2,140,e$
  text 175,160,"GAME OVER DEFENCE COMMANDER!"
  text 120,100,"DEFENCE COMMAND CITY SHIELD IS DESTROYED!"
  text 130,120,"!!!!!!WE ARE EVACUATING YOU NOW!!!!!!!"
  if peek("port1")<>0 b=b+5
 next b
repeat
gosub buffer
until (peek("port1")=0)
goto endout

label title_screen
'>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<
'>> Reset Menu and Scroll Variables <<
'>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<

  choice=1
  p=0
  scroll=1
  s$=instruct$
  scx=0
  e$=str$(score)+" CITIZENS ESCAPED DURING YOUR LAST MISSION"
'>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<
'>> Start of title screen loop cycle <<
'>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<

repeat

 ypos=200
 setdrawbuf dw
 dw=1-dw
 setdispbuf dw 
      red=20+20*sin(mm)
      grn=20+20*sin(mm/2)
      blu=20+20*sin(mm/3)

         mm=mm+.1
         setrgb 1,red,5,20
         setrgb 2,5,grn,15
         setrgb 3,30,20,blu

           gtriangle 0,0 to 640,512 to 0,512
           gtriangle 0,0 to 640,512 to 640,0

   setrgb 1,200+red,55,100
   rectangle 113,45 to 536,26
   rectangle 238,ypos-13 to 392,ypos+95

     setrgb 1,255,255,255
     text 115,40,"DEFENCE COMMAND PROGRAMMED BY MR.SHOCKWAVE"
     setrgb 1,40,40,80
     text 4+(640-(len(e$)*10))/2,130,e$

     text 60,ypos+170,"PRESS UP AND DOWN TO MOVE SELECTOR AND (X) TO CHOOSE"
 for a=1 to 4
   setrgb 1,140,140,200+blu
         if int(choice)=a setrgb 1,255,255,255
         text 240,ypos,mc$(a)
         ypos=ypos+30
 next a
       if (and(c,64)<>0) choice=choice+.1
       if (and(c,16)<>0) choice=choice-.1
         if (and(c,32)<>0) scx=scx+1
         if (and(c,128)<>0) scx=scx-1
           if choice>4 choice=4
           if choice<1 choice=1

   if (and(c,16384)<>0) then
       if int(choice)=3 then
       p=0
       s$=instruct$
       fi
   if int(choice)=4 then
       p=0
       s$=hello$
       fi
   fi

   setrgb 1,140,140,blu*10
   text scx,450,mid$(s$,p,67)
   scx=scx-2

if scx<-10 then
   scx=scx+10
   p=p+1
   if p>len(s$) p=0
fi
c=peek("port1")
until (and(c,16384)<>0 and (choice<=3))
choice=int(choice)
maxmissiles=8
if choice=1 maxmissiles=6
'>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<
'>> End of title screen loop cycle <<
'>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<
goto tout

'########################################################
'## Set screen and every variable and array needed for ##
'## the game.                                          ##
'########################################################
label setup
'>>>>>>>>>><<<<<<<<<<<<
'>> Title variables: <<
'>>>>>>>>>>>><<<<<<<<<<

title=1 : rem      Turn title screen on or off 0=off 1=on.
    dim mc$(4) : rem menu choices definitions ;
    mc$(1)="BEGIN EASY GAME"
    mc$(2)="BEGIN HARD GAME"
    mc$(3)="  HOW TO PLAY  "
    mc$(4)="PERSONAL HELLOS"
instruct$="                                                                  "
instruct$=instruct$+"PROTECT THE CITY AGAINST A NUCLEAR "
instruct$=instruct$+"THREAT! GUIDE THE CURSOR WITH YOUR "
instruct$=instruct$+"D-PAD, PRESS (X) WHEN YOU ARE LOCKED"
instruct$=instruct$+" ON TO FIRE YOUR BEAM WEAPON WHICH "
instruct$=instruct$+"WILL DESTROY INCOMMING MISSILES. "
instruct$=instruct$+"IF ANY GET THROUGH THEY WILL CRASH "
instruct$=instruct$+"INTO THE ELECTROMAGNETIC SHIELD ABOV"
instruct$=instruct$+"E THE CITY AND DETONATE, WEAKENING "
instruct$=instruct$+"THE SHIELD. THE SHIELD REGENERATES"
instruct$=instruct$+" OVER TIME BUT IF IT IS DESTROYED TH"
instruct$=instruct$+"E CITY WILL BE DEFENCELESS AND IT'S "
instruct$=instruct$+"GAME OVER.  THERE ARE NO LEVELS AS "
instruct$=instruct$+"SUCH BUT YOU'LL FIND THE THREAT "
instruct$=instruct$+"BECOMES MORE INTENSE OVER TIME. "
instruct$=instruct$+"THE LONGER YOU FEND OFF THE ATTACK, "
instruct$=instruct$+"THE MORE PEOPLE WILL BE ABLE TO "
instruct$=instruct$+"EVACUATE THE DOOMED CITY!   "

   hello$="                                                                 "
   hello$=hello$+"PROGRAMMED BY MR.SHOCKWAVE IN DECEMBER "
   hello$=hello$+"2001.. CHECK OUT WWW.YABASIC.CO.UK FOR "
   hello$=hello$+"YABASIC PROGRAMMING HELP AND TO CONTACT"
   hello$=hello$+" ME... MANY THANKS TO XALTHORN AND "
   hello$=hello$+"JACOB BUSBY FOR PLAYTESTING THE EARLY "
   hello$=hello$+"VERSION OF THIS GAME, WITHOUT YOUR "
   hello$=hello$+"COMMENTS THIS GAME WOULD HAVE BEEN CRAP"
   hello$=hello$+".. SPECIAL HANDSHAKES TO: FRYER, "
   hello$=hello$+"ADAM LAY, DOCTOR, DEAN THOMAS, JOMORROW"
   hello$=hello$+", GOTHI, MASTER TONBERRY, SNAKEDOGG, "
   hello$=hello$+"GRANT AND MATT MARTIN OF PSI2 MAGAZINE,"
   hello$=hello$+" JINX, MONKEYPANTS, SEPHIROTH, JACOB, "
   hello$=hello$+"TREV, STATICGERBIL, "
   hello$=hello$+"MARC GALE, FISHMAN, VERYBASIC AND ALL "
   hello$=hello$+"THE OTHER FORUM USERS AT WWW.YABASIC.CO"
   hello$=hello$+".UK  THAT'S ALL FOLKS.....  "


'>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'
'       -= Set up permanent variables for game =- 
'          ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

  maxmissiles=8

  dim missx(maxmissiles) : rem missile x pos.
  dim missy(maxmissiles) : rem missile y pos.
  dim misss(maxmissiles) : rem missile status.

  dim buildings(20):rem buildings height.
  dim starx(20):rem     twinkle stars x pos.
  dim stary(20):rem     twinkle stars y pos.

  sparks=6
  dim spx(sparks): rem Spark particle x pos.
  dim spy(sparks): rem Spark particle Y pos.
 dim spxd(sparks): rem spark particle x vector.
 dim spyd(sparks): rem spark particle y vector.
  dim spc(sparks): rem spark colour and status flag.

  particles=19 : rem       Amount of particles per bang.
   explstate=0 : rem       0=inacive.
 dim expx(particles) : rem Particle explosion x pos.
 dim expy(particles) : rem Particle explosion Y pos.
dim expxd(particles) : rem Particle explosion X vector.
dim expyd(particles) : rem Particle explosion Y vector.

 for a=1 to 20
     buildings(a)=420+ran(100)
        starx(a)=ran(640)
        stary(a)=ran(400)
 next a

open window 640,512
goto outer



