Microsoft Small Basic

Program Listing: MXP129-0
'_________________________________________________________________'
' Perlin's Scene Generator
' by Amir CPS
' Graphical Challenge (2012/Nov)

' MXP129-0

' http://social.msdn.microsoft.com/Forums/en-US/smallbasic
' /thread/15b8d568-1420-4b3e-b424-42bade37acd3
'_________________________________________________________________'
gw = 640
gh = 480
ghLim1 = Math.Round(gh*97/100)
ghLim2 = Math.Round(gh*83/100)

GraphicsWindow.Title = "Perlin's Scene Generator"
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
GraphicsWindow.BackgroundColor = "LightGray"

isNight = "Tru" ' Set "False" for day / "True" for night
showTree = "True" ' Set "True" to show tree

noiseFunc = 3 ' lower values flatter the hills
ampFunc = 128 ' lower values lower hills height
freqFunc = 6

GraphicsWindow.KeyDown = KeyPressed
GraphicsWindow.MouseDown = KeyPressed
'_________________________________________________________________'
KeepGoing:

time0 = Clock.ElapsedMilliseconds

GraphicsWindow.Clear()

Landscape()

If showTree Then
TreeRange()
EndIf

Sound.PlayChimes()

timeDelta = (Clock.ElapsedMilliseconds - time0) / 1000
GraphicsWindow.Title = "Scene Generator - Elapsed: " + timeDelta + "s"

toWait = "True"
While toWait
Program.Delay(200)
EndWhile

Sound.PlayClickAndWait()

Goto KeepGoing
'_________________________________________________________________'
Sub Landscape

If isNight Then
col = 20
Else
col = 180
EndIf

sw = "True"
lowR = 50
lowMount = 0
startVal1 = ampFunc
startVal2 = freqFunc

' draw 6 mountain ranges
For chain=1 To 6
newVal1 = startVal1 * 2
newVal2 = startVal2 / 2

'each mountain range consists of Perlin noise functions with
'decreasing amplitude and increasing frequency
For inc=1 To noiseFunc
newVal1 = newVal1 / 2
newVal2 = newVal2 * 2
amplitude = newVal1
frequency = newVal2

seed = Math.GetRandomNumber(10) / 10
seed = seed / Math.GetRandomNumber(10)
Perlin()
EndFor

'draw the mountain range
GraphicsWindow.PenColor = GraphicsWindow.GetColorFromRGB(col,col,col)

For i=0 To gw
upperY = range[i] + lowMount

If upperY>ghLim1 Then
upperY = ghLim1
ElseIf upperY<0 Then
upperY = 0
EndIf

GraphicsWindow.DrawLine(i-1,upperY i-1,gh)
EndFor

lowMount = lowMount + lowR
lowR = lowR + 15

'reset For next range
range = ""

'make color darker
If isNight Then
col = col + 6
Else
col = col - 23
EndIf
EndFor

EndSub
'_________________________________________________________________'
Sub TreeRange

If isNight Then
colG = 40
Else
colG = 60
EndIf

sw = "True"
lowR = 380
lowMount = 0
startVal1 = 50
startVal2 = 128

'draw 2 tree ranges
newVal1 = startVal1 * 2
newVal2 = startVal2 / 2

'the tree range consists of 2 Perlin noise functions with
'decreasing amplitude and increasing frequency
For inc=1 To 2
newVal1 = newVal1 / 2
newVal2 = newVal2 * 3
amplitude = newVal1
frequency = newVal2

seed = Math.GetRandomNumber(10) / 10
Perlin()
EndFor

'draw the tree range
GraphicsWindow.PenColor = GraphicsWindow.GetColorFromRGB(30,colG,30)

For i=0 To gw
upperY = range[i] + ghLim2
If upperY>ghLim1 Then
upperY = ghLim1
ElseIf upperY<0 Then
upperY = 0
EndIf

GraphicsWindow.DrawLine(i,upperY i,gh)

EndFor

lowMount = lowMount + lowR

'reset For next range
range = ""

EndSub
'_________________________________________________________________'
Sub Perlin

k = 0

For zz=1 To frequency
MyRnd()

pointA = pointB
pointB = a

periodStep = 1 / (gw/frequency)

For x=0 To 1 Step periodStep
If sw Then
f = ( 1 - Math.Cos(x * 3.14) ) / 2
interp = pointA*(1-f) + pointB*f
Else
interp = pointA*(1-x) + pointB*x
EndIf

range[k] = range[k] + interp*amplitude
k = k + 1
EndFor

EndFor

EndSub
'_________________________________________________________________'
Sub MyRnd

seed = seed*221 + 2113
seed = seed - Math.Round(seed/10000)*10000
a = seed/10000

EndSub
'_________________________________________________________________'
Sub KeyPressed

If GraphicsWindow.LastKey = "Escape" Then
Sound.PlayChimeAndWait()
Program.End()
Else
toWait = "False"
EndIf

EndSub
'_________________________________________________________________'