[nbos] [AS] Make habitable Script
Daniel Williamson
Mon Apr 9th, 2007
OK,

My second modification of the Big Bang script. This one keeps regenerating the contents of the selected star (and any companion stars if the main system is selected, in theory) until at least one of the child bodies is Hospitable.

I have not tried it with a multiple star system yet. I would caution you to save before you run this as it should be considered an alpha release. It can be run by hitting control-h.

Easy.

I really need a VBScript/VB reference before I take on more ambitious projects like the find spectral classes in distance script that Mike Oliver has requested.

Dan Williamson
Baltimore

___________________________________________________
"Umm..."


MakeHabitable.astroscript


#plugin Make Hospitable (Ctrl+H)
#author Dan Williamson Monday, April 09, 2007 at 9:35 PM
#desc Generate System Contents in a system until there is a Hospitable planet in the system.
#menuhotkey Ctrl+H

cancelled = False
sector = GetCurrentSector()
NumberOfAttempts = 0
ScanSystems
RefreshScene

Sub ScanSystems
sector.RenderMessageBig = "Making this system habitable. Hit [ESC] to cancel and [P] to pause processing..."
RefreshScene

ProcessSystem()

If (cancelled) Then Exit Sub

sector.UpdateVisibleCount
End Sub

Sub ProcessSystem()
CheckIfCancelled
If (cancelled) Then Exit Sub
CheckIfPaused

aSystem = EditingBody()

If not aSystem.Loaded Then
sector.DynaLoad aSystem
End If

' This flag is set to 1 if the system contains a white dwarf
' It indicates that no planets are to be found in the system.
noplanets = 0

' If the system is of Type Multiple
If aSystem.TypeID = BODY_TYPE_MULT Then
' Only create child bodies for each substar individually.

' Check for the presence of a White Dwarf in the system
For currentStar = 1 to aSystem.ChildrenCount()
thisStar = aSystem.getChild(currentStar-1)
If thisStar.TypeID = BODY_TYPE_WHITEDWARF Then
noplanets = 1
End If
Next

' If there is no White Dwarf, then we can go ahead and generate the system contents for
' each star individually
If noplanets = 0 Then
For currentStar = 1 to aSystem.ChildrenCount()
thisStar = aSystem.getChild(currentStar-1)
If thisStar.TypeID = BODY_TYPE_STAR Then
RegenerateSystem thisStar
End If
Next
End If
End If

' If the system is of Type Star (not White Dwarf), we can go ahead and generate a full system.
If aSystem.TypeID = BODY_TYPE_STAR Then
RegenerateSystem aSystem
End If

If (cancelled) Then Exit Sub

If (aSystem.ChildrenCount() = 0) Then Exit Sub

'if system is populated, change the label color
if aSystem.ChildPopulation > 0 then
aSystem.LabelColor = rgb( 128, 255, 0)
end if

If (cancelled) Then Exit Sub

'do this so that astro can keep track of things like populations & political affiliations more efficiently
If (sector.Modified = True) Then
aSystem.UpdateRootBody
End If
End Sub

Sub RegenerateSystem( aSystem )
' save name
temp = aSystem.Name
habitable = False

Do
aSystem.ClearFields
RandomSystem aSystem, true 'use built-in astro generator, w/ populations.
aSystem.Name = temp 'restore name in case it gets cancelled.

' Don't need to remove space stations as they are not considered hospitable.

' Check for habitability
If aSystem.GetMaxChildHabitability() > HAB_HABITABLE Then
habitable = True
End If

'check for a cancel
CheckIfCancelled
If (cancelled) Then Exit Sub
CheckIfPaused
Loop While Not (habitable)

End Sub

Sub CheckIfCancelled
If (cancelled = False) Then
cancelled = (GetKey() = 27)
End If
End Sub

sub CheckIfPaused
If ((GetKey() = 80) Or (GetKey() = 112)) Then
sector.RenderMessageBig = "Processing paused. Hit [P] to continue processing."
RefreshScene

KeyPressed = GetKey()
Do While (KeyPressed <> 80) And (KeyPressed <> 112)
Pause 500
KeyPressed = GetKey()
Loop

sector.RenderMessageBig = "Making this system habitable. Hit [ESC] to cancel and [P] to pause processing..."
RefreshScene
End If
End Sub






____________________________________________________________________________________
Don't pick lemons.
See all the new 2007 cars at Yahoo! Autos.
http://autos.yahoo.com/new_cars.html
_______________________________________________
Nbossoftware mailing list


Copyright © 2003-2007, NBOS Software. All rights reserved. 'Fractal Mapper', 'ScreenMonkey', 'Character Sketcher', 'Inspiration Pad', 'Fractal World Explorer', 'Goblin API', 'AstroSynthesis' are trademarks of NBOS Software. 'Dwarven Beserker' art by V. Shane.
Member contributed resources