Microsoft Small Basic
Program Listing: MXP129-0
List Program
'_________________________________________________________________'
' 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
'_________________________________________________________________'