09-11-2005, 05:19 AM
I thought this might prove useful and interesting to people, but this runs quite nicely under FB. A simple version of the mathamatical system known as Life. I wrote this quite some time ago, but seems to work rather well under FB.
How to use:
When you first start the program, you'll see a small yellow cursor in the middle. Use keys 'A' for up, 'Z' for down, '<' for left and '>' for right. Press SPACE to toggle the cell as active or dead. Create numerous patterns based on the common patterns found in Life, i.e. Gliders, Pulsars and such.
When ready, hit Enter to begin cell generation. Cell groups that drift off the screen will cycle over to the opposite side. To stop cell generation, hit Enter again.
Lastly, 'C' in edit mode will clear the cell field, and 'Q' ends the program.
Enjoy.
How to use:
When you first start the program, you'll see a small yellow cursor in the middle. Use keys 'A' for up, 'Z' for down, '<' for left and '>' for right. Press SPACE to toggle the cell as active or dead. Create numerous patterns based on the common patterns found in Life, i.e. Gliders, Pulsars and such.
When ready, hit Enter to begin cell generation. Cell groups that drift off the screen will cycle over to the opposite side. To stop cell generation, hit Enter again.
Lastly, 'C' in edit mode will clear the cell field, and 'Q' ends the program.
Enjoy.
Code:
REM *********************************************************
REM
REM LIFE
REM Programmed by Paul Samuel John Millard
REM
REM *********************************************************
REM ******* Program function and sub definitions.
DECLARE SUB SetCell (nX%, nY%, nMode%)
DECLARE SUB ShowNewDisplay (nMode%)
DECLARE FUNCTION GetCellCount% (nX%, nY%, nMode%)
DECLARE SUB ShowCell (nX%, nY%, nCol%)
DECLARE SUB EditCells ()
DECLARE SUB CursorOn (nX%, nY%)
DECLARE SUB CursorOff (nX%, nY%)
DECLARE SUB ClearUpAfter ()
DECLARE SUB DELAY (fTime#)
SCREEN 12
REM ******* DECLARE GLOBAL ARRAYS
CONST KILLCELL = 0
CONST LIVECELL = 1
CONST GRIDWIDTH = 128
CONST GRIDHEIGHT = 128
CONST TRUE = 1
CONST FALSE = 0
REM ******* Workspace for main cell growth
DIM SHARED nWorkScrn%(GRIDWIDTH, GRIDHEIGHT)
REM ******* Display grid for results of cell growth
DIM SHARED nDispScrn%(GRIDWIDTH, GRIDHEIGHT)
REM ****** Old display grid, optimizes the speed of displaying
DIM SHARED nOldScrn%(GRIDWIDTH, GRIDHEIGHT)
DIM nCellsFound% 'Number of cells found in 3x3 test grid
DIM nLoopx% 'For-Next loops
DIM nLoopy%
DIM x%, y%
DIM SHARED sx%, sy%, fx%, fy%
REM ******* Edit grid before cell generation
EditCells
REM ******* Start cell generations.
DO
strKey$ = UCASE$(INKEY$)
sx% = GRIDWIDTH + 1
sy% = GRIDHEIGHT + 1
fx% = -1
fy% = -1
found% = FALSE
FOR nLoopy% = 0 TO GRIDHEIGHT
FOR nLoopx% = 0 TO GRIDWIDTH
IF nWorkScrn%(nLoopx%, nLoopy%) = LIVECELL THEN
IF nLoopx% < sx% THEN sx% = nLoopx%
IF nLoopx% > fx% THEN fx% = nLoopx%
IF nLoopy% < sy% THEN sy% = nLoopy%
IF nLoopy% > fy% THEN fy% = nLoopy%
found% = TRUE
END IF
NEXT nLoopx%
NEXT nLoopy%
sx% = sx% - 1
fx% = fx% + 1
sy% = sy% - 1
fy% = fy% + 1
IF found% = TRUE THEN
IF sx% < 0 THEN sx% = 0
IF sy% < 0 THEN sy% = 0
IF fx% > GRIDWIDTH THEN fx% = GRIDWIDTH
IF fy% > GRIDHEIGHT THEN fy% = GRIDHEIGHT
END IF
sx% = 0
sy% = 0
fx% = GRIDWIDTH
fy% = GRIDHEIGHT
FOR nLoopy% = sy% TO fy%
FOR nLoopx% = sx% TO fx%
nDispScrn%(nLoopx%, nLoopy%) = nWorkScrn%(nLoopx%, nLoopy%)
REM ******* Get number of neighbouring cells.
REM ******* This number excludes the central cell.
nCellsFound% = GetCellCount(nLoopx%, nLoopy%, FALSE)
SELECT CASE nCellsFound%
CASE 1
SetCell nLoopx%, nLoopy%, KILLCELL
CASE 2
SetCell nLoopx%, nLoopy%, KILLCELL
CASE 3
SetCell nLoopx%, nLoopy%, LIVECELL
CASE IS > 4
SetCell nLoopx%, nLoopy%, KILLCELL
END SELECT
NEXT nLoopx%
NEXT nLoopy%
REM ******* Display nDispScrn array to screen
ShowNewDisplay FALSE
'Sleep 40
REM ******* Copy nDispScrn to nWorkScrn and clear nDispScrn.
FOR nLoopy% = sy% TO fy%
FOR nLoopx% = sx% TO fx%
nWorkScrn%(nLoopx%, nLoopy%) = nDispScrn%(nLoopx%, nLoopy%)
nDispScrn%(nLoopx%, nLoopy%) = KILLCELL
NEXT nLoopx%
NEXT nLoopy%
IF strKey$ = CHR$(13) THEN
EditCells
END IF
LOOP UNTIL strKey$ = "Q" 'Continue generating until 'Q' key pressed.
ClearUpAfter
SUB ClearUpAfter
SCREEN 0
END
END SUB
SUB CursorOff (nX%, nY%)
IF nWorkScrn%(nX%, nY%) = LIVECELL THEN
nCol% = 13
ELSE
nCol% = 0
END IF
ShowCell nX%, nY%, nCol%
END SUB
SUB CursorOn (nX%, nY%)
ShowCell nX%, nY%, 14
END SUB
SUB DELAY (fTime#)
DIM fStartTime#
fStartTime# = TIMER
DIM fCurrentTime#
DO
fCurrentTime# = TIMER - fStartTime#
LOOP UNTIL fCurrentTime# > fTime#
END SUB
SUB EditCells
DIM nCurx%, nCury%
nCurx% = GRIDWIDTH / 2
nCury% = GRIDHEIGHT / 2
DIM strKey$
FOR nLoopy% = 0 TO GRIDHEIGHT
FOR nLoopx% = 0 TO GRIDWIDTH
nOldScrn%(nLoopx%, nLoopy%) = 255
IF nWorkScrn%(nLoopx%, nLoopy%) = LIVECELL THEN
CursorOff nLoopx%, nLoopy%
END IF
NEXT nLoopx%
NEXT nLoopy%
CursorOn nCurx%, nCury%
DO
strKey$ = UCASE$(INKEY$)
SELECT CASE strKey$
CASE "A"
IF nCury% > 0 THEN
CursorOff nCurx%, nCury%
nCury% = nCury% - 1
CursorOn nCurx%, nCury%
END IF
CASE "Z"
IF nCury% < GRIDHEIGHT THEN
CursorOff nCurx%, nCury%
nCury% = nCury% + 1
CursorOn nCurx%, nCury%
END IF
CASE ","
IF nCurx% > 0 THEN
CursorOff nCurx%, nCury%
nCurx% = nCurx% - 1
CursorOn nCurx%, nCury%
END IF
CASE "."
IF nCurx% < GRIDWIDTH THEN
CursorOff nCurx%, nCury%
nCurx% = nCurx% + 1
CursorOn nCurx%, nCury%
END IF
CASE " "
IF nWorkScrn%(nCurx%, nCury%) = LIVECELL THEN
nWorkScrn%(nCurx%, nCury%) = KILLCELL
ELSE
nWorkScrn%(nCurx%, nCury%) = LIVECELL
END IF
CursorOff nCurx%, nCury%
DELAY .2
CursorOn nCurx%, nCury%
CASE "C"
CursorOff nCurx%, nCury%
FOR nLoopy% = 0 TO GRIDHEIGHT
FOR nLoopx% = 0 TO GRIDWIDTH
IF nWorkScrn%(nLoopx%, nLoopy%) = LIVECELL THEN
nWorkScrn%(nLoopx%, nLoopy%) = KILLCELL
CursorOff nLoopx%, nLoopy%
END IF
NEXT nLoopx%
NEXT nLoopy%
CursorOn nCurx%, nCury%
CASE "Q"
ClearUpAfter
END SELECT
IF strKey$ = CHR$(13) THEN
CursorOff nCurx%, nCury%
EXIT SUB
END IF
LOOP
END SUB
FUNCTION GetCellCount% (nX%, nY%, nMode%)
DIM nLoopx%, nLoopy%
DIM nVirtX%, nVirtY%
DIM nFound%
DIM nCell%
nFound% = 0
FOR nLoopy% = (nY% - 1) TO (nY% + 1)
FOR nLoopx% = (nX% - 1) TO (nX% + 1)
SELECT CASE nLoopx%
CASE -1
nVirtX% = GRIDWIDTH
CASE GRIDWIDTH + 1
nVirtX% = 0
CASE ELSE
nVirtX% = nLoopx%
END SELECT
SELECT CASE nLoopy%
CASE -1
nVirtY% = GRIDHEIGHT
CASE GRIDWIDTH + 1
nVirtY% = 0
CASE ELSE
nVirtY% = nLoopy%
END SELECT
IF nMode% = FALSE THEN
nCell% = nWorkScrn%(nVirtX%, nVirtY%)
ELSE
nCell% = nDispScrn%(nVirtX%, nVirtY%)
END IF
IF nCell% = LIVECELL THEN
nFound% = nFound% + 1
END IF
NEXT nLoopx%
NEXT nLoopy%
IF nMode% = FALSE THEN
nCell% = nWorkScrn%(nX%, nY%)
ELSE
nCell% = nDispScrn%(nX%, nY%)
END IF
GetCellCount = nFound%
END FUNCTION
SUB SetCell (nX%, nY%, nMode%)
SELECT CASE nMode%
CASE KILLCELL
nDispScrn%(nX%, nY%) = KILLCELL
CASE LIVECELL
nDispScrn%(nX%, nY%) = LIVECELL
END SELECT
END SUB
SUB ShowCell (nX%, nY%, nCol%)
DIM fSizeX AS DOUBLE
DIM fSizeY AS DOUBLE
DIM fPixX AS DOUBLE
DIM FPixY AS DOUBLE
fSizeX = 640 / (GRIDWIDTH + 1)
fSizeY = 480 / (GRIDHEIGHT + 1)
fPixX = nX% * fSizeX
FPixY = nY% * fSizeY
LINE (fPixX + 1, FPixY + 1)-(fPixX + fSizeX - 1, FPixY + fSizeY - 1), nCol%, BF
END SUB
SUB ShowNewDisplay (nMode%)
DIM nLoopx%, nLoopy%
DIM nCell%
DIM nOldCell%
DIM nCol%
FOR nLoopy% = sy% TO fy%
FOR nLoopx% = sx% TO fx%
nCell% = nDispScrn%(nLoopx%, nLoopy%)
nOldCell% = nOldScrn%(nLoopx%, nLoopy%)
IF nCell% <> nOldCell% THEN
nOldScrn%(nLoopx%, nLoopy%) = nCell%
IF nMode% = TRUE THEN
nCol% = 15 - GetCellCount(nLoopx%, nLoopy%, TRUE)
ELSE
nCol% = 15
END IF
SELECT CASE nDispScrn%(nLoopx%, nLoopy%)
CASE KILLCELL
ShowCell nLoopx%, nLoopy%, 0
CASE LIVECELL
ShowCell nLoopx%, nLoopy%, nCol%
END SELECT
END IF
NEXT nLoopx%
NEXT nLoopy%
END SUB
url=http://www.apexnow.co.uk]![[Image: sig.png]](http://www.apexnow.co.uk/sig.png)
[/url]
Home of the Cartography Shop - DarkBASIC Professional map importer
[/url]Home of the Cartography Shop - DarkBASIC Professional map importer
![[Image: freebasic.png]](http://www.deleter.phatcode.net/freebasic.png)