CHDIR ".\qbasicapps\simulation\life"


' Life simulator/editor
' made by Svjatoslav Agejenko
' in 2001
' H-Page: svjatoslav.eu
' E-Mail: svjatoslavagejenko@gmail.com
 

' in observing mode use keys:
' ---------------------------

' x - run for 10000 cycles
' s - run for specified amount of cycles
' n - run for 1 cycle
' z - stop running
' c - clear all
' w - write state to file
' l - load state from file
' e - switch to edit mode
' q - quit


' in edit mode use keys:
' ----------------------

' cursor keys - move around
' 4 8 6 2 - move arund in large jumps
' s - switch to select mode
' v - paste from copy buffer
' SPACE - toggle cell on/off
' ESC - return to observing mode


' in select mode use keys:
' ------------------------

' cursor keys - select area
' 4 8 6 2 - select area in large jumps
' c - copy
' x - cut
' ESC - return to edit mode


DECLARE SUB load ()
DECLARE SUB wri ()
DECLARE SUB shbuf ()
DEFINT A-Z

DECLARE SUB sel (x, y)
DECLARE SUB cle ()
DECLARE SUB ed ()
DECLARE SUB disp ()
DECLARE SUB cl ()
DECLARE SUB proc ()
DECLARE SUB start ()
DIM SHARED buf1(1 TO 50, 1 TO 50)
DIM SHARED buf2(1 TO 50, 1 TO 50)
DIM SHARED mill
DIM SHARED frm
DIM SHARED ski
DIM SHARED buf3(0 TO 50, 0 TO 50)
DIM SHARED bufxs, bufys
start

1
proc
frm = frm + 1

2
LOCATE 1, 27
PRINT "frame:" + STR$(frm) + "   "
LOCATE 2, 27
PRINT "skip:" + STR$(ski) + "   "


a$ = INKEY$

IF a$ = "s" THEN
LOCATE 5, 27
INPUT "skip ", ski
cl
END IF

IF a$ = "q" THEN
SYSTEM
END IF

IF a$ = "n" THEN GOTO 1

IF a$ = "c" THEN cle

IF a$ = "e" THEN ed

IF a$ = "z" THEN ski = 0

IF a$ = "x" THEN ski = 10000

IF a$ = "w" THEN wri

IF a$ = "l" THEN load

IF ski > 0 THEN ski = ski - 1: GOTO 1
GOTO 2

SUB cl
LOCATE 5, 27
PRINT "              "
END SUB

SUB cle

FOR y = 1 TO 50
FOR x = 1 TO 50
buf1(x, y) = 0
buf2(x, y) = 0
NEXT x
NEXT y

mill = 0
frm = 0
ski = 0

disp
END SUB

SUB disp

FOR y = 1 TO 50
FOR x = 1 TO 50
IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)
IF c = 0 THEN c = 1 ELSE c = 10
LINE (x * 4, y * 4)-(x * 4 + 2, y * 4 + 2), c, BF
NEXT x
NEXT y


END SUB

SUB ed
x = 25
y = 25
3
IF x < 1 THEN x = 1
IF y < 1 THEN y = 1
IF x > 50 THEN x = 50
IF y > 49 THEN y = 49

IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)
IF c = 0 THEN c = 1 ELSE c = 10
LINE (x * 4, y * 4)-(x * 4 + 2, y * 4 + 2), c, BF

LINE (x * 4 - 1, y * 4 - 1)-(x * 4 + 3, y * 4 + 3), 14, B
4
a$ = INKEY$
IF a$ = "" THEN GOTO 4

LINE (x * 4 - 1, y * 4 - 1)-(x * 4 + 3, y * 4 + 3), 0, B

IF a$ = CHR$(0) + "M" THEN x = x + 1
IF a$ = CHR$(0) + "K" THEN x = x - 1
IF a$ = CHR$(0) + "P" THEN y = y + 1
IF a$ = CHR$(0) + "H" THEN y = y - 1
IF a$ = "6" THEN x = x + 8
IF a$ = "4" THEN x = x - 8
IF a$ = "2" THEN y = y + 8
IF a$ = "8" THEN y = y - 8

IF a$ = CHR$(27) THEN GOTO 5
IF a$ = "s" THEN sel x, y

IF a$ = "v" THEN
FOR y1 = 0 TO bufys
FOR x1 = 0 TO bufxs
c = buf3(x1, y1)
x2 = x1 + x
y2 = y1 + y

IF (x2 < 50) AND (y2 < 50) THEN
IF mill = 0 THEN buf1(x2, y2) = c ELSE buf2(x2, y2) = c
END IF

NEXT x1
NEXT y1
disp
END IF

IF a$ = " " THEN
IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)
IF c = 1 THEN c = 0 ELSE c = 1
IF mill = 0 THEN buf1(x, y) = c ELSE buf2(x, y) = c
END IF

GOTO 3
5

END SUB

SUB load

cle
LOCATE 5, 27
INPUT "file ", f$
cl

y = 1
OPEN f$ FOR INPUT AS #1
9
IF EOF(1) <> 0 THEN GOTO 10

LINE INPUT #1, a$

FOR x = 1 TO LEN(a$)
B$ = RIGHT$(LEFT$(a$, x), 1)
IF B$ = "#" THEN c = 1 ELSE c = 0
IF mill = 0 THEN buf1(x, y) = c ELSE buf2(x, y) = c
NEXT x
y = y + 1

GOTO 9
10
CLOSE #1
disp

END SUB

SUB proc

IF mill = 0 THEN
FOR y = 2 TO 48
FOR x = 2 TO 49
IF buf1(x - 1, y - 1) = 1 THEN c = 1 ELSE c = 0
IF buf1(x, y - 1) = 1 THEN c = c + 1
IF buf1(x + 1, y - 1) = 1 THEN c = c + 1
IF buf1(x - 1, y) = 1 THEN c = c + 1
IF buf1(x + 1, y) = 1 THEN c = c + 1
IF buf1(x - 1, y + 1) = 1 THEN c = c + 1
IF buf1(x, y + 1) = 1 THEN c = c + 1
IF buf1(x + 1, y + 1) = 1 THEN c = c + 1

IF buf1(x, y) = 1 THEN
IF c = 2 OR c = 3 THEN buf2(x, y) = 1 ELSE buf2(x, y) = 0
ELSE
IF c = 3 THEN buf2(x, y) = 1 ELSE buf2(x, y) = 0
END IF

NEXT x
NEXT y
mill = 1
disp
ELSE

FOR y = 2 TO 48
FOR x = 2 TO 49
IF buf2(x - 1, y - 1) = 1 THEN c = 1 ELSE c = 0
IF buf2(x, y - 1) = 1 THEN c = c + 1
IF buf2(x + 1, y - 1) = 1 THEN c = c + 1
IF buf2(x - 1, y) = 1 THEN c = c + 1
IF buf2(x + 1, y) = 1 THEN c = c + 1
IF buf2(x - 1, y + 1) = 1 THEN c = c + 1
IF buf2(x, y + 1) = 1 THEN c = c + 1
IF buf2(x + 1, y + 1) = 1 THEN c = c + 1

IF buf2(x, y) = 1 THEN
IF c = 2 OR c = 3 THEN buf1(x, y) = 1 ELSE buf1(x, y) = 0
ELSE
IF c = 3 THEN buf1(x, y) = 1 ELSE buf1(x, y) = 0
END IF
NEXT x
NEXT y

mill = 0
disp
END IF

END SUB

SUB sel (x, y)
x1 = x * 4 - 1
y1 = y * 4 - 1
x2 = x + 2
y2 = y + 2

6
x3 = x2 * 4 + 3
y3 = y2 * 4 + 3

LINE (x1, y1)-(x3, y3), 14, B
8
a$ = INKEY$
IF a$ = "" THEN GOTO 8
LINE (x1, y1)-(x3, y3), 0, B

IF a$ = CHR$(0) + "M" THEN x2 = x2 + 1
IF a$ = CHR$(0) + "K" THEN x2 = x2 - 1
IF a$ = CHR$(0) + "P" THEN y2 = y2 + 1
IF a$ = CHR$(0) + "H" THEN y2 = y2 - 1

IF a$ = "6" THEN x2 = x2 + 8
IF a$ = "4" THEN x2 = x2 - 8
IF a$ = "2" THEN y2 = y2 + 8
IF a$ = "8" THEN y2 = y2 - 8

IF a$ = CHR$(27) THEN GOTO 7
IF a$ = "c" THEN
bufxs = x2 - x
bufys = y2 - y

FOR y4 = y TO y2
FOR x4 = x TO x2
IF mill = 0 THEN c = buf1(x4, y4) ELSE c = buf2(x4, y4)
buf3(x4 - x, y4 - y) = c
NEXT x4
NEXT y4
shbuf
END IF

IF a$ = "x" THEN
bufxs = x2 - x
bufys = y2 - y

FOR y4 = y TO y2
FOR x4 = x TO x2
IF mill = 0 THEN c = buf1(x4, y4): buf1(x4, y4) = 0 ELSE c = buf2(x4, y4): buf2(x4, y4) = 0
buf3(x4 - x, y4 - y) = c
NEXT x4
NEXT y4
shbuf
disp
END IF



GOTO 6
7

END SUB

SUB shbuf

'PRINT bufxs
'PRINT bufys

x = bufxs
IF x > 15 THEN x = 15
y = bufys
IF y > 15 THEN y = 15

LINE (204, 99)-(319, 199), 0, BF
LINE (204, 99)-(208 + 4 * bufxs, 103 + 4 * bufys), 14, B

FOR y2 = 0 TO y
FOR x2 = 0 TO x
c = buf3(x2, y2)
IF c = 0 THEN c = 1 ELSE c = 10
LINE (x2 * 4 + 205, y2 * 4 + 100)-(x2 * 4 + 2 + 205, y2 * 4 + 2 + 100), c, BF
NEXT x2
NEXT y2


END SUB

SUB start
SCREEN 13
RANDOMIZE TIMER

bufxs = 0
bufys = 0

cle

END SUB

SUB wri
LOCATE 5, 27
INPUT "file ", f$
cl

OPEN f$ FOR OUTPUT AS #1

FOR y = 1 TO 50
a$ = ""
FOR x = 1 TO 50
IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)
IF c = 0 THEN a$ = a$ + "." ELSE a$ = a$ + "#"
NEXT x
PRINT #1, a$
NEXT y

CLOSE #1


END SUB