Another update from ingydotnet^djgoku
This commit is contained in:
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
38
Task/Forest-fire/BASIC/forest-fire-1.basic
Normal file
38
Task/Forest-fire/BASIC/forest-fire-1.basic
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
N = 150 : M = 150 : P = 0.03 : F = 0.00003
|
||||
|
||||
dim f(N+2,M+2) # 1 tree, 0 empty, 2 fire
|
||||
dim fn(N+2,M+2)
|
||||
graphsize N,M
|
||||
fastgraphics
|
||||
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
if rand<0.5 then f[x,y] = 1
|
||||
next y
|
||||
next x
|
||||
|
||||
while True
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
if not f[x,y] and rand<P then fn[x,y]=1
|
||||
if f[x,y]=2 then fn[x,y]=0
|
||||
if f[x,y]=1 then
|
||||
fn[x,y] = 1
|
||||
if f[x-1,y-1]=2 or f[x,y-1]=2 or f[x+1,y-1]=2 then fn[x,y]=2
|
||||
if f[x-1,y]=2 or f[x+1,y]=2 or rand<F then fn[x,y]=2
|
||||
if f[x-1,y+1]=2 or f[x,y+1]=2 or f[x+1,y+1]=2 then fn[x,y]=2
|
||||
end if
|
||||
# Draw
|
||||
if fn[x,y]=0 then color black
|
||||
if fn[x,y]=1 then color green
|
||||
if fn[x,y]=2 then color yellow
|
||||
plot x-1,y-1
|
||||
next y
|
||||
next x
|
||||
refresh
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
f[x,y] = fn[x,y]
|
||||
next y
|
||||
next x
|
||||
end while
|
||||
36
Task/Forest-fire/BASIC/forest-fire-2.basic
Normal file
36
Task/Forest-fire/BASIC/forest-fire-2.basic
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
VDU 23,22,400;400;16,16,16,128
|
||||
OFF
|
||||
|
||||
DIM old&(200,200), new&(200,200)
|
||||
p = 0.01
|
||||
f = 0.0001
|
||||
|
||||
REM 0 = empty, 1 = tree, 2 = burning
|
||||
REPEAT
|
||||
WAIT 10
|
||||
FOR x% = 1 TO 199
|
||||
FOR y% = 1 TO 199
|
||||
CASE old&(x%,y%) OF
|
||||
WHEN 0:
|
||||
IF p > RND(1) THEN
|
||||
new&(x%,y%) = 1
|
||||
GCOL 2
|
||||
PLOT 4*x%,4*y%
|
||||
ENDIF
|
||||
WHEN 1:
|
||||
IF f > RND(1) OR old&(x%-1,y%)=2 OR old&(x%+1,y%)=2 OR \
|
||||
\ old&(x%-1,y%-1)=2 OR old&(x%,y%-1)=2 OR old&(x%+1,y%-1)=2 OR \
|
||||
\ old&(x%-1,y%+1)=2 OR old&(x%,y%+1)=2 OR old&(x%+1,y%+1)=2 THEN
|
||||
new&(x%,y%) = 2
|
||||
GCOL 1
|
||||
PLOT 4*x%,4*y%
|
||||
ENDIF
|
||||
WHEN 2:
|
||||
new&(x%,y%) = 0
|
||||
GCOL 15
|
||||
PLOT 4*x%,4*y%
|
||||
ENDCASE
|
||||
NEXT
|
||||
NEXT x%
|
||||
old&() = new&()
|
||||
UNTIL FALSE
|
||||
96
Task/Forest-fire/BASIC/forest-fire-3.basic
Normal file
96
Task/Forest-fire/BASIC/forest-fire-3.basic
Normal file
|
|
@ -0,0 +1,96 @@
|
|||
'[RC] Forest Fire
|
||||
'written for FreeBASIC v16
|
||||
'Program code based on BASIC256 from Rosettacode website
|
||||
'http://rosettacode.org/wiki/Forest_fire#BASIC256
|
||||
|
||||
dim fire as double
|
||||
dim p as single
|
||||
P = 0.003 : fire = 0.00003
|
||||
gen = 0
|
||||
N = 400 : M = 400
|
||||
|
||||
dim f0(-1 to N+2,-1 to M+2)
|
||||
dim fn(-1 to N+2,-1 to M+2)
|
||||
dim number1 as double
|
||||
|
||||
white = 15 'color 15 is white
|
||||
yellow = 14 'color 14 is yellow
|
||||
black = 0 'color 0 is black
|
||||
green = 2 'color 2 is green
|
||||
red = 4 'color 4 is red
|
||||
|
||||
screen 18 'Resolution 640x480 with at least 256 colors
|
||||
randomize timer
|
||||
|
||||
locate 28,1
|
||||
BEEP
|
||||
Print " Welcome to Forest Fire"
|
||||
locate 29,1
|
||||
print " press any key to start"
|
||||
sleep
|
||||
locate 28,1
|
||||
Print " Welcome to Forest Fire"
|
||||
locate 29,1
|
||||
print " "
|
||||
|
||||
' 1 tree, 0 empty, 2 fire
|
||||
color green ' this is green color for trees
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
if rnd < 0.5 then 'populate original tree density
|
||||
f0(x,y) = 1
|
||||
pset (x,y)
|
||||
end if
|
||||
next y
|
||||
next x
|
||||
|
||||
color white
|
||||
locate 29,1
|
||||
Print " Press any key to continue "
|
||||
sleep
|
||||
locate 29,1
|
||||
Print " Press 'space bar' to continue/pause, ESC to stop "
|
||||
|
||||
do
|
||||
press$ = inkey$
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
if not f0(x,y) and rnd<P then fn(x,y)=1
|
||||
if f0(x,y)=2 then fn(x,y)=0
|
||||
if f0(x,y)=1 then
|
||||
fn(x,y) = 1
|
||||
if f0(x-1,y-1)=2 or f0(x,y-1)=2 or f0(x+1,y-1)=2 then fn(x,y)=2
|
||||
if f0(x-1,y)=2 or f0(x+1,y)=2 or rnd<fire then fn(x,y)=2
|
||||
if f0(x-1,y+1)=2 or f0(x,y+1)=2 or f0(x+1,y+1)=2 then fn(x,y)=2
|
||||
end if
|
||||
'set up color and drawing
|
||||
'0 empty (black), 1 tree (green), 2 fire (white)
|
||||
if fn(x,y)=0 then color black 'empty
|
||||
if fn(x,y)=1 then color green 'tree
|
||||
if fn(x,y)=2 then color white 'fire
|
||||
'plot x-1,y-1
|
||||
pset (x-1,y-1)
|
||||
next y
|
||||
next x
|
||||
'print generation number
|
||||
gen = gen + 1
|
||||
locate 28,1
|
||||
color white 'this is white color
|
||||
Print " Generation number # ";gen
|
||||
'transfer new generation to current generation
|
||||
for x = 1 to N
|
||||
for y = 1 to M
|
||||
f0(x,y) = fn(x,y)
|
||||
next y
|
||||
next x
|
||||
|
||||
sleep 3 ' slow down a little ... goes too fast otherwise
|
||||
if press$ = " " then sleep : press$ = inkey$
|
||||
if press$ = "s" then sleep
|
||||
LOOP UNTIL press$ = CHR$(27) 'return to do loop up top until "esc" key is pressed.
|
||||
|
||||
locate 28,1
|
||||
color white
|
||||
Print " You entered ESC - goodbye "
|
||||
Print " Press any key to exit "
|
||||
sleep
|
||||
167
Task/Forest-fire/BASIC/forest-fire-4.basic
Normal file
167
Task/Forest-fire/BASIC/forest-fire-4.basic
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
; Some systems reports high CPU-load while running this code.
|
||||
; This may likely be due to the graphic driver used in the
|
||||
; 2D-function Plot().
|
||||
; If experiencing this problem, please reduce the #Width & #Height
|
||||
; or activate the parameter #UnLoadCPU below with a parameter 1 or 2.
|
||||
;
|
||||
; This code should work with the demo version of PureBasic on both PC & Linux
|
||||
|
||||
; General parameters for the world
|
||||
#f = 1e-6
|
||||
#p = 1e-2
|
||||
#SeedATree = 0.005
|
||||
#Width = 400
|
||||
#Height = 400
|
||||
|
||||
; Setting up colours
|
||||
#Fire = $080CF7
|
||||
#BackGround = $BFD5D3
|
||||
#YoungTree = $00E300
|
||||
#NormalTree = $00AC00
|
||||
#MatureTree = $009500
|
||||
#OldTree = $007600
|
||||
#Black = $000000
|
||||
|
||||
; Depending on your hardware, use this to control the speed/CPU-load.
|
||||
; 0 = No load reduction
|
||||
; 1 = Only active about every second frame
|
||||
; 2 = '1' & release the CPU after each horizontal line.
|
||||
#UnLoadCPU = 0
|
||||
|
||||
Enumeration
|
||||
#Empty =0
|
||||
#Ignited
|
||||
#Burning
|
||||
#Tree
|
||||
#Old=#Tree+20
|
||||
EndEnumeration
|
||||
|
||||
Global Dim Forest.i(#Width, #Height)
|
||||
Global Title$="Forest fire in PureBasic"
|
||||
Global Cnt
|
||||
|
||||
Macro Rnd()
|
||||
(Random(2147483647)/2147483647.0)
|
||||
EndMacro
|
||||
|
||||
Procedure Limit(n, min, max)
|
||||
If n<min
|
||||
n=min
|
||||
ElseIf n>max
|
||||
n=max
|
||||
EndIf
|
||||
ProcedureReturn n
|
||||
EndProcedure
|
||||
|
||||
Procedure SpreadFire(x,y)
|
||||
Protected cnt=0, i, j
|
||||
For i=Limit(x-1, 0, #Width) To Limit(x+1, 0, #Width)
|
||||
For j=Limit(y-1, 0, #Height) To Limit(y+1, 0, #Height)
|
||||
If Forest(i,j)>=#Tree
|
||||
Forest(i,j)=#Ignited
|
||||
EndIf
|
||||
Next
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure InitMap()
|
||||
Protected x, y, type
|
||||
For y=1 To #Height
|
||||
For x=1 To #Width
|
||||
If Rnd()<=#SeedATree
|
||||
type=#Tree
|
||||
Else
|
||||
type=#Empty
|
||||
EndIf
|
||||
Forest(x,y)=type
|
||||
Next
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure UpdateMap()
|
||||
Protected x, y
|
||||
For y=1 To #Height
|
||||
For x=1 To #Width
|
||||
Select Forest(x,y)
|
||||
Case #Burning
|
||||
Forest(x,y)=#Empty
|
||||
SpreadFire(x,y)
|
||||
Case #Ignited
|
||||
Forest(x,y)=#Burning
|
||||
Case #Empty
|
||||
If Rnd()<=#p
|
||||
Forest(x,y)=#Tree
|
||||
EndIf
|
||||
Default
|
||||
If Rnd()<=#f
|
||||
Forest(x,y)=#Burning
|
||||
Else
|
||||
Forest(x,y)+1
|
||||
EndIf
|
||||
EndSelect
|
||||
Next
|
||||
Next
|
||||
EndProcedure
|
||||
|
||||
Procedure PresentMap()
|
||||
Protected x, y, c
|
||||
cnt+1
|
||||
SetWindowTitle(0,Title$+", time frame="+Str(cnt))
|
||||
StartDrawing(ImageOutput(1))
|
||||
For y=0 To OutputHeight()-1
|
||||
For x=0 To OutputWidth()-1
|
||||
Select Forest(x,y)
|
||||
Case #Empty
|
||||
c=#BackGround
|
||||
Case #Burning, #Ignited
|
||||
c=#Fire
|
||||
Default
|
||||
If Forest(x,y)<#Tree+#Old
|
||||
c=#YoungTree
|
||||
ElseIf Forest(x,y)<#Tree+2*#Old
|
||||
c=#NormalTree
|
||||
ElseIf Forest(x,y)<#Tree+3*#Old
|
||||
c=#MatureTree
|
||||
ElseIf Forest(x,y)<#Tree+4*#Old
|
||||
c=#OldTree
|
||||
Else ; Tree died of old age
|
||||
Forest(x,y)=#Empty
|
||||
c=#Black
|
||||
EndIf
|
||||
EndSelect
|
||||
Plot(x,y,c)
|
||||
Next
|
||||
CompilerIf #UnLoadCPU>1
|
||||
Delay(1)
|
||||
CompilerEndIf
|
||||
Next
|
||||
StopDrawing()
|
||||
ImageGadget(1, 0, 0, #Width, #Height, ImageID(1))
|
||||
EndProcedure
|
||||
|
||||
If OpenWindow(0, 10, 30, #Width, #Height, Title$, #PB_Window_MinimizeGadget)
|
||||
SmartWindowRefresh(0, 1)
|
||||
If CreateImage(1, #Width, #Height)
|
||||
Define Event, freq
|
||||
If ExamineDesktops() And DesktopFrequency(0)
|
||||
freq=DesktopFrequency(0)
|
||||
Else
|
||||
freq=60
|
||||
EndIf
|
||||
AddWindowTimer(0,0,5000/freq)
|
||||
InitMap()
|
||||
Repeat
|
||||
Event = WaitWindowEvent()
|
||||
Select Event
|
||||
Case #PB_Event_CloseWindow
|
||||
End
|
||||
Case #PB_Event_Timer
|
||||
CompilerIf #UnLoadCPU>0
|
||||
Delay(25)
|
||||
CompilerEndIf
|
||||
UpdateMap()
|
||||
PresentMap()
|
||||
EndSelect
|
||||
ForEver
|
||||
EndIf
|
||||
EndIf
|
||||
65
Task/Forest-fire/BASIC/forest-fire-5.basic
Normal file
65
Task/Forest-fire/BASIC/forest-fire-5.basic
Normal file
|
|
@ -0,0 +1,65 @@
|
|||
Sub Run()
|
||||
//Handy named constants
|
||||
Const empty = 0
|
||||
Const tree = 1
|
||||
Const fire = 2
|
||||
Const ablaze = &cFF0000 //Using the &c numeric operator to indicate a color in hex
|
||||
Const alive = &c00FF00
|
||||
Const dead = &c804040
|
||||
|
||||
//Our forest
|
||||
Dim worldPic As New Picture(480, 480, 32)
|
||||
Dim newWorld(120, 120) As Integer
|
||||
Dim oldWorld(120, 120) As Integer
|
||||
|
||||
//Initialize forest
|
||||
Dim rand As New Random
|
||||
For x as Integer = 0 to 119
|
||||
For y as Integer = 0 to 119
|
||||
if rand.InRange(0, 2) = 0 Or x = 119 or y = 119 or x = 0 or y = 0 Then
|
||||
newWorld(x, y) = empty
|
||||
worldPic.Graphics.ForeColor = dead
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
Else
|
||||
newWorld(x, y) = tree
|
||||
worldPic.Graphics.ForeColor = alive
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Next
|
||||
Next
|
||||
oldWorld = newWorld
|
||||
|
||||
//Burn, baby burn!
|
||||
While Window1.stop = False
|
||||
For x as Integer = 0 To 119
|
||||
For y As Integer = 0 to 119
|
||||
Dim willBurn As Integer = rand.InRange(0, Window1.burnProb.Value)
|
||||
Dim willGrow As Integer = rand.InRange(0, Window1.growProb.Value)
|
||||
if x = 119 or y = 119 or x = 0 or y = 0 Then
|
||||
Continue
|
||||
end if
|
||||
Select Case oldWorld(x, y)
|
||||
Case empty
|
||||
If willGrow = (Window1.growProb.Value) Then
|
||||
newWorld(x, y) = tree
|
||||
worldPic.Graphics.ForeColor = alive
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Case tree
|
||||
if oldWorld(x - 1, y) = fire Or oldWorld(x, y - 1) = fire Or oldWorld(x + 1, y) = fire Or oldWorld(x, y + 1) = fire Or oldWorld(x + 1, y + 1) = fire Or oldWorld(x - 1, y - 1) = fire Or oldWorld(x - 1, y + 1) = fire Or oldWorld(x + 1, y - 1) = fire Or willBurn = (Window1.burnProb.Value) Then
|
||||
newWorld(x, y) = fire
|
||||
worldPic.Graphics.ForeColor = ablaze
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
end if
|
||||
Case fire
|
||||
newWorld(x, y) = empty
|
||||
worldPic.Graphics.ForeColor = dead
|
||||
worldPic.Graphics.FillRect(x*4, y*4, 4, 4)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
Window1.Canvas1.Graphics.DrawPicture(worldPic, 0, 0)
|
||||
oldWorld = newWorld
|
||||
me.Sleep(Window1.speed.Value)
|
||||
Wend
|
||||
End Sub
|
||||
11
Task/Forest-fire/BASIC/forest-fire-6.basic
Normal file
11
Task/Forest-fire/BASIC/forest-fire-6.basic
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
Sub Open()
|
||||
//First method to run on the creation of a new Window. We instantiate an instance of our forestFire thread and run it.
|
||||
Dim fire As New forestFire
|
||||
fire.Run()
|
||||
End Sub
|
||||
|
||||
stop As Boolean //a globally accessible property of Window1. Boolean properties default to False.
|
||||
|
||||
Sub Pushbutton1.Action()
|
||||
stop = True
|
||||
End Sub
|
||||
25
Task/Forest-fire/BASIC/forest-fire-7.basic
Normal file
25
Task/Forest-fire/BASIC/forest-fire-7.basic
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
graphic #g, 200,200
|
||||
dim preGen(200,200)
|
||||
dim newGen(200,200)
|
||||
|
||||
for gen = 1 to 200
|
||||
for x = 1 to 199
|
||||
for y = 1 to 199
|
||||
select case preGen(x,y)
|
||||
case 0
|
||||
if rnd(0) > .99 then newGen(x,y) = 1 : #g "color green ; set "; x; " "; y
|
||||
case 2
|
||||
newGen(x,y) = 0 : #g "color brown ; set "; x; " "; y
|
||||
case 1
|
||||
if preGen(x-1,y-1) = 2 or preGen(x-1,y) = 2 or preGen(x-1,y+1) = 2 _
|
||||
or preGen(x,y-1) = 2 or preGen(x,y+1) = 2 or preGen(x+1,y-1) = 2 _
|
||||
or preGen(x+1,y) = 2 or preGen(x+1,y+1) = 2 or rnd(0) > .999 then
|
||||
#g "color red ; set "; x; " "; y
|
||||
newGen(x,y) = 2
|
||||
end if
|
||||
end select
|
||||
preGen(x-1,y-1) = newGen(x-1,y-1)
|
||||
next y
|
||||
next x
|
||||
next gen
|
||||
render #g
|
||||
104
Task/Forest-fire/BASIC/forest-fire-8.basic
Normal file
104
Task/Forest-fire/BASIC/forest-fire-8.basic
Normal file
|
|
@ -0,0 +1,104 @@
|
|||
Public Class ForestFire
|
||||
Private _forest(,) As ForestState
|
||||
Private _isBuilding As Boolean
|
||||
Private _bm As Bitmap
|
||||
Private _gen As Integer
|
||||
Private _sw As Stopwatch
|
||||
|
||||
Private Const _treeStart As Double = 0.5
|
||||
Private Const _f As Double = 0.00001
|
||||
Private Const _p As Double = 0.001
|
||||
|
||||
Private Const _winWidth As Integer = 300
|
||||
Private Const _winHeight As Integer = 300
|
||||
|
||||
Private Enum ForestState
|
||||
Empty
|
||||
Burning
|
||||
Tree
|
||||
End Enum
|
||||
|
||||
Private Sub ForestFire_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
||||
Me.ClientSize = New Size(_winWidth, _winHeight)
|
||||
ReDim _forest(_winWidth, _winHeight)
|
||||
|
||||
Dim rnd As New Random()
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
_forest(j, i) = IIf(rnd.NextDouble <= _treeStart, ForestState.Tree, ForestState.Empty)
|
||||
Next
|
||||
Next
|
||||
|
||||
_sw = New Stopwatch
|
||||
_sw.Start()
|
||||
DrawForest()
|
||||
Timer1.Start()
|
||||
End Sub
|
||||
|
||||
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
|
||||
If _isBuilding Then Exit Sub
|
||||
|
||||
_isBuilding = True
|
||||
GetNextGeneration()
|
||||
|
||||
DrawForest()
|
||||
_isBuilding = False
|
||||
End Sub
|
||||
|
||||
Private Sub GetNextGeneration()
|
||||
Dim forestCache(_winWidth, _winHeight) As ForestState
|
||||
Dim rnd As New Random()
|
||||
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
Select Case _forest(j, i)
|
||||
Case ForestState.Tree
|
||||
If forestCache(j, i) <> ForestState.Burning Then
|
||||
forestCache(j, i) = IIf(rnd.NextDouble <= _f, ForestState.Burning, ForestState.Tree)
|
||||
End If
|
||||
|
||||
Case ForestState.Burning
|
||||
For i2 As Integer = i - 1 To i + 1
|
||||
If i2 = -1 OrElse i2 >= _winHeight Then Continue For
|
||||
For j2 As Integer = j - 1 To j + 1
|
||||
If j2 = -1 OrElse i2 >= _winWidth Then Continue For
|
||||
If _forest(j2, i2) = ForestState.Tree Then forestCache(j2, i2) = ForestState.Burning
|
||||
Next
|
||||
Next
|
||||
forestCache(j, i) = ForestState.Empty
|
||||
|
||||
Case Else
|
||||
forestCache(j, i) = IIf(rnd.NextDouble <= _p, ForestState.Tree, ForestState.Empty)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
|
||||
_forest = forestCache
|
||||
_gen += 1
|
||||
End Sub
|
||||
|
||||
Private Sub DrawForest()
|
||||
Dim bmCache As New Bitmap(_winWidth, _winHeight)
|
||||
|
||||
For i As Integer = 0 To _winHeight - 1
|
||||
For j As Integer = 0 To _winWidth - 1
|
||||
Select Case _forest(j, i)
|
||||
Case ForestState.Tree
|
||||
bmCache.SetPixel(j, i, Color.Green)
|
||||
|
||||
Case ForestState.Burning
|
||||
bmCache.SetPixel(j, i, Color.Red)
|
||||
End Select
|
||||
Next
|
||||
Next
|
||||
|
||||
_bm = bmCache
|
||||
Me.Refresh()
|
||||
End Sub
|
||||
|
||||
Private Sub ForestFire_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
|
||||
e.Graphics.DrawImage(_bm, 0, 0)
|
||||
|
||||
Me.Text = "Gen " & _gen.ToString() & " @ " & (_gen / (_sw.ElapsedMilliseconds / 1000)).ToString("F02") & " FPS: Forest Fire"
|
||||
End Sub
|
||||
End Class
|
||||
|
|
@ -4,69 +4,68 @@ my $GREEN = "\e[1;32m";
|
|||
my $CLEAR = "\e[0m";
|
||||
|
||||
enum Cell-State <Empty Tree Heating Burning>;
|
||||
my @show = (' ', $GREEN ~ '木', $YELLOW ~ '木', $RED ~ '木');
|
||||
my @pix = ' ', $GREEN ~ '木', $YELLOW ~ '木', $RED ~ '木';
|
||||
|
||||
class Forest {
|
||||
has @!grid;
|
||||
has Rat $.p = 0.01;
|
||||
has Rat $.f = 0.001;
|
||||
has Int $!height;
|
||||
has Int $!width;
|
||||
has @!coords;
|
||||
has @!spot;
|
||||
has @!neighbors;
|
||||
has Int $.height;
|
||||
has Int $.width;
|
||||
has $.p;
|
||||
has $.f;
|
||||
has @!cells = ^$!height X ^$!width;
|
||||
|
||||
method new(Int $height, Int $width, $p=0.01, $f=0.001) {
|
||||
my $c = self.bless(:$height, :$width, :$p, :$f);
|
||||
$c!init-grid;
|
||||
$c!init-neighbors;
|
||||
return $c;
|
||||
}
|
||||
|
||||
method !init-grid {
|
||||
@!grid = [ (Bool.pick ?? Tree !! Empty) xx $!width ] xx $!height;
|
||||
method BUILD (Int :$!height, Int :$!width) {
|
||||
@!coords = ^$!height X ^$!width;
|
||||
@!spot = [ (Bool.pick ?? Tree !! Empty) xx $!width ] xx $!height;
|
||||
self!init-neighbors;
|
||||
}
|
||||
|
||||
method !init-neighbors {
|
||||
for @!cells -> $i, $j {
|
||||
for @!coords -> ($i, $j) {
|
||||
@!neighbors[$i][$j] = eager gather for
|
||||
[-1,-1],[+0,-1],[+1,-1],
|
||||
[-1,+0],( ),[+1,+0],
|
||||
[-1,+0], [+1,+0],
|
||||
[-1,+1],[+0,+1],[+1,+1]
|
||||
{
|
||||
take-rw @!grid[$i + .[0]][$j + .[1]] // next;
|
||||
take-rw @!spot[$i + .[0]][$j + .[1]] // next;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
method step {
|
||||
my @heat;
|
||||
for @!cells -> $i, $j {
|
||||
given @!grid[$i][$j] {
|
||||
when Empty { @!grid[$i][$j] = rand < $!p ?? Tree !! Empty }
|
||||
when Tree { @!grid[$i][$j] = rand < $!f ?? Heating !! Tree }
|
||||
when Heating { @!grid[$i][$j] = Burning; push @heat, $i, $j; }
|
||||
when Burning { @!grid[$i][$j] = Empty }
|
||||
for @!coords -> ($i, $j) {
|
||||
given @!spot[$i][$j] {
|
||||
when Empty { $_ = Tree if rand < $!p }
|
||||
when Tree { $_ = Heating if rand < $!f }
|
||||
when Heating { $_ = Burning; push @heat, ($i, $j); }
|
||||
when Burning { $_ = Empty }
|
||||
}
|
||||
}
|
||||
for @heat -> $i,$j {
|
||||
for @heat -> ($i,$j) {
|
||||
$_ = Heating for @!neighbors[$i][$j].grep(Tree);
|
||||
}
|
||||
}
|
||||
|
||||
method show {
|
||||
for ^$!height -> $i {
|
||||
say @show[@!grid[$i].list].join;
|
||||
say @pix[@!spot[$i].list].join;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my Forest $f .= new(20,30);
|
||||
print "\e[2J"; # ANSI clear screen
|
||||
my ($ROWS, $COLS) = qx/stty size/.words;
|
||||
|
||||
my $i = 0;
|
||||
loop {
|
||||
print "\e[H"; # ANSI home
|
||||
say $CLEAR, $i++;
|
||||
$f.show;
|
||||
$f.step;
|
||||
signal(SIGINT).act: { print "\e[H\e[2J"; exit }
|
||||
|
||||
sub MAIN (Int $height = $ROWS - 2, Int $width = +$COLS div 2 - 1) {
|
||||
my Forest $forest .= new(:$height, :$width);
|
||||
print "\e[2J"; # ANSI clear screen
|
||||
loop {
|
||||
print "\e[H"; # ANSI home
|
||||
say $++;
|
||||
$forest.show;
|
||||
$forest.step;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,63 +1,60 @@
|
|||
/*REXX program grows and displays a forest (with growth and lightning).
|
||||
┌───────────────────────────elided version─────────────────────────┐
|
||||
├─── full version has many more options and enhanced displays. ────┤
|
||||
└──────────────────────────────────────────────────────────────────┘ */
|
||||
signal on syntax; signal on novalue /*handle REXX program errors. */
|
||||
signal on halt /*handle growth interruptus. */
|
||||
_= /*(below) nullify some options. */
|
||||
parse var _ generations rows cols birth lightning bare! fire! tree!,
|
||||
randseed clearscreen every
|
||||
if randseed\=='' then call random ,,randseed
|
||||
percent = 100 /*handy-dandy constant for using%*/
|
||||
field = percent**2 /*size of the probability field. */
|
||||
blank = 'BLANK'
|
||||
generations = p(generations 100)
|
||||
rows = p(rows word(scrsize(),1)-2)
|
||||
cols = p(cols max(79,linesize())-1)
|
||||
bare! = pickchar(bare! blank)
|
||||
fire! = pickchar(fire! '▒')
|
||||
tree! = pickchar(tree! '18'x)
|
||||
clearscreen = p(clearscreen 1)
|
||||
every = p(every 999999999)
|
||||
birth = p(strip(birth,,'%') 50 )*percent
|
||||
lightning = p(strip(lightning,,'%') 1/8)*percent
|
||||
$.=bare! /*the forest is a treeless field.*/
|
||||
@.=bare! /*also, the alternate universe. */
|
||||
/*REXX pgm grows and displays a forest (with growth and fires (lightning).
|
||||
┌────────────────────────────elided version──────────────────────────┐
|
||||
├──── original version has many more options & enhanced displays.────┤
|
||||
└────────────────────────────────────────────────────────────────────┘*/
|
||||
signal on syntax; signal on noValue /*handle run─time REXX pgm errors*/
|
||||
signal on halt /*handle forest life interruptus.*/
|
||||
parse value scrSize() with sd sw . /*the size of the term. display. */
|
||||
parse arg generations birth lightning randSeed . /*get optional args. */
|
||||
if randSeed\=='' then call random ,,randSeed /*want repeatability?*/
|
||||
generations = p(generations 100) /*maybe use 100 generations. */
|
||||
birth = p(strip(birth , ,'%') 50 ) * 100 /*calculate the %*/
|
||||
lightning = p(strip(lightning, ,'%') 1/8) * 100 /* " " "*/
|
||||
clearScreen = 1 /*(or 0) ─── uses CLS (DOS cmd)*/
|
||||
forest = 100**2 /* " " " " forest (field).*/
|
||||
bare! = ' ' /*glyph used to show a bare place*/
|
||||
fire! = '▒' /*well, close to a fire glyph. */
|
||||
tree! = '18'x /*this is an up─arrow [↑] glyph.*/
|
||||
rows = max(12, sd-2) /*shrink the screen rows by two. */
|
||||
cols = max(79, sw-1) /* " " " cols " one. */
|
||||
every = 999999999 /*shows a snapshot every Nth time*/
|
||||
$.=bare! /*forest: now a treeless field. */
|
||||
@.=$. /*ditto, the "shadow" forest. */
|
||||
gens=abs(generations) /*use this for convenience. */
|
||||
/*═════════════════════════════════════watch the forest grow and/or burn*/
|
||||
do life=1 for gens /*process a forest life cycle. */
|
||||
do r=1 for rows; rank=bare!
|
||||
do life=1 for gens /*simulate a forest's life cycle.*/
|
||||
do r=1 for rows; rank=bare! /*start a rank with it being bare*/
|
||||
do c=2 for cols; ?=substr($.r,c,1); ??=?
|
||||
select /*select da quickest choice first*/
|
||||
when ?==tree! then if ignite?() then ??=fire!
|
||||
when ?==bare! then if random(1,field)<=birth then ??=tree!
|
||||
otherwise /*fire*/ ??=bare!
|
||||
end /*select*/
|
||||
rank=rank || ??
|
||||
end /*c*/ /*ignore column 1, start with 2.*/
|
||||
@.r=rank
|
||||
end /*r*/
|
||||
when ?==tree! then if ignite?() then ??=fire!
|
||||
when ?==bare! then if random(1,forest)<=birth then ??=tree!
|
||||
otherwise /*it's bare.*/ ??=bare!
|
||||
end /*select*/ /* [↑] when┼if ≡ short circuit. */
|
||||
rank=rank || ?? /*build rank: 1 thingy at a time.*/
|
||||
end /*c*/ /*ignore column 1, start with 2. */
|
||||
@.r=rank /*and assign to alternate forest.*/
|
||||
end /*r*/ /* [↓] ···and, later, back again*/
|
||||
|
||||
do r=1 for rows; $.r=@.r; end /*assign alternate cells ──► real*/
|
||||
if life//every==0 | generations>0 | life==gens then call showForest
|
||||
end /*life*/
|
||||
/*═════════════════════════════════════stop watching the forest grow. */
|
||||
halt: cycles=life-1; if cycles\==gens then say 'REXX program interrupted.'
|
||||
halt: if life-1\==gens then say 'REXX program interrupted.' /*HALTed?*/
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*───────────────────────────────SHOWFOREST subroutine──────────────────*/
|
||||
showForest: if clearscreen then 'CLS' /* ◄─── change this for your OS.*/
|
||||
showForest: if clearScreen then 'CLS' /* ◄─── change this for your OS.*/
|
||||
do r=rows by -1 for rows /*show the forest in proper order*/
|
||||
say strip(substr($.r,2),'T') /*be neat about trailing blanks. */
|
||||
end /*r*/
|
||||
end /*r*/ /* [↑] that's to say, remove 'em*/
|
||||
say right(copies('═',cols)life, cols) /*show&tell for a stand of trees.*/
|
||||
return
|
||||
/*──────────────────────────────────IGNITE? subroutine──────────────────*/
|
||||
ignite?: if substr($.r,c+1,1)==fire! then return 1 /*east on fire ?*/
|
||||
if substr($.r,c-1,1)==fire! then return 1; rp=r+1; rm=r-1
|
||||
cm=c-1; if pos(fire!,substr($.rm,cm,3)substr($.rp,cm,3))\==0 then return 1
|
||||
return random(1,field) <= lightning
|
||||
/*──────────────────────────────────IGNITE? subroutine──────────────────────*/
|
||||
ignite?: if substr($.r,c+1,1)==fire! then return 1 /*is east on fire? */
|
||||
if substr($.r,c-1,1)==fire! then return 1; /* " west " " */
|
||||
rp=r+1; rm=r-1 /*curr. row offsets.*/
|
||||
if pos(fire!,substr($.rm,c-1,3)substr($.rp,c-1,3))\==0 then return 1
|
||||
return random(1,forest)<=lightning
|
||||
/*───────────────────────────────1─liner subroutines─────────────────────────────────────────────────────────────────────────────────*/
|
||||
err: say;say;say center(' error! ',max(40,linesize()%2),"*");say;do j=1 for arg();say arg(j);say;end;say;exit 13
|
||||
novalue: syntax: call err 'REXX program' condition('C') "error",condition('D'),'REXX source statement (line' sigl"):",sourceline(sigl)
|
||||
pickchar: _=p(arg(1));if translate(_)==blank then _=' ';if length(_) ==3 then _=d2c(_);if length(_) ==2 then _=x2c(_);return _
|
||||
p: return word(arg(1),1)
|
||||
err: say; say; say center(' error! ',max(40,sw%2),"*"); say; do _=1 for arg(); say arg(_); say; end; say; exit 13
|
||||
noValue: syntax: call err 'REXX program' condition('C') "error",condition('D'),'REXX source statement (line' sigl"):",sourceline(sigl)
|
||||
p: return word(arg(1),1) /*pick─a─word: first or second word.*/
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue