[DBC/DBP] Universe! - GameCreators Forum

Author

Message

Libervurto

16

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 21st Mar 2010 17:06 Edited at: 3rd Nov 2010 19:48

Link

I was inspired by Elite.
Does everyone get Woanwe as the default origin planet?

Uncompressed:

rem Name: Galaxy Generator
rem Author: OBese87
rem ---------------
hide mouse
sync on
sync rate 60
rem Set the galaxy seed: changing this will produce unique galaxies.
galaxy = 100
rem set cursor origin
cx=320:cy=160

rem === MAIN ===
Do
  rem Control cursor.
  u=upkey():r=rightkey():d=downkey():l=leftkey()
  cx=cx+r-l : cy=cy+d-u
  if cx<20 then cx=20
  if cx>620 then cx=620
  if cy<20 then cy=20
  if cy>310 then cy=310
  rem change origin planet
  if returnkey()=1 then neworigin=1
  rem snap to origin planet
  if inkey$()="o" then snaporigin=1

`= Draw the Galaxy =
  ink -2,0
  rem Seed the galaxy.
  randomize galaxy
  rem Draw Border.
  bw = 3 : rem border width.
  box 20-bw,20-bw,620+bw,20
  box 620,20,620+bw,310+bw
  box 20-bw,310,620+bw,310+bw
  box 20-bw,20-bw,20,310+bw
  rem Draw planets.
  for i = 0 to 999
    px = rnd(596)+22
    py = rnd(286)+22
    ink -2,0
    box px-rnd(1),py-rnd(1),px+rnd(1),py+rnd(1)
    rem if cursor on planet store planet number for later
    if abs(cx-px)<2 and abs(cy-py)<2
      info=1
      planeti = i
    endif
    rem Draw origin cursor.
    if i=origin
      ink 65535,0
      box px-15,py,px+15,py
      box px,py-15,px,py+15
      ink 0,0
      dot px,py
      rem Snap planet cursor to origin planet after "o" pressed.
      if snaporigin=1 then cx=px : cy=py : snaporigin=0
    endif
  next i

rem Display planet info.
  if info=1
    info=0
    rem Seed specific planet.
    randomize galaxy*1000+planeti
    planet$ = Planet_Name$()
    text 20,320,upper$(planet$):`+" "+str$(planeti) :`planet number.
    text 20,340,Planet_Desc$(planet$)
    rem set origin
    if neworigin=1 then origin=planeti : neworigin=0
  endif

rem Draw user cursor.
  ink 65535,0
  box cx-10,cy,cx+10,cy
  box cx,cy-10,cx,cy+10
  ink 0,0
  dot cx,cy
  rem Tell user what the frick to do.
  ink 65535,0
  text 0,420,"Use arrow keys to move the cursor. Press 'o' to snap to the origin planet."
  text 0,440,"Press RETURN to set the current planet as the new origin."
  text 0,460,"To change galaxy press ESC to bring up the CLI and type 'galaxy = [integer]'"
  rem Program info.
  text 0,0,"FPS: "+str$(screen fps())
  sync:cls
Loop

rem === FUNCTIONS ===
Function Planet_Name$()
  rem Empty the string.
  planet$=""
  rem Define number of character pairs to generate.
  name_len = rnd(2)+1

for i = 0 to name_len
    rem After first letter switch to lower case.
    if i>0 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(4)
        if child=0 then planet$=planet$+"l"
        if child=1 then planet$=planet$+"n"
        if child=2 then planet$=planet$+"r"
        if child=3 then planet$=planet$+"s"
        if child=4 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
    Endselect
  next i
Endfunction planet$
`//

Function Planet_Desc$(planet$)
  rem Get the "ian" word for the planet i.e. "Iranian" for "Iran"
  last$=right$(planet$,1)
  rem Remove ending vowel.
  if last$="a" or last$="e" or last$="i" or last$="o" or last$="u"
    namian$ = left$(planet$,len(planet$)-1)+"ian"
  else
    namian$ = planet$+"ian"
  endif

rem Use a stacked number to generate descriptions.
  rem This needs to be planned out better to give a more unique appearence.
  d = rnd(31)
  rem is the "This/The"(0/1) bit set to "The"(1)?
  if (d&1) = 1
    rem The "This/The" bit = 1("The") in here.
    rem is the "Planet/World"(1/3) bit set to "World"(3)?
    if (d&2) = 2
      rem Binary = 11 (3).
      desc$ = "The world "+planet$
    else
      rem Binary = 01 (1).
      desc$ = "The planet "+planet$
    endif
  else
    rem The "This/The" bit = 0("This") in here.
    rem Is the "Planet/World"(0/2) bit set to "World"(2)?
    if (d&2) = 2
      rem Binary = 10 (2).
      desc$ = "This world"
    else
      rem Binary = 00 (0).
      desc$ = "This planet"
    endif
  endif
  rem What is it famous for?
  if (d&4)=4
    desc$ = desc$+" is famous for "+namian$+" evil juice"
  else
    desc$ = desc$+" is famous for zero-g cricket"
  endif
  rem Do they love stuff?
  if (d&8)=8
    desc$=desc$+" and its inhabitants' love of "
    if (d&16)=16
      desc$=desc$+"spoons"
    else
      desc$=desc$+"Dark Basic"
    endif
  endif
  rem Endo story.
  desc$=desc$+"."
Endfunction desc$
`//

+ Code Snippet

rem Name: Galaxy Generator
rem Author: OBese87
rem ---------------
hide mouse
sync on
sync rate 60
rem Set the galaxy seed: changing this will produce unique galaxies.
galaxy = 100
rem set cursor origin
cx=320:cy=160

rem === MAIN ===
Do
  rem Control cursor.
  u=upkey():r=rightkey():d=downkey():l=leftkey()
  cx=cx+r-l : cy=cy+d-u
  if cx<20 then cx=20
  if cx>620 then cx=620
  if cy<20 then cy=20
  if cy>310 then cy=310
  rem change origin planet
  if returnkey()=1 then neworigin=1
  rem snap to origin planet
  if inkey$()="o" then snaporigin=1

  `= Draw the Galaxy =
  ink -2,0
  rem Seed the galaxy.
  randomize galaxy
  rem Draw Border.
  bw = 3 : rem border width.
  box 20-bw,20-bw,620+bw,20
  box 620,20,620+bw,310+bw
  box 20-bw,310,620+bw,310+bw
  box 20-bw,20-bw,20,310+bw
  rem Draw planets.
  for i = 0 to 999
    px = rnd(596)+22
    py = rnd(286)+22
    ink -2,0
    box px-rnd(1),py-rnd(1),px+rnd(1),py+rnd(1)
    rem if cursor on planet store planet number for later
    if abs(cx-px)<2 and abs(cy-py)<2
      info=1
      planeti = i
    endif
    rem Draw origin cursor.
    if i=origin
      ink 65535,0
      box px-15,py,px+15,py
      box px,py-15,px,py+15
      ink 0,0
      dot px,py
      rem Snap planet cursor to origin planet after "o" pressed.
      if snaporigin=1 then cx=px : cy=py : snaporigin=0
    endif
  next i

  rem Display planet info.
  if info=1
    info=0
    rem Seed specific planet.
    randomize galaxy*1000+planeti
    planet$ = Planet_Name$()
    text 20,320,upper$(planet$):`+" "+str$(planeti) :`planet number.
    text 20,340,Planet_Desc$(planet$)
    rem set origin
    if neworigin=1 then origin=planeti : neworigin=0
  endif

  rem Draw user cursor.
  ink 65535,0
  box cx-10,cy,cx+10,cy
  box cx,cy-10,cx,cy+10
  ink 0,0
  dot cx,cy
  rem Tell user what the frick to do.
  ink 65535,0
  text 0,420,"Use arrow keys to move the cursor. Press 'o' to snap to the origin planet."
  text 0,440,"Press RETURN to set the current planet as the new origin."
  text 0,460,"To change galaxy press ESC to bring up the CLI and type 'galaxy = [integer]'"
  rem Program info.
  text 0,0,"FPS: "+str$(screen fps())
  sync:cls
Loop

rem === FUNCTIONS ===
Function Planet_Name$()
  rem Empty the string.
  planet$=""
  rem Define number of character pairs to generate.
  name_len = rnd(2)+1

  for i = 0 to name_len
    rem After first letter switch to lower case.
    if i>0 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(4)
        if child=0 then planet$=planet$+"l"
        if child=1 then planet$=planet$+"n"
        if child=2 then planet$=planet$+"r"
        if child=3 then planet$=planet$+"s"
        if child=4 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
    Endselect
  next i
Endfunction planet$
`//

Function Planet_Desc$(planet$)
  rem Get the "ian" word for the planet i.e. "Iranian" for "Iran"
  last$=right$(planet$,1)
  rem Remove ending vowel.
  if last$="a" or last$="e" or last$="i" or last$="o" or last$="u"
    namian$ = left$(planet$,len(planet$)-1)+"ian"
  else
    namian$ = planet$+"ian"
  endif

  rem Use a stacked number to generate descriptions.
  rem This needs to be planned out better to give a more unique appearence.
  d = rnd(31)
  rem is the "This/The"(0/1) bit set to "The"(1)?
  if (d&1) = 1
    rem The "This/The" bit = 1("The") in here.
    rem is the "Planet/World"(1/3) bit set to "World"(3)?
    if (d&2) = 2
      rem Binary = 11 (3).
      desc$ = "The world "+planet$
    else
      rem Binary = 01 (1).
      desc$ = "The planet "+planet$
    endif
  else
    rem The "This/The" bit = 0("This") in here.
    rem Is the "Planet/World"(0/2) bit set to "World"(2)?
    if (d&2) = 2
      rem Binary = 10 (2).
      desc$ = "This world"
    else
      rem Binary = 00 (0).
      desc$ = "This planet"
    endif
  endif
  rem What is it famous for?
  if (d&4)=4
    desc$ = desc$+" is famous for "+namian$+" evil juice"
  else
    desc$ = desc$+" is famous for zero-g cricket"
  endif
  rem Do they love stuff?
  if (d&8)=8
    desc$=desc$+" and its inhabitants' love of "
    if (d&16)=16
      desc$=desc$+"spoons"
    else
      desc$=desc$+"Dark Basic"
    endif
  endif
  rem Endo story.
  desc$=desc$+"."
Endfunction desc$
`//

Compressed:

hide mouse:sync on:sync rate 60:galaxy = 100:cx=320:cy=160:Do:u=upkey():r=rightkey():d=downkey():l=leftkey():cx=cx+r-l : cy=cy+d-u:if cx<20:cx=20:endif:if cx>620:cx=620:endif:if cy<20:cy=20:endif:if cy>310:cy=310:endif
if returnkey()=1:neworigin=1:endif:if inkey$()="o":snaporigin=1:endif:ink -2,0:randomize galaxy:bw=3:box 20-bw,20-bw,620+bw,20:box 620,20,620+bw,310+bw:box 20-bw,310,620+bw,310+bw:box 20-bw,20-bw,20,310+bw:for i=0 to 999
px=rnd(596)+22:py=rnd(286)+22:ink -2,0:box px-rnd(1),py-rnd(1),px+rnd(1),py+rnd(1):if abs(cx-px)<2 and abs(cy-py)<2:info=1:planeti=i:endif:if i=origin:ink 65535,0:box px-15,py,px+15,py:box px,py-15,px,py+15:ink 0,0:dot px,py
if snaporigin=1:cx=px:cy=py:snaporigin=0:endif:endif:next i:if info=1:info=0:randomize galaxy*1000+planeti:planet$=Planet_Name$():text 20,320,upper$(planet$):text 20,340,Planet_Desc$(planet$):if neworigin=1:origin=planeti:neworigin=0
endif:endif:ink 65535,0:box cx-10,cy,cx+10,cy:box cx,cy-10,cx,cy+10:ink 0,0:dot cx,cy:ink 65535,0:text 0,420,"Use arrow keys to move the cursor. Press 'o' to snap to the origin planet."
text 0,440,"Press RETURN to set the current planet as the new origin.":text 0,460,"To change galaxy press ESC to bring up the CLI and type 'galaxy = [integer]'":text 0,0,"FPS: "+str$(screen fps()):sync:cls:Loop
Function Planet_Name$()
planet$="":name_len=rnd(2)+1
for i=0 to name_len:not=0:if i>0:capoff=32:else:capoff=0:endif:Parent = rnd(25)+65:if i=name_len:if Parent=81:Parent=Parent-1-rnd(15):endif:endif:planet$ = planet$+chr$(Parent+capoff):if Parent=81:not=1:planet$=planet$+"u":endif
If parent=(65 or 69 or 73 or 79 or 85):not=1:child = rnd(4):if child=0:planet$=planet$+"l":endif:if child=1:planet$=planet$+"n":endif:if child=2:planet$=planet$+"r":endif:if child=3:planet$=planet$+"s":endif:if child=4:planet$=planet$+"t"
endif:endif:if not=0:child=rnd(4):if child=0:planet$=planet$+"a":endif:if child=1:planet$=planet$+"e":endif:if child=2:planet$=planet$+"i":endif:if child=3:planet$=planet$+"o":endif:if child=4:planet$=planet$+"u":endif:endif:next i
Endfunction planet$
Function Planet_Desc$(planet$)
last$=right$(planet$,1):if last$="a" or last$="e" or last$="i" or last$="o" or last$="u":namian$ = left$(planet$,len(planet$)-1)+"ian":else:namian$ = planet$+"ian":endif
d = rnd(31):if (d&1)=1:if (d&2)=2:desc$ = "The world "+planet$:else:desc$ = "The planet "+planet$:endif:else:if (d&2) = 2:desc$ = "This world":else:desc$ = "This planet":endif:endif
if (d&4)=4:desc$ = desc$+" is famous for "+namian$+" evil juice":else:desc$ = desc$+" is famous for zero-g cricket":endif
if (d&8)=8:desc$=desc$+" and its inhabitants' love of ":if (d&16)=16:desc$=desc$+"spoons":else:desc$=desc$+"Dark Basic":endif:endif:desc$=desc$+"."
Endfunction desc$

+ Code Snippet

hide mouse:sync on:sync rate 60:galaxy = 100:cx=320:cy=160:Do:u=upkey():r=rightkey():d=downkey():l=leftkey():cx=cx+r-l : cy=cy+d-u:if cx<20:cx=20:endif:if cx>620:cx=620:endif:if cy<20:cy=20:endif:if cy>310:cy=310:endif
if returnkey()=1:neworigin=1:endif:if inkey$()="o":snaporigin=1:endif:ink -2,0:randomize galaxy:bw=3:box 20-bw,20-bw,620+bw,20:box 620,20,620+bw,310+bw:box 20-bw,310,620+bw,310+bw:box 20-bw,20-bw,20,310+bw:for i=0 to 999
px=rnd(596)+22:py=rnd(286)+22:ink -2,0:box px-rnd(1),py-rnd(1),px+rnd(1),py+rnd(1):if abs(cx-px)<2 and abs(cy-py)<2:info=1:planeti=i:endif:if i=origin:ink 65535,0:box px-15,py,px+15,py:box px,py-15,px,py+15:ink 0,0:dot px,py
if snaporigin=1:cx=px:cy=py:snaporigin=0:endif:endif:next i:if info=1:info=0:randomize galaxy*1000+planeti:planet$=Planet_Name$():text 20,320,upper$(planet$):text 20,340,Planet_Desc$(planet$):if neworigin=1:origin=planeti:neworigin=0
endif:endif:ink 65535,0:box cx-10,cy,cx+10,cy:box cx,cy-10,cx,cy+10:ink 0,0:dot cx,cy:ink 65535,0:text 0,420,"Use arrow keys to move the cursor. Press 'o' to snap to the origin planet."
text 0,440,"Press RETURN to set the current planet as the new origin.":text 0,460,"To change galaxy press ESC to bring up the CLI and type 'galaxy = [integer]'":text 0,0,"FPS: "+str$(screen fps()):sync:cls:Loop
Function Planet_Name$()
planet$="":name_len=rnd(2)+1
for i=0 to name_len:not=0:if i>0:capoff=32:else:capoff=0:endif:Parent = rnd(25)+65:if i=name_len:if Parent=81:Parent=Parent-1-rnd(15):endif:endif:planet$ = planet$+chr$(Parent+capoff):if Parent=81:not=1:planet$=planet$+"u":endif
If parent=(65 or 69 or 73 or 79 or 85):not=1:child = rnd(4):if child=0:planet$=planet$+"l":endif:if child=1:planet$=planet$+"n":endif:if child=2:planet$=planet$+"r":endif:if child=3:planet$=planet$+"s":endif:if child=4:planet$=planet$+"t"
endif:endif:if not=0:child=rnd(4):if child=0:planet$=planet$+"a":endif:if child=1:planet$=planet$+"e":endif:if child=2:planet$=planet$+"i":endif:if child=3:planet$=planet$+"o":endif:if child=4:planet$=planet$+"u":endif:endif:next i
Endfunction planet$
Function Planet_Desc$(planet$)
last$=right$(planet$,1):if last$="a" or last$="e" or last$="i" or last$="o" or last$="u":namian$ = left$(planet$,len(planet$)-1)+"ian":else:namian$ = planet$+"ian":endif
d = rnd(31):if (d&1)=1:if (d&2)=2:desc$ = "The world "+planet$:else:desc$ = "The planet "+planet$:endif:else:if (d&2) = 2:desc$ = "This world":else:desc$ = "This planet":endif:endif
if (d&4)=4:desc$ = desc$+" is famous for "+namian$+" evil juice":else:desc$ = desc$+" is famous for zero-g cricket":endif
if (d&8)=8:desc$=desc$+" and its inhabitants' love of ":if (d&16)=16:desc$=desc$+"spoons":else:desc$=desc$+"Dark Basic":endif:endif:desc$=desc$+"."
Endfunction desc$

HowDo kindly ported my code to DBP, so all you modern types can marvel in the wonders of the universe.

rem Name: Galaxy Generator
rem Author: OBese87
rem ---------------
hide mouse
sync on
sync rate 60
rem Set the galaxy seed: changing this will produce unique galaxies.
galaxy = 100
rem set cursor origin
cx=320:cy=160
backdrop on
color backdrop 0
rem === MAIN ===
Do
  rem Control cursor.
  u=upkey():r=rightkey():d=downkey():l=leftkey()
  cx=cx+r-l : cy=cy+d-u
  if cx<20 then cx=20
  if cx>620 then cx=620
  if cy<20 then cy=20
  if cy>310 then cy=310
  rem change origin planet
  if returnkey()=1 then neworigin=1
  rem snap to origin planet
  if inkey$()="o" then snaporigin=1

`= Draw the Galaxy =
  ink -2,0
  rem Seed the galaxy.
  randomize galaxy
  rem Draw Border.
  bw = 3 : rem border width.
  box 20-bw,20-bw,620+bw,20
  box 620,20,620+bw,310+bw
  box 20-bw,310,620+bw,310+bw
  box 20-bw,20-bw,20,310+bw
  rem Draw planets.
  for i = 0 to 999
    px = rnd(596)+22
    py = rnd(286)+22
    ink -2,0
    box px-rnd(1),py-rnd(1),px+rnd(1),py+rnd(1)
    rem if cursor on planet store planet number for later
    if abs(cx-px)<2 and abs(cy-py)<2
      info=1
      planeti = i
    endif
    rem Draw origin cursor.
    if i=origin
     ink rgb(255,255,255),0
      line px-15,py,px+15,py
      line px,py-15,px,py+15
      ink 0,0
      dot px,py
      rem Snap planet cursor to origin planet after "o" pressed.
      if snaporigin=1 then cx=px : cy=py : snaporigin=0
    endif
  next i

rem Display planet info.
  if info=1
    info=0
    rem Seed specific planet.
    randomize galaxy*1000+planeti
    planet$ = Planet_Name$()
    text 20,320,upper$(planet$):`+" "+str$(planeti) :`planet number.
    text 20,340,Planet_Desc$(planet$)
    rem set origin
    if neworigin=1 then origin=planeti : neworigin=0
  endif

rem Draw user cursor.
  line cx-10,cy,cx+10,cy
  line cx,cy-10,cx,cy+10
  ink 0 ,0
  dot cx,cy
  rem Tell user what the frick to do.
  ink rgb(255,255,255) ,0
  text 0,420,"Use arrow keys to move the cursor. Press 'o' to snap to the origin planet."
  text 0,440,"Press RETURN to set the current planet as the new origin."
  text 0,460,"To change galaxy press ESC to bring up the CLI and type 'galaxy = [integer]'"
  rem Program info.
  text 0,0,"FPS: "+str$(screen fps())
  sync
Loop

rem === FUNCTIONS ===
Function Planet_Name$()
local child
  rem Empty the string.
  planet$=""
  rem Define number of character pairs to generate.
  name_len = rnd(2)+1

for i = 0 to name_len
    rem After first letter switch to lower case.
    if i>0 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 , 69 , 73 , 79 , 85
        child = rnd(4)
        if child = 0 then planet$=planet$+"l"
        if child=1 then planet$=planet$+"n"
        if child=2 then planet$=planet$+"r"
        if child=3 then planet$=planet$+"s"
        if child=4 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
    Endselect
  next i
Endfunction planet$
`//

Function Planet_Desc$(planet$)
  rem Get the "ian" word for the planet i.e. "Iranian" for "Iran"
  last$=right$(planet$,1)
  rem Remove ending vowel.
  if last$="a" or last$="e" or last$="i" or last$="o" or last$="u"
    namian$ = left$(planet$,len(planet$)-1)+"ian"
  else
    namian$ = planet$+"ian"
  endif

rem Use a stacked number to generate descriptions.
  rem This needs to be planned out better to give a more unique appearence.
  d = rnd(31)
  rem is the "This/The"(0/1) bit set to "The"(1)?
  if (d&&1) = 1
    rem The "This/The" bit = 1("The") in here.
    rem is the "Planet/World"(1/3) bit set to "World"(3)?
    if (d && 2) = 2
      rem Binary = 11 (3).
      desc$ = "The world "+planet$
    else
      rem Binary = 01 (1).
      desc$ = "The planet "+planet$
    endif
  else
    rem The "This/The" bit = 0("This") in here.
    rem Is the "Planet/World"(0/2) bit set to "World"(2)?
    if (d&&2) = 2
      rem Binary = 10 (2).
      desc$ = "This world"
    else
      rem Binary = 00 (0).
      desc$ = "This planet"
    endif
  endif
  rem What is it famous for?
  if (d&&4)=4
    desc$ = desc$+" is famous for "+namian$+" evil juice"
  else
    desc$ = desc$+" is famous for zero-g cricket"
  endif
  rem Do they love stuff?
  if (d&&8)=8
    desc$=desc$+" and its inhabitants' love of "
    if (d&&16)=16
      desc$=desc$+"spoons"
    else
      desc$=desc$+"Dark Basic"
    endif
  endif
  rem Endo story.
  desc$=desc$+"."
Endfunction desc$

+ Code Snippet

rem Name: Galaxy Generator
rem Author: OBese87
rem ---------------
hide mouse
sync on
sync rate 60
rem Set the galaxy seed: changing this will produce unique galaxies.
galaxy = 100
rem set cursor origin
cx=320:cy=160
backdrop on
color backdrop 0
rem === MAIN ===
Do
  rem Control cursor.
  u=upkey():r=rightkey():d=downkey():l=leftkey()
  cx=cx+r-l : cy=cy+d-u
  if cx<20 then cx=20
  if cx>620 then cx=620
  if cy<20 then cy=20
  if cy>310 then cy=310
  rem change origin planet
  if returnkey()=1 then neworigin=1
  rem snap to origin planet
  if inkey$()="o" then snaporigin=1

  `= Draw the Galaxy =
  ink -2,0
  rem Seed the galaxy.
  randomize galaxy
  rem Draw Border.
  bw = 3 : rem border width.
  box 20-bw,20-bw,620+bw,20
  box 620,20,620+bw,310+bw
  box 20-bw,310,620+bw,310+bw
  box 20-bw,20-bw,20,310+bw
  rem Draw planets.
  for i = 0 to 999
    px = rnd(596)+22
    py = rnd(286)+22
    ink -2,0
    box px-rnd(1),py-rnd(1),px+rnd(1),py+rnd(1)
    rem if cursor on planet store planet number for later
    if abs(cx-px)<2 and abs(cy-py)<2
      info=1
      planeti = i
    endif
    rem Draw origin cursor.
    if i=origin
     ink rgb(255,255,255),0
      line px-15,py,px+15,py
      line px,py-15,px,py+15
      ink 0,0
      dot px,py
      rem Snap planet cursor to origin planet after "o" pressed.
      if snaporigin=1 then cx=px : cy=py : snaporigin=0
    endif
  next i

  rem Display planet info.
  if info=1
    info=0
    rem Seed specific planet.
    randomize galaxy*1000+planeti
    planet$ = Planet_Name$()
    text 20,320,upper$(planet$):`+" "+str$(planeti) :`planet number.
    text 20,340,Planet_Desc$(planet$)
    rem set origin
    if neworigin=1 then origin=planeti : neworigin=0
  endif

  rem Draw user cursor.
  line cx-10,cy,cx+10,cy
  line cx,cy-10,cx,cy+10
  ink 0 ,0
  dot cx,cy
  rem Tell user what the frick to do.
  ink rgb(255,255,255) ,0
  text 0,420,"Use arrow keys to move the cursor. Press 'o' to snap to the origin planet."
  text 0,440,"Press RETURN to set the current planet as the new origin."
  text 0,460,"To change galaxy press ESC to bring up the CLI and type 'galaxy = [integer]'"
  rem Program info.
  text 0,0,"FPS: "+str$(screen fps())
  sync
Loop

rem === FUNCTIONS ===
Function Planet_Name$()
local child
  rem Empty the string.
  planet$=""
  rem Define number of character pairs to generate.
  name_len = rnd(2)+1

  for i = 0 to name_len
    rem After first letter switch to lower case.
    if i>0 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 , 69 , 73 , 79 , 85
        child = rnd(4)
        if child = 0 then planet$=planet$+"l"
        if child=1 then planet$=planet$+"n"
        if child=2 then planet$=planet$+"r"
        if child=3 then planet$=planet$+"s"
        if child=4 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
    Endselect
  next i
Endfunction planet$
`//

Function Planet_Desc$(planet$)
  rem Get the "ian" word for the planet i.e. "Iranian" for "Iran"
  last$=right$(planet$,1)
  rem Remove ending vowel.
  if last$="a" or last$="e" or last$="i" or last$="o" or last$="u"
    namian$ = left$(planet$,len(planet$)-1)+"ian"
  else
    namian$ = planet$+"ian"
  endif

  rem Use a stacked number to generate descriptions.
  rem This needs to be planned out better to give a more unique appearence.
  d = rnd(31)
  rem is the "This/The"(0/1) bit set to "The"(1)?
  if (d&&1) = 1
    rem The "This/The" bit = 1("The") in here.
    rem is the "Planet/World"(1/3) bit set to "World"(3)?
    if (d && 2) = 2
      rem Binary = 11 (3).
      desc$ = "The world "+planet$
    else
      rem Binary = 01 (1).
      desc$ = "The planet "+planet$
    endif
  else
    rem The "This/The" bit = 0("This") in here.
    rem Is the "Planet/World"(0/2) bit set to "World"(2)?
    if (d&&2) = 2
      rem Binary = 10 (2).
      desc$ = "This world"
    else
      rem Binary = 00 (0).
      desc$ = "This planet"
    endif
  endif
  rem What is it famous for?
  if (d&&4)=4
    desc$ = desc$+" is famous for "+namian$+" evil juice"
  else
    desc$ = desc$+" is famous for zero-g cricket"
  endif
  rem Do they love stuff?
  if (d&&8)=8
    desc$=desc$+" and its inhabitants' love of "
    if (d&&16)=16
      desc$=desc$+"spoons"
    else
      desc$=desc$+"Dark Basic"
    endif
  endif
  rem Endo story.
  desc$=desc$+"."
Endfunction desc$

Do oranges know what colour they are?

Back to top

Profile PM Email

Libervurto

16

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 25th Mar 2010 02:53 Edited at: 25th Mar 2010 02:54

Link

No comments?
How does my damaged film get commented on and not this?

"With games, we create these elaborate worlds in our minds, and the computer is there to do the bookkeeping." - Will Wright

Back to top

Profile PM Email

GreenDixy

14

Years of Service

User Offline

Joined: 24th Jul 2008

Location: Toronto

Posted: 25th Mar 2010 11:04

Link

sometimes the forums goes dead for awhile depending on the time of day as for me i just got no life atm so i crawl forums im on haha

===================
No life, Lots of love, 2 Kids, God save me LOL

Back to top

Profile PM Email

Benjames8

13

Years of Service

User Offline

Joined: 6th Jan 2010

Location: Your Nightmares

Posted: 19th Apr 2010 08:15 Edited at: 19th Apr 2010 08:23

Link

I dont get it. There where like a bunch of simple errors and after I fixed them all it is, is a star feild.

edit ... O well nvmd I kinda get it but not really. What exactly is the point here?

edit my favorite planit heju.

Back to top

Profile PM Email

Indicium

15

Years of Service

User Offline

Joined: 26th May 2008

Location:

Posted: 24th Apr 2010 03:38 Edited at: 24th Apr 2010 03:39

Link

won't run.

edit: nevermind, dbc

Rawwrr. Sig Fail.
Newcastle is awesome

Back to top

Profile PM

Libervurto

16

Years of Service

User Offline

Joined: 30th Jun 2006

Location: On Toast

Posted: 25th Apr 2010 22:38 Edited at: 25th Apr 2010 22:44

Link

I don't understand why this doesn't work in DBP.
BenJames could you post your edited code if you still have it please.

The program generates 1000 planets: each planet's position, size, name and description are all procedurally generated. Nothing is even stored. The program uses about 1.4mb RAM.

You can change the galaxy seed to generate a near infinite amount of different galaxies. It's not quite infinite because the map size is finite and there are only so many combinations for the planet names.

I've attached an EXE as it doesn't seem to be working for DBP users.
Unfortunately you cannot change the galaxy as this was done via the CLI

Attachments

Login to view attachments

Back to top

Profile PM Email

Indicium

15

Years of Service

User Offline

Joined: 26th May 2008

Location:

Posted: 30th Apr 2010 01:02

Link

CASE needs a literal parameter at line 116.

Rawwrr. Sig Fail.
Newcastle is awesome

Back to top

Profile PM

HowDo

20

Years of Service

User Offline

Joined: 28th Nov 2002

Location: United Kingdom

Posted: 19th May 2010 11:48 Edited at: 20th May 2010 18:22

Link

@OBese87

Hope you don't mined ,have made it work for DBP.