This is my simple star system generator.
It is 3D, obviously, and it is easily operated with arrowkeys to cycle between planets and spacekey to generate another system.
It is really simple, but I'm really proud of it, since it is the fifth star system generator I make and it is the first that doesn't rely on any external media file. Yeah, it makes everything by itself, but it is pretty minimalist as you can see.
set text size 100
GLOBAL KEYPRESS AS INTEGER
GLOBAL VIEW AS INTEGER
type star_data
x as integer
y as integer
z as integer
size as word
color as byte
planets as byte
seed as double integer
endtype
type planet_data
number as byte
size as byte
class as byte
mass as byte
speed as float
angle as float
tilt as float
DISTance as integer
seed as double integer
spin as float
rings as byte
endtype
sync on
sync rate 60
SET DISPLAY MODE 1366,768,32 : SET WINDOW LAYOUT 0,0,0 : MAXIMIZE WINDOW
color backdrop 0
SET AMBIENT LIGHT 0
set camera range 0,1,10000
fog off
autocam off
DO
RANDOMIZE TIMER()
make_system(1)
SET CAMERA FOV 0,90
REPEAT
star_atm(1)
//control camera using arrowkeys 0,5,2
VIEW = EXPLORE(1)
dynamics(1)
sync
UNTIL SPACEKEY() = 1
FOR O = 1 TO 100
IF OBJECT EXIST(O) = 1 THEN DELETE OBJECT O
IF IMAGE EXIST(O) = 1 THEN DELETE IMAGE O
Next
VIEW = 0 : UNDIM PLANET()
Loop
FUNCTION STAR(IMG,SIZE,COLOR)
IF COLOR = 0 : C1 = RGB(255,127,0) : C2 = RGB(255,255,0) : ENDIF
IF COLOR = 1 : C1 = RGB(0,255,255) : C2 = RGB(255,255,255) : ENDIF
IF COLOR = 2 : C1 = RGB(200,0,0) : C2 = RGB(255,100,0) : ENDIF
IF COLOR = 3 : C1 = RGB(255,255,255) : C2 = RGB(200,200,255) : ENDIF
IF COLOR = 4 : C1 = RGB(230,100,0) : C2 = RGB(255,200,0) : ENDIF
IF COLOR = 5 : C1 = RGB(30,0,0) : C2 = RGB(255,127,0) : ENDIF
w = 20 : h = 10
CREATE BITMAP IMG,W,H
s = (w*h)/2
cls c1
LOCK PIXELS
c = 0
repeat
x = rnd(w) : y = rnd(h)
dot x,y,C2
inc c
Until c = s
UNLOCK PIXELS
get image IMG,0,0,w,h,1
DELETE BITMAP IMG
make object sphere IMG,SIZE
texture object IMG,IMG
SET OBJECT TEXTURE IMG,2,1
SC = RND(5)+1
SCALE OBJECT TEXTURE IMG,SC,SC
set object filter IMG,2
set object light IMG,0
SET SPOT LIGHT 0,360,360
SET LIGHT RANGE 0,3000
//COLOR light 0,c2
ENDFUNCTION
FUNCTION STAR_ATM(OBJ)
sx# = (rnd(100) * 0.01) - (rnd(100) * 0.01)
sy# = (rnd(100) * 0.01) - (rnd(100) * 0.01)
scroll object texture OBJ,sx#,sy#
POINT LIGHT 0,OBJECT POSITION X(OBJ),OBJECT POSITION Y(OBJ),OBJECT POSITION Z(OBJ)
POSITION LIGHT 0,OBJECT POSITION X(OBJ),OBJECT POSITION Y(OBJ),OBJECT POSITION Z(OBJ)
Endfunction
FUNCTION _planet(obj,SIZE,CLASS,RING)
if CLASS = 0
//hot rocky
mass = (rnd(3)*25)+25
color1= rgb(50+rnd(205),50+rnd(205),0)
color2= rgb(50+rnd(205),50+rnd(205),0)
Endif
if CLASS = 1
//terra
mass = (rnd(3)*25)+25
color1 = rgb(0,rnd(127),rnd(127)+127)
color2 = rgb(rnd(254)+1,rnd(254)+1,rnd(254)+1)
Endif
if CLASS = 2
//frozen giant
mass = (rnd(3)*25)+25
color1 = rgb(230+rnd(25),230+rnd(25),230+rnd(25))
color2 = rgb(127+rnd(127),127+rnd(127),127+rnd(127))
Endif
if CLASS = 3
//gas giant
mass = (rnd(2)*25)+50
color1 = rgb(rnd(254)+1,rnd(254)+1,rnd(254)+1)
color2 = rgb(rnd(254)+1,rnd(254)+1,rnd(254)+1)
Endif
if CLASS = 4
//luna
mass = rnd(95)+5
co1 = rnd(100)+155 : co2 = rnd(254)+1
color1 = rgb(co1,co1,co1)
color2 = rgb(co2,co2,co2)
Endif
W = SIZE : H = SIZE/2
CREATE BITMAP obj,W,H
CLS COLOR1
LOCK PIXELS
mass = 30+mass
L = 0 : LM = CEIL((W*H)/2) * (0.01 * mass)
REPEAT
X = RND(W) : Y = RND(H) : DOT X,Y,COLOR2 : inc l
Until L = LM
UNLOCK PIXELS
if CLASS = 3 then get image obj,0,0,1,h,1 else GET IMAGE obj,0,0,W,H,1 : DELETE BITMAP obj
MAKE OBJECT SPHERE OBJ,SIZE,W,H
TEXTURE OBJECT OBJ,OBJ
SET OBJECT FILTER OBJ,2
if RING = 1
WR = W*2.5
CREATE BITMAP OBJ+1,1,WR
cr1 = rgb(rnd(127)+127,rnd(127)+127,rnd(127)+127)
cr2 = rgb(rnd(200)+55,rnd(200)+55,rnd(200)+55)
LOCK PIXELS
cls 0
RI = WR/4.5
RS = RND(RI) : RE = RND(RI)
for r = (WR/2) + RS TO WR - RE
RT = RND(3)
if RT = 2 then LINE 0,R,2,R,cr1
IF RT = 3 THEN LINE 0,R,2,R,CR2
Next
UNLOCK PIXELS
get image OBJ+1,0,0,1,bitmap height(OBJ+1),1
delete bitmap OBJ+1
make OBJect sphere OBJ+1,W*2.5,2,24
scale OBJect OBJ+1,100,1,100
texture OBJect OBJ+1,OBJ+1
set OBJect texture OBJ+1,2,1
scale OBJect texture OBJ+1,1,2
set OBJect transparency OBJ+1,1
set OBJect cull OBJ+1,0
SET OBJECT FILTER OBJ+1,0
SET ALPHA MAPPING ON obj+1,25+(RND(3)*25)
glue OBJect to limb obj+1,obj,0
Endif
Endfunction
FUNCTION ORBITs(sn,Pn,DIST,ANGLE#)
sX = OBJECT POSITION X(sn)
SY = OBJECT POSITION Y(sn)
SZ = OBJECT POSITION Z(sn)
PX = SX + (SIN(ANGLE#) * DIST) : PZ = SZ+(COS(ANGLE#) * DIST)
POSITION OBJECT Pn,PX,SY,PZ
Endfunction
function show_orbits()
create bitmap 100,2000,2000
ink rgb(255,255,255)
get image 100,0,0,2000,2000,1
delete bitmap 100
make object plain 100,2000,2000
set object cull 100,0
texture object 100,100
pitch object up 100,90
set object transparency 100,1
set object light 100,0
set object filter 100,0
set object texture 100,0,1
Endfunction
function make_system(obj)
global sun as star_data
sun.size = rnd(150)+50
sun.color = rnd(5)
sun.planets = rnd(9)+1
sun.seed = rnd(1999999999)+1
star(obj,sun.size,sun.color)
randomize sun.seed
planet_attrib(obj)
Endfunction
function planet_attrib(obj)
d = sun.size*3
pobj = obj+1
dim planet(0) as planet_data
for p = 1 to sun.planets
array insert at bottom planet()
planet().number = p*2
planet().class = rnd(4)
if planet().class = 3 then planet().size = rnd(40)+40 else planet().size = rnd(30)+10
planet().speed = rnd(300)*0.001
planet().angle = rnd(359)
planet().tilt = rnd(90)
dc = (rnd(50)+50+planet().size*2)
planet().DISTance = dc + d
planet().seed = rnd(999999999999999)
planet().spin = (rnd(300) * 0.01) - (rnd(300) * 0.01)
planet().rings = rnd(4)
_planet(planet().number,planet().size,planet().class,planet().rings)
roll object left planet().number,planet().tilt
x = object position x(obj) : y = object position y(obj) : z = object position z(obj)
px = sin(planet().angle) * planet().distance
pz = cos(planet().angle) * planet().distance
position object planet().number,px,y,pz
inc d,dc
Next
ac = array count(planet())
create bitmap 100,3000,3000
for p = 1 to ac
d = planet(p).distance
circle 1500,1500,d
Next
get image 100,0,0,3000,3000,1
delete bitmap 100
make object plain 100,3000,3000
pitch object up 100,90
texture object 100,100
set object transparency 100,1
set object light 100,0
set object cull 100,0
set object filter 100,0
Endfunction
function dynamics(sn)
for p = 1 to array count(planet(0))
planet(p).angle = wrapvalue(planet(p).angle + planet(p).speed)
orbits(sn,planet(P).number,planet(p).distance,planet(p).ANGLE)
turn object left planet(p).number,planet(p).spin
Next
Endfunction
FUNCTION EXPLORE(sun)
IF LEFTKEY() = 1 AND KEYPRESS < TIMER() : VIEW = VIEW-1 : KEYPRESS = TIMER() + 500 : ENDIF
IF RIGHTKEY() = 1 AND KEYPRESS < TIMER() : VIEW = VIEW+1 : KEYPRESS = TIMER() + 500 : ENDIF
IF VIEW > ARRAY COUNT(PLANET()) THEN VIEW = ARRAY COUNT(PLANET())
IF VIEW < 0 THEN VIEW = 0
IF VIEW >= 1 THEN O = PLANET(VIEW).NUMBER ELSE O = sun
X = OBJECT POSITION X(O) : Y = OBJECT POSITION Y(O) : Z = OBJECT POSITION Z(O) : R = OBJECT SIZE X(O)*1.5
A = 0 : H = 5
SET CAMERA TO FOLLOW X,Y,Z,A,R,H,10,1
Endfunction VIEW
It's 333 lines long and it is part of something I am creating and that I'll share with this community as soon as it's done.
Any suggestions of enhancements - simple ones, please, I am trying to make this as simple as possible - will be welcome.
By the way, I need a name for the game. I used to call this project "Pixel Force", but I found out that it is already the name of an existing game - and since the third version it is 3D, so, no more pixels for me.
[size=+2]Forever and one[/size]
