Sorry your browser is not supported!

`Started: 17/04/2005 -> 3:20am
`Description: short breakout program to help any new programmers to visualise other methods of detecting collision,
`             and how to use user defined types effectively.
`             not a particularly great game tho ^_^

`constant describing the force of gravity
#constant grav = 0.2
#constant padSize = 50.0
#constant blockSize = 30.0
#constant tailSize = 5

`type describing a 2D vector
type vector
   x as float
   y as float
endtype

`type describing an object with movement and position vectors
type object
   move as vector
   pos as vector
endtype

`type describing a surface with force and position vectors
type surface
   force as vector
   pos as vector
endtype

`type describing a entity which has a position a force and may be active or inactive
`i refuse to use DarkBasic boolean as it causes many problems in some functions where they wont work
`i strongly reccomend you do NOT use booleans in your program as it causes many internal bugs of darkbasic to surface
type entity
   isActive as integer
   pos as vector
endtype

type level
   levelNum as integer
   levelScore as integer
   levelLife as integer
   wallPos as integer
   brickColor as integer
   ballSpeed as integer
endtype

arena as level
   arena.levelNum = 1
   arena.levelScore = 0
   arena.levelLife = 10
   arena.wallPos = 5
   arena.brickColor = rgb(rnd(128)+127,rnd(128)+127,rnd(128)+127)
   arena.ballSpeed = 15

`variable to hold the position and movement vector of the ball
ball as object
   ball.move.x = 5
   ball.move.y = -10
   ball.pos.x = 400
   ball.pos.y = 400

`define an array to hold the positions and forces of the walls
dim wall(1) as surface
   `Left wall
   wall(0).pos.x = 10
   wall(0).force.x = 10
   `Right Wall
   wall(1).pos.x = 790
   wall(1).force.x = -10
   `Top Wall
   wall(0).pos.y = 10
   wall(0).force.y = 10
   `Lower Wall
   wall(1).pos.y = 590
   wall(1).force.y = 0

`define an array to hold the positions and forces of the pads
pad as surface
   `values for the 1st pad
   pad.pos.y = 500
   pad.force.x = -500
   pad.force.y = -1000

`define an array to hold the positions of the ball tail
dim tail(tailSize) as vector
   for tailNum = 0 to 5
      tail(tailNum).x = ball.pos.x
      tail(tailNum).y = ball.pos.y
   next tailNum

`define an array for the blocks
dim blocks(49) as entity
   for xPos = 0 to 9
   for yPos = 0 to 4
      blocks(blockNum).isActive = 1
      blocks(blockNum).pos.x = 130 + 60 * xPos
      blocks(blockNum).pos.y = 120 + 40 * yPos
      inc blockNum
   next yPos
   next xPos

dim highScore(9) as integer
   if file exist("tomuscore.dat") = 0
      open to write 1,"tomuscore.dat"
         for score = 0 to 9
            highScore(score) = 300000 / (score + 1)
            write file 1 , highScore(score)
         next score
      close file 1
   else
      open to read 1,"tomuscore.dat"
         for score = 0 to 9
            read file 1,highScore(score)
         next score
      close file 1
   endif


`setup directX display
set display mode 800,600,32

`define the sychronisation rate and flip the buffers twice
sync on : sync rate 30
sync : sync

`hide the mouse cursor
hide mouse

do
   answer = startGame()
   select answer
      case 1
         playGame()
      endcase
      case 2
         endGame()
      endcase
      case 3
         end
      endcase
   endselect
loop

function playGame()
   `main loop
   repeat
      ink rgb(0,128,255),0
      text 10,0,"Level: " + str$(arena.levelNum)
      text 600,0,"Score: " + str$(arena.levelScore)
      text 700,0,"Lives: " + str$(arena.levelLife)
      center text 400,0,"Press "Q" to quit..."
      `user controls the pad and checks for collision with the wall
      pad.pos.x = mousex()
      pad.force.x = mousemovex()
      if abs(pad.pos.x - wall(0).pos.x) < padSize then pad.pos.x = wall(0).pos.x + padSize
      if abs(pad.pos.x - wall(1).pos.x) < padSize then pad.pos.x = wall(1).pos.x - padSize
      `allow user to reset the ball
      if ball.pos.y = wall(1).pos.y
         if spacekey()
            ball.move.x = rnd(10)-5
            ball.move.y = - arena.ballSpeed
            ball.pos.x = 400
            ball.pos.y = 400
            dec arena.levelLife
         else
            center text 400 , 400 , "Press Space To Reset Ball..."
         endif
      endif
      `calculate the users x force
      userX# = curveValue( (rightkey()-leftkey()) * 0.4 , userX# , 10 )
      `call ball control function to refresh the ball data
      controlBall()
      `draw walls
      drawBox( wall(0).pos.x , wall(0).pos.y , wall(1).pos.x , wall(1).pos.y , rgb(255,0,0) )
      drawBox( wall(0).pos.x + 10 , wall(0).pos.y + 10 , wall(1).pos.x - 10 , wall(1).pos.y - 10 , rgb(128,0,0) )
      drawBox( wall(0).pos.x + 20 , wall(0).pos.y + 20 , wall(1).pos.x - 20 , wall(1).pos.y - 20 , rgb(64,0,0) )
      drawBox( wall(0).pos.x + 30 , wall(0).pos.y + 30 , wall(1).pos.x - 30 , wall(1).pos.y - 30 , rgb(32,0,0) )
      `draw tail of ball first so the ball with have priority on screen display
      for tailPos = 0 to 5
         drawBall( tail(tailPos).x , tail(tailPos).y , 5 , 2 , rgb(255,51*tailPos,0) )
      next tailPos
      inc tailNum
      `control move the pointer to the next ball
      if tailNum > tailSize then tailNum = 0
      tail(tailNum).x = ball.pos.x
      tail(tailNum).y = ball.pos.y
      `draw ball
      drawBall( ball.pos.x , ball.pos.y , 10 , 3 , rgb(0,255,128) )
      `draw pads
      drawPad( pad.pos.x , pad.pos.y , padSize , rgb(255,128,0) )
      `draw blocks
      for blockNum = 0 to 49
         if blocks(blockNum).isActive = 1 then drawPad( blocks(blockNum).pos.x , blocks(blockNum).pos.y , blockSize , arena.brickColor )
      next blockNum
      `synchronise the screen
      sync
      `clear screen to avoid pixel dragging
      cls
      `end main loop
      if arena.levelLife < 0 || upper$(inkey$()) = "Q"
         endGame()
         mainmenu = 1
      endif
   until mainmenu = 1
endfunction

`function to start game
function startGame()
   cls
   size = text size()
   set text size size + 20
      ink RGB(0,0,255) , 0
      center text 400 , 100 , "Tomu Breakout!"
      drawPad(400,115,200,RGB(0,128,255))
   set text size size
      ink RGB(0,128,255) , 0
      center text 400 , 200 , "1 - Play Game"
      center text 400 , 250 , "2 - High Scores"
      center text 400 , 300 , "3 - Exit"
   sync
   repeat
      answer = val(inkey$())
   until answer > 0
endfunction answer

`function to end the game
function endGame()
   if arena.levelScore > highScore(9)
      highScore(9) = arena.levelScore
      for score = 1 to 8
         pos = 9 - score
         if highScore(pos) > highScore(pos - 1)
            temp = highScore(pos - 1)
            highScore(pos - 1) = highScore(pos)
            highScore(pos) = temp
         endif
      next score
      delete file "tomuscore.dat"
      open to write 1 , "tomuscore.dat"
         for score = 0 to 9
            write file 1 , highScore(score)
         next score
      close file 1
   endif
   cls
   center text 400 , 100 , "Scores:"
   for score = 0 to 9
      center text 400 , 150 + score * 30 , str$(score+1) + ": " + str$(highScore(score))
   next score
   center text 400 , 100 + (score + 2) * 30 , "press any key to end..."
   sync
   wait key
endfunction

`function to control movement of the ball
function controlBall()
   null = make vector2(1)
      set vector2 1 , ball.move.x , ball.move.y
      magnitude# = length vector2(1)
      divide vector2 1 , magnitude#
      repeat
         for blockNum = 0 to 49
            if blocks(blockNum).isActive = 1
               if ( abs(ball.pos.x - blocks(blockNum).pos.x) <= blockSize ) && ( abs(ball.pos.y - blocks(blockNum).pos.y) <= blockSize / 4 )
                  blocks(blockNum).isActive = 0
                  inc arena.levelScore , 100 * arena.levelNum
                  ball.move.y = - ball.move.y
               endif
               inc totalBlocks
            endif
         next blockNum
         if totalBlocks = 0
            for blockNum = 0 to 49
               blocks(blockNum).isActive = 1
            next blockNum
            if arena.levelNum < 13
               inc wall(0).pos.x , arena.wallPos
               inc wall(0).pos.y , arena.wallPos
               dec wall(1).pos.x , arena.wallPos
               dec wall(1).pos.y , arena.wallPos
            endif
            inc arena.ballSpeed , 2
            inc arena.levelNum , 1
            arena.brickColor = rgb(rnd(128)+127,rnd(128)+127,rnd(128)+127)
         endif
         if ( abs(ball.pos.x - pad.pos.x) <= padSize ) && ( abs(ball.pos.y - pad.pos.y) <= padSize / 4 )
            ball.move.y = - arena.ballSpeed
            inc ball.move.x , ( ball.pos.x - pad.pos.x ) / magnitude#
            `swept collision hack :D
            inc ball.move.x , pad.force.x / magnitude# / 12
         endif
         `work out the inverse square law of the forces on the walls and add pad force
         `inverse square law = ( 1 / distance^2 ) * force
         xForce# = ((1 / (3+abs(ball.pos.x - wall(0).pos.x))^2) * wall(0).force.x) + ((1 / (1+abs(ball.pos.x - wall(1).pos.x))^2) * wall(1).force.x / magnitude#)
         yForce# = ((3 / (1+abs(ball.pos.y - wall(0).pos.y))^2) * wall(0).force.y) + ((1 / (1+abs(ball.pos.y - wall(1).pos.y))^2) * wall(1).force.y / magnitude#)
         `add the wall force to the ball movement vectors. add gravity
         inc ball.move.x , xForce#
         inc ball.move.y , yForce# + grav / magnitude#
         `add movement vector and user input to the ball position
         inc ball.pos.x , ball.move.x / magnitude#
         inc ball.pos.y , ball.move.y / magnitude#
         `check for actual wall collision
         if ball.pos.x < wall(0).pos.x
            ball.pos.x = wall(0).pos.x
         endif
         if ball.pos.x > wall(1).pos.x
            ball.pos.x = wall(1).pos.x
         endif
         if ball.pos.y < wall(0).pos.y
            ball.pos.y = wall(0).pos.y
         endif
         if ball.pos.y > wall(1).pos.y
            ball.pos.y = wall(1).pos.y
         endif
         inc count# , 1 / magnitude#
      until count# > 1
   null = delete vector2(1)
endfunction

`function to draw the ball
function drawBall( xPos , yPos , size# , segments , color)
   increment# = size# / segments
   for seg = 1 to segments
      ink rgb( rgbr(color)/seg , rgbg(color)/seg , rgbb(color)/seg ) , 0
      circle xPos , yPos , increment# * seg
   next seg
endfunction

`function to draw a box
function drawBox( lf , up , rt , dn , color)
   ink color , 0
   line lf , up , rt , up
   line rt , up , rt , dn
   line rt , dn , lf , dn
   line lf , dn , lf , up
endfunction

`function to draw a pad
function drawPad( xPos , yPos , size# , color )
   ink color , 0
   drawBox( xPos - size# , yPos - size# / 4 , xPos + size# , yPos + size# / 4 , rgb( rgbr(color)/2 , rgbg(color)/2 , rgbb(color)/2 ) )
   drawBox( xPos - (size# * 0.5) , yPos - (size# * 0.5) / 4 , xPos + (size# * 0.5) , yPos + (size# * 0.5) / 4 , color )
endfunction

randomize timer()

REM VARIABLES
depth# = 498
screenwidth# = 800
screenheight# = 600
width# = (depth#/100)*160
height# = (depth#/100)*120
even# = screenwidth#/1.6
prop# = depth#/even#
#constant obj_paddle = 1
#constant obj_ball = 2
paddle_X# = screenwidth#/2          :  `X position of paddle (start centered of screen)
paddle_Width = 40                   :  `paddle's half width (if set to 20, total paddle width would be 40)
paddle_thickness = 5                :  `thickness of paddle
#constant INTERFACE_BORDER = 800    :  `x-intercept boundary marking off interface from game area
#constant MAX_ANGLE = 75            :  `max angle that paddle can reflect ball off
#constant BRICK_WIDTH = 60
#constant BRICK_HEIGHT = 40
death = 1
score = 0
lives = 4

type vector2d
   x as float
   y as float
endtype

type toy
   position as vector2d
   oldPosition as vector2d
   direction as vector2d
   velocity as float
   radius as float
endtype

ball as toy

ball.position.x = 50
ball.position.y = paddle_thickness + ball.radius
ball.direction.x = 0
ball.direction.y = 1
ball.velocity = 4
ball.radius = 10

type fadeObject
   object as integer
   fade as integer
endtype

dim fadeObjectOut(0) as fadeObject
fade_count = 0
dim killObject(0)

type triangle
   x1 as float
   y1 as float
   x2 as float
   y2 as float
   x3 as float
   y3 as float
   alive as integer
endtype

type brick
   a as triangle
   b as triangle
endtype

dim map(11,5) as brick

rem temp variable
tri as triangle

null = make vector2(1)  :  `ball direction vector and reflection vector(after calculation)
null = make vector2(2)  :  `line normal


REM SETUP
set display mode screenwidth#,screenheight#,32
sync on
sync rate 60
autocam off
hide mouse

REM CREATE IMAGE
for x=1 to 20
   for y=1 to 20
      c = rnd(255)
      dot rnd(128), rnd(128), rgb(c,c,c)
   next y
next x
get image 1, 1,1,128,128


REM CREATE PADDLE
make object plain obj_paddle,paddle_Width*2,paddle_thickness
color object obj_paddle, rgb(255,0,0)

REM CREATE BALL
make object sphere obj_ball, ball.radius
color object obj_ball, rgb(200,128,0)

REM CREATE BACKGROUND
make object plain 3, screenwidth#+4, screenheight#+4
position object 3, screenwidth#/2, screenheight#/2,500
texture object 3, 1




color as dword
obj = 3
REM Create triangles
   for x = 1 to 11
      for y = 1 to 5
         color = rgb(rnd(255),rnd(255),rnd(255))
         inc obj
         make object triangle obj,0,0,0,0,-BRICK_HEIGHT,0,BRICK_WIDTH,-BRICK_HEIGHT,0
         position object obj, x*BRICK_WIDTH,screenheight#-y*BRICK_HEIGHT,depth#
         color object obj, color
         map(x,y).a.x1 = x*BRICK_WIDTH
         map(x,y).a.y1 = screenheight#-y*BRICK_HEIGHT
         map(x,y).a.x2 = x*BRICK_WIDTH
         map(x,y).a.y2 = screenheight#-(y+1)*BRICK_HEIGHT
         map(x,y).a.x3 = (x+1)*BRICK_WIDTH
         map(x,y).a.y3 = screenheight#-(y+1)*BRICK_HEIGHT
         map(x,y).a.alive = obj

         inc obj
         make object triangle obj,0,0,0,BRICK_WIDTH,0,0,BRICK_WIDTH,-BRICK_HEIGHT,0
         position object obj, x*BRICK_WIDTH,screenheight#-y*BRICK_HEIGHT,depth#
         color object obj, color
         map(x,y).b.x1 = x*BRICK_WIDTH
         map(x,y).b.y1 = screenheight#-y*BRICK_HEIGHT
         map(x,y).b.x2 = (x+1)*BRICK_WIDTH
         map(x,y).b.y2 = screenheight#-y*BRICK_HEIGHT
         map(x,y).b.x3 = (x+1)*BRICK_WIDTH
         map(x,y).b.y3 = screenheight#-(y+1)*BRICK_HEIGHT
         map(x,y).b.alive = obj
      next y
   next x




REM STUFF
position camera width#/2,height#/2,0

speedup_stamp = timer()




REM ==============================  MAIN LOOP =================================
DO

   rem record previous position
   ball.oldPosition.x = ball.position.x
   ball.oldPosition.y = ball.position.y

   gosub _handle_controls

   if death = 0
      rem get new position of ball
      ball.position.x = ball.position.x + ball.direction.x*ball.velocity
      ball.position.y = ball.position.y + ball.direction.y*ball.velocity

      gosub _handle_ball_collisions
   else
      ball.position.x = paddle_X
      if mouseclick() = 1 then death = 0
   endif

   if speedup_stamp+2000 < timer()
      ball.velocity = ball.velocity + 0.2
      speedup_stamp = timer()
   endif

   position object obj_ball, ball.position.x, ball.position.y,depth#
   position object obj_paddle, paddle_X,5,498

   gosub _handle_fading_objects

   center text screenwidth#/2,1,"Score: "+str$(score)
   text screenwidth#-100,1,"Lives: "+str$(lives)
   text 1,1,"FPS: "+str$(screen fps())
   text 1,10,"Speed: "+str$(ball.velocity)


   fastsync
LOOP
REM =========================  END  MAIN  LOOP  ===============================






rem handle paddle movement with mouse and handle paddle's boundaries
_handle_controls:
   paddle_X = paddle_x + mousemovex()/3
   if paddle_X-paddle_Width < 0 then paddle_X = paddle_Width
   if paddle_X+paddle_Width > interface_border then paddle_X = interface_border-paddle_Width
return




rem handles ball collision with paddle, play area boundaries, and brick objects
_handle_ball_collisions:

   rem if ball hits paddle
   if ball.position.y <= (paddle_thickness + ball.radius)
      if ball.position.x >= paddle_X - paddle_Width AND ball.position.x <= paddle_X + paddle_Width
         angle# = 90-((ball.position.x-paddle_X) * MAX_ANGLE)/paddle_Width
         ball.direction.x = cos(angle#)
         ball.direction.y = sin(angle#)
      endif
   endif

   rem walls
   if ball.position.x <= ball.radius
      ball.position.x = ball.radius
      ball.direction.x = ball.direction.x*-1
   endif
   if ball.position.x >= INTERFACE_BORDER-ball.radius
      ball.position.x = INTERFACE_BORDER-ball.radius
      ball.direction.x = ball.direction.x*-1
   endif
   rem ceiling
   if ball.position.y >= screenheight#-ball.radius
      ball.position.y = screenheight#-ball.radius
      ball.direction.y = ball.direction.y*-1
   endif

   rem if ball drops below paddle
   if ball.position.y < 0
      ball.position.y = paddle_thickness + ball.radius
      ball.direction.y = 1
      ball.direction.x = 0
      ball.velocity = 4
      death = 1
      dec lives, 1
   endif

   rem brick collision
   for x = 1 to 11
      for y = 1 to 5
         if map(x,y).a.alive > 0
            tri = map(x,y).a
            if triangle_collide#(ball,tri) > 0
               `hide object map(x,y).a.alive
               array insert at top fadeObjectOut(0)
               fadeObjectOut(0).object = map(x,y).a.alive
               fadeObjectOut(0).fade = 100
               inc fade_count, 1
               inc score, 10
               map(x,y).a.alive = 0
               if map(x,y).a.alive = 0 and map(x,y).b.alive = 0 then inc score, 5
               calculate_reflection()
            endif
         endif
         if map(x,y).b.alive > 0
            tri = map(x,y).b
            if triangle_collide#(ball,tri) > 0
               `hide object map(x,y).b.alive
               array insert at top fadeObjectOut(0)
               fadeObjectOut(0).object = map(x,y).b.alive
               fadeObjectOut(0).fade = 100
               inc fade_count, 1
               inc score, 10
               map(x,y).b.alive = 0
               if map(x,y).a.alive = 0 and map(x,y).b.alive = 0 then inc score, 5
               calculate_reflection()
            endif
         endif
      next y
   next x
return



rem does some stuff, i don't feel like documenting right now
_handle_fading_objects:
   for i = 0 to fade_count
      obj = fadeObjectOut(i).object
      fadeObjectOut(i).fade = fadeObjectOut(i).fade - 2
      if fadeObjectOut(i).fade >= 0
         fade object obj, fadeObjectOut(i).fade
      else
         array insert at top killObject()
         killObject(0) = obj
         `hide object obj
         `array delete element fadeObjectOut(i)
         `dec fade_count, 1
      endif
   next i

   for j = 0 to array count(killObject())
      for i = 0 to fade_count
         if fadeObjectOut(i).object = killObject(j)
            `hide object killObject(j)
            array delete element fadeObjectOut(i)
            dec fade_count, 1
         endif
      next i
   next j
   empty array killObject()

return



rem calculates ball's reflection from brick(triangle)
rem assumes reflection surface vector was set and normalized (vector 2)
function calculate_reflection()
   set vector2 1, ball.direction.x, ball.direction.y
   dp# = dot product vector2(1,2)*2
   multiply vector2 2,dp#
   subtract vector2 1, 1, 2
   normalize vector2 1, 1
   ball.direction.x = x vector2(1)
   ball.direction.y = y vector2(1)
endfunction




rem returns a time value of set [0,1] of closest intersection between ball's velocity vector and triangle's sides
rem if intersection happens, calculates normal of reflection surface and stores in vector 2
rem returns -1 if no sides were hit
function triangle_collide#(b as toy, t as triangle)
   a# = _line_intersect(b.oldPosition.x,b.oldPosition.y,b.position.x,b.position.y,t.x1,t.y1,t.x2,t.y2)
   b# = _line_intersect(b.oldPosition.x,b.oldPosition.y,b.position.x,b.position.y,t.x1,t.y1,t.x3,t.y3)
   c# = _line_intersect(b.oldPosition.x,b.oldPosition.y,b.position.x,b.position.y,t.x2,t.y2,t.x3,t.y3)

   rem if a# is first intersection
   if a# < 1
      if a# < b# and a# < c#
         rem set normal of reflection surface
         set vector2 2, t.y2-t.y1,-(t.x2-t.x1)
         normalize vector2 2,2
         exitfunction a#
      endif
   else
      rem if b# is first intersection
      if b# < 1
         if b# < a# and b# < c#
            rem set normal of reflection surface
            set vector2 2, t.y1-t.y3,-(t.x1-t.x3)
            normalize vector2 2,2
            exitfunction b#
         endif
      else
         rem if c# is first intersection
         if c# < 1
            if c# < a# and c# < b#
               rem set normal of reflection surface
               set vector2 2, t.y3-t.y2,-(t.x3-t.x2)
               normalize vector2 2,2
               exitfunction c#
            endif
         endif
      endif
   endif
endfunction -1.0




REM returns 2 if the two line segments dont intersect, between [0,1] if they do
function _line_intersect(ax#,ay#,bx#,by#,cx#,cy#,dx#,dy#)

   d# = (dy# - cy#)*(bx# - ax#) - (dx# - cx#)*(by# - ay#)
   Ua# = ((dx# - cx#)*(ay# - cy#) - (dy# - cy#)*(ax# - cx#)) / d#
   Ub# = ((bx# - ax#)*(ay# - cy#) - (by# - ay#)*(ax# - cx#)) / d#
   _intersect# = 2

   if Ua# > 0 and Ua# < 1 and Ub# > 0 and Ub# < 1 then _intersect# = Ua#
endfunction _intersect#

`Started: 17/04/2005 -> 3:20am
`Description: short breakout program to help any new programmers to visualise other methods of detecting collision,
`             and how to use user defined types effectively.
`             not a particularly great game tho ^_^

`constant describing the force of gravity
#constant grav = 0.2
#constant padSize = 50.0
#constant blockSize = 30.0
#constant tailSize = 5

`type describing a 2D vector
type vector
   x as float
   y as float
endtype

`type describing an object with movement and position vectors
type object
   move as vector
   pos as vector
endtype

`type describing a surface with force and position vectors
type surface
   force as vector
   pos as vector
endtype

`type describing a entity which has a position a force and may be active or inactive
`i refuse to use DarkBasic boolean as it causes many problems in some functions where they wont work
`i strongly reccomend you do NOT use booleans in your program as it causes many internal bugs of darkbasic to surface
type entity
   isActive as integer
   pos as vector
endtype

type level
   levelNum as integer
   levelScore as integer
   levelLife as integer
   wallPos as integer
   brickColor as integer
   ballSpeed as integer
endtype

arena as level
   arena.levelNum = 1
   arena.levelScore = 0
   arena.levelLife = 10
   arena.wallPos = 5
   arena.brickColor = rgb(rnd(128)+127,rnd(128)+127,rnd(128)+127)
   arena.ballSpeed = 15

`variable to hold the position and movement vector of the ball
ball as object
   ball.move.x = 5
   ball.move.y = -10
   ball.pos.x = 400
   ball.pos.y = 400

`define an array to hold the positions and forces of the walls
dim wall(1) as surface
   `Left wall
   wall(0).pos.x = 10
   wall(0).force.x = 10
   `Right Wall
   wall(1).pos.x = 790
   wall(1).force.x = -10
   `Top Wall
   wall(0).pos.y = 10
   wall(0).force.y = 10
   `Lower Wall
   wall(1).pos.y = 590
   wall(1).force.y = 0

`define an array to hold the positions and forces of the pads
pad as surface
   `values for the 1st pad
   pad.pos.y = 500
   pad.force.x = -500
   pad.force.y = -1000

`define an array to hold the positions of the ball tail
dim tail(tailSize) as vector
   for tailNum = 0 to 5
      tail(tailNum).x = ball.pos.x
      tail(tailNum).y = ball.pos.y
   next tailNum

`define an array for the blocks
dim blocks(49) as entity
   for xPos = 0 to 9
   for yPos = 0 to 4
      blocks(blockNum).isActive = 1
      blocks(blockNum).pos.x = 130 + 60 * xPos
      blocks(blockNum).pos.y = 120 + 40 * yPos
      inc blockNum
   next yPos
   next xPos

dim highScore(9) as integer
   if file exist("tomuscore1.dat") = 0
      open to write 1,"tomuscore1.dat"
         for score = 0 to 9
            highScore(score) = 300000 / (score + 1)
            write file 1 , highScore(score)
         next score
      close file 1
   else
      open to read 1,"tomuscore1.dat"
         for score = 0 to 9
            read file 1,highScore(score)
         next score
      close file 1
   endif


`setup directX display
set display mode 800,600,32

`define the sychronisation rate and flip the buffers twice
sync on : sync rate 30
sync : sync

`hide the mouse cursor
hide mouse

do
   answer = startGame()
   arena.levelNum = 1
   arena.levelScore = 0
   arena.levelLife = 10
   arena.wallPos = 5
   arena.brickColor = rgb(rnd(128)+127,rnd(128)+127,rnd(128)+127)
   arena.ballSpeed = 15
   `Left wall
   wall(0).pos.x = 10
   wall(0).force.x = 10
   `Right Wall
   wall(1).pos.x = 790
   wall(1).force.x = -10
   `Top Wall
   wall(0).pos.y = 10
   wall(0).force.y = 10
   `Lower Wall
   wall(1).pos.y = 590
   wall(1).force.y = 0
   select answer
      case 1
         playGame()
      endcase
      case 2
         endGame()
      endcase
      case 3
         end
      endcase
   endselect
loop

function playGame()
   `main loop
   repeat
      ink rgb(0,128,255),0
      text 10,0,"Level: " + str$(arena.levelNum)
      text 600,0,"Score: " + str$(arena.levelScore)
      text 700,0,"Lives: " + str$(arena.levelLife)
      center text 400,0,"Press "Q" to quit..."
      `user controls the pad and checks for collision with the wall
      pad.pos.x = mousex()
      pad.force.x = mousemovex()
      if abs(pad.pos.x - wall(0).pos.x) < padSize then pad.pos.x = wall(0).pos.x + padSize
      if abs(pad.pos.x - wall(1).pos.x) < padSize then pad.pos.x = wall(1).pos.x - padSize
      `allow user to reset the ball
      if ball.pos.y = wall(1).pos.y
         if spacekey()
            ball.move.x = rnd(10)-5
            ball.move.y = - arena.ballSpeed
            ball.pos.x = 400
            ball.pos.y = 400
            dec arena.levelLife
         else
            center text 400 , 400 , "Press Space To Reset Ball..."
         endif
      endif
      `calculate the users x force
      userX# = curveValue( (rightkey()-leftkey()) * 0.4 , userX# , 10 )
      `call ball control function to refresh the ball data
      controlBall()
      `draw walls
      drawBox( wall(0).pos.x , wall(0).pos.y , wall(1).pos.x , wall(1).pos.y , rgb(255,0,0) )
      drawBox( wall(0).pos.x + 10 , wall(0).pos.y + 10 , wall(1).pos.x - 10 , wall(1).pos.y - 10 , rgb(128,0,0) )
      drawBox( wall(0).pos.x + 20 , wall(0).pos.y + 20 , wall(1).pos.x - 20 , wall(1).pos.y - 20 , rgb(64,0,0) )
      drawBox( wall(0).pos.x + 30 , wall(0).pos.y + 30 , wall(1).pos.x - 30 , wall(1).pos.y - 30 , rgb(32,0,0) )
      `draw tail of ball first so the ball with have priority on screen display
      for tailPos = 0 to 5
         drawBall( tail(tailPos).x , tail(tailPos).y , 5 , 2 , rgb(255,51*tailPos,0) )
      next tailPos
      inc tailNum
      `control move the pointer to the next ball
      if tailNum > tailSize then tailNum = 0
      tail(tailNum).x = ball.pos.x
      tail(tailNum).y = ball.pos.y
      `draw ball
      drawBall( ball.pos.x , ball.pos.y , 10 , 3 , rgb(0,255,128) )
      `draw pads
      drawPad( pad.pos.x , pad.pos.y , padSize , rgb(255,128,0) )
      `draw blocks
      for blockNum = 0 to 49
         if blocks(blockNum).isActive = 1 then drawPad( blocks(blockNum).pos.x , blocks(blockNum).pos.y , blockSize , arena.brickColor )
      next blockNum
      `synchronise the screen
      sync
      `clear screen to avoid pixel dragging
      cls
      `end main loop
      if arena.levelLife < 0 || upper$(inkey$()) = "Q"
         endGame()
         mainmenu = 1
      endif
   until mainmenu = 1
endfunction

`function to start game
function startGame()
   cls
   size = text size()
   set text size size + 20
      ink RGB(0,0,255) , 0
      center text 400 , 100 , "Tomu Breakout!"
      drawPad(400,115,200,RGB(0,128,255))
   set text size size
      ink RGB(0,128,255) , 0
      center text 400 , 200 , "1 - Play Game"
      center text 400 , 250 , "2 - High Scores"
      center text 400 , 300 , "3 - Exit"
   sync
   repeat
      answer = val(inkey$())
   until answer > 0
endfunction answer

`function to end the game
function endGame()
   if arena.levelScore > highScore(9)
      highScore(9) = arena.levelScore
      place = 9
      for score = 0 to 8
         pos = 9 - score
         if highScore(pos) > highScore(pos - 1)
            temp = highScore(pos - 1)
            highScore(pos - 1) = highScore(pos)
            highScore(pos) = temp
            dec place
         endif
      next score
      delete file "tomuscore1.dat"
      open to write 1 , "tomuscore1.dat"
         for score = 0 to 9
            write file 1 , highScore(score)
         next score
      close file 1
   endif
   cls
   center text 400 , 100 , "Scores:"
   for score = 0 to 9
      if score = place
         ink RGB(0,0,255),0o
      else
         if score = 0
            ink RGB(255,128,0),0
         else
            ink RGB(0,128,255),0
         endif
      endif
      center text 400 , 150 + score * 30 , str$(score+1) + ": " + str$(highScore(score))
   next score
   if arena.levelScore > 0 then center text 400 , 100 + (score + 2) * 30 , "Your Score: " + str$(arena.levelScore)
   center text 400 , 100 + (score + 3) * 30 , "press any key to end..."
   sync
   wait key
endfunction

`function to control movement of the ball
function controlBall()
   null = make vector2(1)
      set vector2 1 , ball.move.x , ball.move.y
      magnitude# = length vector2(1)
      divide vector2 1 , magnitude#
      repeat
         for blockNum = 0 to 49
            if blocks(blockNum).isActive = 1
               if ( abs(ball.pos.x - blocks(blockNum).pos.x) <= blockSize ) && ( abs(ball.pos.y - blocks(blockNum).pos.y) <= blockSize / 4 )
                  blocks(blockNum).isActive = 0
                  inc arena.levelScore , 100 * arena.levelNum
                  ball.move.y = - ball.move.y
               endif
               inc totalBlocks
            endif
         next blockNum
         if totalBlocks = 0
            for blockNum = 0 to 49
               blocks(blockNum).isActive = 1
            next blockNum
            if arena.levelNum < 13
               inc wall(0).pos.x , arena.wallPos
               inc wall(0).pos.y , arena.wallPos
               dec wall(1).pos.x , arena.wallPos
               dec wall(1).pos.y , arena.wallPos
            endif
            inc arena.ballSpeed , 2
            inc arena.levelNum , 1
            arena.brickColor = rgb(rnd(128)+127,rnd(128)+127,rnd(128)+127)
         endif
         if ( abs(ball.pos.x - pad.pos.x) <= padSize ) && ( abs(ball.pos.y - pad.pos.y) <= padSize / 4 )
            ball.move.y = - arena.ballSpeed
            inc ball.move.x , ( ball.pos.x - pad.pos.x ) / magnitude#
            `swept collision hack :D
            inc ball.move.x , pad.force.x / magnitude# / 12
         endif
         `work out the inverse square law of the forces on the walls and add pad force
         `inverse square law = ( 1 / distance^2 ) * force
         xForce# = ((1 / (3+abs(ball.pos.x - wall(0).pos.x))^2) * wall(0).force.x) + ((1 / (1+abs(ball.pos.x - wall(1).pos.x))^2) * wall(1).force.x / magnitude#)
         yForce# = ((3 / (1+abs(ball.pos.y - wall(0).pos.y))^2) * wall(0).force.y) + ((1 / (1+abs(ball.pos.y - wall(1).pos.y))^2) * wall(1).force.y / magnitude#)
         `add the wall force to the ball movement vectors. add gravity
         inc ball.move.x , xForce#
         inc ball.move.y , yForce# + grav / magnitude#
         `add movement vector and user input to the ball position
         inc ball.pos.x , ball.move.x / magnitude#
         inc ball.pos.y , ball.move.y / magnitude#
         `check for actual wall collision
         if ball.pos.x < wall(0).pos.x
            ball.pos.x = wall(0).pos.x
         endif
         if ball.pos.x > wall(1).pos.x
            ball.pos.x = wall(1).pos.x
         endif
         if ball.pos.y < wall(0).pos.y
            ball.pos.y = wall(0).pos.y
         endif
         if ball.pos.y > wall(1).pos.y
            ball.pos.y = wall(1).pos.y
         endif
         inc count# , 1 / magnitude#
      until count# > 1
   null = delete vector2(1)
endfunction

`function to draw the ball
function drawBall( xPos , yPos , size# , segments , color)
   increment# = size# / segments
   for seg = 1 to segments
      ink rgb( rgbr(color)/seg , rgbg(color)/seg , rgbb(color)/seg ) , 0
      circle xPos , yPos , increment# * seg
   next seg
endfunction

`function to draw a box
function drawBox( lf , up , rt , dn , color)
   ink color , 0
   line lf , up , rt , up
   line rt , up , rt , dn
   line rt , dn , lf , dn
   line lf , dn , lf , up
endfunction

`function to draw a pad
function drawPad( xPos , yPos , size# , color )
   ink color , 0
   drawBox( xPos - size# , yPos - size# / 4 , xPos + size# , yPos + size# / 4 , rgb( rgbr(color)/2 , rgbg(color)/2 , rgbb(color)/2 ) )
   drawBox( xPos - (size# * 0.5) , yPos - (size# * 0.5) / 4 , xPos + (size# * 0.5) , yPos + (size# * 0.5) / 4 , color )
endfunction

for i = 1 to 10
  obj = i + 100
  hide object i
next i

IBOL

Scored extremely well in:
Addictiveness: I was very drawn into this game
Creativity: Different approach to breakout with some psycodelic graphics

Scored well in:
Playability: It was a little tough to make sure the ball didn't hit the center, but since you didn't have 'lives', it didn't matter much.
Graphics: Mostly scored well on graphics in creativity. Very nice explosions and overall look.

Tomu

Scored extremely well in:
Playability: Although a standard breakout game, it worked as it should along with the gravity physics.

Scored well in:
Graphics: For a 2D graphics game made from mostly boxes, you did a fine job. The playing field was niceley done and the colored trail for the ball was a great touch.
Add ins: Menu was a nice touch, as well as little reminders like "Press Space to Launch". Also, the ball moving across the bottom of the field when you
lost it was a small bonus as well.

sync on
sync rate 60

randomize 1000

dim lots_of_names$(1000)
create_random_system_names()
y = 0

repeat
	
	for i = 1 to 1000
		
		text 0, y, lots_of_names$(i)
		y = y + 16
		
	next i
	
	sync
	
until spacekey() > 0



Rem PJY - function to create random names for the systems

FUNCTION create_random_system_names()

	dim vowels(4) AS string
	vowels(0) = "A"
	vowels(1) = "E"
	vowels(2) = "I"
	vowels(3) = "O"
	vowels(4) = "U"
	
	dim consonants(20) AS string
	consonants(0) = "B"
	consonants(1) = "C"
	consonants(2) = "D"
	consonants(3) = "F"
	consonants(4) = "G"
	consonants(5) = "H"
	consonants(6) = "J"
	consonants(7) = "K"
	consonants(8) = "L"
	consonants(9) = "M"
	consonants(10) = "N"
	consonants(11) = "P"
	consonants(12) = "Q"
	consonants(13) = "R"
	consonants(14) = "S"
	consonants(15) = "T"
	consonants(16) = "V"
	consonants(17) = "W"
	consonants(18) = "X"
	consonants(19) = "Y"
	consonants(20) = "Z"
	
	randomize 1000
	
	total_letters = 10

	for i = 1 to 100
		
		repeat
	
			word_length = rnd(total_letters)
		
		until word_length > 3
	
		for j = 1 to word_length
			
			chance = rnd(99)
			if j = 1
				
				if chance =< 19
				
					name$ = vowels(rnd(4))
					last = 0
			
				else
			
					name$ = consonants(rnd(20))
					last = 1
				
				endif
				
			endif
			
			if last = 1
				
				name$ = name$ + vowels(rnd(4))
				last = 0
			
			else
			
				name$ = name$ + consonants(rnd(20))
				last = 1
				
			endif
			
			Rem PJY - break loop if the name is too long
			name_length = len(name$)
			if name_length => word_length
				
				j = word_length + 10
				
			endif			
			
		next j
		
		lots_of_names$(i) = name$
		
	next i

ENDFUNCTION

randomize timer()


   cls
   set cursor 0,0
   print generateName$(5)
   print generateName$(6)
   print generateName$(7)
   print generateName$(8)
   print generateName$(9)
   print
   print generateName$(5)
   print generateName$(6)
   print generateName$(7)
   print generateName$(8)
   print generateName$(9)
   print
   print generateName$(5)
   print generateName$(6)
   print generateName$(7)
   print generateName$(8)
   print generateName$(9)


suspend for key



function generateName$(length)
   werd$ = ""
   con = 0
   vow = 0
   cc = 0

   for c = 1 to length
      if vow+con = 0
         a$ = chr$(rnd(25)+97)
         if isVowel(a$)
            con = 1
         else
            inc cc, 1
            if cc = 2 then vow = 1 : cc = 0
         endif
      else
         if vow = 1 then a$ = getVowel$(rnd(4)+1) : vow = rnd(1)
         if con = 1 then a$ = getCon$(rnd(20)+1) : con = 0
      endif


      if a$="c" OR a$="p" OR a$="s" then if rnd(1) then a$ = a$+"h"
      if a$="q" then if rnd(2) then a$ = a$+"u"

      werd$ = werd$+a$
   next c
endfunction werd$


function isVowel(L$)
   if L$ = "a" OR L$ = "e" OR L$ = "i" OR L$ = "o" OR L$ = "u" then exitfunction 1
endfunction 0



function getCon$(c)
   cons$ = "bcdfghjklmnpqrstvwxyz"
   cc$ = mid$(cons$,c)
endfunction cc$

function getVowel$(v)
   vows$ = "aeiou"
   vv$ = mid$(vows$,v)
endfunction vv$

Din
Cola
Mepin
Bemave
Furoret (ok so this one is the wierdest one i've seen come out of it ;))

and

Vuh
Nona
Rojal
Bemeba
Putajor

Rah
Dumi
Nurur
Namuri
Runimer

Bet
Vono
Moqel
Cohaco
Nurirol

uvmesh
gfaide
qdeoiiu
shdufyeii
ddiarxier

oshrpi
phubawch
equvbeui
yobgiuiu
zxevwouka

shwishy
whuaii
kmevovh
xbuaeval
tazchuunfa

Randomize Timer()
Set Text Size 12
Set Text Font "Arial"

Type GroupSize
   Single as String
   Pair as String
   Trip as String
EndType

Global maxsize as Integer
maxsize=150
Dim Con(maxsize) as GroupSize
Dim Vow(maxsize) as GroupSize

Dim Seed(20) as String

Print "Please enter 3 to 20 names in the style you would like. Enter 'exit' to quit."
For i = 1 to 20
   Do
      Input "Enter name ";i;" (or 'exit' to quit): ",Seed(i)
      If Len(Seed(i))>2 then Exit
      Print "Names must be at least 3 letters long."
   Loop
   Seed(i)=Lower$(Seed(i))
   If Seed(i)="exit"
      Seed(i)=""
      If i<4
         Print "Please enter at least 3 names. You have ";i;" so far."
      Else
         Exit
      Endif
   Endif
Next i
If i>20 then i = 20
Generate_Seq(i)
For j = 1 to 10
   Print Generate_Name()
Next j
Wait key
End

Function Generate_Name()
   name$=""
   t=rnd(1)
   Do
      name$=name$+Generate_Seg(t)
      l=len(name$)-3
      If rnd(25)<l Then Exit
      l$=Right$(name$,1)
      If l$="q" then name$=name$+"u":l$="u"
      if Is_Cons(l$,1) Then t=1 Else t=0
   Loop
   name$=Upper$(Left$(Name$,1))+Lower$(Right$(name$,Len(name$)-1))
EndFunction name$

Function Generate_Seg(ltype)
   If ltype = 0
      l=rnd(4)+1
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Con(s).Single
      Endif
      If l=2
         seg$=Con(s).Pair
      Endif
      If l>2
         seg$=Con(s).Trip
      Endif
   Else
      l=rnd(2)+1
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Vow(s).Single
      Endif
      If l=2
         seg$=Vow(s).Pair
      Endif
      If l>3
         seg$=Vow(s).Trip
      Endif
   Endif
EndFunction seg$

Function Generate_Seq(names)
   For i = 1 to maxsize
      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Single = Mid$(Seed(n),p)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Single = Mid$(Seed(n),p)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)

      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Cons(Seed(n),p) Then Exit
            Loop
            Con(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)
            Exit
         Endif
      Loop

      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Vowel(Seed(n),p) Then Exit
            Loop
            Vow(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)
            Exit
         Endif
      Loop
      Print ".";
      i#=i
      If i#/50.0=int(i/50) then Print
   Next i
EndFunction

Function Is_Cons(name$,pos)
Restore Consonants
Flag =0
For i= 1 to 21
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag

Function Is_Vowel(name$,pos)
Restore Vowels
Flag =0
For i= 1 to 6
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag

Consonants:
Data "b","c","d","f","g","h","j","k","l","m","n","p","q","r","s","t","v","w","x","y","z"

Vowels:
Data "a","e","i","o","u","y"

randomize timer()

data "e","u","i","o","a"
data "q","w","r","t","y","p","s","d","f","g","h","j","k","l","z","x","c","v","b","n","m"

`read vowels
dim vowel$(5)
for n=1 to 5
read vowel$(n)
next n

`read consonants
dim consonant$(21)
for n=1 to 21
read consonant$(n)
next n

numberofwords=10
dim word$(numberofwords)

do

for repeatword=1 to numberofwords

  `start word with a consonant
  consonant=1
  vowel=-1

  `randomize word length
  numberofletters=3+rnd(7)
  dim letter$(numberofletters)

  for repeatletter=1 to numberofletters

    `select random consonant
    if consonant=1
      letter$(repeatletter)=consonant$(rnd(20)+1)
    endif

    `select random consonant
    if vowel=1
      letter$(repeatletter)=vowel$(rnd(4)+1)
    endif

`alternate between consonant and vowel
consonant=consonant*-1
vowel=vowel*-1


  next repeatletter

  `build the word from the chosen letters
  word$(repeatword)=""
  for buildword=1 to numberofletters
    word$(repeatword)=word$(repeatword)+letter$(buildword)
  next buildword

  print word$(repeatword)

next repeatword


print
print "Press space to regenerate"
print "Press 's' to save to file"

repeat

`save words to file
if inkey$()="s"
  if file exist ("c:\wordgenerator.txt") then delete file "c:\wordgenerator.txt"
  open to write 1,"c:\wordgenerator.txt"
  for repeatword=1 to numberofwords
    write string 1,word$(repeatword)
  next repeatword
  print "Saved as 'c:\wordgenerator.txt'"
  close file 1
  wait 1000
endif


until spacekey()=1
wait 200
cls
loop

Randomize Timer()
Set Text Size 12
Set Text Font "Arial"

sync on
sync rate 0

Type GroupSize
   Single as String
   Pair as String
   Trip as String
EndType

Global maxsize as Integer
maxsize=150
Dim Con(maxsize) as GroupSize
Dim Vow(maxsize) as GroupSize

Dim Seed(20) as String

Print "Please enter 3 to 20 names in the style you would like. Enter 'exit' to quit."
sync
For i = 1 to 20
   Do
      Input "Enter name ";i;" (or 'exit' to quit): ",Seed(i)
      sync
      If Len(Seed(i))>2 then Exit
      Print "Names must be at least 3 letters long."
      sync
   Loop
   Seed(i)=Lower$(Seed(i))
   If Seed(i)="exit"
      Seed(i)=""
      If i<4
         Print "Please enter at least 3 names. You have ";i;" so far."
         sync
      Else
         Exit
      Endif
   Endif
Next i
If i>20 then i = 20
Generate_Seq(i)
For j = 1 to 10
   Print Generate_Name()
   sync
Next j
Wait key
End

Function Generate_Name()
   name$=""
   t=rnd(1)
   Do
      name$=name$+Generate_Seg(t)
      l=len(name$)-3
      If rnd(25)<l Then Exit
      l$=Right$(name$,1)
      If l$="q" then name$=name$+"u":l$="u"
      if Is_Cons(l$,1) Then t=1 Else t=0
   Loop
   name$=Upper$(Left$(Name$,1))+Lower$(Right$(name$,Len(name$)-1))
EndFunction name$

Function Generate_Seg(ltype)
   If ltype = 0
      l=rnd(4)+1
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Con(s).Single
      Endif
      If l=2
         seg$=Con(s).Pair
      Endif
      If l>2
         seg$=Con(s).Trip
      Endif
   Else
      l=rnd(2)+1
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Vow(s).Single
      Endif
      If l=2
         seg$=Vow(s).Pair
      Endif
      If l>3
         seg$=Vow(s).Trip
      Endif
   Endif
EndFunction seg$

Function Generate_Seq(names)
   For i = 1 to maxsize
      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Single = Mid$(Seed(n),p)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Single = Mid$(Seed(n),p)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)

      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Cons(Seed(n),p) Then Exit
            Loop
            Con(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)
            Exit
         Endif
      Loop

      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Vowel(Seed(n),p) Then Exit
            Loop
            Vow(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)
            Exit
         Endif
      Loop
      `Print ".";
      `sync
      i#=i
      `If i#/50.0=int(i/50) then Print
      `sync
   Next i
EndFunction

Function Is_Cons(name$,pos)
Restore Consonants
Flag =0
For i= 1 to 21
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag

Function Is_Vowel(name$,pos)
Restore Vowels
Flag =0
For i= 1 to 6
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag

Consonants:
Data "b","c","d","f","g","h","j","k","l","m","n","p","q","r","s","t","v","w","x","y","z"

Vowels:
Data "a","e","i","o","u","y"

Randomize Timer()
Set Text Size 12
Set Text Font "Arial"

sync on
sync rate 0

Type GroupSize
   Single as String
   Pair as String
   Trip as String
EndType
Global maxnames as Integer
Global maxsize as Integer
`**************************************Change these variables as desired**************************
maxnames = 50
maxsize=1000
`*************************************************************************************************
Dim Con(maxsize) as GroupSize
Dim Vow(maxsize) as GroupSize
Global avg_len as Float
avg_len = 0

Dim Seed(maxnames) as String
Sync
Do
   Do
      Input "'Load' or 'Enter' names? ",ent$
      Sync
      ent$=Lower$(ent$)
      If ent$="load" or ent$="enter" Then Exit
   Loop
   If ent$="enter"
      Print "Please enter 3 to ";maxnames;" names in the style you would like. Enter 'exit' to quit."
      sync
      Print
      For i = 1 to maxnames
         Do
            Input "Enter name ";i;" (or 'exit' to quit): ",Seed(i)
            sync
            i#=i:if i#/20.0 = int(i/20) Then cls
            If Len(Seed(i))>2 then Exit
            Print "Names must be at least 3 letters long."
            sync
         Loop
         Seed(i)=Lower$(Seed(i))
         avg_len=avg_len+len(Seed(i))
         If Seed(i)="exit"
            Seed(i)=""
            If i<4
               Print "Please enter at least 3 names. You have ";i;" so far."
               sync
            Else
               Exit
            Endif
         Endif
      Next i
      If i>maxnames then i = maxnames
      i#=i
      Input "Do you want to save this list?",save$:Sync
      save$=lower$(save$)
      If save$="y" or save$="yes"
         Input "Enter the file name (without extension): ",filename$:Sync
         ov$="y":filename$=filename$+".nmf"
         If File Exist(filename$)
            Input "File already exists. Overwrite? ",ov$:Sync
            ov$=Lower$(ov$)
         Endif
         If  ov$="y" or ov$="yes"
            If File Exist(filename$) Then Delete File filename$
            Save Array filename$,Seed()
         Endif
      Endif
      Exit
   Else
      Input "Enter the file name (without extension): ",filename$:Sync
      filename$=filename$+".nmf"
      If File Exist(filename$)
         Load Array filename$,Seed()
         For i = 1 to maxnames
            if Seed(i)="" Then Exit
            avg_len=avg_len+len(Seed(i))
         Next i
         i=i-1:i#=i
         Exit
      Else
         Print: Print "Error: File not found.":Print:Sync
      Endif
   Endif
Loop
avg_len=avg_len/i#
Generate_Seq(i)

Do
   Print
   For j = 1 to 10
      Print j;") ";Generate_Name()
      sync
   Next j
   Wait key
Loop
End

Function Generate_Name()
   name$=""
   t=rnd(1)
   name$=name$+Generate_Seg(t,1)
   Do
      l$=Right$(name$,1)
      If l$="q" then name$=name$+"u":l$="u"
      if Is_Cons(l$,1) Then t=1 Else t=0
      name$=name$+Generate_Seg(t,0)
      l=len(name$)-3 + (len(name$)>(avg_len-2))*3
      If rnd(10+avg_len)<l Then Exit
   Loop
   name$=Upper$(Left$(name$,1))+Lower$(Right$(name$,Len(name$)-1))
EndFunction name$

Function Generate_Seg(ltype,flag)
   l=rnd(3)+1
   If flag then l=1
   If ltype = 0
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Con(s).Single
      Endif
      If l=2
         seg$=Con(s).Pair
      Endif
      If l>2
         seg$=Con(s).Trip
      Endif
   Else
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Vow(s).Single
      Endif
      If l=2
         seg$=Vow(s).Pair
      Endif
      If l>3
         seg$=Vow(s).Trip
      Endif
   Endif
EndFunction seg$

Function Generate_Seq(names)
   For i = 1 to maxsize
      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Single = Mid$(Seed(n),p)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Single = Mid$(Seed(n),p)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)

      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)

      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Cons(Seed(n),p) Then Exit
            Loop
            Con(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)
            Exit
         Endif
      Loop

      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Vowel(Seed(n),p) Then Exit
            Loop
            Vow(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)
            Exit
         Endif
      Loop
   Next i
EndFunction

Function Is_Cons(name$,pos)
Restore Consonants
Flag =0
For i= 1 to 21
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag

Function Is_Vowel(name$,pos)
Restore Vowels
Flag =0
For i= 1 to 6
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag

Consonants:
Data "b","c","d","f","g","h","j","k","l","m","n","p","q","r","s","t","v","w","x","y","z"

Vowels:
Data "a","e","i","o","u","y"

randomize timer()
sync on
sync rate 0
sync

dim vow$(5) as string
dim con$(6,6) as string
dim name$(100)

for t=1 to 5
 read a$
 vow$(t)=a$
next t

for t=1 to 6
 for x=1 to 6
  read a$
  con$(t,x)=a$
 next x
next t

for n=1 to 100
 ` n=name number

l=rnd(5)+4
 ` l=name length

cv=1
if rnd(3)=2 then cv=-1
 ` cv=consonant/vowel : 1=c, -1=v

  ` here is where actual name creation happens:
a$=""
for t=1 to l

select cv

case -1
a$=a$+vow$(rnd(4)+1)
endcase

case 1

 repeat

a=(t>1 and t<l)
x=rnd(18+a)+1
 ` x is the random determiner 1-20
y=0
z=0
 ` y is which consonant group, z is how many valid members it has.

if x<10
 y=1
 z=5
 exit
endif

if x>9 and x<15
 y=2
 z=5
 exit
endif

if x>14 and x<18
 y=3
 z=5
 exit
endif

if x=18
 y=4
 z=4
 exit
endif

if x=19
 y=5
 z=6
 exit
endif

if x=20
 y=6
 z=5
 exit
endif

until z>0

a$=a$+con$(y,rnd(z-1)+1)

endcase

endselect

 ` this way, we go from vowel to consonant, no matter what we are on currently
cv=-cv

` there's a 25% chance a word will end in a double vowel.
if t+1=l
 if cv=1
  if rnd(3)=0
   cv=-1
  endif
 endif
endif

next t

name$(n)=a$

next n


for t=1 to 20
 for x=0 to 4
  text x*100,t*20,name$(t+x*20)
 next x
next t

text 0,440,"if you don't want this saved as a file, hit [ESC]. otherwise, hit any key."
sync
wait key

open to write 1,"namegen"+str$(int(timer()/98765))+".txt"
 for n=1 to 100
  write string 1,name$(n)
 next n
close file 1


data "a","e","i","o","u"
data "r","s","t","l","n","-"
data "b","c","d","m","y","-"
data "f","g","h","k","p","-"
data "st","th","ph","sh","-","-"
data "qu","x","z","j","w","v"
data "nn","pp","ss","rr","gg","-"

cepi
oranacota
ocofiboo
meye
phibuthe
inibafu
inanenoye
phaganayit
yopase
lulephus
gogohe
tita
ayifose
cocoppu
dalee
elim
huratuniu
lilophuze
cipo
latarigaa
ileyagiri
geho
caracapa
setoyeme
cadastiboe
loley
ineli
totupudeg
sekelunnoth
menehut
remoe
naretaru
acere
gorice
sarinus
niyibu
honunoco
arufuhi
yiriwi
piniyo
iwio
geseppolob
kenu
sticayudad
ofeto
tesas
atotuna
yagari
ninahu
fecomupo
nehohepol
doritati
detal
tilith
sekome
enelote
lobusalat
rokasusue
retosako
dappiph
agijariu
tuhasa
phekaggoget
sugemanel
efilebi
iheyissi
utolu
holozeriy
dulun
suquurun
emele
lebisul
ohaho
etelesimu
lisoc
ucenaye
talilusal
kacapade
wociquel
tosastil
udiliror
itotidet
guppon
onaxigu
shulel
ifalole
lepeyasei
darota
petij
rici
irinepe
sakomotho
anura
gonire
zewasadea
etuteshune
vophoti
thinahuta
yeburalod
usecu

set display mode 1024,768,32
randomize timer()

data "e","u","i","o","a"
data "q","w","r","t","y","p","s","d","f","g","h","j","k","l","z","x","c","v","b","n","m"
data "Br","Tr","St","Dr","Sr","Th","Ph","Zr","Wr","Gl","Ch","Pr","Q","W","R","T","Y","P","S","D","F","G","H","J","K","L","Z","X","C","V","B","N","M"
data "nt","d","s","rt","p","k","b","g","m","st","ps","ts","ns","ms","nd","fs"
data "1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20"

`read vowels
dim vowel$(5)
for n=1 to 5
read vowel$(n)
next n

`read consonants
dim consonant$(21)
for n=1 to 21
read consonant$(n)
next n

`read beginnings of names
dim begin$(33)
for n=1 to 33
read begin$(n)
next n

`read ends of names
dim end$(16)
for n=1 to 16
read end$(n)
next n

`read number of word
dim numberwrd$(20)
for n=1 to 20
read numberwrd$(n)
next n

numberofwords=20
dim word$(numberofwords)

do
for repeatword=1 to numberofwords
rndbegin=rnd(11)+1
rndend=rnd(15)+1
  `start word with a consonant
  begin=1
  endc=0
  consonant=-1
  vowel=1

  `randomize word length
  numberofletters=3+rnd(5)
  if numberofletters=3 or 5 or 7
  if rnd(1)=0
  inc numberofletters
  else
  dec numberofletters
  endif
  endif
  dim letter$(numberofletters)

  for repeatletter=1 to numberofletters

    `select random consonant
    if consonant=1
      letter$(repeatletter)=consonant$(rnd(20)+1)
      if letter$(repeatletter)="q" then letter$(repeatletter)="qu"
      if letter$(repeatletter)="c"
      if rnd(1)=0 then letter$(repeatletter)="ck"
      endif
    endif

    `select random consonant
    if vowel=1
      letter$(repeatletter)=vowel$(rnd(4)+1)
      if letter$(repeatletter)="o"
      if rnd(1)=0 then letter$(repeatletter)="oo"
      endif
    endif

`alternate between consonant and vowel
consonant=consonant*-1
if rnd(5)<>1
vowel=vowel*-1
endif
  next repeatletter
  `build the word from the chosen letters
  word$(repeatword)=""
  word$(repeatword)=word$(repeatword)+begin$(rndbegin)
  for buildword=1 to numberofletters
    word$(repeatword)=word$(repeatword)+letter$(buildword)
  next buildword
  word$(repeatword)=numberwrd$(repeatword)+"-"+word$(repeatword)+end$(rndend)
  center text screen width()/2,10+repeatword*12,word$(repeatword)
next repeatword
print "Press space to regenerate"
print "Press 's' to save a word to file"

repeat

`save words to file
if inkey$()="s"
  print "Type name of file"
  Input "",filename$
  filename$="c:\"+filename$+".txt"
  if file exist (filename$) then delete file filename$
  open to write 1,filename$
  print "Type number of names you would like to save"
  Input "",numbername
  print "Type the numbers of the words you want to save"
  for x=1 to numbername
    Input "Word #"+str$(x)+"--",number
    write string 1,word$(number)
  next x
  print "Saved as '"+filename$+"'"
  close file 1
  wait 1000
endif


until spacekey()=1
wait 200
cls
loop

Minazo
Lenoke
Qili
Getim
Nalibo
Luho
Rumasur
Pubor
Lunah
Ciludem
Raba
Sehurot
Maban
Rame
Det
Vetiza
Ram
Bulal
Pinuh
Samurat
Huhoci
Bel
Wanur
Hanat
Dibo
Getosi
Nela
Cinebe
Satum
Kir
Boborib
Danel
Conunah
Deno
Somulob
Nuloru
Canatat
Cutub
Doteh
Lobo
Genon
Gabace
Belude
Tibatan
Salilen
Hanot
Runobol
Mihaca
Nihiqam
Rabesoh
Nala
Mena
Meb
Sumi
Behuda
Sineru
Dur
Nal
Larukub
Cunube
Putecim
Nun
Yimum
Geh
Bonurah
Suhacar
Guha
Culasun
Menu
Wer
Hanu
Yim
Bohumon
Duneloh
Melen
Bon
Reto
Zineroh
Del
Qirumo
Pum
Nane
Turidam
Dut
Zeto
Nun
Gin
Dime
Lebasub
Bale
Dem
Sanepin (at least it's not an INsane pin :o )
Tenifan
Sehuri
Rehoror
Kireguh
Con
Hem
Nib
Murol

kehodu
gohoc
saranu
luopmiwim
lovol
kasap
gajuces
imdebo
fiboso
qekuquu
yatuge
rapure
ojkeom
yacifo
piluugmog(hehe, sounds funny)
omzamona
soukfix
erbudawit
wooyb
wacuqi
jurug
minarile
gomedam (lol, say that aloud)
ithegaahm
herixo
fegodo
oykidi

sync on
sync rate 60

sync
sync

randomize timer()

start:
cls
choice = 0

repeat
   print "1-save 100 random names to a file"
   print "2-choose a certain length, create names of that length, and save them to a file"
   print "3-choose a first letter, create names that use it, and save them to a file"
   print "4-do both option 2 and 3 (set your own length AND first letter)"
   print "5-Exit"
   print "What would you like to do?"
   sync
   input "",choice
   if choice > 0 and choice < 6
      valid = 1
   else
      valid = 0
      CLS
      print "You must enter a number between 1 and 5"
      print " "
      sync
   endif
until valid=1

sync

if choice = 1
   cls

   file$ = getfilename()

   if file exist(file$ + ".txt") then delete file file$ + ".txt"

   open to write 1, file$ + ".txt"

   for i=1 to 100
      length = rnd(4)+3
      write string 1, name(length, "")
      sync
   next i

   close file 1

   print "The 100 names have been saved to '" + file$ + ".txt'"
   print "Press any key to continue"
   sync
   wait key
   goto start
endif


if choice = 2
   cls

   length = getlength()

   num = 0
   print "How many names do you want to save to the file?"
   sync
   input "",num

   file$ = getfilename()

   if file exist(file$ + ".txt") then delete file file$ + ".txt"

   open to write 1, file$ + ".txt"

   for i=1 to num
      write string 1, name(length, "")
      sync
   next i

   close file 1

   print "The names have been saved to '" + file$ + ".txt'"
   print "Press any key to continue"
   sync
   wait key
   goto start
endif


if choice = 3
   cls
   first$ = ""
   length = 0

   print "Enter the letter you want your names to start with"
   sync
   input "",first$

   num = 0
   print "How many names do you want to save to the file?"
   sync
   input "",num

   file$ = getfilename()

   if file exist(file$ + ".txt") then delete file file$ + ".txt"

   open to write 1, file$ + ".txt"

   for i=1 to num
      length = rnd(4)+3
      write string 1, name(length, first$)
      sync
   next i

   close file 1

   print "The names have been saved to '" + file$ + ".txt'"
   print "Press any key to continue"
   sync
   wait key
   goto start
endif

if choice = 4
   cls
   first$ = ""
   length = 0

   print "Enter the letter you want your names to start with"
   sync
   input "",first$

   length = getlength()

   num = 0
   print "How many names do you want to save to the file?"
   sync
   input "",num

   file$ = getfilename()

   if file exist(file$ + ".txt") then delete file file$ + ".txt"

   open to write 1, file$ + ".txt"

   for i=1 to num
      write string 1, name(length, first$)
      sync
   next i

   close file 1

   print "The names have been saved to '" + file$ + ".txt'"
   print "Press any key to continue"
   sync
   wait key
   goto start
endif

if choice = 5
   end
endif




function name(length, first$)
   select length

      case 3
         name$ = firstletter(first$) + lower$(midletter()) + lower$(lastletter())
         break
      endcase

      case 4
         name$ = firstletter(first$) + lower$(midletter()) + lower$(lastletter()) + lower$(midletter())
         break
      endcase

      case 5
         name$ = firstletter(first$) + lower$(midletter()) + lower$(lastletter()) + lower$(midletter()) + lower$(lastletter())
         break
      endcase

      case 6
         name$ = firstletter(first$) + lower$(midletter()) + lower$(lastletter()) + lower$(midletter()) + lower$(firstletter("")) + lower$(midletter())
         break
      endcase

      case 7
         name$ = firstletter(first$) + lower$(midletter()) + lower$(lastletter()) + lower$(midletter()) + lower$(firstletter("")) + lower$(midletter()) + lower$(lastletter())
         break
      endcase

   endselect
endfunction name$

function firstletter(rule$)
   if rule$=""
      num = rnd(2)+1
      select num
         case 1
            letters$ = "BCDLMNRS"
         endcase
         case 2
            letters$ = "BCDFGHKLMNPRSTW"
         endcase
         case 3
            letters$ = "BCDFGHJKLMNPQRSTVWXYZ"
         endcase
      endselect

      a$ = mid$(letters$, rnd(len(letters$)-1)+1)
   else
      a$ = rule$
   endif

endfunction a$

function midletter()
   letters$ = "AEIOU"
   a$ = mid$(letters$, rnd(len(letters$)-1)+1)
endfunction a$


function lastletter()
   letters$ = "RTNHLMNB"
   a$ = mid$(letters$, rnd(len(letters$)-1)+1)
endfunction a$

function getlength()

   length = 0
   print "Enter the length you want your names to be. From 3 to 7"
   sync
   input "",length
   repeat
      if length > 2 and length < 8
         complete = 1
      else
         cls
         print "That is an illegal length! please enter a length between 3 and 7"
         sync
         input "",length
         complete = 0
      endif
   until complete = 1
endfunction length

function getfilename()
   complete = 0
   repeat
      file$ = ""
      print "Enter a name for the file"
      sync
      input "",file$

      ask$ = ""
      if file exist(file$ + ".txt")
         print "That file exists, overwrite? y/n"
         sync
         input "",ask$
         if ask$ = "y"
            complete = 1
         else
            complete = 0
            cls
         endif
      else
         complete = 1
      endif
   until complete = 1
endfunction file$

Sanal
Soteh
Situb
Saral
Serer
Samur
Samoh
Sutim
Solub
Sutem
Sunir
Senom
Sunim
Seheb
Sihoh
Sehur
Soret
Suteh
Subun
Senol