2016 Update
This commit is contained in:
Tina Müller
parent
948b86eafa
commit
dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
|
|
@ -1,96 +1,108 @@
|
|||
'[RC] Forest Fire
|
||||
'written for FreeBASIC v16
|
||||
'written for FreeBASIC
|
||||
'Program code based on BASIC256 from Rosettacode website
|
||||
'http://rosettacode.org/wiki/Forest_fire#BASIC256
|
||||
'06-10-2016 updated/tweaked the code
|
||||
'compile with fbc -s gui
|
||||
|
||||
dim fire as double
|
||||
dim p as single
|
||||
P = 0.003 : fire = 0.00003
|
||||
gen = 0
|
||||
N = 400 : M = 400
|
||||
#Define M 400
|
||||
#Define N 640
|
||||
|
||||
dim f0(-1 to N+2,-1 to M+2)
|
||||
dim fn(-1 to N+2,-1 to M+2)
|
||||
dim number1 as double
|
||||
Dim As Double p = 0.003
|
||||
Dim As Double fire = 0.00003
|
||||
'Dim As Double number1
|
||||
Dim As Integer gen, x, y
|
||||
Dim As String press
|
||||
|
||||
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
|
||||
'f0() and fn() use memory from the memory pool
|
||||
Dim As UByte f0(), fn()
|
||||
ReDim f0(-1 To N +2, -1 To M +2)
|
||||
ReDim fn(-1 To N +2, -1 To M +2)
|
||||
|
||||
screen 18 'Resolution 640x480 with at least 256 colors
|
||||
randomize timer
|
||||
Dim As UByte white = 15 'color 15 is white
|
||||
Dim As UByte yellow = 14 'color 14 is yellow
|
||||
Dim As UByte black = 0 'color 0 is black
|
||||
Dim As UByte green = 2 'color 2 is green
|
||||
Dim As UByte red = 4 'color 4 is red
|
||||
|
||||
locate 28,1
|
||||
BEEP
|
||||
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 " "
|
||||
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 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
|
||||
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
|
||||
Do
|
||||
press = InKey
|
||||
ScreenLock
|
||||
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 OrElse f0(x,y-1)=2 OrElse f0(x+1,y-1)=2 Then fn(x,y)=2
|
||||
If f0(x-1,y)=2 OrElse f0(x+1,y)=2 OrElse Rnd<fire Then fn(x,y)=2
|
||||
If f0(x-1,y+1)=2 OrElse f0(x,y+1)=2 OrElse 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 red '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
|
||||
ScreenUnlock
|
||||
|
||||
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.
|
||||
' amount for sleep is in milliseconds, 1 = ignore key press
|
||||
Sleep 50, 1 ' slow down a little ... goes too fast otherwise
|
||||
If press = " " Then Sleep : press = InKey
|
||||
If press = "s" Then Sleep
|
||||
' return to do loop up top until "esc" key is pressed.
|
||||
' clicking close windows "X", closes the window immediately
|
||||
Loop Until press = Chr(27) OrElse press = Chr(255)+"k"
|
||||
If press = Chr(255) + "k" Then End
|
||||
|
||||
locate 28,1
|
||||
color white
|
||||
Print " You entered ESC - goodbye "
|
||||
Print " Press any key to exit "
|
||||
sleep
|
||||
Locate 28,1
|
||||
Color white
|
||||
Print " You entered ESC - goodbye "
|
||||
Print " Press any key to exit "
|
||||
Sleep
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue