Sorry your browser is not supported!

remstart
Space RTS - by IBOL - 20th March 2010
Continued by OBese87 - Last Updated: 10/JAN/2013
------------
-=- Known Bugs -=-
* Not all planets are building ships.
* Instant ship building at start of game if order given while paused (useful for testing purposes however).
* Enemy ships continue defending a planet even after their colony has been destroyed.
------------
-=- Feature Ideas -=-
- Stay Together -
Ships in a group should move at the speed of the slowest member.
- Advanced Movement Orders -
Guard or follow other ships.
Set up patrol routes.
Move in formation.
- Limited Resources -
Each planet has a finite mineral pool, minerals are harvested by the inhabitants and converted into currency for building ships.
Once a planet's resources are depleated the population will start to drop and consume currency.
A new class of ship, the trade vessel, can take resources from an abundant planet and deliver them where they are needed, but these ships cannot
defend themselves or attack the enemy.
(When the game is expanded to more than two races the merchant will also be able to trade with allies and send peace offerings.)
- Strategic Repairs -
Ships only repair when near a homeworld. Maybe some kind of carrier ship can be a mobile base for repairs too.
- Ship Progression -
Ships receive stat boosts for combat experience and kills.
------------
remend

set display mode 1024,768,32
sync on
sync rate 0
randomize timer()
set text font "lucida console",1
set text size 16
ink -2,0
gosub arrays_and_globals
gosub race_select
gosub initialize
gosub make_backdrop

rem === MAIN ===
do
   rem >> INPUT >>
   oldkey = key
   key = scancode()

`{
   rem Adjust game speed (+/- keys) Pause "P".
   if key>oldkey
      rem Pause game else adjust speed.
      if key=25
         gamespeed#=0
      else
         if key=78 or key=74
            gamespeed# = gamespeed# * ( (key=78)*2 + (key=74)*0.5 )
            if gamespeed#<1 then gamespeed#=1
            if gamespeed#>32 then gamespeed#=32
         endif
      endif
   endif
`}

   gosub command_select_objects
   gosub validate_selection
   gosub command_move_ships

`{
   rem Planetary Command Centre
   if planet_selected and planet#(planet_selected,3)=1
      rem Calculate ship building permits for this planet.
      for u = 1 to 4
         rem What ship classes can we afford here?
         enough_people = Planet#(planet_selected,4)>=(Ship_Class(u,6)*2) :rem I don't like how this *2 is hidden away in here.
         enough_money = Planet#(planet_selected,5)>=Ship_Class(u,5)
         build_permit(u) = enough_people * enough_money :`AND logic
         build_permit(u)=1 :`override for testing !!!!
      next u

      if key > oldkey
         rem We want to build a ship.
         if key>=2 and key<=5
            class = key-1 :`convert scancode to ship class.
            rem Can we afford to build this class of ship?
            if build_permit(class)
               rem Subtract build cost from planetary resources.
               Planet#(planet_selected,4) = Planet#(planet_selected,4)-Ship_Class(class,6)
               Planet#(planet_selected,5) = Planet#(planet_selected,5)-Ship_Class(class,5)
               rem Begin construction.
               build_error = Build_Ship(1,pr(1),Planet#(planet_selected,1),Planet#(planet_selected,2),class,Rnd(359))
               if build_error = -1 then end
            endif
         endif
      endif
   endif
`}

   rem >> PROCESS >>
   if gamespeed#>0
      rem Control game timer
      gameticks# = (timer()-t1) * gamespeed# * 0.00004
      t1=timer()
      gosub update_planet_data
      gosub update_ship_data
      gosub update_ai
      gosub check_end_game
   endif

   rem >> OUTPUT >>
   gosub display
   sync:cls
loop
END


rem ======================================
rem === DATA ===
rem ======================================
rem Propaganda Descriptions
data "Glorious", "Righteous", "Noble", "Mighty", "Brave", "Valiant"
data "Vile", "Evil", "Wretched", "Foul", "Savage", "Cowardly"

data 18,15,128,222 :`ascii codes for ship graphics
data "Viper","Falcon","Titan","Colonizer"
data "DEFEND","PREPARE","ATTACK","COLONIZE"
`    RACE
`    atk,def,pgr,eco,  R,  G,  B,#col, engage dist
data 33, 14, 17, 11, 255,  0,  0,   4, 300
data 17, 26, 11, 14, 180,  0,180,   5, 150
data 14, 11, 20, 17,   0,180,  0,   8, 225
data 11, 17, 14, 20, 255,180,  0,   6, 100
` SHIPS:
`  atk,def,spd,rng,cost,POP-cost
data 3, 2, 20, 20, 500,  50
data 6, 5, 15, 27, 1000, 100
data 12,14,10, 34, 2000, 150
data 0, 1, 7,  0,  1500, 500
`//

rem ======================================
rem === SUBROUTINES ===
rem ======================================
arrays_and_globals:
   remstart
   (ship classes always ordered: Destroyer, Cruiser, Battleship, Colonizer)
   NAME        DESCRIPTION  DATA
   ai           AI           0=number of colonies, 1-4=number of ships in each class, 5=number of enemy colonies,
                            6=colony under attack,7=sync countdown of coming out of defence, 9=AI state decided on.
   build_permit Ship build   1-4=ship classes by size(1=can build,0=cannot build).
   string$           Game text    1-4=race names, 5-8=ship ascii images, 9-12=ship names, 13-16=ai state strings.
   planet$      Planet name  0=planet name.
   planet#      Planets      1=x, 2=y, 3=owner(0=none,1=human,2=AI), 4=population, 5=wealth,
                            6=race(1-4:equal to player or enemy race at time of colonising), 7=K1?, 8=K2?
   race         Races        1=attack, 2=defence, 3=pgr?, 4=economy, 5=colour, 6=desired colonies, 7=engage distance.
   ship_class   Ship class   1=attack, 2=defence, 3=speed, 4=range, 5=wealth cost, 6=population cost.
   ship#        Ship data    1=x, 2=y, 3=Owner[0=none|1=player|2=ai], 4=class, 5=attack, 6=defence, 7=speed, 8=range, 9=defence remaining,
                            10=destination x, 11=destination y, 12=fight duration, 13=build status(11=complete),
                            [14]= time since attacked, [15]= some AI thing??
   shipsel      Ship select  [0]= number of ships selected, [1]+ is a list where each entity stores the ID# of a selected ship.
   remend

   rem Propaganda Descriptions
   dim propaganda$(11)
   for i = 0 to 11 : read propaganda$(i) : next i

   rem DBC "globals"
   rem Ship limit
   dim ship_lim(0)
   ship_lim = 100 :`yes we need this too because DB doesn't like arrays being used to declare other arrays!
   ship_lim(0) = ship_lim
   rem Player and Enemy race
   dim PR(2)
   rem Colours (colours 1 and 2 are the player colours.)
   dim colour(3)
   colour(0) = rgb(255,255,255)
   colour(3) = rgb(108,108,108)
   rem Game Speed Modifier
   gamespeed# = 0

   rem Define arrays.
   dim string$(16)
   dim race(4,7)
   dim Ship_Class(4,6)
   dim Ship#(ship_lim,15)
   dim ShipSel(ship_lim)
   dim Planet#(31,8)
   dim planet$(31)
   dim build_permit(4)
   dim AI(9)

   rem read-in ship graphics
   for t=5 to 8
      read a
      string$(t)=chr$(a)
   next t

   rem read-in game text (race names generated in INITIALIZE:)
   for t=9 to 16
      read a$
      string$(t)=a$
   next t
   rem read race data
   race(0,5)=colour(0) :`neutral colour is colour(0).
   for t=1 to 4
      for u=1 to 7
         read a
         if u = 5
            read b
            read c
            race(t,u) = rgb(a,b,c)
         else
            race(t,u)=a
         endif
      next u
   next t
   rem read ship class data
   for t=1 to 4
      for u=1 to 6
         read a
         Ship_Class(t,u)=a
      next u
   next t
return
`//arrays_and_globals

make_backdrop:
  create bitmap 1,1024,768

  rem HUD border
  box 9,9,1013,740
  ink 0,0
  box 10,10,739,739
  box 741,10,1012,739

  rem create starry backdrop
   maxstars=1024
  for t=1 to maxstars
    x=rnd(720)+15
    y=rnd(720)+15
    rem star intensity
    i=230
    if (t/(maxstars+.0)) >= 0.10 then i=128
    if (t/(maxstars+.0)) >= 0.40 then i=64
    ink rgb(i,i,i),0
    dot x,y
  next t

  ink colour(0),0
  set current bitmap 0
return
`//make backdrop

check_end_game:
  rem check both sides have at least one planet each.
  p1=0 : p2=0
  for t=1 to 30
     if Planet#(t,3)=1 then p1 = 1
     if Planet#(t,3)=2 then p2 = 1
     if p1=1 and p2=1 then exit
  next t

  if p1=0 or p2=0
    if p2=0
      a$ = "VICTORY IS OURS!"
      b$ = "Congratulations General! You have vanquished The "
    else
      a$ = "ALL IS LOST!"
      b$ = "Your colony has been overrun by The "
    endif
    cls
    center text 512,200,a$
    center text 512,250,b$+propaganda$(6+rnd(5))+" "+string$(pr(2))+"s"
    wait 700
    sync
    wait key
    END
  endif
return
`//check end game

command_move_ships:
  rem Is a ship selected?
  if ShipSel(0)>0
    rem can only issue commands to our own ships!
    if ( ShipSel(0)=1 and Ship#(shipsel(1),3)=1 ) or shipsel(0)>1
      if mouseclick()=2
        if mousex()>10 and mousey()>10 and mousex()<740 and mousey()<740
          ships = shipsel(0) :`can't use arrays as parameters in loops.
          xoffset=0 : yoffset=0
          rem Give the ships their movement commands.
          for t=1 to ships
            if Ship#(shipsel(t),1)>0
              `spread out ships
              if ships>1
                n=(t+4)*1.5
                xoff=rnd(n+n)-n
                yoff=rnd(n+n)-n
              else
                xoff=0 : yoff=0
              endif
              Ship#(shipsel(t),10)=mousex()+xoff
              Ship#(shipsel(t),11)=mousey()+yoff
              rem keep ships within map
              if ship#(shipsel(t),10)<25 then ship#(shipsel(t),10)=25
              if ship#(shipsel(t),10)>725 then ship#(shipsel(t),10)=725
              if ship#(shipsel(t),11)<25 then ship#(shipsel(t),11)=25
              if ship#(shipsel(t),11)>725 then ship#(shipsel(t),11)=725
            endif
          next t
        endif
      endif
    endif
  endif
return
`//command move ships

command_select_objects:
   old_LMB = new_LMB
   new_LMB = (mouseclick()=1)
   rem Begin selection.
   if selecting=0 and new_LMB>old_LMB and mousex()<740 and mousey()<740
      selecting = 1
      planet_selected = 0
      ShipSel(0) = 0 :`reset number of ships selected.
      rem store mouse position when clicked
      mX_start = mousex()
      mY_start = mousey()
      slogan = rnd(5) :rem randomize propaganda slogans
   endif

   rem End selection: process selection.
   if selecting=1 and new_LMB<old_LMB
      selecting = 0
      rem store mouse position at release
      mX_end = mousex()
      mY_end = mousey()
      rem Box selection else pick selection.
      if abs(mX_end + mY_end - mX_start - mY_start) > 8
         rem sort box coordinates
         if mX_start > mX_end then inc mX_start, mX_end : mX_end = mX_start-mX_end : dec mX_start, mX_end
         if mY_start > mY_end then inc mY_start, mY_end : mY_end = mY_start-mY_end : dec mY_start, mY_end
         rem Mark ships within selection box as selected.
         for t=1 to ship_lim(0)
            ShipSel(t)=0 :`wipe the old selection data just to be tidy.
            rem only box-select player owned, constructed ships.
            if Ship#(t,3)=1 and Ship#(t,13)>11
               if Ship#(t,1)>mX_start and Ship#(t,1)<mX_end and Ship#(t,2)>mY_start and Ship#(t,2)<mY_end
                  ShipSel(0)=ShipSel(0)+1 :`increase the number of ships that have been selected.
                  ShipSel(ShipSel(0))=t :`place the selected ship in the new list place.
               endif
            endif
         next t
      else
         chosen = pick(mX_end,mY_end)
         if chosen>0 and chosen<31 then planet_selected = chosen              :rem planet selected (1 to 30)
         if chosen>1000 then ShipSel(0)=1 : ShipSel(ShipSel(0))=chosen-1000   :rem ship selected (1000+)
      endif
   endif
return
`//command select objects

display:
   rem refresh backdrop
   copy bitmap 1,0
   rem Show selection box during selection.
   if selecting=1
      rem store new mouse position
      mX = mousex()
      mY = mousey()
      rem draw selection box (fiddly but boxes are so much faster than lines)
      ax = mx_start : bx = mx
      ay = my_start : by = my
      if ax > bx then ax = bx+ax : bx = ax-bx : ax = ax-bx
      if ay > by then ay = by+ay : by = ay-by : ay = ay-by
      box ax,ay,bx,ay
      box bx,ay,bx,by
      box ax,by,bx,by
      box ax,ay,ax,by
   endif

   ` draw PLANETS
   set text size 18
   for t=1 to 30
      a$=""
      if Planet#(t,7)>1 then a$="?"
      if VIS(Planet#(t,1),Planet#(t,2),1) then a$ = "@" : ink colour(planet#(t,3)),0
      text Planet#(t,1)-5,Planet#(t,2)-7,a$
      ink colour(0),0
   next t
   set text size 14

   `DRAW SHIPS
   for t=1 to ship_lim(0)
      if Ship#(t,3)>0 and Ship#(t,1)>0
         if Ship#(t,3)=1 or VIS(Ship#(t,1),Ship#(t,2),1)
            if Ship#(t,13)<11
               ink colour(3),0
            else
               ink colour(Ship#(t,3)),0
            endif
            center text Ship#(t,1),Ship#(t,2)-6,string$(int(Ship#(t,4)+4))
         endif
      endif
   next t
   ink colour(0),0

   rem display selected planet data
   if planet_selected
      circle Planet#(planet_selected,1),Planet#(planet_selected,2),9
      a$="Uninhabited"
      s$=""
      if Planet#(planet_selected,3)=2
         a$="The "+propaganda$(6+slogan)+" "
         s$="s"
      endif
      if Planet#(planet_selected,3)=1
         a$="The "+propaganda$(slogan)+" "
         s$="s"
         rem Display ships for construction, with unaffordable ships in colour(3).
         for u=1 to 4
            c = 80+build_permit(u)*175
            ink rgb(c,c,c),0
            set text size 14
            text 760,300+u*20,str$(u)+". BUILD "+string$(u+8)
         next u
      endif

      ink -2,0
      text 760,20,str$(planet_selected)
      center text 876,40,"-=- "+planet$(planet_selected)+" -=-"
      text 760,80,"GOV: "+a$+string$(int(Planet#(planet_selected,6)))+s$
      text 760,100,"POP: "+str$(int(Planet#(planet_selected,4)))
      text 760,120,"CUR: "+str$(int(Planet#(planet_selected,5)))
   endif

   rem If single ship selected , display ship data
   if ShipSel(0)=1
   rem who owns the ship?
   if Ship#(ShipSel(1),3)=1
   owner_race$=string$(pr(1))
   else
   owner_race$=string$(pr(2))
   endif
   rem ship weapons status
   if Ship#(ShipSel(1),12)>0.1 then weapons$="Weapons Charging" else weapons$="Ready To Fire"
   rem ship damage status
   if Ship#(ShipSel(1),9)<Ship#(ShipSel(1),6)
   damage$="Damaged"
   if Ship#(ShipSel(1),14)>5 then damage$ = damage$+", REPAIRING NOW"
   else
   damage$="All Systems Operational"
   endif
   rem Under Construction
   if ship#(shipsel(1),13)<11
      ink 65535,0
      text 760,60,"UNDER CONSTRUCTION: "+str$(int(ship#(shipsel(1),13)*9))+"%"
      ink colour(0),0
   endif

   center text 876,40,"-=- "+owner_race$+" "+string$(int(Ship#(ShipSel(1),4))+8)+" -=-"
   text 760,80,"ATK: "+str$(int(Ship#(ShipSel(1),5)))
   text 760,100,"DEF: "+str$(int(Ship#(ShipSel(1),9)))+" / "+str$(int(Ship#(ShipSel(1),6)))
   text 760,140,weapons$
   text 760,160,damage$
   rem Ship "cam"
   x = ship#(shipsel(1),1) : y = ship#(shipsel(1),2)
   set current bitmap 0
   get image 1,x-20,y-20,x+20,y+20
   box 949,79,991,121
   paste image 1,950,80

   endif
   rem Show selected ship map graphics.
   if ShipSel(0)>0
   fleetposx#=0:fleetposy#=0:fleetdestx#=0:fleetdesty#=0:fleetmoving=0
   for t = 1 to ShipSel(0)
   rem circle the selected ship
   circle Ship#(ShipSel(t),1),Ship#(ShipSel(t),2),9
   rem show friendly ship path
   destx# = Ship#(ShipSel(t),10)
   desty# = Ship#(ShipSel(t),11)
   if destx#>0 AND Ship#(ShipSel(t),3)=1
   if ShipSel(0)=1
   rem show path if a single ship selected
   line Ship#(ShipSel(t),1),Ship#(ShipSel(t),2),destx#,desty#
   else
   inc fleetmoving
   rem store average data for a group selection
   fleetposx# = fleetposx# + Ship#(ShipSel(t),1)
   fleetposy# = fleetposy# + Ship#(ShipSel(t),2)
   fleetdestx# = fleetdestx# + destx#
   fleetdesty# = fleetdesty# + desty#
   endif
   endif
   next t
   rem show one path for a group selection
   if ShipSel(0)>1 and fleetmoving>0
   ax = fleetposx#/fleetmoving
   ay = fleetposy#/fleetmoving
   bx = fleetdestx#/fleetmoving
   by = fleetdesty#/fleetmoving
   line ax,ay,bx,by
   endif
   endif

   rem display game data
   select gamespeed#
   case 0 : a$="PAUSED" : endcase
   case default : a$=str$(gamespeed#) : endcase
   endselect
   text 760,700,"GAME SPEED : "+a$
   text 760,720,"FPS : "+str$(screen fps())
return
`//display

generate_races:
  rem generate race names
  for t=1 to 4
    a$=Generate_Race$()
    string$(t)=a$
  next t
return
`//

initialize:
  rem create planets
  repeat
    fail=0
    sxs=1

    for t=1 to 30
      yes=1
      repeat
        inc fail
        x=rnd(690)+30
        y=rnd(690)+30
        for u=1 to t-1
          dist#=d2d(x+.0,y+.0,Planet#(u,1),Planet#(u,2))
          if dist#<30
            yes=0
          endif
        next u
      until yes=1 or fail>1500

      if fail<=1500
        Planet#(t,1)=x
        Planet#(t,2)=y
        Planet#(t,3)=0
        planet$(t)=generate_planet$() :`generate planet name.
      else
        sxs=0
        EXIT
      endif
    next t
  until sxs=1

  ` NEW DESIGNATE HOMEWORLDS
  rem Human
  X=20
  for t=1 to 3
    sxs=0
    repeat
      inc X
      for u=1 to 30
        if Planet#(u,3)<1
          if Planet#(u,1)<x
            Planet#(u,3)=1
            Planet#(u,4)=1500
            Planet#(u,5)=1000
            Planet#(u,6)=pr(1)
            SXS=1
            EXIT
          endif
        endif
      next u
    until sxs=1
  next t
  rem AI
  X=720
  for t=4 to 6
    sxs=0
    repeat
      dec X
      for u=1 to 30
        if Planet#(u,3)<1
          if Planet#(u,1)>x
            Planet#(u,3)=2
            Planet#(u,4)=1500
            Planet#(u,5)=1000
            Planet#(u,6)=pr(2)
            SXS=1
            EXIT
          endif
        endif
      next u
    until sxs=1
  next t
return
`//initialize

race_select:
   repeat
      gosub generate_races
      rem list races
      cls
      center text 512,200,"Welcome. Use The Keyboard To Select Your Race"
      text 300,300,"1. "+string$(1) : text 600,300,"  (Warriors)"
      text 300,330,"2. "+string$(2) : text 600,330,"(Scientists)"
      text 300,360,"3. "+string$(3) : text 600,360,"  (Breeders)"
      text 300,390,"4. "+string$(4) : text 600,390,"   (Traders)"
      center text 512,450,"Press 5 to randomize the race names."

      rem wait for valid key press
      repeat
         sc=scancode()-1
         sync
      until sc>0 and sc<=5
   until sc<=4

   pr(1)=SC
   rem select enemy race.
   enemy = pr(1) + rnd(2)+1
   if enemy > 4 then dec enemy,4
   pr(2) = enemy
   rem store active colours
   colour(1) = race(pr(1),5)
   colour(2) = race(pr(2),5)

   rem display enemy race
   center text 512,500,"You Face The "+propaganda$(6+rnd(5))+" "+string$(pr(2))+"s!"
   sync:wait 2000:cls
return
`//race_select

`*** UNEDITED ***
update_ai:
 `0 numcol, 1 num DD, 2 num CA, 3 num BB, 4 # colships, 5 num ENEMY colonies,
 `6 - colony being attacked. 7. sync countdown of coming out of defense. 9 AI STATE DECIDED ON

`===================AI====================

` AI STATE determines WHICH SHIP IS BUILT.

` 1. DEFEND. build destroyers. send all ships within DOUBLE engagement range to the attacked planet.
` 2. PREPARE. build cruisers. CA & BB don't move. destroyers PATROL HOME.
` 3. ATTACK. build BB's. send all ships to their nearest seen enemy planet. if no enemy planet is seen, DDs PATROL AWAY.
` 4. COLONIZE. build COL ships. one at a time. (while any colony ships exist). if no empty planets are seen, DDs PATROL AWAY. as long as numcol<num_col_want

` clear AI statistics-keeping.
for t=0 to 5
 ai(t)=0
next t

NumEnColSeen=0

` AI, count your ships and planets.
for t=1 to 30
  if Planet#(t,3)=1 and Planet#(t,8)>0
    ai(5)= ai(5)+1
      if VIS(Planet#(t,1),Planet#(t,2),2)
        inc NumEnColSeen
      endif
    endif
  if Planet#(t,3)=2 then ai(0) = ai(0)+1
next t
for t=1 to ship_lim(0)
  if Ship#(t,3)=2
    ai(int(Ship#(t,4))) = ai(int(Ship#(t,4)))+1
  endif
next t

` THIS decides on the AI state.
` if you are NOT under attack, AND you have enough DESTROYERS
if ai(6)=0 and ai(1)>=ai(0)
 ` if you don't have enough colonies, AND you don't have any colony ships, then COLONIZE.
 if ai(0)<race(pr(2),6) and ai(4)<1
  ai(9)=4
 else

   pow=ai(1)+ai(2)*2+ai(3)*3
   snd=ai(0)*4+ai(5)

    if pow>snd
     ai(9)=3 : ` if you have enough ships to attack, then do so.
    else
     ai(9)=2 : ` otherwise wait, and keep building.
    endif

       IF pow>(3*snd) AND ai(0)<25
        ` ifyou have LOTS of ships and not totally colonized all of space, then colonize.
        ai(9)=4
       ENDIF

 endif
else
 ai(9)=1 : ` if you're under attack, or you don't have enough destroyers, then state=1.
endif

if ai(6)>0
 ai(7) = ai(7)-1
 ai(9)=1
  if ai(7)<1
   ai(6)=0
  endif
endif

` this builds ships based on AI STATE:
 if ai(9)>0
for t=1 to 30
 if Planet#(t,3)=2
  if Planet#(t,4)>Ship_Class(ai(9),6)*2
  if Planet#(t,5)>Ship_Class(ai(9),5)
   Planet#(t,4) = Planet#(t,4)-Ship_Class(ai(9),6)
   Planet#(t,5) = Planet#(t,5)-Ship_Class(ai(9),5)
   Build_Ship(2,pr(2),Planet#(t,1),Planet#(t,2),ai(9),Rnd(359))
   EXIT : ` ONLY ONE ships is built per cycle, so we don't build too many of something.
  endif
  endif
 endif
next t
 endif

  ` this will build COLONY SHIPS at any owned planet with a POP >2499 , as long as you have <10 colonies
if ai(0)<13
for t=1 to 30
 if Planet#(t,3)=2
  if Planet#(t,4)>2499
  if Planet#(t,5)>Ship_Class(4,5)
   Planet#(t,4) = Planet#(t,4)-Ship_Class(4,6)
   Planet#(t,5) = Planet#(t,5)-Ship_Class(4,5)
   Build_Ship(2,pr(2),Planet#(t,1),Planet#(t,2),4,Rnd(359))
  endif
  endif
 endif
next t
endif

 ` if we are really under attack, defend the colony:
if ai(9)=1
 if ai(6)>0
  Defend_Planet(ai(6))
 endif
endif

if ai(9)=3
 ` if ATTACK
   for t=1 to ship_lim(0)
     Ship#(t,15)=0
    IF Ship#(t,4)<4
     if Ship#(t,3)=2
     if Ship#(t,13)>11
     if Ship#(t,1)>0
     if Ship#(t,10)<10
      Ship#(t,15)=99
        Ship#(t,10)=rnd(710)+20
        Ship#(t,11)=rnd(710)+20
     endif
     endif
     endif
     endif
    ENDIF
   next t

   attack()
 endif

`these should be called regardless of AI STATE.
`if you have built colony ships, then use them! if you see enemy, attack!
AI_Engage_Ship()
Send_Colony_Ships()

`===================END=AI====================
return
`//update ai

update_planet_data:
  for t=1 to 30
    `grow the pop & economy. make wealth first, then grow pop.
    if Planet#(t,3)>0
      Planet#(t,5)=Planet#(t,5)+ ( (race(int(Planet#(t,6)),4)*Planet#(t,4))*gameticks#)/250.1
      Planet#(t,4)=Planet#(t,4)+ ( (race(int(Planet#(t,6)),3))*gameticks#)
      if Planet#(t,4)>2500 then Planet#(t,4)=2500
    endif
    rem planets visible by human
    if VIS(Planet#(t,1),Planet#(t,2),1)
      Planet#(t,7)=99
    endif
    rem planets visible by ai
    if VIS(Planet#(t,1),Planet#(t,2),2)
      Planet#(t,8)=99
    endif
  next t
return
`//

update_ship_data:
  `Ship live data: 1=x,2=y,3=own,4=size,5=atk,6=def,7=spd,8=range,9=def_left,10=targetx,11=targety
  `                12=FightTime,13=built,14=Time Since been hit
  for t=1 to ship_lim(0)
    rem Check the ship exists (has an owner).
    if Ship#(t,3)>0
      rem BUILD SHIPS - once ship#[t,13] reaches 11 the ship is completed.
      if Ship#(t,13) <= 11
        rem big ships take longer to build.
        Ship#(t,13) = Ship#(t,13)+(gameticks#*7)/Ship#(t,4)
      endif
      ` REPAIR SHIPS - any ship that has not been shot in the last 20 gameticks# will start to slowly repair itself.
      Ship#(t,14) = Ship#(t,14)+gameticks#
      if Ship#(t,14)>5
        if Ship#(t,9)<Ship#(t,6)
          Ship#(t,9) = Ship#(t,9)+gameticks#*21
        endif
      endif
      ` MOVE SHIPS - move any ship that has a target co-ordinate.
      if Ship#(t,10)>0
        rem check ship is built
        if Ship#(t,13)>11
          dx#=(Ship#(t,1)-Ship#(t,10))
          dy#=(Ship#(t,2)-Ship#(t,11))
          rem destination reached.
          if abs(dx#)<3 and abs(dy#)<3
            Ship#(t,10)=0
            Ship#(t,11)=0
          endif
          rem move ship towards target
          a#=wrapvalue((ATANFULL(dx#,dy#)))
          Ship#(t,1)=Ship#(t,1)-( sin(a#)*gameticks#*Ship#(t,7)*3 )
          Ship#(t,2)=Ship#(t,2)-( cos(a#)*gameticks#*Ship#(t,7)*3 )
        endif
      endif
      ` COLONIZE/ATTACK PLANETS (colonizers don't attack)
      Ship#(t,12) = Ship#(t,12)-gameticks#*5
      for u=1 to 30
        if Ship#(t,4)=4
          ` Colonize Empty Planets - this works for everybody, automatically.
          if Planet#(u,3)=0
            if d2d(Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2))<7.0
              Planet#(u,3)=Ship#(t,3)
              Planet#(u,4)=500
              Planet#(u,5)=350
              Planet#(u,6)=pr(Ship#(t,3))
               kill_ship(t)
            endif
          endif
        else
          ` Attack Planet
          if Ship#(t,12)<0.1
            ` if you still haven't fired, try to attack planets.
            if Planet#(u,3)>0 and Planet#(u,3)<>Ship#(t,3)
              if d2d(Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2))<20
                line Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2)
                for a=int(Ship#(t,1))-2 to int(Ship#(t,1))+2
                  for b=int(Ship#(t,2))-2 to int(Ship#(t,2))+2
                    line a,b,Planet#(u,1),Planet#(u,2)
                  next b
                next a
                Planet#(u,4) = Planet#(u,4)-Ship#(t,5)
                ` tell AI one of its planets is under attack.
                if Planet#(u,3)=2 AND ai(6)=0
                  ai(6)=u
                  ai(7)=500
                endif
                rem wipe out population.
                if Planet#(u,4)<1
                  Planet#(u,3)=0
                  Planet#(u,4)=0
                  Planet#(u,5)=0
                  Planet#(u,6)=0
                endif
                Ship#(t,12)=2.5+( rnd(99)/9.9 ):`increase attack time.
                EXIT:`only one attack per turn
              endif
            endif
          endif
        endif
      next u
      ` SHIPS FIGHT
      if Ship#(t,4)<4 : ` colony ships DON'T ATTACK.
        if Ship#(t,12)<0.1
          `attack an enemy ship
          for u=1 to ship_lim(0)
            if Ship#(u,3)>0 and Ship#(u,3)<>Ship#(t,3)
              if d2d(Ship#(t,1),Ship#(t,2),Ship#(u,1),Ship#(u,2))<Ship#(t,8)
                for a=int(Ship#(t,1))-2 to int(Ship#(t,1))+2
                  for b=int(Ship#(t,2))-2 to int(Ship#(t,2))+2
                    line a,b,Ship#(u,1),Ship#(u,2)
                  next b
                next a
                Ship#(t,12)=2.5+( rnd(99)/9.9 ):`increase attack time.
                ` enemy ship hit.
                Ship#(u,9) = Ship#(u,9)-Ship#(t,5)
                Ship#(u,14)=0
                ` kill dead ships:
                if Ship#(u,9)<1
                  kill_ship(u)
                  ` since ship T killed ship U, give ship T some EXPERIENCE.
                  Ship#(T,5) = Ship#(T,5)+(Ship#(t,4)) : ` +1 atk/size
                  Ship#(T,6) = Ship#(T,6)+5*(Ship#(t,4)) : ` +5 DEF per size
                  Ship#(T,7) = Ship#(T,7)+1 : ` +1 SPD regardless of size
                  Ship#(T,8) = Ship#(T,8)+1 : ` +1 RNG regardless of size
                endif
                EXIT:`only one attack per turn
              endif
            endif
          next u
        endif
      endif
    endif
  next t
return
`//update ship data

validate_selection:
  rem Non-human planet still visible.
  if planet_selected and planet#(planet_selected,3)<>1
    if VIS(planet#(planet_selected,1),planet#(planet_selected,2),1)=0 then planet_selected=0
  endif
  rem Ships
  if ShipSel(0)>0
    rem Enemy ship still visible.
    if ship#(ShipSel(1),3)=2
      if VIS(ship#(ShipSel(1),1),ship#(ShipSel(1),2),1)=0 then deselect_ship(ShipSel(1))
    else
      rem Check for dead ships.
      for t = 1 to ShipSel(0)
        if Ship#(ShipSel(t),3)=0 then deselect_ship(ShipSel(t))
      next t
    endif
  endif
return
`//


rem ======================================
rem === FUNCTIONS ===
rem ======================================
function kill_ship(n)
   for i = 1 to 15 : ship#(n,i)=0 : next i
   deselect_ship(n)
endfunction
`//

function deselect_ship(n)
  rem Find and remove the ship from the selection list.
  for t = 1 to ShipSel(0)
    if ShipSel(t)=n
      `Move higher entries down to fill the gap.
      for bump = t to ShipSel(0)-1
        ShipSel(bump) = ShipSel(bump+1)
      next bump
      ShipSel(ShipSel(0))=0 :`Delete last entry which is no longer needed.
      ShipSel(0) = ShipSel(0)-1 :`reduce number of ships in the list.
      EXIT
    endif
  next t
endfunction
`//

function d2d(ax#,ay#,bx#,by#)
  rem distance between A and B.
  dist#=sqrt( (ax#-bx#)*(ax#-bx#) + (ay#-by#)*(ay#-by#) )
endfunction dist#
`//

Function VIS(x#,y#,p)
   rem This function determines whether player P can see coord x,y. 0=no, 1=yes
   V=0
   for t=1 to ship_lim(0)
      if Ship#(t,3)=p
         if Ship#(t,13)>11
            dist#=d2d(Ship#(t,1),Ship#(t,2),x#,y#)
            if dist#<50 then V=1 : EXIT
         endif
      endif
   next t
   for t=1 to 30
      if int(Planet#(t,3))=p
         dist#=d2d(Planet#(t,1),Planet#(t,2),x#,y#)
         if dist#<100 then V=1 : EXIT
      endif
   next t
Endfunction V
`//

Function PICK(x,y)
   `Only the HUMAN player uses this function. Returns 0 for nothing picked, 1-30 for a planet, 1001-2000 for a ship.
   for t=1 to 30
      if VIS(Planet#(t,1),Planet#(t,2),1)
         if d2d(Planet#(t,1),Planet#(t,2),x+.0,y+.0)<7 then exitfunction t
      endif
   next t

   rem Only check for ships if no planet is found.
   for t=1 to ship_lim(0)
      if VIS(Ship#(t,1),Ship#(t,2),1)
         if d2d(Ship#(t,1),Ship#(t,2),x+.0,y+.0)<7 then exitfunction t+1000
      endif
   next t
Endfunction 0
`//

Function Build_Ship(owner,race,x#,y#,class,ang)
   for s = 1 to ship_lim(0)
      if Ship#(s,3)=0.0 then exit
   next s
   if s>ship_lim(0) then exitfunction -1 :`break if no id available

   for u=1 to 14 : Ship#(s,u)=0 : next u :`wipe old data
   Ship#(s,1)=x#+(sin(ang)*16)
   Ship#(s,2)=y#+(cos(ang)*16)
   Ship#(s,3)=owner
   Ship#(s,4)=class
   Ship#(s,5)=race(race,1)*Ship_Class(class,1)
   Ship#(s,6)=race(race,2)*Ship_Class(class,2)*15
   Ship#(s,7)=Ship_Class(class,3)
   Ship#(s,8)=Ship_Class(class,4)
   Ship#(s,9)=race(race,2)*Ship_Class(class,2)*15
Endfunction
`//

Function AI_Engage_Ship()
   rem if an AI ship SEES another ship (and it's not already in combat) ,
   rem it might just attack that other ship. but there is a range limit.
   rem this should NOT happen if AI STATE is DEFEND.
   for t=1 to ship_lim(0)
      if Ship#(t,3)=2
         if Ship#(t,13)>11
            if Ship#(t,1)>0
               if Ship#(t,4)<4
                  if Ship#(t,14)>8
                     for u=1 to ship_lim(0)
                        if Ship#(u,3)=1
                           if Ship#(u,13)>11
                              if Ship#(u,1)>0
                                 if VIS(Ship#(u,1),Ship#(u,2),2) : ` if we see this enemy ship.
                                    if d2d(Ship#(t,1),Ship#(t,2),Ship#(u,1),Ship#(u,2))<race(pr(2),7) : ` if its within our ENGAGEMENT RANGE
                                       Ship#(t,10)=Ship#(u,1)+rnd(15)-8
                                       Ship#(t,11)=Ship#(u,2)+rnd(15)-8
                                       EXIT
                                    endif
                                 endif
                              endif
                           endif
                        endif
                     next u
                  endif
               endif
            endif
         endif
      endif
   next t
Endfunction
`//

Function Defend_Planet(p)
   for t=1 to ship_lim(0)
      if Ship#(t,3)=2
         if Ship#(t,13)>11
            if Ship#(t,1)>0
               if Ship#(t,4)<4
                  if d2d(Ship#(t,1),Ship#(t,2),Planet#(p,1),Planet#(p,2))<450 : ` make defense much more of a Priority. : ` (race(er,7)*2)
                     Ship#(t,10)=Planet#(p,1)+rnd(15)-8
                     Ship#(t,11)=Planet#(p,2)+rnd(15)-8
                  endif
               endif
            endif
         endif
      endif
   next t
Endfunction
`//

Function Send_Colony_Ships()
   for t=1 to ship_lim(0)
      IF Ship#(t,4)=4
         if Ship#(t,3)=2
            if Ship#(t,13)>11
               if Ship#(t,1)>0
                  dis=999
                  plan=0
                  for u=1 to 30
                     if Planet#(u,3)=0
                        if VIS(Planet#(u,1),Planet#(u,2),2)
                           dist#=d2d(Planet#(u,1),Planet#(u,2),Ship#(t,1),Ship#(t,2))
                           if dist#<dis
                              dis=dist#
                              plan=u
                           endif
                        endif
                     endif
                  next u
                  if plan>0
                     Ship#(t,10)=Planet#(plan,1)
                     Ship#(t,11)=Planet#(plan,2)
                  endif
               endif
            endif
         endif
      ENDIF
   next t
Endfunction
`//

Function ATTACK()
  for t=1 to ship_lim(0)
    if Ship#(t,3)=2
       if Ship#(t,13)>11
          if Ship#(t,1)>0
             if Ship#(t,4)<4
                dis=999
                plan=0
                for u=1 to 30
                   if Planet#(u,3)=1
                      if VIS(Planet#(u,1),Planet#(u,2),2)
                         dist#=d2d(Planet#(u,1),Planet#(u,2),Ship#(t,1),Ship#(t,2))
                         if dist#<dis
                            dis=dist#
                            plan=u
                         endif
                      endif
                   endif
                next u
                if plan>0
                   Ship#(t,10)=Planet#(plan,1)
                   Ship#(t,11)=Planet#(plan,2)
                endif
             endif
          endif
       endif
     endif
  next t
Endfunction
`//

rem *** OBESE87'S RANDOM NAME GENERATOR FUNCTIONS ***
function Generate_Race$()
  race$ = ""
  race$ = Generate_Planet$()
  rem Select a suffix depending on the last letter.
  last$ = right$(race$,1)
   select last$
      case "a" "e" "o" "i" "u" : k=rnd(5) : endcase
      case default : k=rnd(4)+4 : endcase
   endselect

   select k
      case 0 : race$ = race$+"n" : endcase
      case 1 : endcase
      case 2 : race$ = race$+"can" : endcase
      case 3 : race$ = race$+"ni" : endcase
      case 4 : race$ = race$+"an" : endcase
      case 5 : race$ = race$+"on" : endcase
      case 6 : race$ = race$+"i" : endcase
      case 7 : race$ = race$+"ese" : endcase
      case 8 : race$ = race$+"ite" : endcase
   endselect
endfunction race$
`//

function Generate_Planet$()
  planet$=""
  rem Define number of character pairs to generate.
  name_len = rnd(1)+2

  for i = 1 to name_len
    rem After first letter switch to lower case.
    if i>1 then capoff=32 else capoff=0
    rem Get a random parent character.
    Parent = rnd(25)+65
    rem Make sure name doesn't end in "QU".
    if i=name_len
      if Parent=81 then Parent=Parent-1-rnd(15)
    endif
    rem Add parent to planet name.
    planet$ = planet$+chr$(Parent+capoff)
    rem Generate child from parent.
    Select Parent
      rem Q.
      Case 81 : planet$=planet$+"u" : Endcase
      rem Vowel.
      Case 65 or 69 or 73 or 79 or 85
        child = rnd(5)
        if child=0 then planet$=planet$+"d"
        if child=1 then planet$=planet$+"l"
        if child=2 then planet$=planet$+"n"
        if child=3 then planet$=planet$+"r"
        if child=4 then planet$=planet$+"s"
        if child=5 then planet$=planet$+"t"
      Endcase
      rem Consonant.
      Case Default
        child = rnd(4)
        if child=0 then planet$=planet$+"a"
        if child=1 then planet$=planet$+"e"
        if child=2 then planet$=planet$+"i"
        if child=3 then planet$=planet$+"o"
        if child=4 then planet$=planet$+"u"
      Endcase
  next i
endfunction planet$
`//

remstart
Space RTS - by IBOL - 20th March 2010
Continued by OBese87 - Last Updated: 10/JAN/2013
Fluffy Rabbit added music (just as a demonstration)
------------
-=- Known Bugs -=-
* Not all planets are building ships.
* Instant ship building at start of game if order given while paused (useful for testing purposes however).
* Enemy ships continue defending a planet even after their colony has been destroyed.
------------
-=- Feature Ideas -=-
- Stay Together -
Ships in a group should move at the speed of the slowest member.
- Advanced Movement Orders -
Guard or follow other ships.
Set up patrol routes.
Move in formation.
- Limited Resources -
Each planet has a finite mineral pool, minerals are harvested by the inhabitants and converted into currency for building ships.
Once a planet's resources are depleated the population will start to drop and consume currency.
A new class of ship, the trade vessel, can take resources from an abundant planet and deliver them where they are needed, but these ships cannot
defend themselves or attack the enemy.
(When the game is expanded to more than two races the merchant will also be able to trade with allies and send peace offerings.)
- Strategic Repairs -
Ships only repair when near a homeworld. Maybe some kind of carrier ship can be a mobile base for repairs too.
- Ship Progression -
Ships receive stat boosts for combat experience and kills.
------------
remend

set display mode 1024,768,32
sync on
sync rate 0
randomize timer()
set text font "lucida console",1
set text size 16
ink -2,0
hide mouse
gosub arrays_and_globals
gosub make_tunes
gosub race_select
gosub initialize
gosub make_backdrop
show mouse

rem === MAIN ===
do
   rem >> INPUT >>
   oldkey = key
   key = scancode()

`{
   rem Adjust game speed (+/- keys) Pause "P".
   if key>oldkey
      rem Pause game else adjust speed.
      if key=25
         gamespeed#=0
      else
         if key=78 or key=74
            gamespeed# = gamespeed# * ( (key=78)*2 + (key=74)*0.5 )
            if gamespeed#<1 then gamespeed#=1
            if gamespeed#>32 then gamespeed#=32
         endif
      endif
   endif
`}

   gosub command_select_objects
   gosub validate_selection
   gosub command_move_ships

`{
   rem Planetary Command Centre
   if planet_selected and planet#(planet_selected,3)=1
      rem Calculate ship building permits for this planet.
      for u = 1 to 4
         rem What ship classes can we afford here?
         enough_people = Planet#(planet_selected,4)>=(Ship_Class(u,6)*2) :rem I don't like how this *2 is hidden away in here.
         enough_money = Planet#(planet_selected,5)>=Ship_Class(u,5)
         build_permit(u) = enough_people * enough_money :`AND logic
         build_permit(u)=1 :`override for testing !!!!
      next u

      if key > oldkey
         rem We want to build a ship.
         if key>=2 and key<=5
            class = key-1 :`convert scancode to ship class.
            rem Can we afford to build this class of ship?
            if build_permit(class)
               rem Subtract build cost from planetary resources.
               Planet#(planet_selected,4) = Planet#(planet_selected,4)-Ship_Class(class,6)
               Planet#(planet_selected,5) = Planet#(planet_selected,5)-Ship_Class(class,5)
               rem Begin construction.
               build_error = Build_Ship(1,pr(1),Planet#(planet_selected,1),Planet#(planet_selected,2),class,Rnd(359))
               if build_error = -1 then end
            endif
         endif
      endif
   endif
`}

   rem >> PROCESS >>
   if gamespeed#>0
      rem Control game timer
      gameticks# = (timer()-t1) * gamespeed# * 0.00004
      t1=timer()
      gosub update_planet_data
      gosub update_ship_data
      gosub update_ai
      gosub check_end_game
   endif

   rem >> OUTPUT >>
   gosub display
   sync:cls
loop
END


rem ======================================
rem === DATA ===
rem ======================================
rem Propaganda Descriptions
data "Glorious", "Righteous", "Noble", "Mighty", "Brave", "Valiant"
data "Vile", "Evil", "Wretched", "Foul", "Savage", "Cowardly"

data 18,15,128,222 :`ascii codes for ship graphics
data "Viper","Falcon","Titan","Colonizer"
data "DEFEND","PREPARE","ATTACK","COLONIZE"
`    RACE
`    atk,def,pgr,eco,  R,  G,  B,#col, engage dist
data 33, 14, 17, 11, 255,  0,  0,   4, 300
data 17, 26, 11, 14, 180,  0,180,   5, 150
data 14, 11, 20, 17,   0,180,  0,   8, 225
data 11, 17, 14, 20, 255,180,  0,   6, 100
` SHIPS:
`  atk,def,spd,rng,cost,POP-cost
data 3, 2, 20, 20, 500,  50
data 6, 5, 15, 27, 1000, 100
data 12,14,10, 34, 2000, 150
data 0, 1, 7,  0,  1500, 500
`//

rem ======================================
rem === SUBROUTINES ===
rem ======================================
arrays_and_globals:
   remstart
   (ship classes always ordered: Destroyer, Cruiser, Battleship, Colonizer)
   NAME        DESCRIPTION  DATA
   ai           AI           0=number of colonies, 1-4=number of ships in each class, 5=number of enemy colonies,
                            6=colony under attack,7=sync countdown of coming out of defence, 9=AI state decided on.
   build_permit Ship build   1-4=ship classes by size(1=can build,0=cannot build).
   string$           Game text    1-4=race names, 5-8=ship ascii images, 9-12=ship names, 13-16=ai state strings.
   planet$      Planet name  0=planet name.
   planet#      Planets      1=x, 2=y, 3=owner(0=none,1=human,2=AI), 4=population, 5=wealth,
                            6=race(1-4:equal to player or enemy race at time of colonising), 7=K1?, 8=K2?
   race         Races        1=attack, 2=defence, 3=pgr?, 4=economy, 5=colour, 6=desired colonies, 7=engage distance.
   ship_class   Ship class   1=attack, 2=defence, 3=speed, 4=range, 5=wealth cost, 6=population cost.
   ship#        Ship data    1=x, 2=y, 3=Owner[0=none|1=player|2=ai], 4=class, 5=attack, 6=defence, 7=speed, 8=range, 9=defence remaining,
                            10=destination x, 11=destination y, 12=fight duration, 13=build status(11=complete),
                            [14]= time since attacked, [15]= some AI thing??
   shipsel      Ship select  [0]= number of ships selected, [1]+ is a list where each entity stores the ID# of a selected ship.
   remend

   rem Propaganda Descriptions
   dim propaganda$(11)
   for i = 0 to 11 : read propaganda$(i) : next i

   rem DBC "globals"
   rem Ship limit
   dim ship_lim(0)
   ship_lim = 100 :`yes we need this too because DB doesn't like arrays being used to declare other arrays!
   ship_lim(0) = ship_lim
   rem Player and Enemy race
   dim PR(2)
   rem Colours (colours 1 and 2 are the player colours.)
   dim colour(3)
   colour(0) = rgb(255,255,255)
   colour(3) = rgb(108,108,108)
   rem Game Speed Modifier
   gamespeed# = 0

   rem Define arrays.
   dim string$(16)
   dim race(4,7)
   dim Ship_Class(4,6)
   dim Ship#(ship_lim,15)
   dim ShipSel(ship_lim)
   dim Planet#(31,8)
   dim planet$(31)
   dim build_permit(4)
   dim AI(9)

   rem read-in ship graphics
   for t=5 to 8
      read a
      string$(t)=chr$(a)
   next t

   rem read-in game text (race names generated in INITIALIZE:)
   for t=9 to 16
      read a$
      string$(t)=a$
   next t
   rem read race data
   race(0,5)=colour(0) :`neutral colour is colour(0).
   for t=1 to 4
      for u=1 to 7
         read a
         if u = 5
            read b
            read c
            race(t,u) = rgb(a,b,c)
         else
            race(t,u)=a
         endif
      next u
   next t
   rem read ship class data
   for t=1 to 4
      for u=1 to 6
         read a
         Ship_Class(t,u)=a
      next u
   next t
return
`//arrays_and_globals

make_backdrop:
  create bitmap 1,1024,768

  rem HUD border
  box 9,9,1013,740
  ink 0,0
  box 10,10,739,739
  box 741,10,1012,739

  rem create starry backdrop
   maxstars=1024
  for t=1 to maxstars
    x=rnd(720)+15
    y=rnd(720)+15
    rem star intensity
    i=230
    if (t/(maxstars+.0)) >= 0.10 then i=128
    if (t/(maxstars+.0)) >= 0.40 then i=64
    ink rgb(i,i,i),0
    dot x,y
  next t

  ink colour(0),0
  set current bitmap 0
return
`//make backdrop

make_tunes:
  mus_theme=1

  snd_click1=2
  snd_click2=3

  trashmem=20

  sg(mus_theme,trashmem,8,"abcdefgabcdefg--bbbbbbbb--abcdefgabcdefg--aaaaaaaa--")

  sg(snd_click1,trashmem,16,"A")
  sg(snd_click2,trashmem,32,"AD")
return
`//make tunes

check_end_game:
  rem check both sides have at least one planet each.
  p1=0 : p2=0
  for t=1 to 30
     if Planet#(t,3)=1 then p1 = 1
     if Planet#(t,3)=2 then p2 = 1
     if p1=1 and p2=1 then exit
  next t

  if p1=0 or p2=0
    if p2=0
      a$ = "VICTORY IS OURS!"
      b$ = "Congratulations General! You have vanquished The "
    else
      a$ = "ALL IS LOST!"
      b$ = "Your colony has been overrun by The "
    endif
    cls
    center text 512,200,a$
    center text 512,250,b$+propaganda$(6+rnd(5))+" "+string$(pr(2))+"s"
    wait 700
    sync
    wait key
    END
  endif
return
`//check end game

command_move_ships:
  rem Is a ship selected?
  if ShipSel(0)>0
    rem can only issue commands to our own ships!
    if ( ShipSel(0)=1 and Ship#(shipsel(1),3)=1 ) or shipsel(0)>1
      if mouseclick()=2
        if mousex()>10 and mousey()>10 and mousex()<740 and mousey()<740
          ships = shipsel(0) :`can't use arrays as parameters in loops.
          xoffset=0 : yoffset=0
          rem Give the ships their movement commands.
          for t=1 to ships
            if Ship#(shipsel(t),1)>0
              `spread out ships
              if ships>1
                n=(t+4)*1.5
                xoff=rnd(n+n)-n
                yoff=rnd(n+n)-n
              else
                xoff=0 : yoff=0
              endif
              Ship#(shipsel(t),10)=mousex()+xoff
              Ship#(shipsel(t),11)=mousey()+yoff
              rem keep ships within map
              if ship#(shipsel(t),10)<25 then ship#(shipsel(t),10)=25
              if ship#(shipsel(t),10)>725 then ship#(shipsel(t),10)=725
              if ship#(shipsel(t),11)<25 then ship#(shipsel(t),11)=25
              if ship#(shipsel(t),11)>725 then ship#(shipsel(t),11)=725
            endif
          next t
        endif
      endif
    endif
  endif
return
`//command move ships

command_select_objects:
   old_LMB = new_LMB
   new_LMB = (mouseclick()=1)
   rem Begin selection.
   if selecting=0 and new_LMB>old_LMB and mousex()<740 and mousey()<740
      play sound snd_click1

      selecting = 1
      planet_selected = 0
      ShipSel(0) = 0 :`reset number of ships selected.
      rem store mouse position when clicked
      mX_start = mousex()
      mY_start = mousey()
      slogan = rnd(5) :rem randomize propaganda slogans
   endif

   rem End selection: process selection.
   if selecting=1 and new_LMB<old_LMB
      play sound snd_click2

      selecting = 0
      rem store mouse position at release
      mX_end = mousex()
      mY_end = mousey()
      rem Box selection else pick selection.
      if abs(mX_end + mY_end - mX_start - mY_start) > 8
         rem sort box coordinates
         if mX_start > mX_end then inc mX_start, mX_end : mX_end = mX_start-mX_end : dec mX_start, mX_end
         if mY_start > mY_end then inc mY_start, mY_end : mY_end = mY_start-mY_end : dec mY_start, mY_end
         rem Mark ships within selection box as selected.
         for t=1 to ship_lim(0)
            ShipSel(t)=0 :`wipe the old selection data just to be tidy.
            rem only box-select player owned, constructed ships.
            if Ship#(t,3)=1 and Ship#(t,13)>11
               if Ship#(t,1)>mX_start and Ship#(t,1)<mX_end and Ship#(t,2)>mY_start and Ship#(t,2)<mY_end
                  ShipSel(0)=ShipSel(0)+1 :`increase the number of ships that have been selected.
                  ShipSel(ShipSel(0))=t :`place the selected ship in the new list place.
               endif
            endif
         next t
      else
         chosen = pick(mX_end,mY_end)
         if chosen>0 and chosen<31 then planet_selected = chosen              :rem planet selected (1 to 30)
         if chosen>1000 then ShipSel(0)=1 : ShipSel(ShipSel(0))=chosen-1000   :rem ship selected (1000+)
      endif
   endif
return
`//command select objects

display:
   rem refresh backdrop
   copy bitmap 1,0
   rem Show selection box during selection.
   if selecting=1
      rem store new mouse position
      mX = mousex()
      mY = mousey()
      rem draw selection box (fiddly but boxes are so much faster than lines)
      ax = mx_start : bx = mx
      ay = my_start : by = my
      if ax > bx then ax = bx+ax : bx = ax-bx : ax = ax-bx
      if ay > by then ay = by+ay : by = ay-by : ay = ay-by
      box ax,ay,bx,ay
      box bx,ay,bx,by
      box ax,by,bx,by
      box ax,ay,ax,by
   endif

   ` draw PLANETS
   set text size 18
   for t=1 to 30
      a$=""
      if Planet#(t,7)>1 then a$="?"
      if VIS(Planet#(t,1),Planet#(t,2),1) then a$ = "@" : ink colour(planet#(t,3)),0
      text Planet#(t,1)-5,Planet#(t,2)-7,a$
      ink colour(0),0
   next t
   set text size 14

   `DRAW SHIPS
   for t=1 to ship_lim(0)
      if Ship#(t,3)>0 and Ship#(t,1)>0
         if Ship#(t,3)=1 or VIS(Ship#(t,1),Ship#(t,2),1)
            if Ship#(t,13)<11
               ink colour(3),0
            else
               ink colour(Ship#(t,3)),0
            endif
            center text Ship#(t,1),Ship#(t,2)-6,string$(int(Ship#(t,4)+4))
         endif
      endif
   next t
   ink colour(0),0

   rem display selected planet data
   if planet_selected
      circle Planet#(planet_selected,1),Planet#(planet_selected,2),9
      a$="Uninhabited"
      s$=""
      if Planet#(planet_selected,3)=2
         a$="The "+propaganda$(6+slogan)+" "
         s$="s"
      endif
      if Planet#(planet_selected,3)=1
         a$="The "+propaganda$(slogan)+" "
         s$="s"
         rem Display ships for construction, with unaffordable ships in colour(3).
         for u=1 to 4
            c = 80+build_permit(u)*175
            ink rgb(c,c,c),0
            set text size 14
            text 760,300+u*20,str$(u)+". BUILD "+string$(u+8)
         next u
      endif

      ink -2,0
      text 760,20,str$(planet_selected)
      center text 876,40,"-=- "+planet$(planet_selected)+" -=-"
      text 760,80,"GOV: "+a$+string$(int(Planet#(planet_selected,6)))+s$
      text 760,100,"POP: "+str$(int(Planet#(planet_selected,4)))
      text 760,120,"CUR: "+str$(int(Planet#(planet_selected,5)))
   endif

   rem If single ship selected , display ship data
   if ShipSel(0)=1
   rem who owns the ship?
   if Ship#(ShipSel(1),3)=1
   owner_race$=string$(pr(1))
   else
   owner_race$=string$(pr(2))
   endif
   rem ship weapons status
   if Ship#(ShipSel(1),12)>0.1 then weapons$="Weapons Charging" else weapons$="Ready To Fire"
   rem ship damage status
   if Ship#(ShipSel(1),9)<Ship#(ShipSel(1),6)
   damage$="Damaged"
   if Ship#(ShipSel(1),14)>5 then damage$ = damage$+", REPAIRING NOW"
   else
   damage$="All Systems Operational"
   endif
   rem Under Construction
   if ship#(shipsel(1),13)<11
      ink 65535,0
      text 760,60,"UNDER CONSTRUCTION: "+str$(int(ship#(shipsel(1),13)*9))+"%"
      ink colour(0),0
   endif

   center text 876,40,"-=- "+owner_race$+" "+string$(int(Ship#(ShipSel(1),4))+8)+" -=-"
   text 760,80,"ATK: "+str$(int(Ship#(ShipSel(1),5)))
   text 760,100,"DEF: "+str$(int(Ship#(ShipSel(1),9)))+" / "+str$(int(Ship#(ShipSel(1),6)))
   text 760,140,weapons$
   text 760,160,damage$
   rem Ship "cam"
   x = ship#(shipsel(1),1) : y = ship#(shipsel(1),2)
   set current bitmap 0
   get image 1,x-20,y-20,x+20,y+20
   box 949,79,991,121
   paste image 1,950,80

   endif
   rem Show selected ship map graphics.
   if ShipSel(0)>0
   fleetposx#=0:fleetposy#=0:fleetdestx#=0:fleetdesty#=0:fleetmoving=0
   for t = 1 to ShipSel(0)
   rem circle the selected ship
   circle Ship#(ShipSel(t),1),Ship#(ShipSel(t),2),9
   rem show friendly ship path
   destx# = Ship#(ShipSel(t),10)
   desty# = Ship#(ShipSel(t),11)
   if destx#>0 AND Ship#(ShipSel(t),3)=1
   if ShipSel(0)=1
   rem show path if a single ship selected
   line Ship#(ShipSel(t),1),Ship#(ShipSel(t),2),destx#,desty#
   else
   inc fleetmoving
   rem store average data for a group selection
   fleetposx# = fleetposx# + Ship#(ShipSel(t),1)
   fleetposy# = fleetposy# + Ship#(ShipSel(t),2)
   fleetdestx# = fleetdestx# + destx#
   fleetdesty# = fleetdesty# + desty#
   endif
   endif
   next t
   rem show one path for a group selection
   if ShipSel(0)>1 and fleetmoving>0
   ax = fleetposx#/fleetmoving
   ay = fleetposy#/fleetmoving
   bx = fleetdestx#/fleetmoving
   by = fleetdesty#/fleetmoving
   line ax,ay,bx,by
   endif
   endif

   rem display game data
   select gamespeed#
   case 0 : a$="PAUSED" : endcase
   case default : a$=str$(gamespeed#) : endcase
   endselect
   text 760,700,"GAME SPEED : "+a$
   text 760,720,"FPS : "+str$(screen fps())
return
`//display

generate_races:
  rem generate race names
  for t=1 to 4
    a$=Generate_Race$()
    string$(t)=a$
  next t
return
`//

initialize:
  rem create planets
  repeat
    fail=0
    sxs=1

    for t=1 to 30
      yes=1
      repeat
        inc fail
        x=rnd(690)+30
        y=rnd(690)+30
        for u=1 to t-1
          dist#=d2d(x+.0,y+.0,Planet#(u,1),Planet#(u,2))
          if dist#<30
            yes=0
          endif
        next u
      until yes=1 or fail>1500

      if fail<=1500
        Planet#(t,1)=x
        Planet#(t,2)=y
        Planet#(t,3)=0
        planet$(t)=generate_planet$() :`generate planet name.
      else
        sxs=0
        EXIT
      endif
    next t
  until sxs=1

  ` NEW DESIGNATE HOMEWORLDS
  rem Human
  X=20
  for t=1 to 3
    sxs=0
    repeat
      inc X
      for u=1 to 30
        if Planet#(u,3)<1
          if Planet#(u,1)<x
            Planet#(u,3)=1
            Planet#(u,4)=1500
            Planet#(u,5)=1000
            Planet#(u,6)=pr(1)
            SXS=1
            EXIT
          endif
        endif
      next u
    until sxs=1
  next t
  rem AI
  X=720
  for t=4 to 6
    sxs=0
    repeat
      dec X
      for u=1 to 30
        if Planet#(u,3)<1
          if Planet#(u,1)>x
            Planet#(u,3)=2
            Planet#(u,4)=1500
            Planet#(u,5)=1000
            Planet#(u,6)=pr(2)
            SXS=1
            EXIT
          endif
        endif
      next u
    until sxs=1
  next t
return
`//initialize

race_select:
   loop sound mus_theme

   repeat
      gosub generate_races
      rem list races
      cls
      center text 512,200,"Welcome. Use The Keyboard To Select Your Race"
      text 300,300,"1. "+string$(1) : text 600,300,"  (Warriors)"
      text 300,330,"2. "+string$(2) : text 600,330,"(Scientists)"
      text 300,360,"3. "+string$(3) : text 600,360,"  (Breeders)"
      text 300,390,"4. "+string$(4) : text 600,390,"   (Traders)"
      center text 512,450,"Press 5 to randomize the race names."

      rem wait for valid key press
      repeat
         sc=scancode()-1
         sync
      until sc>0 and sc<=5
   until sc<=4

   pr(1)=SC
   rem select enemy race.
   enemy = pr(1) + rnd(2)+1
   if enemy > 4 then dec enemy,4
   pr(2) = enemy
   rem store active colours
   colour(1) = race(pr(1),5)
   colour(2) = race(pr(2),5)

   rem display enemy race
   center text 512,500,"You Face The "+propaganda$(6+rnd(5))+" "+string$(pr(2))+"s!"
   sync:wait 2000:cls

   stop sound mus_theme
return
`//race_select

`*** UNEDITED ***
update_ai:
 `0 numcol, 1 num DD, 2 num CA, 3 num BB, 4 # colships, 5 num ENEMY colonies,
 `6 - colony being attacked. 7. sync countdown of coming out of defense. 9 AI STATE DECIDED ON

`===================AI====================

` AI STATE determines WHICH SHIP IS BUILT.

` 1. DEFEND. build destroyers. send all ships within DOUBLE engagement range to the attacked planet.
` 2. PREPARE. build cruisers. CA & BB don't move. destroyers PATROL HOME.
` 3. ATTACK. build BB's. send all ships to their nearest seen enemy planet. if no enemy planet is seen, DDs PATROL AWAY.
` 4. COLONIZE. build COL ships. one at a time. (while any colony ships exist). if no empty planets are seen, DDs PATROL AWAY. as long as numcol<num_col_want

` clear AI statistics-keeping.
for t=0 to 5
 ai(t)=0
next t

NumEnColSeen=0

` AI, count your ships and planets.
for t=1 to 30
  if Planet#(t,3)=1 and Planet#(t,8)>0
    ai(5)= ai(5)+1
      if VIS(Planet#(t,1),Planet#(t,2),2)
        inc NumEnColSeen
      endif
    endif
  if Planet#(t,3)=2 then ai(0) = ai(0)+1
next t
for t=1 to ship_lim(0)
  if Ship#(t,3)=2
    ai(int(Ship#(t,4))) = ai(int(Ship#(t,4)))+1
  endif
next t

` THIS decides on the AI state.
` if you are NOT under attack, AND you have enough DESTROYERS
if ai(6)=0 and ai(1)>=ai(0)
 ` if you don't have enough colonies, AND you don't have any colony ships, then COLONIZE.
 if ai(0)<race(pr(2),6) and ai(4)<1
  ai(9)=4
 else

   pow=ai(1)+ai(2)*2+ai(3)*3
   snd=ai(0)*4+ai(5)

    if pow>snd
     ai(9)=3 : ` if you have enough ships to attack, then do so.
    else
     ai(9)=2 : ` otherwise wait, and keep building.
    endif

       IF pow>(3*snd) AND ai(0)<25
        ` ifyou have LOTS of ships and not totally colonized all of space, then colonize.
        ai(9)=4
       ENDIF

 endif
else
 ai(9)=1 : ` if you're under attack, or you don't have enough destroyers, then state=1.
endif

if ai(6)>0
 ai(7) = ai(7)-1
 ai(9)=1
  if ai(7)<1
   ai(6)=0
  endif
endif

` this builds ships based on AI STATE:
 if ai(9)>0
for t=1 to 30
 if Planet#(t,3)=2
  if Planet#(t,4)>Ship_Class(ai(9),6)*2
  if Planet#(t,5)>Ship_Class(ai(9),5)
   Planet#(t,4) = Planet#(t,4)-Ship_Class(ai(9),6)
   Planet#(t,5) = Planet#(t,5)-Ship_Class(ai(9),5)
   Build_Ship(2,pr(2),Planet#(t,1),Planet#(t,2),ai(9),Rnd(359))
   EXIT : ` ONLY ONE ships is built per cycle, so we don't build too many of something.
  endif
  endif
 endif
next t
 endif

  ` this will build COLONY SHIPS at any owned planet with a POP >2499 , as long as you have <10 colonies
if ai(0)<13
for t=1 to 30
 if Planet#(t,3)=2
  if Planet#(t,4)>2499
  if Planet#(t,5)>Ship_Class(4,5)
   Planet#(t,4) = Planet#(t,4)-Ship_Class(4,6)
   Planet#(t,5) = Planet#(t,5)-Ship_Class(4,5)
   Build_Ship(2,pr(2),Planet#(t,1),Planet#(t,2),4,Rnd(359))
  endif
  endif
 endif
next t
endif

 ` if we are really under attack, defend the colony:
if ai(9)=1
 if ai(6)>0
  Defend_Planet(ai(6))
 endif
endif

if ai(9)=3
 ` if ATTACK
   for t=1 to ship_lim(0)
     Ship#(t,15)=0
    IF Ship#(t,4)<4
     if Ship#(t,3)=2
     if Ship#(t,13)>11
     if Ship#(t,1)>0
     if Ship#(t,10)<10
      Ship#(t,15)=99
        Ship#(t,10)=rnd(710)+20
        Ship#(t,11)=rnd(710)+20
     endif
     endif
     endif
     endif
    ENDIF
   next t

   attack()
 endif

`these should be called regardless of AI STATE.
`if you have built colony ships, then use them! if you see enemy, attack!
AI_Engage_Ship()
Send_Colony_Ships()

`===================END=AI====================
return
`//update ai

update_planet_data:
  for t=1 to 30
    `grow the pop & economy. make wealth first, then grow pop.
    if Planet#(t,3)>0
      Planet#(t,5)=Planet#(t,5)+ ( (race(int(Planet#(t,6)),4)*Planet#(t,4))*gameticks#)/250.1
      Planet#(t,4)=Planet#(t,4)+ ( (race(int(Planet#(t,6)),3))*gameticks#)
      if Planet#(t,4)>2500 then Planet#(t,4)=2500
    endif
    rem planets visible by human
    if VIS(Planet#(t,1),Planet#(t,2),1)
      Planet#(t,7)=99
    endif
    rem planets visible by ai
    if VIS(Planet#(t,1),Planet#(t,2),2)
      Planet#(t,8)=99
    endif
  next t
return
`//

update_ship_data:
  `Ship live data: 1=x,2=y,3=own,4=size,5=atk,6=def,7=spd,8=range,9=def_left,10=targetx,11=targety
  `                12=FightTime,13=built,14=Time Since been hit
  for t=1 to ship_lim(0)
    rem Check the ship exists (has an owner).
    if Ship#(t,3)>0
      rem BUILD SHIPS - once ship#[t,13] reaches 11 the ship is completed.
      if Ship#(t,13) <= 11
        rem big ships take longer to build.
        Ship#(t,13) = Ship#(t,13)+(gameticks#*7)/Ship#(t,4)
      endif
      ` REPAIR SHIPS - any ship that has not been shot in the last 20 gameticks# will start to slowly repair itself.
      Ship#(t,14) = Ship#(t,14)+gameticks#
      if Ship#(t,14)>5
        if Ship#(t,9)<Ship#(t,6)
          Ship#(t,9) = Ship#(t,9)+gameticks#*21
        endif
      endif
      ` MOVE SHIPS - move any ship that has a target co-ordinate.
      if Ship#(t,10)>0
        rem check ship is built
        if Ship#(t,13)>11
          dx#=(Ship#(t,1)-Ship#(t,10))
          dy#=(Ship#(t,2)-Ship#(t,11))
          rem destination reached.
          if abs(dx#)<3 and abs(dy#)<3
            Ship#(t,10)=0
            Ship#(t,11)=0
          endif
          rem move ship towards target
          a#=wrapvalue((ATANFULL(dx#,dy#)))
          Ship#(t,1)=Ship#(t,1)-( sin(a#)*gameticks#*Ship#(t,7)*3 )
          Ship#(t,2)=Ship#(t,2)-( cos(a#)*gameticks#*Ship#(t,7)*3 )
        endif
      endif
      ` COLONIZE/ATTACK PLANETS (colonizers don't attack)
      Ship#(t,12) = Ship#(t,12)-gameticks#*5
      for u=1 to 30
        if Ship#(t,4)=4
          ` Colonize Empty Planets - this works for everybody, automatically.
          if Planet#(u,3)=0
            if d2d(Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2))<7.0
              Planet#(u,3)=Ship#(t,3)
              Planet#(u,4)=500
              Planet#(u,5)=350
              Planet#(u,6)=pr(Ship#(t,3))
               kill_ship(t)
            endif
          endif
        else
          ` Attack Planet
          if Ship#(t,12)<0.1
            ` if you still haven't fired, try to attack planets.
            if Planet#(u,3)>0 and Planet#(u,3)<>Ship#(t,3)
              if d2d(Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2))<20
                line Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2)
                for a=int(Ship#(t,1))-2 to int(Ship#(t,1))+2
                  for b=int(Ship#(t,2))-2 to int(Ship#(t,2))+2
                    line a,b,Planet#(u,1),Planet#(u,2)
                  next b
                next a
                Planet#(u,4) = Planet#(u,4)-Ship#(t,5)
                ` tell AI one of its planets is under attack.
                if Planet#(u,3)=2 AND ai(6)=0
                  ai(6)=u
                  ai(7)=500
                endif
                rem wipe out population.
                if Planet#(u,4)<1
                  Planet#(u,3)=0
                  Planet#(u,4)=0
                  Planet#(u,5)=0
                  Planet#(u,6)=0
                endif
                Ship#(t,12)=2.5+( rnd(99)/9.9 ):`increase attack time.
                EXIT:`only one attack per turn
              endif
            endif
          endif
        endif
      next u
      ` SHIPS FIGHT
      if Ship#(t,4)<4 : ` colony ships DON'T ATTACK.
        if Ship#(t,12)<0.1
          `attack an enemy ship
          for u=1 to ship_lim(0)
            if Ship#(u,3)>0 and Ship#(u,3)<>Ship#(t,3)
              if d2d(Ship#(t,1),Ship#(t,2),Ship#(u,1),Ship#(u,2))<Ship#(t,8)
                for a=int(Ship#(t,1))-2 to int(Ship#(t,1))+2
                  for b=int(Ship#(t,2))-2 to int(Ship#(t,2))+2
                    line a,b,Ship#(u,1),Ship#(u,2)
                  next b
                next a
                Ship#(t,12)=2.5+( rnd(99)/9.9 ):`increase attack time.
                ` enemy ship hit.
                Ship#(u,9) = Ship#(u,9)-Ship#(t,5)
                Ship#(u,14)=0
                ` kill dead ships:
                if Ship#(u,9)<1
                  kill_ship(u)
                  ` since ship T killed ship U, give ship T some EXPERIENCE.
                  Ship#(T,5) = Ship#(T,5)+(Ship#(t,4)) : ` +1 atk/size
                  Ship#(T,6) = Ship#(T,6)+5*(Ship#(t,4)) : ` +5 DEF per size
                  Ship#(T,7) = Ship#(T,7)+1 : ` +1 SPD regardless of size
                  Ship#(T,8) = Ship#(T,8)+1 : ` +1 RNG regardless of size
                endif
                EXIT:`only one attack per turn
              endif
            endif
          next u
        endif
      endif
    endif
  next t
return
`//update ship data

validate_selection:
  rem Non-human planet still visible.
  if planet_selected and planet#(planet_selected,3)<>1
    if VIS(planet#(planet_selected,1),planet#(planet_selected,2),1)=0 then planet_selected=0
  endif
  rem Ships
  if ShipSel(0)>0
    rem Enemy ship still visible.
    if ship#(ShipSel(1),3)=2
      if VIS(ship#(ShipSel(1),1),ship#(ShipSel(1),2),1)=0 then deselect_ship(ShipSel(1))
    else
      rem Check for dead ships.
      for t = 1 to ShipSel(0)
        if Ship#(ShipSel(t),3)=0 then deselect_ship(ShipSel(t))
      next t
    endif
  endif
return
`//


rem ======================================
rem === FUNCTIONS ===
rem ======================================
function kill_ship(n)
   for i = 1 to 15 : ship#(n,i)=0 : next i
   deselect_ship(n)
endfunction
`//

function deselect_ship(n)
  rem Find and remove the ship from the selection list.
  for t = 1 to ShipSel(0)
    if ShipSel(t)=n
      `Move higher entries down to fill the gap.
      for bump = t to ShipSel(0)-1
        ShipSel(bump) = ShipSel(bump+1)
      next bump
      ShipSel(ShipSel(0))=0 :`Delete last entry which is no longer needed.
      ShipSel(0) = ShipSel(0)-1 :`reduce number of ships in the list.
      EXIT
    endif
  next t
endfunction
`//

function d2d(ax#,ay#,bx#,by#)
  rem distance between A and B.
  dist#=sqrt( (ax#-bx#)*(ax#-bx#) + (ay#-by#)*(ay#-by#) )
endfunction dist#
`//

Function VIS(x#,y#,p)
   rem This function determines whether player P can see coord x,y. 0=no, 1=yes
   V=0
   for t=1 to ship_lim(0)
      if Ship#(t,3)=p
         if Ship#(t,13)>11
            dist#=d2d(Ship#(t,1),Ship#(t,2),x#,y#)
            if dist#<50 then V=1 : EXIT
         endif
      endif
   next t
   for t=1 to 30
      if int(Planet#(t,3))=p
         dist#=d2d(Planet#(t,1),Planet#(t,2),x#,y#)
         if dist#<100 then V=1 : EXIT
      endif
   next t
Endfunction V
`//

Function PICK(x,y)
   `Only the HUMAN player uses this function. Returns 0 for nothing picked, 1-30 for a planet, 1001-2000 for a ship.
   for t=1 to 30
      if VIS(Planet#(t,1),Planet#(t,2),1)
         if d2d(Planet#(t,1),Planet#(t,2),x+.0,y+.0)<7 then exitfunction t
      endif
   next t

   rem Only check for ships if no planet is found.
   for t=1 to ship_lim(0)
      if VIS(Ship#(t,1),Ship#(t,2),1)
         if d2d(Ship#(t,1),Ship#(t,2),x+.0,y+.0)<7 then exitfunction t+1000
      endif
   next t
Endfunction 0
`//

Function Build_Ship(owner,race,x#,y#,class,ang)
   for s = 1 to ship_lim(0)
      if Ship#(s,3)=0.0 then exit
   next s
   if s>ship_lim(0) then exitfunction -1 :`break if no id available

   for u=1 to 14 : Ship#(s,u)=0 : next u :`wipe old data
   Ship#(s,1)=x#+(sin(ang)*16)
   Ship#(s,2)=y#+(cos(ang)*16)
   Ship#(s,3)=owner
   Ship#(s,4)=class
   Ship#(s,5)=race(race,1)*Ship_Class(class,1)
   Ship#(s,6)=race(race,2)*Ship_Class(class,2)*15
   Ship#(s,7)=Ship_Class(class,3)
   Ship#(s,8)=Ship_Class(class,4)
   Ship#(s,9)=race(race,2)*Ship_Class(class,2)*15
Endfunction
`//

Function AI_Engage_Ship()
   rem if an AI ship SEES another ship (and it's not already in combat) ,
   rem it might just attack that other ship. but there is a range limit.
   rem this should NOT happen if AI STATE is DEFEND.
   for t=1 to ship_lim(0)
      if Ship#(t,3)=2
         if Ship#(t,13)>11
            if Ship#(t,1)>0
               if Ship#(t,4)<4
                  if Ship#(t,14)>8
                     for u=1 to ship_lim(0)
                        if Ship#(u,3)=1
                           if Ship#(u,13)>11
                              if Ship#(u,1)>0
                                 if VIS(Ship#(u,1),Ship#(u,2),2) : ` if we see this enemy ship.
                                    if d2d(Ship#(t,1),Ship#(t,2),Ship#(u,1),Ship#(u,2))<race(pr(2),7) : ` if its within our ENGAGEMENT RANGE
                                       Ship#(t,10)=Ship#(u,1)+rnd(15)-8
                                       Ship#(t,11)=Ship#(u,2)+rnd(15)-8
                                       EXIT
                                    endif
                                 endif
                              endif
                           endif
                        endif
                     next u
                  endif
               endif
            endif
         endif
      endif
   next t
Endfunction
`//

Function Defend_Planet(p)
   for t=1 to ship_lim(0)
      if Ship#(t,3)=2
         if Ship#(t,13)>11
            if Ship#(t,1)>0
               if Ship#(t,4)<4
                  if d2d(Ship#(t,1),Ship#(t,2),Planet#(p,1),Planet#(p,2))<450 : ` make defense much more of a Priority. : ` (race(er,7)*2)
                     Ship#(t,10)=Planet#(p,1)+rnd(15)-8
                     Ship#(t,11)=Planet#(p,2)+rnd(15)-8
                  endif
               endif
            endif
         endif
      endif
   next t
Endfunction
`//

Function Send_Colony_Ships()
   for t=1 to ship_lim(0)
      IF Ship#(t,4)=4
         if Ship#(t,3)=2
            if Ship#(t,13)>11
               if Ship#(t,1)>0
                  dis=999
                  plan=0
                  for u=1 to 30
                     if Planet#(u,3)=0
                        if VIS(Planet#(u,1),Planet#(u,2),2)
                           dist#=d2d(Planet#(u,1),Planet#(u,2),Ship#(t,1),Ship#(t,2))
                           if dist#<dis
                              dis=dist#
                              plan=u
                           endif
                        endif
                     endif
                  next u
                  if plan>0
                     Ship#(t,10)=Planet#(plan,1)
                     Ship#(t,11)=Planet#(plan,2)
                  endif
               endif
            endif
         endif
      ENDIF
   next t
Endfunction
`//

Function ATTACK()
  for t=1 to ship_lim(0)
    if Ship#(t,3)=2
       if Ship#(t,13)>11
          if Ship#(t,1)>0
             if Ship#(t,4)<4
                dis=999
                plan=0
                for u=1 to 30
                   if Planet#(u,3)=1
                      if VIS(Planet#(u,1),Planet#(u,2),2)
                         dist#=d2d(Planet#(u,1),Planet#(u,2),Ship#(t,1),Ship#(t,2))
                         if dist#<dis
                            dis=dist#
                            plan=u
                         endif
                      endif
                   endif
                next u
                if plan>0
                   Ship#(t,10)=Planet#(plan,1)
                   Ship#(t,11)=Planet#(plan,2)
                endif
             endif
          endif
       endif
     endif
  next t
Endfunction
`//

rem *** OBESE87'S RANDOM NAME GENERATOR FUNCTIONS ***
function Generate_Race$()
  race$ = ""
  race$ = Generate_Planet$()
  rem Select a suffix depending on the last letter.
  last$ = right$(race$,1)
   select last$
      case "a" "e" "o" "i" "u" : k=rnd(5) : endcase
      case default : k=rnd(4)+4 : endcase
   endselect

   select k
      case 0 : race$ = race$+"n" : endcase
      case 1 : endcase
      case 2 : race$ = race$+"can" : endcase
      case 3 : race$ = race$+"ni" : endcase
      case 4 : race$ = race$+"an" : endcase
      case 5 : race$ = race$+"on" : endcase
      case 6 : race$ = race$+"i" : endcase
      case 7 : race$ = race$+"ese" : endcase
      case 8 : race$ = race$+"ite" : endcase
   endselect
endfunction race$
`//

function Generate_Planet$()
  planet$=""
  rem Define number of character pairs to generate.
  name_len = rnd(1)+2

  for i = 1 to name_len
    rem After first letter switch to lower case.
    if i>1 then capoff=32 else capoff=0
    rem Get a random parent character.
    Parent = rnd(25)+65
    rem Make sure name doesn't end in "QU".
    if i=name_len
      if Parent=81 then Parent=Parent-1-rnd(15)
    endif
    rem Add parent to planet name.
    planet$ = planet$+chr$(Parent+capoff)
    rem Generate child from parent.
    Select Parent
      rem Q.
      Case 81 : planet$=planet$+"u" : Endcase
      rem Vowel.
      Case 65 or 69 or 73 or 79 or 85
        child = rnd(5)
        if child=0 then planet$=planet$+"d"
        if child=1 then planet$=planet$+"l"
        if child=2 then planet$=planet$+"n"
        if child=3 then planet$=planet$+"r"
        if child=4 then planet$=planet$+"s"
        if child=5 then planet$=planet$+"t"
      Endcase
      rem Consonant.
      Case Default
        child = rnd(4)
        if child=0 then planet$=planet$+"a"
        if child=1 then planet$=planet$+"e"
        if child=2 then planet$=planet$+"i"
        if child=3 then planet$=planet$+"o"
        if child=4 then planet$=planet$+"u"
      Endcase
  next i
endfunction planet$
`//

function sg(snd,mem,bps,not$)
    oct=2
    pow#=1.0
    sec#=1.0/bps

    samplerate=26624

    soundsize=sec#*samplerate

    l=len(not$)

    i=0

    for x=1 to l
        if val(mid$(not$,x))=0 then i=i+1
    next x

    size=(soundsize*i)+12
    make memblock mem,size

    write memblock dword mem,0,8
    write memblock dword mem,4,samplerate
    write memblock dword mem,8,size

    place=12

    for y=1 to l
        n$=mid$(not$,y)
        i=val(n$)

        if i!0
            oct=i

                pow#=0.5
                for x=2 to oct
                    pow#=pow#*2.0
                next x
        else
            nt=-1

            if n$="a" then nt=110
            if n$="A" then nt=117
            if n$="b" then nt=123
            if n$="B" then nt=127
            if n$="c" then nt=131
            if n$="C" then nt=139
            if n$="d" then nt=147
            if n$="D" then nt=156
            if n$="e" then nt=165
            if n$="E" then nt=175
            if n$="f" then nt=175
            if n$="F" then nt=185
            if n$="g" then nt=196
            if n$="G" then nt=208

            if nt>-1
                hz#=nt*pow#

                p=samplerate/hz#

                anginc#=360.0/p

                for x=place to place+soundsize-1
                    ang#=wrapvalue(ang#+anginc#)

                    sign#=sin(ang#)
                    if sign# <=0 then b=128
                    if sign# > 0 then b=127

                    write memblock byte mem,x,b
                next x
            endif
            place=place+soundsize
        endif
    next y

    make sound from memblock snd,mem
    delete memblock mem
endfunction
`//

remstart
this work is based on a method created by Dave Bollinger (apparently)
http://www.davebollinger.com/works/pixelspaceships/
all the code is mine, but it is based on his descriptions.
Original code: IBOL
Optimization: Obese87
remend
`set display mode 1360,768,32
set display mode 1024,768,32
hide mouse
sync on
sync rate 0

randomize timer()
ink -2,0
set text font "lucida console", 1
set text size 14

dim ship(13,13)
dim template(13,13)
Dim Col(9)

midx = screen width() / 2
Initialize_Ship_Template()
randomize_colours()
generate_ship()

rem = Main ====================================================
Do
   oldkey = key
   key = mouseclick()

   if key>oldkey
      if key=1 then generate_ship()
      if key=2 then randomize_colours()
   endif

remstart
   for j = 0 to 1
      for i = 0 to 4
         for y = 0 to 6
            randomize_colours()
            for x = 0 to 5
               generate_ship()
               draw_ship(50+x*32+i*192,30+y*48+j*336,2)
            next x
         next y
      next i
   next j
   wait key
remend

   draw_ship(midx-48,60,8)
   draw_ship(midx-150,60,2)
   hud()
   sync:cls
loop
END

rem = Functions ===============================================
function draw_ship(x,y,w)
   h = w * 1.5
   rem draw ship
   for v = 1 to 12
      for u = 1 to 12
         ink col(ship(u,v)),0
         box x+u*w,y+v*h,x+(u+1)*w-1,y+(v+1)*h-1
      next u
   next v
endfunction
`//

function Initialize_Ship_Template()
   for y=1 to 12 : for x=1 to 6 : read template(x,y) : next x : next y
   data 0,0,0,0,5,5
   data 0,0,0,5,2,2
   data 0,0,0,5,2,1
   data 0,0,5,2,2,1
   data 0,0,5,2,2,1
   data 0,5,2,2,2,1
   data 5,2,2,2,3,3
   data 5,2,2,2,3,3
   data 5,2,2,2,3,3
   data 5,2,2,2,2,1
   data 0,5,5,2,2,2
   data 0,0,0,5,5,5
endfunction
`//

function Generate_Ship()
   rem reset values
   for x = 1 to 12 : for y = 1 to 12 : ship(x,y) = 0 : next y : next x

   mod=rnd(1) :`modifier adds slight colour variation with same scheme.

   for y = 1 to 12
      for x = 1 to 6
         C = template(x,y)
         SELECT C
            `Always BLACK: NOT part of the spaceship.
            Case 0 : ship(x,y)=0 : endcase
            `ALWAYS SOLID
            Case 1: if mod=1 then ship(x,y)=2 else ship(x,y)=1 :endcase
            `Body: 50% chance of being ON, or BLACK (totally off)
            Case 2: if rnd(1) then ship(x,y)=3 else ship(x,y)=0 :endcase
            `COCKPIT
            Case 3
              `50% on or off. if it's ON the color is the OPPOSITE of the "always on" color. if it's OFF, its BLACK.
              if rnd(1)
                  if mod=1 then ship(x,y)=5 else ship(x,y)=4
               else
                  ship(x,y)=6
               endif
            endcase
            `nothing here
            Case 4 : endcase
            `trim: done LAST , and EVERY 'ON' PART creates trim. done elsewhere.
            Case 5 : endcase
         ENDSELECT
      next x
   next y

   rem Ship trim
   for y = 1 to 12
      for x = 1 to 6
         if ship(x,y) = 0
            if ship(x-1,y)>1 or  ship(x+1,y)>1 or  ship(x,y-1)>1 or  ship(x,y+1)>1
               `IF this square is black, and an adjacent square is ON, and it's not beyond the outer trim
               if template(x,y)>0 then ship(x,y)=6
            endif
         endif
      next x
   next y

   rem MIRROR the ship [1,12 ; 2,11 ; 3,10 ; 4,9 ; 5,8 ; 6,7]
   for y=1 to 12
      for x=1 to 6
         ship(13-x,y)=ship(x,y)
      next x
   next y
Endfunction
`//

Function hud()
   ink col(1),0 : box 500,320,700,330
   ink col(2),0 : box 500,340,700,350
   ink col(3),0 : box 500,360,700,370
   ink col(4),0 : box 500,380,700,390
   ink col(5),0 : box 500,400,700,410
   ink col(6),0 : box 500,420,700,430

   ink -2,0
   text 300,300,"0 - BLACK - Non-ship squares"
   text 300,320,"1 - Decal A "
   text 300,340,"2 - Decal B"
   text 300,360,"3 - Body"
   text 300,380,"4 - Cockpit A"
   text 300,400,"5 - Cockpit B"
   text 300,420,"6 - Outer Trim"
   center text 512,480,"RIGHT CLICK TO GENERATE COLOUR SCHEME"
   center text 512,500,"LEFT CLICK TO GENERATE SHIP DESIGN"
   text 000,730,"check out this web site :"
   text 000,750,"http://www.davebollinger.com/works/pixelspaceships/"
endfunction
`//

function randomize_colours()
   base = rgb(100,100,100)
   main = fuzzycol(base,40)
   col(1) = fuzzycol(main,40)
   col(2) = fuzzycol(col(1),60)
   col(3) = fuzzycol(main,40)
   col(4) = fuzzycol(base,90)
   col(5) = fuzzycol(col(4),60)
   col(6) = fuzzycol(base,40)
endfunction
`//

rem Randomly generates a colour where r/g/b are all within f range of c.
function fuzzycol(c,f)
   col = rgb(rgbr(c)+rnd(f+f)-f,rgbg(c)+rnd(f+f)-f,rgbb(c)+rnd(f+f)-f)
endfunction col
`//

remstart
this work is based on a method created by Dave Bollinger (apparently)
http://www.davebollinger.com/works/pixelspaceships/
all the code is mine, but it is based on his descriptions.
Original code: IBOL
Optimization: Obese87
remend
`set display mode 1360,768,32
set display mode 1024,768,32
hide mouse
sync on
sync rate 0

randomize timer()
ink -2,0
set text font "lucida console", 1
set text size 14

dim ship(13,13)
dim template(13,13)
Dim Col(9)

midx = screen width() / 2
Initialize_Ship_Template()
randomize_colours()
generate_ship()

rem = Main ====================================================
Do
   oldkey = key
   key = mouseclick()

   if key>oldkey
      if key=1 then generate_ship()
      if key=2 then randomize_colours()
   endif

   for j = 0 to 1
      for i = 0 to 4
         for y = 0 to 6
            randomize_colours()
            for x = 0 to 5
               generate_ship()
               draw_ship(50+x*32+i*192,30+y*48+j*336,2)
            next x
         next y
      next i
   next j
   wait key

`   draw_ship(midx-48,60,8)
`   draw_ship(midx-150,60,2)
`   hud()
   sync:cls
loop
END

rem = Functions ===============================================
function draw_ship(x,y,w)
   h = w * 1.5
   rem draw ship
   for v = 1 to 12
      for u = 1 to 12
         ink col(ship(u,v)),0
         box x+u*w,y+v*h,x+(u+1)*w-1,y+(v+1)*h-1
      next u
   next v
endfunction
`//

function Initialize_Ship_Template()
   for y=1 to 12 : for x=1 to 6 : read template(x,y) : next x : next y
   data 0,0,0,0,5,5
   data 0,0,0,5,2,2
   data 0,0,0,5,2,1
   data 0,0,5,2,2,1
   data 0,0,5,2,2,1
   data 0,5,2,2,2,1
   data 5,2,2,2,3,3
   data 5,2,2,2,3,3
   data 5,2,2,2,3,3
   data 5,2,2,2,2,1
   data 0,5,5,2,2,2
   data 0,0,0,5,5,5
endfunction
`//

function Generate_Ship()
   rem reset values
   for x = 1 to 12 : for y = 1 to 12 : ship(x,y) = 0 : next y : next x

   mod=rnd(1) :`modifier changes colour of a few components while keeping the same scheme.

   for y = 1 to 12
      for x = 1 to 6
         C = template(x,y)
         SELECT C
            `Always BLACK: NOT part of the spaceship.
            Case 0 : ship(x,y)=0 : endcase
            `ALWAYS SOLID
            Case 1: if mod=1 then ship(x,y)=2 else ship(x,y)=1 :endcase
            `Body: 50% chance of being ON, or BLACK (totally off)
            Case 2: if rnd(1) then ship(x,y)=3 else ship(x,y)=0 :endcase
            `COCKPIT
            Case 3
              `50% on or off. if it's ON the color is the OPPOSITE of the "always on" color. if it's OFF, its BLACK.
              if rnd(1)
                  if mod=1 then ship(x,y)=5 else ship(x,y)=4
               else
                  ship(x,y)=6
               endif
            endcase
            `nothing here
            Case 4 : endcase
            `trim: done LAST , and EVERY 'ON' PART creates trim. done elsewhere.
            Case 5 : endcase
         ENDSELECT
      next x
   next y

   rem Ship trim
   for y = 1 to 12
      for x = 1 to 6
         if ship(x,y) = 0
`            if ship(x-1,y)>1 or ship(x+1,y)>1 or ship(x,y-1)>1 or ship(x,y+1)>1
            if rnd(1)
               if ship(x,y-1)>1 or ship(x,y+1)>1 or ship(x-1,y)>1
                  if template(x,y)>0 then ship(x,y)=6
               endif
            else
               if ship(x-1,y)>1 or ship(x+1,y)>1
                  if template(x,y)>0 then ship(x,y)=6
               endif
            endif
         endif
      next x
   next y

   rem MIRROR the ship [1,12 ; 2,11 ; 3,10 ; 4,9 ; 5,8 ; 6,7]
   for y=1 to 12
      for x=1 to 6
         ship(13-x,y)=ship(x,y)
      next x
   next y
Endfunction
`//

Function hud()
   ink col(1),0 : box 500,320,700,330
   ink col(2),0 : box 500,340,700,350
   ink col(3),0 : box 500,360,700,370
   ink col(4),0 : box 500,380,700,390
   ink col(5),0 : box 500,400,700,410
   ink col(6),0 : box 500,420,700,430

   ink -2,0
   text 300,300,"0 - BLACK - Non-ship squares"
   text 300,320,"1 - Decal A "
   text 300,340,"2 - Decal B"
   text 300,360,"3 - Body"
   text 300,380,"4 - Cockpit A"
   text 300,400,"5 - Cockpit B"
   text 300,420,"6 - Outer Trim"
   center text 512,480,"RIGHT CLICK TO GENERATE COLOUR SCHEME"
   center text 512,500,"LEFT CLICK TO GENERATE SHIP DESIGN"
   text 000,730,"check out this web site :"
   text 000,750,"http://www.davebollinger.com/works/pixelspaceships/"
endfunction
`//

function randomize_colours()
   base = rgb(100,100,100)
   main = fuzzycol(base,50)
   col(1) = fuzzycol(main,60)
   col(2) = fuzzycol(col(1),60)
   col(3) = fuzzycol(main,40)
   col(4) = fuzzycol(base,90)
   col(5) = fuzzycol(col(4),60)
   col(6) = fuzzycol(main,10)
endfunction
`//

rem Randomly generates a colour where r/g/b are all within f range of c.
function fuzzycol(c,f)
   col = rgb(rgbr(c)+rnd(f+f)-f,rgbg(c)+rnd(f+f)-f,rgbb(c)+rnd(f+f)-f)
endfunction col
`//

`set display mode 1360,768,32
set display mode 1024,768,32
hide mouse
sync on
sync rate 0

randomize timer()
ink -2,0
set text font "lucida console", 1
set text size 14

dim face(13,13)
dim template(13,13)
Dim Col(9)

midx = screen width() / 2
Initialize_face_Template()
randomize_colours()
generate_face()

rem = Main ====================================================
Do
   oldkey = key
   key = mouseclick()

   if key>oldkey
      if key=1 then generate_face()
      if key=2 then randomize_colours()
   endif

   for j = 0 to 1
      for i = 0 to 4
         for y = 0 to 6
            randomize_colours()
            for x = 0 to 5
               generate_face()
               draw_face(50+x*32+i*192,30+y*48+j*336,2)
            next x
         next y
      next i
   next j
   wait key

   sync:cls
loop
END

rem = Functions ===============================================
function draw_face(x,y,w)
   h = w * 1.5
   rem draw face
   for v = 1 to 12
      for u = 1 to 12
         ink col(face(u,v)),0
         box x+u*w,y+v*h,x+(u+1)*w-1,y+(v+1)*h-1
      next u
   next v
endfunction
`//

function Initialize_face_Template()
   for y=1 to 12 : for x=1 to 6 : read template(x,y) : next x : next y
   data 5,5,5,2,2,5
   data 5,5,2,3,3,5
   data 5,2,3,3,3,5
   data 5,2,3,3,3,1
   data 5,2,2,2,2,1
   data 5,2,2,2,2,1
   data 5,2,2,4,4,4
   data 5,5,2,4,4,4
   data 5,5,2,2,4,4
   data 0,0,0,5,1,1
   data 0,0,2,2,1,1
   data 5,2,1,1,1,1
endfunction
`//

function Generate_face()
   rem reset values
   for x = 1 to 12 : for y = 1 to 12 : face(x,y) = 0 : next y : next x

   mod=rnd(1) :`modifier changes colour of a few components while keeping the same scheme.
   eyes=rnd(1)

   for y = 1 to 12
      for x = 1 to 6
         C = template(x,y)
         SELECT C
            `Always BLACK: NOT part of the spaceface.
            Case 0 : face(x,y)=0 : endcase
            `ALWAYS SOLID
            Case 1: if mod=1 then face(x,y)=6 else face(x,y)=3 :endcase
            `Flesh: 50% chance of being ON, or BLACK (totally off)
            Case 2: if rnd(1) then face(x,y)=3 else face(x,y)=0 :endcase
            `Eyes
            Case 3
              `50% on or off. if it's ON the color is the OPPOSITE of the "always on" color. if it's OFF, its BLACK.
              if rnd(2)
                  face(x,y) = 4 + eyes
               else
                  face(x,y)=6
               endif
            endcase
            `Mouth
            Case 4
               if rnd(1)
                  face(x,y)=2
               else
                  if mod=1 then face(x,y)=6 else face(x,y)=3
               endif
            endcase
            `skin (done outside)
            Case 5 : endcase
         ENDSELECT
      next x
   next y

   rem one of the two mid-mouth pieces must be on
   face(6,7+rnd(1))=2

   rem touch ups
   for y = 1 to 12
      for x = 1 to 6
         rem fix broken eyes
         if face(x,y)=3 or face(x,y)=6
            eyebits = 0
            if face(x-1,y)=4+eyes then inc eyebits
            if face(x+1,y)=4+eyes then inc eyebits
            if face(x,y-1)=4+eyes then inc eyebits
            if face(x,y+1)=4+eyes then inc eyebits
            if eyebits>=3 then face(x,y)=4+eyes
         endif
         rem skin
         if face(x,y) = 0
            if rnd(1)
               if face(x,y-1)>1 or face(x,y+1)>1 or face(x-1,y)>1
                  if template(x,y)>0 then face(x,y)=6
               endif
            else
               if face(x-1,y)>1 or face(x+1,y)>1
                  if template(x,y)>0 then face(x,y)=6
               endif
            endif
         endif
      next x
   next y

   rem MIRROR the face [1,12 ; 2,11 ; 3,10 ; 4,9 ; 5,8 ; 6,7]
   for y=1 to 12
      for x=1 to 6
         face(13-x,y)=face(x,y)
      next x
   next y
Endfunction
`//

function randomize_colours()
   base = rgb(100,100,100)
   main = fuzzycol(base,50)
   col(1) = fuzzycol(main,60)
   col(2) = fuzzycol(base,40)
   col(3) = fuzzycol(main,40)
   col(4) = fuzzycol(base,90)
   col(5) = fuzzycol(col(4),60)
   col(6) = fuzzycol(main,10)
endfunction
`//

rem Randomly generates a colour where r/g/b are all within f range of c.
function fuzzycol(c,f)
   col = rgb(rgbr(c)+rnd(f+f)-f,rgbg(c)+rnd(f+f)-f,rgbb(c)+rnd(f+f)-f)
endfunction col
`//

remstart
-=- Procedural Planet Generator -=-
by OBese87
concept by IBOL
JAN-2013
remend

set display mode 1360,768,32
`set display mode 1024,768,32
hide mouse
sync on
sync rate 0
randomize timer()

dim planet(19,19)
dim template(19,19)
Dim Col(9)
Initialize_planet_Template()

rem = Main ====================================================
Do
   for j = 0 to 1
      for i = 0 to 3
         randomize_colours()
         `colour swatches
         for c = 1 to 5
            cx=i*300+c*10+40 : cy=j*360+20
            ink col(c),0 : box cx,cy,cx+10,cy+10
         next c

         `planets
         for y = 0 to 6
            for x = 0 to 5
               generate_planet()
               draw_planet(50+x*48+i*300,40+y*48+j*360,2)
            next x
         next y
      next i
   next j

   ink -2,0
   center text screen width()/2,740,"PRESS ANY KEY TO GENERATE MORE PLANETS"
   sync
   wait key
   sync:cls
loop
END

rem = Functions ===============================================
function draw_planet(x,y,s)
   rem draw planet
   for v = 1 to 18
      for u = 1 to 18
         ink col(planet(u,v)),0
         box x+u*s,y+v*s,x+(u+1)*s-1,y+(v+1)*s-1
      next u
   next v
endfunction
`//

function Initialize_planet_Template()
   for y=1 to 9
      for x=1 to 9
         read t
         template(x,y) = t
         template(x,19-y) = t
         template(19-x,y) = t
         template(19-x,19-y) = t
      next x
   next y

   data 0,0,0,0,0,0,1,1,1
   data 0,0,0,0,1,1,3,3,3
   data 0,0,0,1,3,3,3,3,3
   data 0,0,1,4,4,4,4,4,4
   data 0,1,4,4,4,4,4,4,4
   data 0,1,4,4,4,4,4,4,4
   data 1,5,5,5,5,5,5,5,5
   data 1,5,5,5,5,5,5,5,5
   data 1,5,5,5,5,5,5,5,5
endfunction
`//

function Generate_planet()
   rem reset values
   for x = 1 to 18 : for y = 1 to 18 : planet(x,y) = 0 : next y : next x

   rem Magnitude of "gas" dictates the level of distortion of the template, allowing for distinct rocky and gas planets.
   gas = rnd(2)
   smooth=rnd(10^gas)

   rem generation algorithm
   for y = 1 to 18
      `uniform rings on gas giants
      if template(9,y)>1 then ring = rnd(template(9,y)-2)+2

      for x = 1 to 18
         if template(x,y)<2
            planet(x,y)=template(x,y)
         else
            rem smoothness of the planet defines level of distortion in the rings
            if rnd(smooth)
               planet(x,y) = ring
            else
               planet(x,y) = rnd(template(x,y)-2)+2
            endif
         endif
      next x
   next y
Endfunction
`//

function randomize_colours()
   a = rgb(80,80,80)
   a = fuzzycol(a,60)
   b = fuzzycol(a,40)
   b = contrast(b,0-10)
   c = fuzzycol(a,60)
   c = contrast(c,0-10)
   d = fuzzycol(c,40)
   d = contrast(d,0-10)
   col(1) = a
   col(2) = contrast(d,rnd(20)-10)
   col(3) = contrast(c,rnd(20)-10)
   col(4) = contrast(b,rnd(20)-10)
   col(5) = contrast(a,rnd(20)-10)
endfunction
`//

function contrast(c,f)
   r = rgbr(c)+f
   if r>255 then r=255
   if r<0 then r=0
   g = rgbg(c)+f
   if g>255 then g=255
   if g<0 then g=0
   b = rgbb(c)+f
   if b>255 then b=255
   if b<0 then b=0
endfunction rgb(r,g,b)
`//

rem Randomly generates a colour similar to the given colour.
function fuzzycol(c,f)
   r = abs(rgbr(c)+rnd(f+f)-f)
   if r>255 then dec r,255
   g = abs(rgbg(c)+rnd(f+f)-f)
   if g>255 then dec g,255
   b = abs(rgbb(c)+rnd(f+f)-f)
   if b>255 then dec b,255
endfunction rgb(r,g,b)
`//

remstart
-=- Procedural Spaceship Generator -=-
by Obese87
version 2.0
-------------
- Special Thanks -
IBOL
Dave Bollinger - http://www.davebollinger.com/works/pixelspaceships/
--------------
What's Next?
* Sort out the algorithm and remove all random numbers so that a single value can be entered to produce a specific ship.
* Add colour bias so that distinct faction colour schemes can be reliably produced.
remend

set display mode 1360,768,32
`set display mode 1024,768,32
hide mouse
sync on
sync rate 0
randomize timer()

sw = screen width()
sh = screen height()

dim ship(13,17)
dim template(13,17)
Dim Col(5)
Initialize_Ship_Template()

rem Faction colours
dim faction(11)
f:
data 128,0,0, 128,64,0, 128,128,0, 64,128,0, 0,128,0, 0,128,64
data 0,64,128, 0,0,128, 64,0,128, 128,0,128, 128,0,64, 128,128,128
restore f
for c = 0 to 11
   read r
   read g
   read b
   faction(c) = rgb(r,g,b)
next c

rem = Main ====================================================
Do
   for j = 0 to 1
      for i = 0 to 5
         generate_colours(faction(i+j*6))
         for c = 1 to 5
            ink col(c),0
            cx = i*192+c*4+30
            cy = j*360+20
            box cx,cy,cx+4,cy+4
         next c

         for y = 0 to 6
            for x = 0 to 5
               generate_ship()
               draw_ship(30+x*32+i*192,30+y*48+j*360,2)
            next x
         next y
      next i
   next j

   ink -2,0
   center text screen width()/2,740,"PRESS ANY KEY TO GENERATE MORE SHIPS"
   wait key
   sync:cls
loop
END

rem = Functions ===============================================
function draw_ship(x,y,s)
   rem draw ship
   for v = 1 to 16
      for u = 1 to 12
         ink col(ship(u,v)),0
         box x+u*s,y+v*s,x+(u+1)*s-1,y+(v+1)*s-1
      next u
   next v
endfunction
`//

function Initialize_Ship_Template()
   restore t
   for y=1 to 16 : for x=1 to 6 : read template(x,y) : next x : next y
   t:
   data 0,0,0,0,1,1
   data 0,0,0,1,1,1
   data 0,0,0,1,2,2
   data 0,0,1,2,2,3
   data 0,0,1,2,2,3
   data 0,1,2,2,2,3
   data 1,2,2,2,2,3
   data 1,2,2,2,2,3
   data 1,2,2,2,2,5
   data 1,2,2,2,5,5
   data 1,2,2,2,5,5
   data 1,2,2,2,5,5
   data 1,2,2,2,2,3
   data 0,1,2,2,2,3
   data 0,0,1,1,2,2
   data 0,0,0,0,1,1
endfunction
`//

function Generate_Ship()
   rem reset values
   for x = 1 to 12 : for y = 1 to 16 : ship(x,y) = 0 : next y : next x

   decal=rnd(2)

   for y = 1 to 16
      for x = 1 to 6
         C = template(x,y)
         SELECT C
            `Void
            case 0 : ship(x,y)=0 : endcase
            `Body
            case 2: ship(x,y)=rnd(2) :endcase
            `Centre
            case 3
               if decal
                  ship(x,y) = 2+decal
               else
                  ship(x,y)=rnd(1)+1
               endif
            endcase
            `Cockpit
            case 5
              if rnd(1)
                  ship(x,y)=5
               else
                  ship(x,y)=rnd(1)+1
               endif
            endcase
         ENDSELECT
      next x
   next y

   rem Ship trim
   for y = 1 to 16
      for x = 1 to 6
         if ship(x,y) = 0
            if ship(x-1,y)>1 or ship(x+1,y)>1 or ship(x,y-1)>1 or ship(x,y+1)>1
               if template(x,y)>0 then ship(x,y)=rnd(1)+1
            endif
         endif

         rem Mirror the ship
         ship(13-x,y)=ship(x,y)
      next x
   next y
Endfunction
`//

function generate_colours(a)
   a = contrast(a,rnd(20)-10)
   b = contrast(a,(rnd(1)*2-1)*(60))
   b = fuzzycol(b,10)
   e = invertcl(b)
   e = contrast(e,rnd(40)-20)
   e = fuzzycol(e,30)
   c = fuzzycol(e,60)
   d = fuzzycol(a,120)
   col(1) = a       :`trim
   col(2) = b       :`body
   col(3) = c       :`decal a
   col(4) = d       :`decal b
   col(5) = e       :`cockpit
endfunction
`//

function contrast(c,f)
   r = abs(rgbr(c)+f) : if r>255 then dec r,160
   g = abs(rgbg(c)+f) : if g>255 then dec g,160
   b = abs(rgbb(c)+f) : if b>255 then dec b,160
endfunction rgb(r,g,b)
`//

rem Randomly generates a colour similar to the given colour.
function fuzzycol(c,f)
   r = abs(rgbr(c)+rnd(f+f)-f) : if r>255 then dec r,128
   g = abs(rgbg(c)+rnd(f+f)-f) : if g>255 then dec g,128
   b = abs(rgbb(c)+rnd(f+f)-f) : if b>255 then dec b,128
endfunction rgb(r,g,b)
`//

function invertcl(c)
   r = 255 - rgbr(c)
   g = 255 - rgbg(c)
   b = 255 - rgbb(c)
endfunction rgb(r,g,b)
`//

remstart
-=- Procedural Spaceship Generator -=-
by Obese87
version 2.1
-------------
- Special Thanks -
IBOL - Original Code @ http://forum.thegamecreators.com/?m=forum_view&b=11&t=170425&p=0
Dave Bollinger - http://www.davebollinger.com/works/pixelspaceships/
--------------
What's Next?
* Sort out the algorithm and remove all random numbers so that a single value can be entered to produce a specific ship.
* Add colour bias so that distinct faction colour schemes can be reliably produced.
remend

set display mode 1360,768,32
`set display mode 1024,768,32
hide mouse
sync on
sync rate 0
randomize timer()

sw = screen width()
sh = screen height()

dim ship(13,17)
dim template(13,17)
Dim Col(5)
Initialize_Ship_Template()

rem Faction colours
dim faction(11)
f:
data 128,0,0, 128,64,0, 128,128,0, 64,128,0, 0,128,0, 0,128,64
data 0,64,128, 0,0,128, 64,0,128, 128,0,128, 128,0,64, 128,128,128
restore f
for c = 0 to 11
   read r
   read g
   read b
   faction(c) = rgb(r,g,b)
next c

s=1

rem = Main ====================================================
Do
   backdrop()

   for j = 0 to 3/s
      for i = 0 to 11/s
remstart
         generate_colours(faction((i+j*12)*(s/4.0)))
         for c = 1 to 5
            ink col(c),0
            cx = i*96*s+c*4+15
            cy = j*180*s+5
            box cx,cy,cx+4,cy+4
         next c
remend

         for y = 0 to 6
            for x = 0 to 5
               generate_colours(fuzzycol(rgb(128,128,128),0,80))
               generate_ship()
               draw_ship(15+x*16*s+i*96*s,15+y*24*s+j*180*s,s)
            next x
         next y
      next i
   next j

   ink -2,0
   center text screen width()/2,740,"PRESS ANY KEY TO GENERATE MORE SHIPS"
   wait key
   sync:cls
loop
END

rem = Functions ===============================================
function draw_ship(x,y,s)
   rem draw ship
   for v = 1 to 16
      for u = 1 to 12
         c = col(ship(u,v))
         if c>0
            ink c,0
            box x+u*s,y+v*s,x+(u+1)*s-1,y+(v+1)*s-1
         endif
      next u
   next v
endfunction
`//

function Initialize_Ship_Template()
   restore t
   for y=1 to 16 : for x=1 to 6 : read template(x,y) : next x : next y
   t:
   data 0,0,0,0,1,1
   data 0,0,0,1,1,1
   data 0,0,0,1,2,2
   data 0,0,1,2,2,3
   data 0,0,1,2,2,3
   data 0,1,2,2,2,3
   data 1,2,2,2,2,3
   data 1,2,2,2,2,3
   data 1,2,2,2,2,5
   data 1,2,2,2,5,5
   data 1,2,2,2,5,5
   data 1,2,2,2,5,5
   data 1,2,2,2,2,3
   data 0,1,2,2,2,3
   data 0,0,1,1,2,2
   data 0,0,0,0,1,1
endfunction
`//

function Generate_Ship()
   rem reset values
   for x = 1 to 12 : for y = 1 to 16 : ship(x,y) = 0 : next y : next x

   decal=rnd(2)

   for y = 1 to 16
      for x = 1 to 6
         C = template(x,y)
         SELECT C
            `Void
            case 0 : ship(x,y)=0 : endcase
            `Body
            case 2: ship(x,y)=rnd(2) :endcase
            `Centre
            case 3
               if decal
                  ship(x,y) = 2+decal
               else
                  ship(x,y)=rnd(1)+1
               endif
            endcase
            `Cockpit
            case 5
              if rnd(1)
                  ship(x,y)=5
               else
                  ship(x,y)=rnd(1)+1
               endif
            endcase
         ENDSELECT
      next x
   next y

   rem Ship trim
   for y = 1 to 16
      for x = 1 to 6
         if ship(x,y) = 0
            if ship(x-1,y)>1 or ship(x+1,y)>1 or ship(x,y-1)>1 or ship(x,y+1)>1
               if template(x,y)>0 then ship(x,y)=rnd(1)+1
            endif
         endif

         rem Mirror the ship
         ship(13-x,y)=ship(x,y)
      next x
   next y
Endfunction
`//

function generate_colours(a)
   a = fuzzycol(a,0,15)
   b = fuzzycol(a,0,5)
   b = contrast(b,rndch(55,75))
   c = fuzzycol(b,60,128)
   d = fuzzycol(c,20,60)
   e = invertcol(b)
   e = fuzzycol(e,30,70)
   col(1) = a       :`trim
   col(2) = b       :`body
   col(3) = c       :`decal a
   col(4) = d       :`decal b
   col(5) = e       :`cockpit
endfunction
`//

function changehue(c,ir,ig,ib)
   r = rgbr(c)+ir : r=r*(r>=0)*(r<=255)+(r>255)*255 :`if 0<=r<=255 then r=r elseif r<0 then r=0 elseif r>255 then r=255
   g = rgbg(c)+ig : g=g*(g>=0)*(g<=255)+(g>255)*255
   b = rgbb(c)+ib : b=b*(b>=0)*(b<=255)+(b>255)*255
endfunction rgb(r,g,b)
`//

function contrast(c,f)
   c = changehue(c,f,f,f)
endfunction c
`//

rem randomizes a colour by a random amount between +/-min and +/-max
function fuzzycol(c,min,max)
   c = changehue(c,rndch(min,max),rndch(min,max),rndch(min,max))
endfunction c
`//

function invertcol(c)
   r=255-rgbr(c) : g=255-rgbg(c) : b=255-rgbb(c)
endfunction rgb(r,g,b)
`//

rem Random Change: can be positive or negative, at least +/-min, at most +/-max
function rndch(min,max)
   v = (rnd(1)*2-1)*(rnd(max-min)+min)
endfunction v
`//

function backdrop()
   if bitmap exist(1)=0
      v = 127
      s=64
      create bitmap 1,s,s
      for y = 0 to s-1
         for x = 0 to s-1
            ink ((x&v)+(y&v))*4,0
            dot x,y
         next x
      next y
      set current bitmap 0
   endif
   `paste to screen
   for y = 0 to screen height()/s -1
      for x = 0 to screen width()/s -1
         copy bitmap 1,0,0,bitmap width(1)-1,bitmap height(1)-1, 0,s*x,s*y,s*x+bitmap width(1)-1,s*y+bitmap height(1)-1
      next x
   next y
endfunction
`//

melTheme = newSound(8,"4C{8}E{4}G{4}a{9}-GGFFCCF{9}-eecc3aa4C{8}-{7}C{8}E{4}G{4}5C{9}-4bbaa5CCc{8}--CC4bbaab{8}-{8}")
basTheme = newSound(8,"3C{16}2F{16}3c{16}a{14}-C{16}F{16}2b{16}3e{16}")
selSnd = newSound(16,"5DA") :`select sound
desSnd = newSound(16,"4AD") :`deselect sound
ordSnd = newSound(16,"5D4D5A6D") :`give order sound
laserSnd = newSound(128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(128,"1CcDeEFfGaAbB2CcDeEFfGaAbB3CcDeEFfGaAbB4CcDeEFfGaAbB5C{32}3BbAaGfFEeDcC2BbAaGfFEeDcC{32}-{64}")
warpSnd = newSound(64,"0CcDeEFfGaAbB1C0cDeEFfGaAbB1Cc0eEFfGaAbB1CcDe0FfGaAbB1CcDeF0GaAbB1CcDeEFfGaAbB2CcDeEFfGaAbB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(64,"0CcDeEFfGaAbB1C0cDeEFfGaAbB1Cc0eEFfGaAbB1CcDe0FfGaAbB1CcDeF0GaAbB1CcDeEFfGaAbB2CcDeEFfGaAbB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")
traviataBassSnd = newSound(16,"3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-2B{4}-3F{4}-3F{4}-2G{4}-3F{4}-3F{4}-")
traviataMeloSnd = newSound(16,"-{55}4G{4}-5E{16}-{4}4G{4}-5E{4}-5E{4}-4G{4}-5E{4}-5EEFEEe{4}-E{4}-G{16}-{4}F{4}-E{4}-D{4}-DDDccDDEEED{4}-DDDccDDEEED{8}-C{5}4G{16}-{150}")

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBassSnd
            loop sound traviataMeloSnd
         else
            stop sound traviataBassSnd
            stop sound traviataMeloSnd
         endif
      endcase
   endselect
loop
end

function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 255
      if sound exist(snd)=0 then exit
   next snd
   if snd > 255 then print "NO FREE SOUND NUMBER AVAILABLE." : end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then print "NO FREE MEMBLOCK NUMBER AVAILABLE." : end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 40000
`   samplerate# = 26624 :`Why this number?
   soundsize = samplerate# / bps

   rem Find number of actual notes in music$.
   i=0 :`forgot variables inside function are persistent: eugh DB is not a good example for new coders. No other language I know does this. :'(
   for x = 1 to strLen
      n$ = mid$(music$,x)
      if val(n$)=0
         rem Number inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(snippet$(music$,x+1,bracket-1))-1 :`we minus one from the length because note will have been counted by itself.
                  inc i,numinbracket :`add number in brackets to note count.
                  x = bracket : `this just moves the x pointer past the brackets.
                  exit
               endif
            next bracket
         else
            inc i :`single note
         endif
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         rem Numbers inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(snippet$(music$,x+1,bracket-1))-1 :`we minus one from the length because note will have been counted by itself.
                  n$ = mid$(music$,x-1) :`take the note before the brackets.
                  x = bracket : `this just moves the pointer past the brackets.
                  bracket = strLen
               endif
            next bracket
         else
            numinbracket = 1
         endif

         for noteLen = 1 to numinbracket
            rem -- Store Note --
            select n$
               rem Based on 7th octave.
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "e" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "a" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "b" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  b = 128 + sin(ang#) :`since integers are truncated b will always be 127 or 128. (Except when ang#= 90|270 then b= 126|129.)
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   set sound volume snd,5 :rem Default volume is bloody loud!
   delete memblock mem
endfunction snd
`//

function snippet$(a$,head,tail)
   return$ = right$(left$(a$,tail),tail+1-head)
endfunction return$
`//

remstart
Space RTS - by IBOL - 20th March 2010
Continued by OBese87 - Last Updated: 10/JAN/2013
------------
-=- Known Bugs -=-
* Not all planets are building ships.
* Instant ship building at start of game if order given while paused (useful for testing purposes however).
* Enemy ships continue defending a planet even after their colony has been destroyed.
------------
-=- Feature Ideas -=-
- Variable ai Difficulty -
The ai gives orders instantaneously!
- Stay Together -
Ships in a group should move at the speed of the slowest member.
- Advanced Movement Orders -
Guard or follow other ships.
Set up patrol routes.
Move in formation.
- Limited Resources -
Each planet has a finite mineral pool, minerals are harvested by the inhabitants and converted into currency for building ships.
Once a planet's resources are depleated the population will start to drop and consume currency.
A new class of ship, the trade vessel, can take resources from an abundant planet and deliver them where they are needed, but these ships cannot
defend themselves or attack the enemy.
(When the game is expanded to more than two races the merchant will also be able to trade with allies and send peace offerings.)
- Strategic RepAirs -
Ships only repAir when near a homeworld. Maybe some kind of carrier ship can be a mobile base for repAirs too.
- Ship Progression -
Ships receive stat boosts for combat experience and kills. Already half implemented.
------------
remend

set display mode 1024,768,32
sync on
sync rate 0
randomize timer()
set text font "lucida console",1
set text size 16
ink -2,0
gosub arraysAndGlobals
gosub makeBackdrop
gosub makeSounds
gosub raceSelect
gosub initialize

rem === MAiN ===
do
   rem >> INPUT >>
   if key=0 then key=scancode() else key=0-scancode() :`World's most efficient trip-switch?
   if mc=0 then mc=mouseclick() else mc=0-mouseclick()

`{
   rem Adjust game speed (+/- keys) Pause "P".
   if key>0
      if key=57 then omniscience = 1 - omniscience :`spacekey

      rem Pause game else adjust speed.
      if key=25 :`P for qwerty; L for dvorak.
         gamespeed#=0 : play sound sndWarpFail
      else
         if key=78
            if gamespeed#=0 then gamespeed#=1 else inc gamespeed#,gamespeed#
            if gamespeed#>32 then gamespeed#=32 else play sound sndFlip
         endif
         if key=74
            gamespeed# = gamespeed#/2
            if gamespeed#<1 then gamespeed#=1 else play sound sndDrop
         endif
      endif
   endif
`}

   gosub commandSelectObjects
   gosub validateSelection
   gosub commandMoveShips

`{
   rem Planetary Command Centre
   if planetSelected and planet#(planetSelected,3)=1
      rem Calculate ship building permits for this planet.
      for u = 1 to 4
         rem What ship classes can we afford here?
         enoughPeople = Planet#(planetSelected,4)>=(ShipClass(u,6)*2) :rem I don't like how this *2 is hidden away in here.
         enoughMoney = Planet#(planetSelected,5)>=ShipClass(u,5)
         buildPermit(u) = enoughPeople * enoughMoney :`AND logic
      next u

      if key
         rem We want to build a ship.
         if key>=2 and key<=5
            class = key-1 :`convert scancode to ship class.
            rem Can we afford to build this class of ship?
            if buildPermit(class)
               rem Subtract build cost from planetary resources.
               Planet#(planetSelected,4) = Planet#(planetSelected,4)-ShipClass(class,6)
               Planet#(planetSelected,5) = Planet#(planetSelected,5)-ShipClass(class,5)
               rem Begin construction.
               buildError = BuildShip(1,pr(1),Planet#(planetSelected,1),Planet#(planetSelected,2),class,Rnd(359))
               play sound sndBuy
            endif
         endif
      endif
   endif
`}

   rem >> PROCESS >>
   if gamespeed#>0
      rem Control game timer
      gameticks# = (timer()-t1) * gamespeed# * 0.00004
      t1=timer()
      gosub updatePlanetData
      gosub updateShipData
      gosub updateAi
      gosub checkEndGame
   endif

   rem >> OUTPUT >>
   gosub display
   sync:cls
loop
END


rem ======================================
rem === DATA ===
rem ======================================
rem Propaganda Descriptions
data "Glorious", "Righteous", "Noble", "Mighty", "Brave", "Valiant"
data "Vile", "Evil", "Wretched", "Foul", "Savage", "Cowardly"

data 18,15,128,222 :`ascii codes for ship graphics
data "Viper","Falcon","Titan","Colonizer"
data "DEFEND","PREPARE","ATTACK","COLONIZE"
`    RACE
`    atk,def,pgr,eco,  R,  G,  B,#col, engage dist
data 33, 14, 17, 11, 255,  0,  0,   4, 300
data 17, 26, 11, 14, 180,  0,180,   5, 150
data 14, 11, 20, 17,   0,180,  0,   8, 225
data 11, 17, 14, 20, 255,180,  0,   6, 100
` SHIPS:
`  atk,def,spd,rng,cost,POP-cost
data 3, 2, 20, 20, 500,  50
data 6, 5, 15, 27, 1000, 100
data 12,14,10, 34, 2000, 150
data 0, 1, 7,  0,  1500, 500
`//

rem ======================================
rem === SUBROUTINES ===
rem ======================================
arraysAndGlobals:
   remstart
   (ship classes always ordered: Destroyer, Cruiser, Battleship, Colonizer)
   NAME        DESCRIPTION  DATA
   ai             ai             0=number of colonies, 1-4=number of ships in each class, 5=number of enemy colonies,
                                 6=colony under attack,7=sync countdown of coming out of defence, 9=Ai state decided on.
   buildPermit   Ship build     1-4=ship classes by size(1=can build,0=cannot build).
   string$        Game text      1-4=race names, 5-8=ship ascii images, 9-12=ship names, 13-16=Ai state strings.
   planet$        Planet name    0=planet name.
   planet#        Planets        1=x, 2=y, 3=owner(0=none,1=human,2=Ai), 4=population, 5=wealth,
                                 6=race(1-4:equal to player or enemy race at time of colonising), 7=K1?, 8=K2?
   race           Races          1=attack, 2=defence, 3=pgr?, 4=economy, 5=colour, 6=desired colonies, 7=engage distance.
   shipClass     Ship class     1=attack, 2=defence, 3=speed, 4=range, 5=wealth cost, 6=population cost.
   shipx(1)       Ship Position  0: current x, 1: destination x.
   shipy(1)       Ship Position  0: current y, 1: destination y.
   shipOwner     Ship Data      [0=none|1=player|2=Ai]
   shipClass     Ship Data
   shipAttack    Ship Attribute
   shipDefence   Ship Attribute
   shipSpeed     Ship Attribute
   shipRange     Ship Attribute
   shipHealth    Ship Data
   shipBuild
   shipFightDuration?
   shipTimeSinceAttacked
   shipAiThing?

                            1=x 2=y 3=owner 4=class 5=attack 6=defence 7=speed 8=range 9=health 10=destination x, 11=destination y,
                            12=fight duration, 13=build status(11=complete),
                            [14]= time since attacked, [15]= some ai thing??
   shipsel      Ship select  [0]= number of ships selected, [1]+ is a list where each entity stores the ID# of a selected ship.
   remend



   rem Propaganda Descriptions
   dim propaganda$(11)
   for i = 0 to 11 : read propaganda$(i) : next i

   rem DBC "globals"
   rem Ship limit
   dim shipLim(0)
   shipLim = 50 :`yes we need this too because DB doesn't like arrays being used to declare other arrays!
   shipLim(0) = shipLim
   rem Player and Enemy race
   dim PR(2)
   rem Colours (colours 1 and 2 are the player colours.)
   dim colour(3)
   colour(0) = rgb(255,255,255)
   colour(3) = rgb(108,108,108)
   rem Game Speed Modifier
   gamespeed# = 0

   rem Define arrays.
   dim string$(16)
   dim race(4,7)
   dim ShipClass(4,6)
   dim Ship#(shipLim,15)
   dim ShipSel(shipLim)
   dim Planet#(31,8)
   dim planet$(31)
   dim buildPermit(4)
   dim ai(9)

   rem read-in ship graphics
   for t=5 to 8
      read a
      string$(t)=chr$(a)
   next t

   rem read-in game text (race names generated in INITIALIZE:)
   for t=9 to 16
      read a$
      string$(t)=a$
   next t
   rem read race data
   race(0,5)=colour(0) :`neutral colour is colour(0).
   for t=1 to 4
      for u=1 to 7
         read a
         if u = 5
            read b
            read c
            race(t,u) = rgb(a,b,c)
         else
            race(t,u)=a
         endif
      next u
   next t
   rem read ship class data
   for t=1 to 4
      for u=1 to 6
         read a
         ShipClass(t,u)=a
      next u
   next t
return
`//arraysAndGlobals

makeBackdrop:
  create bitmap 1,1024,768

  rem HUD border
  box 9,9,1013,740
  ink 0,0
  box 10,10,739,739
  box 741,10,1012,739

  rem create starry backdrop
   maxstars=1024
  for t=1 to maxstars
    x=rnd(720)+15
    y=rnd(720)+15
    rem star intensity
    i=230
    if (t/(maxstars+.0)) >= 0.10 then i=128
    if (t/(maxstars+.0)) >= 0.40 then i=64
    ink rgb(i,i,i),0
    dot x,y
  next t

  ink colour(0),0
  set current bitmap 0
return
`//make backdrop


makeSounds:
   meloTheme = newSound(8,"4C{8}E{4}G{4}a{9}-GGFFCCF{9}-eecc3aa4C{8}-{7}C{8}E{4}G{4}5C{9}-4bbaa5CCc{8}--CC4bbaab{8}-{8}")
   bassTheme = newSound(8,"3C{16}2F{16}3c{16}a{14}-C{16}F{16}2b{16}3e{16}")
   sndFlip = newSound(16,"5DA")
   sndDrop = newSound(16,"4AD")
   sndBuy = newSound(16,"5D4D5A6D")
   sndLaser = newSound(128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
   sndClaxon = newSound(128,"1CcDeEFfGaAbB2CcDeEFfGaAbB3CcDeEFfGaAbB4CcDeEFfGaAbB5C{32}3BbAaGfFEeDcC2BbAaGfFEeDcC{32}-{64}")
   sndWarp = newSound(64,"0CcDeEFfGaAbB1C0cDeEFfGaAbB1Cc0eEFfGaAbB1CcDe0FfGaAbB1CcDeF0GaAbB1CcDeEFfGaAbB2CcDeEFfGaAbB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
   sndWarpFail = newSound(64,"0CcDeEFfGaAbB1C0cDeEFfGaAbB1Cc0eEFfGaAbB1CcDe0FfGaAbB1CcDeF0GaAbB1CcDeEFfGaAbB2CcDeEFfGaAbB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")
return
`//

checkEndGame:
  rem check both sides have at least one planet each.
  p1=0 : p2=0
  for t=1 to 30
     if Planet#(t,3)=1 then p1 = 1
     if Planet#(t,3)=2 then p2 = 1
     if p1=1 and p2=1 then exit
  next t

  if p1=0 or p2=0
      loop sound meloTheme : loop sound bassTheme
    if p2=0
      a$ = "VICTORY IS OURS!"
      b$ = "Congratulations General! You have vanquished The "
    else
      a$ = "ALL IS LOST!"
      b$ = "Your colony has been overrun by The "
    endif
    cls
    center text 512,200,a$
    center text 512,250,b$+propaganda$(6+rnd(5))+" "+string$(pr(2))+"s"
    wAit 700
    sync
    wAit key
    END
  endif
return
`//check end game

commandMoveShips:
  rem Is a ship selected?
  if ShipSel(0)>0
    rem can only issue commands to our own ships!
    if ( ShipSel(0)=1 and Ship#(shipsel(1),3)=1 ) or shipsel(0)>1
      if mc=2
         play sound sndDrop
        if mousex()>10 and mousey()>10 and mousex()<740 and mousey()<740
          ships = shipsel(0) :`can't use arrays as parameters in loops.
          xoffset=0 : yoffset=0
          rem Give the ships their movement commands.
          for t=1 to ships
            if Ship#(shipsel(t),1)>0
              `spread out ships
              if ships>1
                n=(t+4)*1.5
                xoff=rnd(n+n)-n
                yoff=rnd(n+n)-n
              else
                xoff=0 : yoff=0
              endif
              Ship#(shipsel(t),10)=mousex()+xoff
              Ship#(shipsel(t),11)=mousey()+yoff
              rem keep ships within map
              if ship#(shipsel(t),10)<25 then ship#(shipsel(t),10)=25
              if ship#(shipsel(t),10)>725 then ship#(shipsel(t),10)=725
              if ship#(shipsel(t),11)<25 then ship#(shipsel(t),11)=25
              if ship#(shipsel(t),11)>725 then ship#(shipsel(t),11)=725
            endif
          next t
        endif
      endif
    endif
  endif
return
`//command move ships

commandSelectObjects:
   rem Begin selection.
   if selecting=0 and mc=1 and mousex()<740 and mousey()<740
      selecting = 1
      planetSelected = 0
      ShipSel(0) = 0 :`reset number of ships selected.
      rem store mouse position when clicked
      mXStart = mousex()
      mYStart = mousey()
      slogan = rnd(5) :rem randomize propaganda slogans
   endif

   rem End selection: process selection.
   if selecting=1 and mc=0
      selecting = 0
      rem store mouse position at release
      mXEnd = mousex()
      mYEnd = mousey()
      rem Box selection else pick selection.
      if abs(mXEnd + mYEnd - mXStart - mYStart) > 8
         rem sort box coordinates
         if mXStart > mXEnd then inc mXStart, mXEnd : mXEnd = mXStart-mXEnd : dec mXStart, mXEnd
         if mYStart > mYEnd then inc mYStart, mYEnd : mYEnd = mYStart-mYEnd : dec mYStart, mYEnd
         rem Mark ships within selection box as selected.
         for t=1 to shipLim(0)
            ShipSel(t)=0 :`wipe the old selection data just to be tidy.
            rem only box-select player owned, constructed ships.
            if Ship#(t,3)=1 and Ship#(t,13)>11
               if Ship#(t,1)>mXStart and Ship#(t,1)<mXEnd and Ship#(t,2)>mYStart and Ship#(t,2)<mYEnd
                  ShipSel(0)=ShipSel(0)+1 :`increase the number of ships that have been selected.
                  ShipSel(ShipSel(0))=t :`place the selected ship in the new list place.
               endif
            endif
         next t
      else
         chosen = pick(mXEnd,mYEnd)
         if chosen>0 and chosen<31 then planetSelected = chosen              :rem planet selected (1 to 30)
         if chosen>1000 then ShipSel(0)=1 : ShipSel(ShipSel(0))=chosen-1000   :rem ship selected (1000+)
      endif

      if shipSel(0)+planetSelected >0 then play sound sndFlip
   endif
return
`//command select objects

display:
   rem refresh backdrop
   copy bitmap 1,0
   rem Show selection box during selection.
   if selecting=1
      rem store new mouse position
      mX = mousex()
      mY = mousey()
      rem draw selection box (fiddly but boxes are so much faster than lines)
      ax = mxStart : bx = mx
      ay = myStart : by = my
      if ax > bx then ax = bx+ax : bx = ax-bx : ax = ax-bx
      if ay > by then ay = by+ay : by = ay-by : ay = ay-by
      box ax,ay,bx,ay
      box bx,ay,bx,by
      box ax,by,bx,by
      box ax,ay,ax,by
   endif

   ` draw PLANETS
   set text size 18
   for t=1 to 30
      a$=""
      if Planet#(t,7)>1 then a$="?"
      if VIS(Planet#(t,1),Planet#(t,2),1) or omniscience then a$ = "@" : ink colour(planet#(t,3)),0
      text Planet#(t,1)-5,Planet#(t,2)-7,a$
      ink colour(0),0
   next t
   set text size 14

   `DRAW SHIPS
   for t=1 to shipLim(0)
      if Ship#(t,3)>0 and Ship#(t,1)>0
         if Ship#(t,3)=1 or VIS(Ship#(t,1),Ship#(t,2),1) or omniscience
            if Ship#(t,13)<11
               ink colour(3),0
            else
               ink colour(Ship#(t,3)),0
            endif
            center text Ship#(t,1),Ship#(t,2)-6,string$(int(Ship#(t,4)+4))
         endif
      endif
   next t
   ink colour(0),0

   rem display selected planet data
   if planetSelected
      circle Planet#(planetSelected,1),Planet#(planetSelected,2),9
      a$="Uninhabited"
      s$=""
      if Planet#(planetSelected,3)=2
         a$="The "+propaganda$(6+slogan)+" "
         s$="s"
      endif
      if Planet#(planetSelected,3)=1
         a$="The "+propaganda$(slogan)+" "
         s$="s"
         rem Display ships for construction, with unaffordable ships in colour(3).
         for u=1 to 4
            c = 80+buildPermit(u)*175
            ink rgb(c,c,c),0
            set text size 14
            text 760,300+u*20,str$(u)+". BUILD "+string$(u+8)
         next u
      endif

      ink -2,0
      text 760,20,str$(planetSelected)
      center text 876,40,"-=- "+planet$(planetSelected)+" -=-"
      text 760,80,"GOV: "+a$+string$(int(Planet#(planetSelected,6)))+s$
      text 760,100,"POP: "+str$(int(Planet#(planetSelected,4)))
      text 760,120,"CUR: "+str$(int(Planet#(planetSelected,5)))
   endif

   rem If single ship selected , display ship data
   if ShipSel(0)=1
   rem who owns the ship?
   if Ship#(ShipSel(1),3)=1
   ownerRace$=string$(pr(1))
   else
   ownerRace$=string$(pr(2))
   endif
   rem ship weapons status
   if Ship#(ShipSel(1),12)>0.1 then weapons$="Weapons Charging" else weapons$="Ready To Fire"
   rem ship damage status
   if Ship#(ShipSel(1),9)<Ship#(ShipSel(1),6)
   damage$="Damaged"
   if Ship#(ShipSel(1),14)>5 then damage$ = damage$+", REPAiRING NOW"
   else
   damage$="All Systems Operational"
   endif
   rem Under Construction
   if ship#(shipsel(1),13)<11
      ink 65535,0
      text 760,60,"UNDER CONSTRUCTION: "+str$(int(ship#(shipsel(1),13)*9))+"%"
      ink colour(0),0
   endif

   center text 876,40,"-=- "+ownerRace$+" "+string$(int(Ship#(ShipSel(1),4))+8)+" -=-"
   text 760,80,"ATK: "+str$(int(Ship#(ShipSel(1),5)))
   text 760,100,"DEF: "+str$(int(Ship#(ShipSel(1),9)))+" / "+str$(int(Ship#(ShipSel(1),6)))
   text 760,140,weapons$
   text 760,160,damage$
   rem Ship "cam"
   x = ship#(shipsel(1),1) : y = ship#(shipsel(1),2)
   set current bitmap 0
   get image 1,x-20,y-20,x+20,y+20
   box 949,79,991,121
   paste image 1,950,80

   endif
   rem Show selected ship map graphics.
   if ShipSel(0)>0
   fleetposx#=0:fleetposy#=0:fleetdestx#=0:fleetdesty#=0:fleetmoving=0
   for t = 1 to ShipSel(0)
   rem circle the selected ship
   circle Ship#(ShipSel(t),1),Ship#(ShipSel(t),2),9
   rem show friendly ship path
   destx# = Ship#(ShipSel(t),10)
   desty# = Ship#(ShipSel(t),11)
   if destx#>0 AND Ship#(ShipSel(t),3)=1
   if ShipSel(0)=1
   rem show path if a single ship selected
   line Ship#(ShipSel(t),1),Ship#(ShipSel(t),2),destx#,desty#
   else
   inc fleetmoving
   rem store average data for a group selection
   fleetposx# = fleetposx# + Ship#(ShipSel(t),1)
   fleetposy# = fleetposy# + Ship#(ShipSel(t),2)
   fleetdestx# = fleetdestx# + destx#
   fleetdesty# = fleetdesty# + desty#
   endif
   endif
   next t
   rem show one path for a group selection
   if ShipSel(0)>1 and fleetmoving>0
   ax = fleetposx#/fleetmoving
   ay = fleetposy#/fleetmoving
   bx = fleetdestx#/fleetmoving
   by = fleetdesty#/fleetmoving
   line ax,ay,bx,by
   endif
   endif

   rem display game data
   select gamespeed#
   case 0 : a$="PAUSED" : endcase
   case default : a$=str$(gamespeed#) : endcase
   endselect
   text 760,700,"GAME SPEED : "+a$
   text 760,720,"FPS : "+str$(screen fps())
return
`//display

generateRaces:
  rem generate race names
  for t=1 to 4
    a$=GenerateRace$()
    string$(t)=a$
  next t
return
`//

initialize:
  rem create planets
  repeat
    fAil=0
    sxs=1

    for t=1 to 30
      yes=1
      repeat
        inc fAil
        x=rnd(690)+30
        y=rnd(690)+30
        for u=1 to t-1
          dist#=d2d(x+.0,y+.0,Planet#(u,1),Planet#(u,2))
          if dist#<30
            yes=0
          endif
        next u
      until yes=1 or fAil>1500

      if fAil<=1500
        Planet#(t,1)=x
        Planet#(t,2)=y
        Planet#(t,3)=0
        planet$(t)=generatePlanet$() :`generate planet name.
      else
        sxs=0
        EXIT
      endif
    next t
  until sxs=1

  ` NEW DESIGNATE HOMEWORLDS
  rem Human
  X=20
  for t=1 to 3
    sxs=0
    repeat
      inc X
      for u=1 to 30
        if Planet#(u,3)<1
          if Planet#(u,1)<x
            Planet#(u,3)=1
            Planet#(u,4)=1500
            Planet#(u,5)=1000
            Planet#(u,6)=pr(1)
            SXS=1
            EXIT
          endif
        endif
      next u
    until sxs=1
  next t
  rem ai
  X=720
  for t=4 to 6
    sxs=0
    repeat
      dec X
      for u=1 to 30
        if Planet#(u,3)<1
          if Planet#(u,1)>x
            Planet#(u,3)=2
            Planet#(u,4)=1500
            Planet#(u,5)=1000
            Planet#(u,6)=pr(2)
            SXS=1
            EXIT
          endif
        endif
      next u
    until sxs=1
  next t
return
`//initialize

raceSelect:
   loop sound meloTheme : loop sound bassTheme

   repeat
      gosub generateRaces
      rem list races
      cls
      center text 512,200,"Welcome. Use The Keyboard To Select Your Race"
      text 300,300,"1. "+string$(1) : text 600,300,"  (Warriors)"
      text 300,330,"2. "+string$(2) : text 600,330,"(Scientists)"
      text 300,360,"3. "+string$(3) : text 600,360,"  (Breeders)"
      text 300,390,"4. "+string$(4) : text 600,390,"   (Traders)"
      center text 512,450,"Press 5 to randomize the race names."

      rem wAit for valid key press
      repeat
         sync
         if key=0 then key=scancode() else key=0-scancode()
      until key>1 and key<=6
      if key = 6 then play sound sndBuy
   until key<=5

   play sound sndDrop

   pr(1)=key-1
   rem select enemy race.
   enemy = pr(1) + rnd(2)+1
   if enemy > 4 then dec enemy,4
   pr(2) = enemy
   rem store active colours
   colour(1) = race(pr(1),5)
   colour(2) = race(pr(2),5)

   rem display enemy race
   center text 512,500,"You Face The "+propaganda$(6+rnd(5))+" "+string$(pr(2))+"s!"
   sync:wait 2000:cls
   stop sound meloTheme : stop sound bassTheme
return
`//raceSelect

`*** UNEDITED ***
updateAi:
 `0 numcol, 1 num DD, 2 num CA, 3 num BB, 4 # colships, 5 num ENEMY colonies,
 `6 - colony being attacked. 7. sync countdown of coming out of defense. 9 ai STATE DECIDED ON

`===================Ai====================

` ai STATE determines WHICH SHIP IS BUILT.

` 1. DEFEND. build destroyers. send all ships within DOUBLE engagement range to the attacked planet.
` 2. PREPARE. build cruisers. CA & BB don't move. destroyers PATROL HOME.
` 3. ATTACK. build BB's. send all ships to their nearest seen enemy planet. if no enemy planet is seen, DDs PATROL AWAY.
` 4. COLONIZE. build COL ships. one at a time. (while any colony ships exist). if no empty planets are seen, DDs PATROL AWAY. as long as numcol<numColWant

` clear ai statistics-keeping.
for t=0 to 5
 ai(t)=0
next t

NumEnColSeen=0

` ai, count your ships and planets.
for t=1 to 30
  if Planet#(t,3)=1 and Planet#(t,8)>0
    ai(5)= ai(5)+1
      if VIS(Planet#(t,1),Planet#(t,2),2)
        inc NumEnColSeen
      endif
    endif
  if Planet#(t,3)=2 then ai(0) = ai(0)+1
next t
for t=1 to shipLim(0)
  if Ship#(t,3)=2
    ai(int(Ship#(t,4))) = ai(int(Ship#(t,4)))+1
  endif
next t

` THIS decides on the ai state.
` if you are NOT under attack, AND you have enough DESTROYERS
if ai(6)=0 and ai(1)>=Ai(0)
 ` if you don't have enough colonies, AND you don't have any colony ships, then COLONIZE.
 if ai(0)<race(pr(2),6) and ai(4)<1
  ai(9)=4
 else

   pow=Ai(1)+Ai(2)*2+Ai(3)*3
   snd=Ai(0)*4+Ai(5)

    if pow>snd
     ai(9)=3 : ` if you have enough ships to attack, then do so.
    else
     ai(9)=2 : ` otherwise wAit, and keep building.
    endif

       IF pow>(3*snd) AND ai(0)<25
        ` ifyou have LOTS of ships and not totally colonized all of space, then colonize.
        ai(9)=4
       ENDIF

 endif
else
 ai(9)=1 : ` if you're under attack, or you don't have enough destroyers, then state=1.
endif

if ai(6)>0
 ai(7) = ai(7)-1
 ai(9)=1
  if ai(7)<1
   ai(6)=0
  endif
endif

` this builds ships based on ai STATE:
 if ai(9)>0
for t=1 to 30
 if Planet#(t,3)=2
  if Planet#(t,4)>ShipClass(Ai(9),6)*2
  if Planet#(t,5)>ShipClass(Ai(9),5)
   Planet#(t,4) = Planet#(t,4)-ShipClass(Ai(9),6)
   Planet#(t,5) = Planet#(t,5)-ShipClass(Ai(9),5)
   BuildShip(2,pr(2),Planet#(t,1),Planet#(t,2),Ai(9),Rnd(359))
   EXIT : ` ONLY ONE ships is built per cycle, so we don't build too many of something.
  endif
  endif
 endif
next t
 endif

  ` this will build COLONY SHIPS at any owned planet with a POP >2499 , as long as you have <10 colonies
if ai(0)<13
for t=1 to 30
 if Planet#(t,3)=2
  if Planet#(t,4)>2499
  if Planet#(t,5)>ShipClass(4,5)
   Planet#(t,4) = Planet#(t,4)-ShipClass(4,6)
   Planet#(t,5) = Planet#(t,5)-ShipClass(4,5)
   BuildShip(2,pr(2),Planet#(t,1),Planet#(t,2),4,Rnd(359))
  endif
  endif
 endif
next t
endif

 ` if we are really under attack, defend the colony:
if ai(9)=1
 if ai(6)>0
  DefendPlanet(Ai(6))
 endif
endif

if ai(9)=3
 ` if ATTACK
   for t=1 to shipLim(0)
     Ship#(t,15)=0
    IF Ship#(t,4)<4
     if Ship#(t,3)=2
     if Ship#(t,13)>11
     if Ship#(t,1)>0
     if Ship#(t,10)<10
      Ship#(t,15)=99
        Ship#(t,10)=rnd(710)+20
        Ship#(t,11)=rnd(710)+20
     endif
     endif
     endif
     endif
    ENDIF
   next t

   attack()
 endif

`these should be called regardless of ai STATE.
`if you have built colony ships, then use them! if you see enemy, attack!
AiEngageShip()
SendColonyShips()

`===================END=Ai====================
return
`//update ai

updatePlanetData:
  for t=1 to 30
    `grow the pop & economy. make wealth first, then grow pop.
    if Planet#(t,3)>0
      Planet#(t,5)=Planet#(t,5)+ ( (race(int(Planet#(t,6)),4)*Planet#(t,4))*gameticks#)/250.1
      Planet#(t,4)=Planet#(t,4)+ ( (race(int(Planet#(t,6)),3))*gameticks#)
      if Planet#(t,4)>2500 then Planet#(t,4)=2500
    endif
    rem planets visible by human
    if VIS(Planet#(t,1),Planet#(t,2),1) or omniscience
      Planet#(t,7)=99
    endif
    rem planets visible by ai
    if VIS(Planet#(t,1),Planet#(t,2),2)
      Planet#(t,8)=99
    endif
  next t
return
`//

updateShipData:
  `Ship live data: 1=x,2=y,3=own,4=size,5=atk,6=def,7=spd,8=range,9=defLeft,10=targetx,11=targety
  `                12=FightTime,13=built,14=Time Since been hit
  for t=1 to shipLim(0)
    rem Check the ship exists (has an owner).
    if Ship#(t,3)>0
      rem BUILD SHIPS - once ship#[t,13] reaches 11 the ship is completed.
      if Ship#(t,13) <= 11
        rem big ships take longer to build.
        Ship#(t,13) = Ship#(t,13)+(gameticks#*7)/Ship#(t,4)
      endif
      ` REPAiR SHIPS - any ship that has not been shot in the last 20 gameticks# will start to slowly repAir itself.
      Ship#(t,14) = Ship#(t,14)+gameticks#
      if Ship#(t,14)>5
        if Ship#(t,9)<Ship#(t,6)
          Ship#(t,9) = Ship#(t,9)+gameticks#*21
        endif
      endif
      ` MOVE SHIPS - move any ship that has a target co-ordinate.
      if Ship#(t,10)>0
        rem check ship is built
        if Ship#(t,13)>11
          dx#=(Ship#(t,1)-Ship#(t,10))
          dy#=(Ship#(t,2)-Ship#(t,11))
          rem destination reached.
          if abs(dx#)<3 and abs(dy#)<3
            Ship#(t,10)=0
            Ship#(t,11)=0
          endif
          rem move ship towards target
          a#=wrapvalue((ATANFULL(dx#,dy#)))
          Ship#(t,1)=Ship#(t,1)-( sin(a#)*gameticks#*Ship#(t,7)*3 )
          Ship#(t,2)=Ship#(t,2)-( cos(a#)*gameticks#*Ship#(t,7)*3 )
        endif
      endif
      ` COLONIZE/ATTACK PLANETS (colonizers don't attack)
      Ship#(t,12) = Ship#(t,12)-gameticks#*5
      for u=1 to 30
        if Ship#(t,4)=4
          ` Colonize Empty Planets - this works for everybody, automatically.
          if Planet#(u,3)=0
            if d2d(Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2))<7.0
              Planet#(u,3)=Ship#(t,3)
              Planet#(u,4)=500
              Planet#(u,5)=350
              Planet#(u,6)=pr(Ship#(t,3))
               killShip(t)
              play sound sndWarp
            endif
          endif
        else
          ` Attack Planet
          if Ship#(t,12)<0.1
            ` if you still haven't fired, try to attack planets.
            if Planet#(u,3)>0 and Planet#(u,3)<>Ship#(t,3)
              if d2d(Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2))<20
                play sound sndLaser
                line Ship#(t,1),Ship#(t,2),Planet#(u,1),Planet#(u,2)
                Planet#(u,4) = Planet#(u,4)-Ship#(t,5)
                ` tell ai one of its planets is under attack.
                if Planet#(u,3)=2 AND ai(6)=0
                  ai(6)=u
                  ai(7)=500
                endif
                rem wipe out population.
                if Planet#(u,4)<1
                  Planet#(u,3)=0
                  Planet#(u,4)=0
                  Planet#(u,5)=0
                  Planet#(u,6)=0
                endif
                Ship#(t,12)=2.5+( rnd(99)/9.9 ):`increase attack time.
                EXIT:`only one attack per turn
              endif
            endif
          endif
        endif
      next u
      ` SHIPS FIGHT
      if Ship#(t,4)<4 : ` colony ships DON'T ATTACK.
        if Ship#(t,12)<0.1
          `attack an enemy ship
          for u=1 to shipLim(0)
            if Ship#(u,3)>0 and Ship#(u,3)<>Ship#(t,3)
              if d2d(Ship#(t,1),Ship#(t,2),Ship#(u,1),Ship#(u,2))<Ship#(t,8)
                  play sound sndLaser
                line Ship#(t,1),Ship#(t,1),Ship#(u,1),Ship#(u,2)

                Ship#(t,12)=2.5+( rnd(99)/9.9 ):`increase attack time.
                ` enemy ship hit.
                Ship#(u,9) = Ship#(u,9)-Ship#(t,5)
                Ship#(u,14)=0
                ` kill dead ships:
                if Ship#(u,9)<1
                  killShip(u)
                  ` since ship T killed ship U, give ship T some EXPERIENCE.
                  Ship#(T,5) = Ship#(T,5)+(Ship#(t,4)) : ` +1 atk/size
                  Ship#(T,6) = Ship#(T,6)+5*(Ship#(t,4)) : ` +5 DEF per size
                  Ship#(T,7) = Ship#(T,7)+1 : ` +1 SPD regardless of size
                  Ship#(T,8) = Ship#(T,8)+1 : ` +1 RNG regardless of size
                endif
                EXIT:`only one attack per turn
              endif
            endif
          next u
        endif
      endif
    endif
  next t
return
`//update ship data

validateSelection:
   if omniscience=0
      rem Non-human planet still visible.
      if planetSelected and planet#(planetSelected,3)!1
         if VIS(planet#(planetSelected,1),planet#(planetSelected,2),1)=0 then planetSelected=0
      endif
      rem Enemy Ship still visible.
      if ShipSel(0)=1
         if ship#(ShipSel(1),3)=2
            if VIS(ship#(ShipSel(1),1),ship#(ShipSel(1),2),1)=0 then ShipSel(0)=0
         endif
      endif
   endif
return
`//


rem ======================================
rem === FUNCTIONS ===
rem ======================================
function killShip(n)
   ship#(n,1)=0
   ship#(n,2)=0
   ship#(n,3)=0
   ship#(n,4)=0
   ship#(n,5)=0
   ship#(n,6)=0
   ship#(n,7)=0
   ship#(n,8)=0
   ship#(n,9)=0
   ship#(n,10)=0
   ship#(n,11)=0
   ship#(n,12)=0
   ship#(n,13)=0
   ship#(n,14)=0
   ship#(n,15)=0
   deselectShip(n)
endfunction
`//

function deselectShip(n)
  rem Find and remove the ship from the selection list.
  for t = 1 to ShipSel(0)
    if ShipSel(t)=n
      `Move higher entries down to fill the gap.
      for bump = t to ShipSel(0)-1
        ShipSel(bump) = ShipSel(bump+1)
      next bump
      ShipSel(ShipSel(0))=0 :`Delete last entry which is no longer needed.
      ShipSel(0) = ShipSel(0)-1 :`reduce number of ships in the list.
      EXIT
    endif
  next t
endfunction
`//

function d2d(ax#,ay#,bx#,by#)
  rem distance between A and B.
  dist#=sqrt( (ax#-bx#)*(ax#-bx#) + (ay#-by#)*(ay#-by#) )
endfunction dist#
`//

Function VIS(x#,y#,p)
   rem This function determines whether player P can see coord x,y. 0=no, 1=yes
   V=0
   for t=1 to shipLim(0)
      if Ship#(t,3)=p
         if Ship#(t,13)>11
            dist#=d2d(Ship#(t,1),Ship#(t,2),x#,y#)
            if dist#<50 then V=1 : EXIT
         endif
      endif
   next t
   for t=1 to 30
      if int(Planet#(t,3))=p
         dist#=d2d(Planet#(t,1),Planet#(t,2),x#,y#)
         if dist#<100 then V=1 : EXIT
      endif
   next t
Endfunction V
`//

Function PICK(x,y)
   `Only the HUMAN player uses this function. Returns 0 for nothing picked, 1-30 for a planet, 1001-2000 for a ship.
   for t=1 to 30
      if VIS(Planet#(t,1),Planet#(t,2),1)
         if d2d(Planet#(t,1),Planet#(t,2),x+.0,y+.0)<7 then exitfunction t
      endif
   next t

   rem Only check for ships if no planet is found.
   for t=1 to shipLim(0)
      if VIS(Ship#(t,1),Ship#(t,2),1)
         if d2d(Ship#(t,1),Ship#(t,2),x+.0,y+.0)<7 then exitfunction t+1000
      endif
   next t
Endfunction 0
`//

Function BuildShip(owner,race,x#,y#,class,ang)
   for s = 1 to shipLim(0)
      if Ship#(s,3)=0.0 then exit
   next s
   if s>shipLim(0) then exitfunction -1 :`break if no id avAilable

   killShip(s) :`wipe old data
   Ship#(s,1)=x#+(sin(ang)*16)
   Ship#(s,2)=y#+(cos(ang)*16)
   Ship#(s,3)=owner
   Ship#(s,4)=class
   Ship#(s,5)=race(race,1)*ShipClass(class,1)
   Ship#(s,6)=race(race,2)*ShipClass(class,2)*15
   Ship#(s,7)=ShipClass(class,3)
   Ship#(s,8)=ShipClass(class,4)
   Ship#(s,9)=race(race,2)*ShipClass(class,2)*15
Endfunction
`//

Function aiEngageShip()
   rem if an ai ship SEES another ship (and it's not already in combat) ,
   rem it might just attack that other ship. but there is a range limit.
   rem this should NOT happen if ai STATE is DEFEND.
   for t=1 to shipLim(0)
      if Ship#(t,3)=2
         if Ship#(t,13)>11
            if Ship#(t,1)>0
               if Ship#(t,4)<4
                  if Ship#(t,14)>8
                     for u=1 to shipLim(0)
                        if Ship#(u,3)=1
                           if Ship#(u,13)>11
                              if Ship#(u,1)>0
                                 if VIS(Ship#(u,1),Ship#(u,2),2) : ` if we see this enemy ship.
                                    if d2d(Ship#(t,1),Ship#(t,2),Ship#(u,1),Ship#(u,2))<race(pr(2),7) : ` if its within our ENGAGEMENT RANGE
                                       Ship#(t,10)=Ship#(u,1)+rnd(15)-8
                                       Ship#(t,11)=Ship#(u,2)+rnd(15)-8
                                       EXIT
                                    endif
                                 endif
                              endif
                           endif
                        endif
                     next u
                  endif
               endif
            endif
         endif
      endif
   next t
Endfunction
`//

Function DefendPlanet(p)
   for t=1 to shipLim(0)
      if Ship#(t,3)=2
         if Ship#(t,13)>11
            if Ship#(t,1)>0
               if Ship#(t,4)<4
                  if d2d(Ship#(t,1),Ship#(t,2),Planet#(p,1),Planet#(p,2))<450 : ` make defense much more of a Priority. : ` (race(er,7)*2)
                     Ship#(t,10)=Planet#(p,1)+rnd(15)-8
                     Ship#(t,11)=Planet#(p,2)+rnd(15)-8
                  endif
               endif
            endif
         endif
      endif
   next t
Endfunction
`//

Function SendColonyShips()
   for t=1 to shipLim(0)
      IF Ship#(t,4)=4
         if Ship#(t,3)=2
            if Ship#(t,13)>11
               if Ship#(t,1)>0
                  dis=999
                  plan=0
                  for u=1 to 30
                     if Planet#(u,3)=0
                        if VIS(Planet#(u,1),Planet#(u,2),2)
                           dist#=d2d(Planet#(u,1),Planet#(u,2),Ship#(t,1),Ship#(t,2))
                           if dist#<dis
                              dis=dist#
                              plan=u
                           endif
                        endif
                     endif
                  next u
                  if plan>0
                     Ship#(t,10)=Planet#(plan,1)
                     Ship#(t,11)=Planet#(plan,2)
                  endif
               endif
            endif
         endif
      ENDIF
   next t
Endfunction
`//

Function ATTACK()
  for t=1 to shipLim(0)
    if Ship#(t,3)=2
       if Ship#(t,13)>11
          if Ship#(t,1)>0
             if Ship#(t,4)<4
                dis=999
                plan=0
                for u=1 to 30
                   if Planet#(u,3)=1
                      if VIS(Planet#(u,1),Planet#(u,2),2)
                         dist#=d2d(Planet#(u,1),Planet#(u,2),Ship#(t,1),Ship#(t,2))
                         if dist#<dis
                            dis=dist#
                            plan=u
                         endif
                      endif
                   endif
                next u
                if plan>0
                   Ship#(t,10)=Planet#(plan,1)
                   Ship#(t,11)=Planet#(plan,2)
                endif
             endif
          endif
       endif
     endif
  next t
Endfunction
`//

rem *** OBESE87'S RANDOM NAME GENERATOR FUNCTIONS ***
function GenerateRace$()
  race$ = ""
  race$ = GeneratePlanet$()
  rem Select a suffix depending on the last letter.
  last$ = right$(race$,1)
   select last$
      case "a" "e" "o" "i" "u" : k=rnd(5) : endcase
      case default : k=rnd(4)+4 : endcase
   endselect

   select k
      case 0 : race$ = race$+"n" : endcase
      case 1 : endcase
      case 2 : race$ = race$+"can" : endcase
      case 3 : race$ = race$+"ni" : endcase
      case 4 : race$ = race$+"an" : endcase
      case 5 : race$ = race$+"on" : endcase
      case 6 : race$ = race$+"i" : endcase
      case 7 : race$ = race$+"ese" : endcase
      case 8 : race$ = race$+"ite" : endcase
   endselect
endfunction race$
`//

function GeneratePlanet$()
  planet$=""
  rem Define number of character pAirs to generate.
  nameLen = rnd(1)+2

  for i = 1 to nameLen
    rem After first letter switch to lower case.
    if i>1 then capoff=32 else capoff=0
    rem Get a random parent character.
    Parent = rnd(25)+65
    rem Make sure name doesn't end in "QU".
    if i=nameLen
      if Parent=81 then Parent=Parent-1-rnd(15)
    endif
    rem Add parent to planet name.
    planet$ = planet$+chr$(Parent+capoff)
    rem Generate child from parent.
    Select Parent
      rem Q.
      Case 81 : planet$=planet$+"u" : Endcase
      rem Vowel.
      Case 65 or 69 or 73 or 79 or 85
        child = rnd(5)
        if child=0 then planet$=planet$+"d"
        if child=1 then planet$=planet$+"l"
        if child=2 then planet$=planet$+"n"
        if child=3 then planet$=planet$+"r"
        if child=4 then planet$=planet$+"s"
        if child=5 then planet$=planet$+"t"
      Endcase
      rem Consonant.
      Case Default
        child = rnd(4)
        if child=0 then planet$=planet$+"a"
        if child=1 then planet$=planet$+"e"
        if child=2 then planet$=planet$+"i"
        if child=3 then planet$=planet$+"o"
        if child=4 then planet$=planet$+"u"
      Endcase
  next i
endfunction planet$
`//

function newSound(bps,music$)
   rem Find avAilable sound
   for snd = 1 to 255
      if sound exist(snd)=0 then exit
   next snd
   if snd > 255 then end

   rem Find avAilable memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 40000
`   samplerate# = 26624 :`Why this number?
   soundsize = samplerate# / bps

   rem Find number of actual notes in music$.
   i=0 :`forgot variables inside function are persistent: eugh DB is not a good example for new coders. No other language I know does this. :'(
   for x = 1 to strLen
      n$ = mid$(music$,x)
      if val(n$)=0
         rem Number inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(snippet$(music$,x+1,bracket-1))-1 :`we minus one from the length because note will have been counted by itself.
                  inc i,numinbracket :`add number in brackets to note count.
                  x = bracket : `this just moves the x pointer past the brackets.
                  exit
               endif
            next bracket
         else
            inc i :`single note
         endif
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         rem Numbers inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(snippet$(music$,x+1,bracket-1))-1 :`we minus one from the length because note will have been counted by itself.
                  n$ = mid$(music$,x-1) :`take the note before the brackets.
                  x = bracket : `this just moves the pointer past the brackets.
                  bracket = strLen
               endif
            next bracket
         else
            numinbracket = 1
         endif

         for noteLen = 1 to numinbracket
            rem -- Store Note --
remstart
         WTF IS THE PROBLEM HERE? WHY WONT THE SELECT COMMAND WORK NOW!?!? >:(
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "e" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "a" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "b" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect
remend
            nt#=-1
            if n$ =  "C" then nt#=2093.00
            if n$ =  "c" then nt#=2217.46
            if n$ =  "D" then nt#=2349.32
            if n$ =  "e" then nt#=2489.02
            if n$ =  "E" then nt#=2637.02
            if n$ =  "F" then nt#=2793.83
            if n$ =  "f" then nt#=2959.96
            if n$ =  "G" then nt#=3135.96
            if n$ =  "a" then nt#=3322.44
            if n$ =  "A" then nt#=3520.00
            if n$ =  "b" then nt#=3729.31
            if n$ =  "B" then nt#=3951.07

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  b = 128 + sin(ang#) :`since integers are truncated b will always be 127 or 128. (Except when ang#= 90|270 then b= 126|129.)
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   set sound volume snd,5 :rem Default volume is bloody loud!
   delete memblock mem
endfunction snd
`//

function snippet$(a$,head,tAil)
   return$ = right$(left$(a$,tAil),tAil+1-head)
endfunction return$
`//

remstart
------------------
-=- String Replace -=-
by OBese87
15 JAN 2013
------------------
remend

open to read 1,"space conflicta.dba"
open to write 2,"space conflictb.dba"

dim replace$(15)
replace$(1) = "_shipX(~)"
replace$(2) = "_shipY(~)"
replace$(3) = "_shipOwner(~)"
replace$(4) = "_shipClass(~)"
replace$(5) = "_shipAtt(~)"
replace$(6) = "_shipDef(~)"
replace$(7) = "_shipSpeed(~)"
replace$(8) = "_shipRange(~)"
replace$(9) = "_shipHP(~)"
replace$(10) = "_shipDestX(~)"
replace$(11) = "_shipDestY(~)"
replace$(12) = "_shipFightTime(~)"
replace$(13) = "_shipBuilt(~)"
replace$(14) = "_shipPeaceTime(~)"
replace$(15) = "_shipOBeseHasNoClueWhatThisIs(~)"

change = 0
while file end(1)=0
   read string 1,a$

   for i = 1 to 15
      b$ = a$
      a$ = _replace$(a$,"Ship#(~,"+str$(i)+")", replace$(i))
      if a$!b$ then inc change : dec i :`run same search again if there was a change.
   next i

   write string 2,a$
endwhile

close file 1
close file 2
delete file "space conflicta.dba"
rename file "space conflictb.dba","space conflicta.dba"

print change;" changes."

end

b$ = "Ship#(j,1) * 5"
print _replace$(b$,"Ship#(~,1) *","shipx(~) /")
print _replace$(b$,"Ship#(~,2)","shipy(~)")
print _replace$(b$,"Ship#(~,3)","ship_owner(~)")
print

wait key
end

function _replace$(source$,search$,replace$)
   sourcelen = len(source$)
   searchlen = len(search$)
   replacelen = len(replace$)
   j=1

   for i = 1 to sourcelen
      if mid$(search$,j) = "~"
         rem If last character of search$ is "~" then we ignore the rest of source$ and return here.
         if j=searchlen
            return$ = left$(replace$,replacelen)
            if left$(search$,1)!"~" then return$ = left$(source$,i-j) + return$ :`drop the start of source$ if search$ starts with "~".
            exitfunction return$
         endif

         rem if search$ first character is "~" then we don't do a subsearch.
         if j > 1
            `If there's a "~" in replace$ then we want to keep the letters in between the two
            `search terms either side of the "~" in search$ ELSE we ignore them.
            for k = 1 to replacelen-1
               if mid$(replace$,k) = "~" then exit
            next k
            if k < replacelen
               subsearch$ = right$(search$,searchlen-j)
               dec k
            else
               subsearch$ = right$(search$,searchlen+1-j)
            endif

            rem Commence subsearch.
            sub$ = _replace$( right$(source$,sourcelen+1-i), subsearch$, right$(replace$,replacelen-k-1) )

            rem If subsearch fails then whole search fails.
            rem Else whole search was successful.
            if sub$ = right$(source$,sourcelen+1-i)
               exitfunction source$
            else
               return$ = left$(replace$,k) + sub$
               if left$(search$,1)!"~" then return$ = left$(source$,i-j) + return$ :`drop the start of source$ if search$ starts with "~".
               exitfunction return$
            endif
         else
            rem If search$(1) = "~" then we need to check the next character along against source$.
            if mid$(search$,j+1) = mid$(source$,i) then inc j,2
         endif
      else
         if mid$(search$,j) = mid$(source$,i)
            if j >= searchlen
               return$ = replace$ + right$(source$,sourcelen-i)
               if left$(search$,1)!"~" then return$ = left$(source$,i-j) + return$ :`drop the start of source$ if search$ starts with "~".
               exitfunction return$
            endif
            inc j
         else
            j=1
         endif
      endif
   next i
   rem If we get here the search failed so just return source$
endfunction source$

Original	if Ship#(ShipSel(1),9) < Ship#(ShipSel(1),6)

Search		Ship#(~,6)

Replace		_shipDef(~)

Return		if _shipDef(ShipSel(1),9) < Ship#(ShipSel(1))

s$="if d2d(Ship#(t,1),Ship#(t,2),Ship#(1),Planet#(u,2))<7.0 and Ship#(t,1)>0"
print s$
print ubereplace$(s$,"Ship#(~,1)","shipX[~]")
wait key
end

function ubereplace$(s$,f$,r$)
   braces = countBraces(f$)
   ftilde = chrPos(f$,"~")
   rtilde = chrPos(r$,"~")

   if ftilde = 0
      rem -- Standard Find & Replace.
      do
         tmp1$ = split$(s$,f$,0)
         tmp2$ = split$(s$,f$,1)
         if tmp1$ = s$ then exitfunction s$
         s$ = tmp1$ + r$ + tmp2$
      loop
   else
      f1$ = left$(f$,ftilde-1)
      f2$ = right$(f$,len(f$)-ftilde)

      if rtilde = 0
         rem -- Replace everything in-between the two search strings.
         rem -- not optimised for braces, may destroy braces structure.
         do
            tmp1$ = split$(s$,f1$,0)
            tmp2$ = split$(s$,f2$,1)
            if tmp1$ = s$ or tmp2$=s$ then exitfunction s$
            s$ = tmp1$ + r$ + tmp2$
         loop
      else
         rem -- Replace just the two search terms preserving the characters in-between.
         rem -- Optimised for safe use with braces! :D
         r1$ = left$(r$,rtilde-1)
         r2$ = right$(r$,len(r$)-rtilde)

         i=0
         do
            tmp1$ = split$(s$,f1$,i)
            tmp3s$ = right$(s$,len(s$)-len(tmp1$))
            tmp3$ = split$(tmp3s$,f2$,1)
            tmp2s$ = split$(s$,f1$,i+1)
            tmp2$ = split$(tmp2s$,f2$,0)

            if tmp1$=s$ or tmp2$=tmp2s$ or tmp3$=tmp3s$ then exitfunction s$

            if braces
               lb = chrPos(tmp2$,"(")
               rb = chrPos(tmp2$,")")
               if lb <= rb and ((countBraces(tmp2$)&1)=0)
                  s$ = tmp1$ + r1$ + tmp2$ + r2$ + tmp3$
                  i=0
               else
                  inc i,2
               endif
            else
               s$ = tmp1$ + r1$ + tmp2$ + r2$ + tmp3$
            endif
         loop
      endif
   endif
endfunction s$
`//

function countBraces(s$)
   braces = 0
   for i = 1 to len(s$)
      if mid$(s$,i) = "(" then inc braces
      if mid$(s$,i) = ")" then inc braces
   next i
endfunction braces
`//

function chrPos(source$,c$)
   for i = 1 to len(source$)
      if mid$(source$,i) = c$ then exitfunction i
   next i
endfunction 0
`//

rem Returns a section of the source string starting at 'pos' and extending 'wid' characters.
function midleft$(a$,pos,wid)
   a$ = right$(left$(a$,pos+wid),wid)
endfunction a$
`//

rem Returns the left- or right-most part of a string split at 'find$'.
rem 'find$' is omitted from the return string.
rem To split the source string at the first instance of 'find$',
rem give 'part' a value of 0 (to return left half) or 1 (to return right half).
rem if you wish to split the string at a further instance of 'find$' simply increase
rem 'part' by 2 for every instance you wish to ignore.
rem If the search fails the source string is returned.
function split$(s$,f$,part)
   for x = 0 to len(s$)-len(f$)
      if midleft$(s$,x,len(f$)) = f$
         select part
            case 0 : exitfunction left$(s$,x) : endcase
            case 1 : exitfunction right$(s$,len(s$)-len(f$)-x) : endcase
            case default : s$ = midleft$(s$,x+1,len(s$)) : dec part,2 : endcase
         endselect
      endif
   next x
endfunction s$
`//

melTheme = newSound(8,"4C{8}E{4}G{4}a{9}-GGFFCCF{9}-eecc3aa4C{8}-{7}C{8}E{4}G{4}5C{9}-4bbaa5CCc{8}--CC4bbaab{8}-{8}")
basTheme = newSound(8,"3C{16}2F{16}3c{16}a{14}-C{16}F{16}2b{16}3e{16}")
selSnd = newSound(16,"5DA") :`select sound
desSnd = newSound(16,"4AD") :`deselect sound
ordSnd = newSound(16,"5D4D5A6D") :`give order sound
laserSnd = newSound(128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(128,"1CcDeEFfGaAbB2CcDeEFfGaAbB3CcDeEFfGaAbB4CcDeEFfGaAbB5C{32}3BbAaGfFEeDcC2BbAaGfFEeDcC{32}-{64}")
warpSnd = newSound(64,"0CcDeEFfGaAbB1C0cDeEFfGaAbB1Cc0eEFfGaAbB1CcDe0FfGaAbB1CcDeF0GaAbB1CcDeEFfGaAbB2CcDeEFfGaAbB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(64,"0CcDeEFfGaAbB1C0cDeEFfGaAbB1Cc0eEFfGaAbB1CcDe0FfGaAbB1CcDeF0GaAbB1CcDeEFfGaAbB2CcDeEFfGaAbB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")
traviataBassSnd = newSound(16,"3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-2B{4}-3F{4}-3F{4}-2G{4}-3F{4}-3F{4}-")
traviataMeloSnd = newSound(16,"-{55}4G{4}-5E{16}-{4}4G{4}-5E{4}-5E{4}-4G{4}-5E{4}-5EEFEEe{4}-E{4}-G{16}-{4}F{4}-E{4}-D{4}-DDDccDDEEED{4}-DDDccDDEEED{8}-C{5}4G{16}-{150}")

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBassSnd
            loop sound traviataMeloSnd
         else
            stop sound traviataBassSnd
            stop sound traviataMeloSnd
         endif
      endcase
   endselect
loop
end

function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 26624
   soundsize = samplerate# / bps

   rem Find number of actual notes in music$.
   i=0 :`forgot variables inside function are persistent: eugh DB is not a good example for new coders. No other language I know does this. :'(
   for x = 1 to strLen
      n$ = mid$(music$,x)
      if val(n$)=0
         rem Number inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(snippet$(music$,x+1,bracket-1))-1 :`we minus one from the length because note will have been counted by itself.
                  inc i,numinbracket :`add number in brackets to note count.
                  x = bracket : `this just moves the x pointer past the brackets.
                  exit
               endif
            next bracket
         else
            inc i :`single note
         endif
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         rem Numbers inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(snippet$(music$,x+1,bracket-1))-1 :`we minus one from the length because note will have been counted by itself.
                  n$ = mid$(music$,x-1) :`take the note before the brackets.
                  x = bracket : `this just moves the pointer past the brackets.
                  bracket = strLen
               endif
            next bracket
         else
            numinbracket = 1
         endif

         for noteLen = 1 to numinbracket
            rem -- Store Note --

            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "e" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "a" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "b" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  b = 128 + sin(ang#) :`since integers are truncated b will always be 127 or 128. (Except when ang#= 90|270 then b= 126|129.)
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

function snippet$(a$,head,tail)
   return$ = right$(left$(a$,tail),tail+1-head)
endfunction return$
`//

melTheme = newSound(instrument,8,"4C{8}E{4}G{4}g{9}-GGFFCCF{9}-ddcc3gg4C{8}-{7}C{8}E{4}G{4}5C{9}-4aagg5CCc{8}--CC4aagga{8}-{8}")
basTheme = newSound(instrument,8,"3C{16}2F{16}3c{16}g{14}-C{16}F{16}2a{16}3d{16}")
selSnd = newSound(instrument,16,"5DA") :`select sound
desSnd = newSound(instrument,16,"4AD") :`deselect sound
ordSnd = newSound(instrument,16,"5D4D5A6D") :`give order sound
laserSnd = newSound(instrument,128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(instrument,128,"1CcDdEFfGgAaB2CcDdEFfGgAaB3CcDdEFfGgAaB4CcDdEFfGgAaB5C{32}3BaAgGfFEdDcC2BaAgGfFEdDcC{32}-{64}")
warpSnd = newSound(instrument,64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(instrument,64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")
traviataBassSnd = newSound(instrument,16,"3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-2B{4}-3F{4}-3F{4}-2G{4}-3F{4}-3F{4}-")
traviataMeloSnd = newSound(instrument,16,"-{55}4G{4}-5E{16}-{4}4G{4}-5E{4}-5E{4}-4G{4}-5E{4}-5EEFEEd{4}-E{4}-G{16}-{4}F{4}-E{4}-D{4}-DDDccDDEEED{4}-DDDccDDEEED{8}-C{5}4G{16}-{150}")

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBassSnd
            loop sound traviataMeloSnd
         else
            stop sound traviataBassSnd
            stop sound traviataMeloSnd
         endif
      endcase
   endselect
loop
end


function newSound(instrument,bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find number of actual notes in music$.
   i=0 :`forgot variables inside function are persistent: eugh DB is not a good example for new coders. No other language I know does this. :'(
   for x = 1 to strLen
      n$ = mid$(music$,x)
      if val(n$)=0
         rem Number inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`we minus one from the length because note will have been counted by itself.
                  inc i,numinbracket :`add number in brackets to note count.
                  x = bracket : `this just moves the x pointer past the brackets.
                  exit
               endif
            next bracket
         else
            inc i :`single note
         endif
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         rem Numbers inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`we minus one from the length because note will have been counted by itself.
                  n$ = mid$(music$,x-1) :`take the note before the brackets.
                  x = bracket : `this just moves the pointer past the brackets.
                  bracket = strLen
               endif
            next bracket
         else
            numinbracket = 1
         endif

         for noteLen = 1 to numinbracket
            rem -- Store Note --

            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)

                  select instrument
                     case 0 : b = 128 + sin(ang#+sin(ang#)*90) : endcase
                     case 8 : b = 128 + sin(ang#*sin(ang#)) : endcase
                     case 7 : b = 128 + sin(ang#^1.2)*cos(ang#^1.2) : endcase
                     case 6 : b = 128 + sin(ang#)+cos(ang#*2) : endcase
                     case 1 : b = 128 + sin(ang#*.6)*64 : endcase
                     case 2 : b = 128 + sin(ang#*2.7) : endcase
                     case 3 : b = 128 + sin(ang#*1.5) : endcase
                     case 4 : b = 128 + sin(ang#*4) : endcase
                     case 5 : b = 128 + sin(ang#^1.5) : endcase
                  endselect

                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

melTheme = newSound(0,instrument,8,"4C{8}E{4}G{4}g{9}-GGFFCCF{9}-ddcc3gg4C{8}-{7}C{8}E{4}G{4}5C{9}-4aagg5CCc{8}--CC4aagga{8}-{8}")
basTheme = newSound(0,instrument,8,"3C{16}2F{16}3c{16}g{14}-C{16}F{16}2a{16}3d{16}")
selSnd = newSound(0,instrument,16,"5DA") :`select sound
desSnd = newSound(0,instrument,16,"4AD") :`deselect sound
ordSnd = newSound(0,instrument,16,"5D4D5A6D") :`give order sound
laserSnd = newSound(0,instrument,128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(0,instrument,128,"1CcDdEFfGgAaB2CcDdEFfGgAaB3CcDdEFfGgAaB4CcDdEFfGgAaB5C{32}3BaAgGfFEdDcC2BaAgGfFEdDcC{32}-{64}")
warpSnd = newSound(0,instrument,64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(0,instrument,64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")
traviataBassSnd = newSound(0,instrument,16,"3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-3C{4}-G{4}-G{4}-2G{4}-3G{4}-G{4}-2B{4}-3F{4}-3F{4}-2G{4}-3F{4}-3F{4}-")
traviataMeloSnd = newSound(0,instrument,16,"-{55}4G{4}-5E{16}-{4}4G{4}-5E{4}-5E{4}-4G{4}-5E{4}-5EEFEEd{4}-E{4}-G{16}-{4}F{4}-E{4}-D{4}-DDDccDDEEED{4}-DDDccDDEEED{8}-C{5}4G{16}-{150}")

newSound(selSnd,instrument,64,"ABGCDFDGCABAB")

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBassSnd
            loop sound traviataMeloSnd
         else
            stop sound traviataBassSnd
            stop sound traviataMeloSnd
         endif
      endcase
   endselect
loop
end


function newSound(snd,instrument,bps,music$)
   if snd<1
      appendMode=0

      rem Find available sound
      for snd = 1 to 1024
         if sound exist(snd)=0 then exit
      next snd
      if snd > 1024 then end
   else
      appendMode=1

      rem Find available memblock.
      for oldmem = 1 to 255
         if memblock exist(oldmem)=0 then exit
      next oldmem
      if oldmem > 255 then end
   endif

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find number of actual notes in music$.
   i=0 :`forgot variables inside function are persistent: eugh DB is not a good example for new coders. No other language I know does this. :'(
   for x = 1 to strLen
      n$ = mid$(music$,x)
      if val(n$)=0
         rem Number inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`we minus one from the length because note will have been counted by itself.
                  inc i,numinbracket :`add number in brackets to note count.
                  x = bracket : `this just moves the x pointer past the brackets.
                  exit
               endif
            next bracket
         else
            inc i :`single note
         endif
      endif
   next x

   if appendMode=0
      rem Make the soundblock
      size=(soundsize*i)+12
      make memblock mem,size
      rem write header
      write memblock dword mem,0,8
      write memblock dword mem,4,samplerate#
      write memblock dword mem,8,size
   else
      rem Make the soundblock
      make memblock from sound oldmem,snd
      rem write header
      memPtr=memblock dword(oldmem,8)
      size=(soundsize*i)+memPtr
      if memblock exist(mem)=0 then make memblock mem,size
      copy memblock oldmem,mem,0,0,memPtr
      delete memblock oldmem
      write memblock dword mem,8,size
   endif

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         rem Numbers inside curly brackets denotes note length.
         if n$="{"
            for bracket = x+1 to strLen
               if mid$(music$,bracket) = "}"
                  numinbracket = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`we minus one from the length because note will have been counted by itself.
                  n$ = mid$(music$,x-1) :`take the note before the brackets.
                  x = bracket : `this just moves the pointer past the brackets.
                  bracket = strLen
               endif
            next bracket
         else
            numinbracket = 1
         endif

         for noteLen = 1 to numinbracket
            rem -- Store Note --

            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)

                  select instrument
                     case 0 : b = 128 + sin(ang#+sin(ang#)*90) : endcase
                     case 8 : b = 128 + sin(ang#*sin(ang#)) : endcase
                     case 7 : b = 128 + sin(ang#^1.2)*cos(ang#^1.2) : endcase
                     case 6 : b = 128 + sin(ang#)+cos(ang#*2) : endcase
                     case 1 : b = 128 + sin(ang#*.6)*64 : endcase
                     case 2 : b = 128 + sin(ang#*2.7) : endcase
                     case 3 : b = 128 + sin(ang#*1.5) : endcase
                     case 4 : b = 128 + sin(ang#*4) : endcase
                     case 5 : b = 128 + sin(ang#^1.5) : endcase
                  endselect

                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   if appendMode=1 then delete sound snd
   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

rem short-hand beat notation: '=4, *=8, ^=16
melTheme = newSound(8,"4C*E'G'g{9}-GGFFCCF{9}-ddcc3gg4C*-{7}C*E'G'5C{9}-4aagg5CCc*--CC4aagga*-*")
basTheme = newSound(8,"3C^2F^3c^g{14}-C^F^2a^3d^")
selSnd = newSound(16,"5DA")
desSnd = newSound(16,"4AD")
ordSnd = newSound(16,"5D4D5A6D")
laserSnd = newSound(128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(128,"1CcDdEFfGgAaB2CcDdEFfGgAaB3CcDdEFfGgAaB4CcDdEFfGgAaB5C{32}3BaAgGfFEdDcC2BaAgGfFEdDcC{32}-{64}")
warpSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")
traviataBassSnd = newSound(16,"3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-2B'-3F'-3F'-2G'-3F'-3F'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-D'-A'-A'-2A'-3A'-A'")
traviataMeloSnd = newSound(16,"-{55}4G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-G^-'F'-E'-D'-DDDccDDEE-D'-DDDccDDEE-D{10}C{5}4G*--G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-A^-'G'-F'-E'-EEddEEFF-D'-DDDccDDEE-C^-")
melo2 = newSound(32,"4C'-D'-E'-G'-F'-F'-A'-G'-G'-5C'-4B'-5C'-4G'-E'-C'-D'-E'-F'-G'-A'-G'-F'-E'-D'-E'-C'-3B'-4C'-D'-3G'-B'-4D'-F'-E'-D'-E'-")
bass2 = newSound(32,"3C{9}-C{14}-2F{14}-3C{14}-C{14}-C{14}-F{14}-3C{14}-2G{14}-G{14}-G{14}-G{14}-3C{5}")
bass3 = newSound(32,"3C*-G*-G*-2G*-3G*-G*-3C*-G*-G*-2G*-3G*-G*-3C*-G*-G*-2G*-3G*-G*-3C*-G*-G*-2G*-3G*-G*-2B*-3F*-F*-2G*-3F*-F*-2B*-3F*-F*-2G*-3F*-F*-")
melo3 = newSound(32,"5-{108}GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--AAA--GG--FFF--EE--DDD--CCC--FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--BBB--AA--GGG--FF--EEE--DDD")

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."
PRINT "PRESS 0 to toggle Classical 2."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBassSnd
            loop sound traviataMeloSnd
         else
            stop sound traviataBassSnd
            stop sound traviataMeloSnd
         endif
      endcase
      case 11
         toggleTwo = 1-toggleTwo
         if toggleTwo=1
            loop sound Melo2
            loop sound bass2
         else
            stop sound Melo2
            stop sound bass2
         endif
      endcase
      case 12
         toggleThree = 1-toggleThree
         if toggleThree=1
            loop sound Melo3
            loop sound bass3
         else
            stop sound Melo3
            stop sound bass3
         endif
      endcase
   endselect
loop
end


function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find the number of samples in music$.
   i=0
   for x = 1 to strLen
      n$ = mid$(music$,x)
      rem If n$ not an octave denoter then count samples.
      if val(n$)=0
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     inc i,samples :`add number in brackets to note count.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : inc i,3 : endcase
            rem Eight samples *
            case "*" : inc i,7 : endcase
            rem Eight samples ^
            case "^" : inc i,15 : endcase
            rem single note/pause
            case default : inc i : endcase
         endselect
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     n$ = mid$(music$,x-1) :`take the note before the brackets.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : n$=mid$(music$,x-1) : samples=3 : endcase
            rem Eight samples *
            case "*" : n$=mid$(music$,x-1) : samples=7 : endcase
            rem Sixteen samples ^
            case "^" : n$=mid$(music$,x-1) : samples=15 : endcase
            rem single note/pause
            case default : samples=1 : endcase
         endselect

         for noteLen = 1 to samples
            rem -- Store Note --
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  `b = 128 + sin((ang#^1.5)*2) :`wibbler
                  b = 128 + sin(ang#^1.2) :`electric guitar
                  `b = ang#*.711
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

rem short-hand beat notation: '=4, *=8, ^=16
melTheme = newSound(8,"4C*E'G'g{9}-GGFFCCF{9}-ddcc3gg4C*-{7}C*E'G'5C{9}-4aagg5CCc*--CC4aagga*-*")
basTheme = newSound(8,"3C^2F^3c^g{14}-C^F^2a^3d^")
selSnd = newSound(16,"5DA")
desSnd = newSound(16,"4AD")
ordSnd = newSound(16,"5D4D5A6D")
laserSnd = newSound(128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(128,"1CcDdEFfGgAaB2CcDdEFfGgAaB3CcDdEFfGgAaB4CcDdEFfGgAaB5C{32}3BaAgGfFEdDcC2BaAgGfFEdDcC{32}-{64}")
warpSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")
traviataBassSnd = newSound(16,"3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-2B'-3F'-3F'-2G'-3F'-3F'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-3C'-G'-G'-2G'-3G'-G'-D'-A'-A'-2A'-3A'-A'")
traviataMeloSnd = newSound(16,"-{55}4G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-G^-'F'-E'-D'-DDDccDDEE-D'-DDDccDDEE-D{10}C{5}4G*--G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-A^-'G'-F'-E'-EEddEEFF-D'-DDDccDDEE-C^-")
melo2 = newSound(32,"4C'-D'-E'-G'-F'-F'-A'-G'-G'-5C'-4B'-5C'-4G'-E'-C'-D'-E'-F'-G'-A'-G'-F'-E'-D'-E'-C'-3B'-4C'-D'-3G'-B'-4D'-F'-E'-D'-E'-")
bass2 = newSound(32,"3C{9}-C{14}-2F{14}-3C{14}-C{14}-C{14}-F{14}-3C{14}-2G{14}-G{14}-G{14}-G{14}-3C{5}")
bass3 = newSound(32,"3C*-G*-G*-2G*-3G*-G*-3C*-G*-G*-2G*-3G*-G*-3C*-G*-G*-2G*-3G*-G*-3C*-G*-G*-2G*-3G*-G*-2B*-3F*-F*-2G*-3F*-F*-2B*-3F*-F*-2G*-3F*-F*-")
melo3 = newSound(32,"5-{108}GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--AAA--GG--FFF--EE--DDD--CCC--FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--BBB--AA--GGG--FF--EEE--DDD")

appendSound(warpSnd,laserSnd)

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."
PRINT "PRESS 0 to toggle Classical 2."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBassSnd
            loop sound traviataMeloSnd
         else
            stop sound traviataBassSnd
            stop sound traviataMeloSnd
         endif
      endcase
      case 11
         toggleTwo = 1-toggleTwo
         if toggleTwo=1
            loop sound Melo2
            loop sound bass2
         else
            stop sound Melo2
            stop sound bass2
         endif
      endcase
      case 12
         toggleThree = 1-toggleThree
         if toggleThree=1
            loop sound Melo3
            loop sound bass3
         else
            stop sound Melo3
            stop sound bass3
         endif
      endcase
   endselect
loop
end


function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find the number of samples in music$.
   i=0
   for x = 1 to strLen
      n$ = mid$(music$,x)
      rem If n$ not an octave denoter then count samples.
      if val(n$)=0
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     inc i,samples :`add number in brackets to note count.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : inc i,3 : endcase
            rem Eight samples *
            case "*" : inc i,7 : endcase
            rem Eight samples ^
            case "^" : inc i,15 : endcase
            rem single note/pause
            case default : inc i : endcase
         endselect
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     n$ = mid$(music$,x-1) :`take the note before the brackets.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : n$=mid$(music$,x-1) : samples=3 : endcase
            rem Eight samples *
            case "*" : n$=mid$(music$,x-1) : samples=7 : endcase
            rem Sixteen samples ^
            case "^" : n$=mid$(music$,x-1) : samples=15 : endcase
            rem single note/pause
            case default : samples=1 : endcase
         endselect

         for noteLen = 1 to samples
            rem -- Store Note --
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  `b = 128 + sin((ang#^1.5)*2) :`wibbler
                  b = 128 + sin(ang#^1.2) :`electric guitar
                  `b = ang#*.711
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

function appendSound(baseSnd,auxSnd)
      rem Find available memblocks.
      baseMem=0 : auxMem=0 : newMem=0
      for i = 1 to 255
         if memblock exist(i)=0
            if baseMem=0
               baseMem=i
            else
               if auxMem=0
                  auxMem=i
               else
                  newMem=i : exit
               endif
            endif
         endif
      next i
      if i > 255 then end

      rem Convert the sounds to soundblocks
      make memblock from sound baseMem,baseSnd
      make memblock from sound auxMem,auxSnd

      rem read headers
      baseBPS     = memblock dword(baseMem,0)
      auxBPS      = memblock dword(auxMem,0)
      baseSamples = memblock dword(baseMem,8)
      auxSamples  = memblock dword(auxMem,8)
      baseSize    = (30000/baseBPS)*baseSamples
      auxSize     = (30000/auxBPS)*auxSamples

      rem make newMem
      make memblock newMem,baseSize+auxSize + 12
      write memblock dword newMem,0,baseBPS
      write memblock dword newMem,4,30000
      write memblock dword newMem,8,baseSize+auxSize

      copy memblock baseMem,newMem,12,12,baseSamples
      copy memblock auxMem,newMem,12,12+baseSamples,auxSamples

      delete sound baseSnd
      make sound from memblock baseSnd,newMem

      rem cleanup
      delete memblock baseMem
      delete memblock auxMem
      delete memblock newMem
endfunction

rem short-hand beat notation: '=4, *=8, ^=16
melTheme = newSound(8,"4C*E'G'g{9}-GGFFCCF{9}-ddcc3gg4C*-{7}C*E'G'5C{9}-4aagg5CCc*--CC4aagga*-*")
basTheme = newSound(8,"3C^2F^3c^g{14}-C^F^2a^3d^")
selSnd = newSound(16,"5DA")
desSnd = newSound(16,"4AD")
ordSnd = newSound(16,"5D4D5A6D")
laserSnd = newSound(128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(128,"1CcDdEFfGgAaB2CcDdEFfGgAaB3CcDdEFfGgAaB4CcDdEFfGgAaB5C{32}3BaAgGfFEdDcC2BaAgGfFEdDcC{32}-{64}")
warpSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")

traviataBass = newsound(16,"3C'-G'-G'-2G'-3G'-G'-")
traviataBassC = newsound(16,"3C'-G'-G'-2G'-3G'-G'-")
traviataBassB = newsound(16,"2B'-3F'-F'-2G'-3F'-F'-")
traviataBassD = newsound(16,"D'-A'-A'-2A'-3A'-A'-")
for x = 1 to 4: appendSound(traviataBass,traviataBassC) :next x
appendSound(traviataBass,traviataBassB)
for x = 1 to 3: appendSound(traviataBass,traviataBassC) :next x
appendSound(traviataBass,traviataBassD)

traviataMeloSnd = newSound(16,"-{55}4G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-G^-'F'-E'-D'-DDDccDDEE-D'-DDDccDDEE-D{10}C{5}4G*--G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-A^-'G'-F'-E'-EEddEEFF-D'-DDDccDDEE-C^-")

melo2 = newSound(32,"4C'-D'-E'-G'-F'-F'-A'-G'-G'-5C'-4B'-5C'-4G'-E'-C'-D'-E'-F'-G'-A'-G'-F'-E'-D'-E'-C'-3B'-4C'-D'-3G'-B'-4D'-F'-E'-D'-E'-")
bass2 = newSound(32,"3C{9}-C{14}-2F{14}-3C{14}-C{14}-C{14}-F{14}-3C{14}-2G{14}-G{14}-G{14}-G{14}-3C{5}")

bass3C$ = "3C*-G*-G*-2G*-3G*-G*-"
bass3B$ = "2B*-3F*-F*-2G*-3F*-F*-"
bass3 = newSound(32,bass3C$ + bass3C$ + bass3C$ + bass3C$ + bass3B$ + bass3B$ + bass3C$ + bass3C$ + bass3B$ + bass3B$)

fstac$ = "5FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--"
gstac$ = "5GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--"
melo3 = newsound(32,"-{108}"+gstac$+"5AAA--GG--FFF--EE--DDD--CCC--"+fstac$+"BBB--AA--GGG--FF--EEE--DDD-")
appendSound(melo3,newsound(32,gstac$+"6EEE--DD--CCC--5BB--AAA--GGG--5FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--EE--DDD--C'"))


bass4CC$ = "2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-"
bass4GG$ = "1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-"
bass4 = newsound(64,bass4CC$+bass4CC$)
APPENDSOUND(bass4,newsound(64,bass4GG$+bass4GG$))

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."
PRINT "PRESS 0 to toggle Classical 2."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBass
            loop sound traviataMeloSnd
         else
            stop sound traviataBass
            stop sound traviataMeloSnd
         endif
      endcase
      case 11
         toggleTwo = 1-toggleTwo
         if toggleTwo=1
            loop sound Melo2
            loop sound bass2
         else
            stop sound Melo2
            stop sound bass2
         endif
      endcase
      case 12
         toggleThree = 1-toggleThree
         if toggleThree=1
            loop sound Melo3
            loop sound bass3
         else
            stop sound Melo3
            stop sound bass3
         endif
      endcase
      case 13
         toggle4 = 1-toggle4
         if toggle4=1
            loop sound bass4
         else
            stop sound bass4
         endif
      endcase
   endselect
loop
end


function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find the number of samples in music$.
   i=0
   for x = 1 to strLen
      n$ = mid$(music$,x)
      rem If n$ not an octave denoter then count samples.
      if val(n$)=0
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     inc i,samples :`add number in brackets to note count.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : inc i,3 : endcase
            rem Eight samples *
            case "*" : inc i,7 : endcase
            rem Eight samples ^
            case "^" : inc i,15 : endcase
            rem single note/pause
            case default : inc i : endcase
         endselect
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     n$ = mid$(music$,x-1) :`take the note before the brackets.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : n$=mid$(music$,x-1) : samples=3 : endcase
            rem Eight samples *
            case "*" : n$=mid$(music$,x-1) : samples=7 : endcase
            rem Sixteen samples ^
            case "^" : n$=mid$(music$,x-1) : samples=15 : endcase
            rem single note/pause
            case default : samples=1 : endcase
         endselect

         for noteLen = 1 to samples
            rem -- Store Note --
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  `b = 128 + sin((ang#^1.5)*2) :`wibbler
                  b = 128 + sin(ang#^1.2) :`electric guitar
                  `b = ang#*.711
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

function appendSound(baseSnd,auxSnd)
      rem Find available memblocks.
      baseMem=0 : auxMem=0 : newMem=0
      for i = 1 to 255
         if memblock exist(i)=0
            if baseMem=0
               baseMem=i
            else
               if auxMem=0
                  auxMem=i
               else
                  newMem=i : exit
               endif
            endif
         endif
      next i
      if i > 255 then end

      rem Convert the sounds to soundblocks
      make memblock from sound baseMem,baseSnd
      make memblock from sound auxMem,auxSnd

      rem read headers
      baseBPS     = memblock dword(baseMem,0)
      auxBPS      = memblock dword(auxMem,0)
      baseSize    = memblock dword(baseMem,8)
      auxSize     = memblock dword(auxMem,8)

      rem make newMem
      make memblock newMem,baseSize+auxSize + 12
      write memblock dword newMem,0,baseBPS
      write memblock dword newMem,4,30000
      write memblock dword newMem,8,baseSize+auxSize

      copy memblock baseMem,newMem,12,12,baseSize
      copy memblock auxMem,newMem,12,12+baseSize,auxSize

      delete sound baseSnd
      make sound from memblock baseSnd,newMem

      rem cleanup
      delete memblock baseMem
      delete memblock auxMem
      delete memblock newMem
endfunction
`//

rem short-hand beat notation: '=4, *=8, ^=16
melTheme = newSound(8,"4C*E'G'g{9}-GGFFCCF{9}-ddcc3gg4C*-{7}C*E'G'5C{9}-4aagg5CCc*--CC4aagga*-*")
basTheme = newSound(8,"3C^2F^3c^g{14}-C^F^2a^3d^")
selSnd = newSound(16,"5DA")
desSnd = newSound(16,"4AD")
ordSnd = newSound(16,"5D4D5A6D")
laserSnd = newSound(128,"0BAGFEDC1BAGFEDC2BAGFEDC3BAGFEDC4BAGFEDC5BAGFEDC6BAGFEDC7BAGFEDC")
claxonSnd = newSound(128,"1CcDdEFfGgAaB2CcDdEFfGgAaB3CcDdEFfGgAaB4CcDdEFfGgAaB5C{32}3BaAgGfFEdDcC2BaAgGfFEdDcC{32}-{64}")
warpSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDEFGAB6CEG7CG8C9C")
warpFailSnd = newSound(64,"0CcDdEFfGgAaB1C0cDdEFfGgAaB1Cc0dEFfGgAaB1CcDd0FfGgAaB1CcDdF0GgAaB1CcDdEFfGgAaB2CcDdEFfGgAaB3CDEFGAB4CDEFGAB5CDE4CDEFGAB3CDEFGAB2CDEFGAB1CDEFGAB0CDEFGAB0BAGFEDC")

traviataBass = newsound(16,"3C'-G'-G'-2G'-3G'-G'-")
traviataBassC = newsound(16,"3C'-G'-G'-2G'-3G'-G'-")
traviataBassB = newsound(16,"2B'-3F'-F'-2G'-3F'-F'-")
traviataBassD = newsound(16,"D'-A'-A'-2A'-3A'-A'-")
for x = 1 to 4: appendSound(traviataBass,traviataBassC) :next x
appendSound(traviataBass,traviataBassB)
for x = 1 to 3: appendSound(traviataBass,traviataBassC) :next x
appendSound(traviataBass,traviataBassD)

traviataMeloSnd = newSound(16,"-{55}4G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-G^-'F'-E'-D'-DDDccDDEE-D'-DDDccDDEE-D{10}C{5}4G*--G'-5E^-'4G'-5E'-E'-4G'-5E'-EEFEEd'-E'-A^-'G'-F'-E'-EEddEEFF-D'-DDDccDDEE-C^-")

melo2 = newSound(32,"4C'-D'-E'-G'-F'-F'-A'-G'-G'-5C'-4B'-5C'-4G'-E'-C'-D'-E'-F'-G'-A'-G'-F'-E'-D'-E'-C'-3B'-4C'-D'-3G'-B'-4D'-F'-E'-D'-E'-")
bass2 = newSound(32,"3C{9}-C{14}-2F{14}-3C{14}-C{14}-C{14}-F{14}-3C{14}-2G{14}-G{14}-G{14}-G{14}-3C{5}")

bass3C$ = "3C*-G*-G*-2G*-3G*-G*-"
bass3B$ = "2B*-3F*-F*-2G*-3F*-F*-"
bass3 = newSound(32,bass3C$ + bass3C$ + bass3C$ + bass3C$ + bass3B$ + bass3B$ + bass3C$ + bass3C$ + bass3B$ + bass3B$)

fstac$ = "5FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--FFF--FF--"
gstac$ = "5GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--GG--GGG--GG--GGG--GGG--GG--"
melo3 = newsound(32,"-{108}"+gstac$+"5AAA--GG--FFF--EE--DDD--CCC--"+fstac$+"BBB--AA--GGG--FF--EEE--DDD-")
appendSound(melo3,newsound(32,gstac$+"6EEE--DD--CCC--5BB--AAA--GGG--5FF--FFF--FF--FFF--FFF--FF--FF--FFF--FF--FFF--EE--DDD--C'"))


bass4CC$ = "2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-2CCCC-3CCCC-"
bass4GG$ = "1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-1GGGG-2GGGG-"
bass4 = newsound(64,bass4CC$+bass4CC$)
APPENDSOUND(bass4,newsound(64,bass4GG$+bass4GG$))

mergeSound(melTheme,basTheme)

print "PRESS 1 toggle theme music."
print "PRESS 2 to play select sound."
print "PRESS 3 to play deselect sound."
print "PRESS 4 to play confirm order sound."
print "PRESS 5 to play lasergun sound."
print "PRESS 6 to toggle claxon sound."
print "PRESS 7 to play warp sound."
print "PRESS 8 to play warp fail sound."
print "PRESS 9 to toggle La Traviata."
PRINT "PRESS 0 to toggle Classical 2."

print "press up to play merged sound"

do
   if key=0 then key= scancode() else key = 0-scancode()

   if upkey() then play sound melTheme

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound melTheme
            stop sound basTheme
         else
            loop sound melTheme
            loop sound basTheme
         endif
      endcase
      case 3 : play sound selSnd : endcase
      case 4 : play sound desSnd : endcase
      case 5 : play sound ordSnd : endcase
      case 6 : play sound laserSnd : endcase
      case 7
         toggleClaxon = 1-toggleClaxon
         if toggleClaxon then loop sound claxonSnd else stop sound claxonSnd
      endcase
      case 8 : play sound warpSnd : endcase
      case 9 : play sound warpFailSnd : endcase
      case 10
         toggleTraviata = 1-toggleTraviata
         if toggleTraviata=1
            loop sound traviataBass
            loop sound traviataMeloSnd
         else
            stop sound traviataBass
            stop sound traviataMeloSnd
         endif
      endcase
      case 11
         toggleTwo = 1-toggleTwo
         if toggleTwo=1
            loop sound Melo2
            loop sound bass2
         else
            stop sound Melo2
            stop sound bass2
         endif
      endcase
      case 12
         toggleThree = 1-toggleThree
         if toggleThree=1
            loop sound Melo3
            loop sound bass3
         else
            stop sound Melo3
            stop sound bass3
         endif
      endcase
      case 13
         toggle4 = 1-toggle4
         if toggle4=1
            loop sound bass4
         else
            stop sound bass4
         endif
      endcase
   endselect
loop
end


function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find the number of samples in music$.
   i=0
   for x = 1 to strLen
      n$ = mid$(music$,x)
      rem If n$ not an octave denoter then count samples.
      if val(n$)=0
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     inc i,samples :`add number in brackets to note count.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : inc i,3 : endcase
            rem Eight samples *
            case "*" : inc i,7 : endcase
            rem Eight samples ^
            case "^" : inc i,15 : endcase
            rem single note/pause
            case default : inc i : endcase
         endselect
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     n$ = mid$(music$,x-1) :`take the note before the brackets.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : n$=mid$(music$,x-1) : samples=3 : endcase
            rem Eight samples *
            case "*" : n$=mid$(music$,x-1) : samples=7 : endcase
            rem Sixteen samples ^
            case "^" : n$=mid$(music$,x-1) : samples=15 : endcase
            rem single note/pause
            case default : samples=1 : endcase
         endselect

         for noteLen = 1 to samples
            rem -- Store Note --
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  `b = 128 + sin((ang#^1.5)*2) :`wibbler
                  b = 128 + sin(ang#^1.2) :`electric guitar
                  `b = ang#*.711
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

function appendSound(baseSnd,auxSnd)
      rem Find available memblocks.
      baseMem=0 : auxMem=0 : newMem=0
      for i = 1 to 255
         if memblock exist(i)=0
            if baseMem=0
               baseMem=i
            else
               if auxMem=0
                  auxMem=i
               else
                  newMem=i : exit
               endif
            endif
         endif
      next i
      if i > 255 then end

      rem Convert the sounds to soundblocks
      make memblock from sound baseMem,baseSnd
      make memblock from sound auxMem,auxSnd

      rem read headers
      baseBPS     = memblock dword(baseMem,0)
      auxBPS      = memblock dword(auxMem,0)
      baseSize    = memblock dword(baseMem,8)
      auxSize     = memblock dword(auxMem,8)

      rem make newMem
      make memblock newMem,baseSize+auxSize + 12
      write memblock dword newMem,0,baseBPS
      write memblock dword newMem,4,30000
      write memblock dword newMem,8,baseSize+auxSize

      copy memblock baseMem,newMem,12,12,baseSize
      copy memblock auxMem,newMem,12,12+baseSize,auxSize

      delete sound baseSnd
      make sound from memblock baseSnd,newMem

      rem cleanup
      delete memblock baseMem
      delete memblock auxMem
      delete memblock newMem
endfunction
`//

function mergeSound(sound1,sound2)
   rem Find available memblock.
   for mem1 = 1 to 255
      if memblock exist(mem1)=0 then exit
   next mem1
   if mem1 > 255 then end

   rem Find available memblock.
   for mem2 = 1 to 255
      if memblock exist(mem2)=0 then exit
   next mem2
   if mem2 > 255 then end

   make memblock from sound mem1,sound1
   make memblock from sound mem2,sound2

   startpos=12
   endpos=memblock dword(mem2,8)-1

   wb=0
   dithsize=4000
   for x=startpos to endpos
      inc wb
      if wb>dithsize
         if wb>dithsize*2 then wb=0
         thebyte=memblock byte(mem1,x)
      else
         thebyte=memblock byte(mem2,x)
      endif
      write memblock byte mem1,x,thebyte
   next x

   delete sound sound1
   make sound from memblock sound1,mem1
   if memblock exist(mem1) then delete memblock mem1
   if memblock exist(mem2) then delete memblock mem2
endfunction
`//

rem short-hand beat notation: '=4, *=8, ^=16
melTheme = newSound(8,"4C*E'G'g{9}-GGFFCCF{9}-ddcc3gg4C*-{7}C*E'G'5C{9}-4aagg5CCc*--CC4aagga*-*")
basTheme = newSound(8,"3C^2F^3c^g{14}-C^F^2a^3d^")

merged = mergeSound(melTheme,basTheme)

print "Press 1 to toggle theme sounds."
print "Press 2 to toggle merged theme."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound bastheme
            stop sound melTheme
         else
            loop sound bastheme
            loop sound melTheme
         endif
      endcase
      case 3
         toggle3 = 1-toggle3
         if toggle3=0
            stop sound merged
         else
            loop sound merged
         endif
      endcase
   endselect
loop
end


function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find the number of samples in music$.
   i=0
   for x = 1 to strLen
      n$ = mid$(music$,x)
      rem If n$ not an octave denoter then count samples.
      if val(n$)=0
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     inc i,samples :`add number in brackets to note count.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : inc i,3 : endcase
            rem Eight samples *
            case "*" : inc i,7 : endcase
            rem Eight samples ^
            case "^" : inc i,15 : endcase
            rem single note/pause
            case default : inc i : endcase
         endselect
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     n$ = mid$(music$,x-1) :`take the note before the brackets.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : n$=mid$(music$,x-1) : samples=3 : endcase
            rem Eight samples *
            case "*" : n$=mid$(music$,x-1) : samples=7 : endcase
            rem Sixteen samples ^
            case "^" : n$=mid$(music$,x-1) : samples=15 : endcase
            rem single note/pause
            case default : samples=1 : endcase
         endselect

         for noteLen = 1 to samples
            rem -- Store Note --
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  `b = 128 + sin((ang#^1.5)*2) :`wibbler
                  b = 128 + sin(ang#^1.2) :`electric guitar
                  `b = ang#*.711
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

function appendSound(baseSnd,auxSnd)
   rem Find available memblocks.
   baseMem=0 : auxMem=0 : newMem=0
   for i = 1 to 255
      if memblock exist(i)=0
         if baseMem=0
            baseMem=i
         else
            if auxMem=0
               auxMem=i
            else
               newMem=i : exit
            endif
         endif
      endif
   next i
   if i > 255 then end

   rem Convert the sounds to soundblocks
   make memblock from sound baseMem,baseSnd
   make memblock from sound auxMem,auxSnd

   rem read headers
   baseBPS     = memblock dword(baseMem,0)
   auxBPS      = memblock dword(auxMem,0)
   baseSize    = memblock dword(baseMem,8)
   auxSize     = memblock dword(auxMem,8)

   rem make newMem
   make memblock newMem,baseSize+auxSize + 12
   write memblock dword newMem,0,baseBPS
   write memblock dword newMem,4,30000
   write memblock dword newMem,8,baseSize+auxSize

   copy memblock baseMem,newMem,12,12,baseSize
   copy memblock auxMem,newMem,12,12+baseSize,auxSize

   delete sound baseSnd
   make sound from memblock baseSnd,newMem

   rem cleanup
   delete memblock baseMem
   delete memblock auxMem
   delete memblock newMem
endfunction
`//

function mergeSound(sound1,sound2)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblocks.
   mem1=0 : mem2=0
   for i = 1 to 255
      if memblock exist(i)=0
         if Mem1=0
            Mem1=i
         else
            Mem2=i : exit
         endif
      endif
   next i
   if i > 255 then end

   make memblock from sound mem1,sound1
   make memblock from sound mem2,sound2

   startpos=12
   endpos=memblock dword(mem2,8)-1

   wb=0
   dithsize=4000
   for x=startpos to endpos
      inc wb
      if wb>dithsize
         if wb>dithsize*2 then wb=0
         thebyte=memblock byte(mem1,x)
      else
         thebyte=memblock byte(mem2,x)
      endif
      write memblock byte mem1,x,thebyte
   next x

   make sound from memblock snd,mem1
   delete memblock mem1
   delete memblock mem2
endfunction snd
`//

rem short-hand beat notation: '=4, *=8, ^=16
melTheme = newSound(8,"4C*E'G'g{9}-GGFFCCF{9}-ddcc3gg4C*-{7}C*E'G'5C{9}-4aagg5CCc*--CC4aagga*-*")
basTheme = newSound(8,"3C^2F^3c^g{14}-C^F^2a^3d^")

merged = mergeSound(melTheme,basTheme)

print "Press 1 to toggle theme sounds."
print "Press 2 to toggle merged theme."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound bastheme
            stop sound melTheme
         else
            loop sound bastheme
            loop sound melTheme
         endif
      endcase
      case 3
         toggle3 = 1-toggle3
         if toggle3=0
            stop sound merged
         else
            loop sound merged
         endif
      endcase
   endselect
loop
end


function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find the number of samples in music$.
   i=0
   for x = 1 to strLen
      n$ = mid$(music$,x)
      rem If n$ not an octave denoter then count samples.
      if val(n$)=0
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     inc i,samples :`add number in brackets to note count.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : inc i,3 : endcase
            rem Eight samples *
            case "*" : inc i,7 : endcase
            rem Eight samples ^
            case "^" : inc i,15 : endcase
            rem single note/pause
            case default : inc i : endcase
         endselect
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     n$ = mid$(music$,x-1) :`take the note before the brackets.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : n$=mid$(music$,x-1) : samples=3 : endcase
            rem Eight samples *
            case "*" : n$=mid$(music$,x-1) : samples=7 : endcase
            rem Sixteen samples ^
            case "^" : n$=mid$(music$,x-1) : samples=15 : endcase
            rem single note/pause
            case default : samples=1 : endcase
         endselect

         for noteLen = 1 to samples
            rem -- Store Note --
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  `b = 128 + sin((ang#^1.5)*2) :`wibbler
                  b = 128 + sin(ang#^1.2) :`electric guitar
                  `b = ang#*.711
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

function appendSound(baseSnd,auxSnd)
   rem Find available memblocks.
   baseMem=0 : auxMem=0 : newMem=0
   for i = 1 to 255
      if memblock exist(i)=0
         if baseMem=0
            baseMem=i
         else
            if auxMem=0
               auxMem=i
            else
               newMem=i : exit
            endif
         endif
      endif
   next i
   if i > 255 then end

   rem Convert the sounds to soundblocks
   make memblock from sound baseMem,baseSnd
   make memblock from sound auxMem,auxSnd

   rem read headers
   baseBPS     = memblock dword(baseMem,0)
   auxBPS      = memblock dword(auxMem,0)
   baseSize    = memblock dword(baseMem,8)
   auxSize     = memblock dword(auxMem,8)

   rem make newMem
   make memblock newMem,baseSize+auxSize + 12
   write memblock dword newMem,0,baseBPS
   write memblock dword newMem,4,30000
   write memblock dword newMem,8,baseSize+auxSize

   copy memblock baseMem,newMem,12,12,baseSize
   copy memblock auxMem,newMem,12,12+baseSize,auxSize

   delete sound baseSnd
   make sound from memblock baseSnd,newMem

   rem cleanup
   delete memblock baseMem
   delete memblock auxMem
   delete memblock newMem
endfunction
`//

function mergeSound(sound1,sound2)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblocks.
   mem1=0 : mem2=0
   for i = 1 to 255
      if memblock exist(i)=0
         if Mem1=0
            Mem1=i
         else
            Mem2=i : exit
         endif
      endif
   next i
   if i > 255 then end

   make memblock from sound mem1,sound1
   make memblock from sound mem2,sound2

   startpos=12
   endpos=memblock dword(mem2,8)-1

   for x=startpos to endpos
      byte1=memblock byte(mem1,x)
      byte2=memblock byte(mem2,x)
      dist1=abs(byte1-128)
      dist2=abs(byte2-128)
      if byte1=0 then dist1=0
      if byte2=0 then dist2=0
      tbyte=(dist1+dist2)*63
      write memblock byte mem1,x,tbyte
   next x

   make sound from memblock snd,mem1
   delete memblock mem1
   delete memblock mem2
endfunction snd
`//

rem short-hand beat notation: '=4, *=8, ^=16
melTheme = newSound(8,"4C*E'G'g{9}-GGFFCCF{9}-ddcc3gg4C*-{7}C*E'G'5C{9}-4aagg5CCc*--CC4aagga*-*")
basTheme = newSound(8,"3C^2F^3c^g{14}-C^F^2a^3d^")

merged = mergeSound(melTheme,basTheme)

print "Press 1 to toggle theme sounds."
print "Press 2 to toggle merged theme."

do
   if key=0 then key= scancode() else key = 0-scancode()

   select key
      case 2
         toggletheme = 1-toggletheme
         if toggletheme=0
            stop sound bastheme
            stop sound melTheme
         else
            loop sound bastheme
            loop sound melTheme
         endif
      endcase
      case 3
         toggle3 = 1-toggle3
         if toggle3=0
            stop sound merged
         else
            loop sound merged
         endif
      endcase
   endselect
loop
end


function newSound(bps,music$)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblock.
   for mem = 1 to 255
      if memblock exist(mem)=0 then exit
   next mem
   if mem > 255 then end

   rem Define constants and variables.
   strLen = len(music$)
   memPtr = 12
   samplerate# = 30000
   soundsize = samplerate# / bps

   rem Find the number of samples in music$.
   i=0
   for x = 1 to strLen
      n$ = mid$(music$,x)
      rem If n$ not an octave denoter then count samples.
      if val(n$)=0
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     inc i,samples :`add number in brackets to note count.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : inc i,3 : endcase
            rem Eight samples *
            case "*" : inc i,7 : endcase
            rem Eight samples ^
            case "^" : inc i,15 : endcase
            rem single note/pause
            case default : inc i : endcase
         endselect
      endif
   next x

   rem Make the soundblock
   size=(soundsize*i)+12
   make memblock mem,size
   rem write header
   write memblock dword mem,0,8
   write memblock dword mem,4,samplerate#
   write memblock dword mem,8,size

   rem write notes
   for x=1 to strLen
      n$=mid$(music$,x)

      if asc(n$) >= 48 and asc(n$) <=57 :`n$ is a number.
         octave = val(n$)
      else
         select n$
            rem Numbers inside curly brackets denote number of samples.
            case "{"
               for bracket = x+1 to strLen
                  if mid$(music$,bracket) = "}"
                     samples = val(right$(left$(music$,bracket-1),bracket-x-1))-1 :`minus one because the note itself was counted before.
                     n$ = mid$(music$,x-1) :`take the note before the brackets.
                     x = bracket : `this moves the for-loop pointer past the brackets.
                     exit
                  endif
               next bracket
            endcase
            rem Four samples '
            case "'" : n$=mid$(music$,x-1) : samples=3 : endcase
            rem Eight samples *
            case "*" : n$=mid$(music$,x-1) : samples=7 : endcase
            rem Sixteen samples ^
            case "^" : n$=mid$(music$,x-1) : samples=15 : endcase
            rem single note/pause
            case default : samples=1 : endcase
         endselect

         for noteLen = 1 to samples
            rem -- Store Note --
            select n$
               case "C" : nt#=2093.00 : endcase
               case "c" : nt#=2217.46 : endcase :`C#/Db
               case "D" : nt#=2349.32 : endcase
               case "d" : nt#=2489.02 : endcase :`Eb/D#
               case "E" : nt#=2637.02 : endcase
               case "F" : nt#=2793.83 : endcase
               case "f" : nt#=2959.96 : endcase :`F#/Gb
               case "G" : nt#=3135.96 : endcase
               case "g" : nt#=3322.44 : endcase :`Ab/G#
               case "A" : nt#=3520.00 : endcase
               case "a" : nt#=3729.31 : endcase :`Bb/A#
               case "B" : nt#=3951.07 : endcase
               case default : nt#=-1 : endcase :`no note (pause)
            endselect

            if nt#>-1
               hz# = nt# / 2^(7.0-octave)
               anginc# = 360.0 * hz# / samplerate#

               for xx = memPtr to memPtr+soundsize-1
                  ang#=wrapvalue(ang#+anginc#)
                  `b = 128 + sin((ang#^1.5)*2) :`wibbler
                  b = 128 + sin(ang#^.9) :`electric guitar
                  write memblock byte mem,xx,b
               next xx
            endif

            inc memPtr, soundsize
         next noteLen
      endif
   next x

   make sound from memblock snd,mem
   delete memblock mem
endfunction snd
`//

function appendSound(baseSnd,auxSnd)
   rem Find available memblocks.
   baseMem=0 : auxMem=0 : newMem=0
   for i = 1 to 255
      if memblock exist(i)=0
         if baseMem=0
            baseMem=i
         else
            if auxMem=0
               auxMem=i
            else
               newMem=i : exit
            endif
         endif
      endif
   next i
   if i > 255 then end

   rem Convert the sounds to soundblocks
   make memblock from sound baseMem,baseSnd
   make memblock from sound auxMem,auxSnd

   rem read headers
   baseBPS     = memblock dword(baseMem,0)
   auxBPS      = memblock dword(auxMem,0)
   baseSize    = memblock dword(baseMem,8)
   auxSize     = memblock dword(auxMem,8)

   rem make newMem
   make memblock newMem,baseSize+auxSize + 12
   write memblock dword newMem,0,baseBPS
   write memblock dword newMem,4,30000
   write memblock dword newMem,8,baseSize+auxSize

   copy memblock baseMem,newMem,12,12,baseSize
   copy memblock auxMem,newMem,12,12+baseSize,auxSize

   delete sound baseSnd
   make sound from memblock baseSnd,newMem

   rem cleanup
   delete memblock baseMem
   delete memblock auxMem
   delete memblock newMem
endfunction
`//

function mergeSound(sound1,sound2)
   rem Find available sound
   for snd = 1 to 1024
      if sound exist(snd)=0 then exit
   next snd
   if snd > 1024 then end

   rem Find available memblocks.
   mem1=0 : mem2=0
   for i = 1 to 255
      if memblock exist(i)=0
         if Mem1=0
            Mem1=i
         else
            Mem2=i : exit
         endif
      endif
   next i
   if i > 255 then end

   make memblock from sound mem1,sound1
   make memblock from sound mem2,sound2

   startpos=12
   endpos=memblock dword(mem2,8)-1

   for x=startpos to endpos
      byte1=memblock byte(mem1,x)
      byte2=memblock byte(mem2,x)
      dist1=abs(byte1-128)
      dist2=abs(byte2-128)
      if byte1=0 then dist1=0
      if byte2=0 then dist2=0
      tbyte=255 - (dist1+dist2)*64
      write memblock byte mem1,x,tbyte
   next x

   make sound from memblock snd,mem1
   delete memblock mem1
   delete memblock mem2
endfunction snd
`//