simulation/life/life.bas

   1 ' Life simulator/editor\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2001\r
   4 ' H-Page: svjatoslav.eu\r
   5 ' E-Mail: svjatoslavagejenko@gmail.com\r
   6  \r
   7 \r
   8 ' in observing mode use keys:\r
   9 ' ---------------------------\r
  10 \r
  11 ' x - run for 10000 cycles\r
  12 ' s - run for specified amount of cycles\r
  13 ' n - run for 1 cycle\r
  14 ' z - stop running\r
  15 ' c - clear all\r
  16 ' w - write state to file\r
  17 ' l - load state from file\r
  18 ' e - switch to edit mode\r
  19 ' q - quit\r
  20 \r
  21 \r
  22 ' in edit mode use keys:\r
  23 ' ----------------------\r
  24 \r
  25 ' cursor keys - move around\r
  26 ' 4 8 6 2 - move arund in large jumps\r
  27 ' s - switch to select mode\r
  28 ' v - paste from copy buffer\r
  29 ' SPACE - toggle cell on/off\r
  30 ' ESC - return to observing mode\r
  31 \r
  32 \r
  33 ' in select mode use keys:\r
  34 ' ------------------------\r
  35 \r
  36 ' cursor keys - select area\r
  37 ' 4 8 6 2 - select area in large jumps\r
  38 ' c - copy\r
  39 ' x - cut\r
  40 ' ESC - return to edit mode\r
  41 \r
  42 \r
  43 DECLARE SUB load ()\r
  44 DECLARE SUB wri ()\r
  45 DECLARE SUB shbuf ()\r
  46 DEFINT A-Z\r
  47 \r
  48 DECLARE SUB sel (x, y)\r
  49 DECLARE SUB cle ()\r
  50 DECLARE SUB ed ()\r
  51 DECLARE SUB disp ()\r
  52 DECLARE SUB cl ()\r
  53 DECLARE SUB proc ()\r
  54 DECLARE SUB start ()\r
  55 DIM SHARED buf1(1 TO 50, 1 TO 50)\r
  56 DIM SHARED buf2(1 TO 50, 1 TO 50)\r
  57 DIM SHARED mill\r
  58 DIM SHARED frm\r
  59 DIM SHARED ski\r
  60 DIM SHARED buf3(0 TO 50, 0 TO 50)\r
  61 DIM SHARED bufxs, bufys\r
  62 start\r
  63 \r
  64 1\r
  65 proc\r
  66 frm = frm + 1\r
  67 \r
  68 2\r
  69 LOCATE 1, 27\r
  70 PRINT "frame:" + STR$(frm) + "   "\r
  71 LOCATE 2, 27\r
  72 PRINT "skip:" + STR$(ski) + "   "\r
  73 \r
  74 \r
  75 a$ = INKEY$\r
  76 \r
  77 IF a$ = "s" THEN\r
  78 LOCATE 5, 27\r
  79 INPUT "skip ", ski\r
  80 cl\r
  81 END IF\r
  82 \r
  83 IF a$ = "q" THEN\r
  84 SYSTEM\r
  85 END IF\r
  86 \r
  87 IF a$ = "n" THEN GOTO 1\r
  88 \r
  89 IF a$ = "c" THEN cle\r
  90 \r
  91 IF a$ = "e" THEN ed\r
  92 \r
  93 IF a$ = "z" THEN ski = 0\r
  94 \r
  95 IF a$ = "x" THEN ski = 10000\r
  96 \r
  97 IF a$ = "w" THEN wri\r
  98 \r
  99 IF a$ = "l" THEN load\r
 100 \r
 101 IF ski > 0 THEN ski = ski - 1: GOTO 1\r
 102 GOTO 2\r
 103 \r
 104 SUB cl\r
 105 LOCATE 5, 27\r
 106 PRINT "              "\r
 107 END SUB\r
 108 \r
 109 SUB cle\r
 110 \r
 111 FOR y = 1 TO 50\r
 112 FOR x = 1 TO 50\r
 113 buf1(x, y) = 0\r
 114 buf2(x, y) = 0\r
 115 NEXT x\r
 116 NEXT y\r
 117 \r
 118 mill = 0\r
 119 frm = 0\r
 120 ski = 0\r
 121 \r
 122 disp\r
 123 END SUB\r
 124 \r
 125 SUB disp\r
 126 \r
 127 FOR y = 1 TO 50\r
 128 FOR x = 1 TO 50\r
 129 IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)\r
 130 IF c = 0 THEN c = 1 ELSE c = 10\r
 131 LINE (x * 4, y * 4)-(x * 4 + 2, y * 4 + 2), c, BF\r
 132 NEXT x\r
 133 NEXT y\r
 134 \r
 135 \r
 136 END SUB\r
 137 \r
 138 SUB ed\r
 139 x = 25\r
 140 y = 25\r
 141 3\r
 142 IF x < 1 THEN x = 1\r
 143 IF y < 1 THEN y = 1\r
 144 IF x > 50 THEN x = 50\r
 145 IF y > 49 THEN y = 49\r
 146 \r
 147 IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)\r
 148 IF c = 0 THEN c = 1 ELSE c = 10\r
 149 LINE (x * 4, y * 4)-(x * 4 + 2, y * 4 + 2), c, BF\r
 150 \r
 151 LINE (x * 4 - 1, y * 4 - 1)-(x * 4 + 3, y * 4 + 3), 14, B\r
 152 4\r
 153 a$ = INKEY$\r
 154 IF a$ = "" THEN GOTO 4\r
 155 \r
 156 LINE (x * 4 - 1, y * 4 - 1)-(x * 4 + 3, y * 4 + 3), 0, B\r
 157 \r
 158 IF a$ = CHR$(0) + "M" THEN x = x + 1\r
 159 IF a$ = CHR$(0) + "K" THEN x = x - 1\r
 160 IF a$ = CHR$(0) + "P" THEN y = y + 1\r
 161 IF a$ = CHR$(0) + "H" THEN y = y - 1\r
 162 IF a$ = "6" THEN x = x + 8\r
 163 IF a$ = "4" THEN x = x - 8\r
 164 IF a$ = "2" THEN y = y + 8\r
 165 IF a$ = "8" THEN y = y - 8\r
 166 \r
 167 IF a$ = CHR$(27) THEN GOTO 5\r
 168 IF a$ = "s" THEN sel x, y\r
 169 \r
 170 IF a$ = "v" THEN\r
 171 FOR y1 = 0 TO bufys\r
 172 FOR x1 = 0 TO bufxs\r
 173 c = buf3(x1, y1)\r
 174 x2 = x1 + x\r
 175 y2 = y1 + y\r
 176 \r
 177 IF (x2 < 50) AND (y2 < 50) THEN\r
 178 IF mill = 0 THEN buf1(x2, y2) = c ELSE buf2(x2, y2) = c\r
 179 END IF\r
 180 \r
 181 NEXT x1\r
 182 NEXT y1\r
 183 disp\r
 184 END IF\r
 185 \r
 186 IF a$ = " " THEN\r
 187 IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)\r
 188 IF c = 1 THEN c = 0 ELSE c = 1\r
 189 IF mill = 0 THEN buf1(x, y) = c ELSE buf2(x, y) = c\r
 190 END IF\r
 191 \r
 192 GOTO 3\r
 193 5\r
 194 \r
 195 END SUB\r
 196 \r
 197 SUB load\r
 198 \r
 199 cle\r
 200 LOCATE 5, 27\r
 201 INPUT "file ", f$\r
 202 cl\r
 203 \r
 204 y = 1\r
 205 OPEN f$ FOR INPUT AS #1\r
 206 9\r
 207 IF EOF(1) <> 0 THEN GOTO 10\r
 208 \r
 209 LINE INPUT #1, a$\r
 210 \r
 211 FOR x = 1 TO LEN(a$)\r
 212 B$ = RIGHT$(LEFT$(a$, x), 1)\r
 213 IF B$ = "#" THEN c = 1 ELSE c = 0\r
 214 IF mill = 0 THEN buf1(x, y) = c ELSE buf2(x, y) = c\r
 215 NEXT x\r
 216 y = y + 1\r
 217 \r
 218 GOTO 9\r
 219 10\r
 220 CLOSE #1\r
 221 disp\r
 222 \r
 223 END SUB\r
 224 \r
 225 SUB proc\r
 226 \r
 227 IF mill = 0 THEN\r
 228 FOR y = 2 TO 48\r
 229 FOR x = 2 TO 49\r
 230 IF buf1(x - 1, y - 1) = 1 THEN c = 1 ELSE c = 0\r
 231 IF buf1(x, y - 1) = 1 THEN c = c + 1\r
 232 IF buf1(x + 1, y - 1) = 1 THEN c = c + 1\r
 233 IF buf1(x - 1, y) = 1 THEN c = c + 1\r
 234 IF buf1(x + 1, y) = 1 THEN c = c + 1\r
 235 IF buf1(x - 1, y + 1) = 1 THEN c = c + 1\r
 236 IF buf1(x, y + 1) = 1 THEN c = c + 1\r
 237 IF buf1(x + 1, y + 1) = 1 THEN c = c + 1\r
 238 \r
 239 IF buf1(x, y) = 1 THEN\r
 240 IF c = 2 OR c = 3 THEN buf2(x, y) = 1 ELSE buf2(x, y) = 0\r
 241 ELSE\r
 242 IF c = 3 THEN buf2(x, y) = 1 ELSE buf2(x, y) = 0\r
 243 END IF\r
 244 \r
 245 NEXT x\r
 246 NEXT y\r
 247 mill = 1\r
 248 disp\r
 249 ELSE\r
 250 \r
 251 FOR y = 2 TO 48\r
 252 FOR x = 2 TO 49\r
 253 IF buf2(x - 1, y - 1) = 1 THEN c = 1 ELSE c = 0\r
 254 IF buf2(x, y - 1) = 1 THEN c = c + 1\r
 255 IF buf2(x + 1, y - 1) = 1 THEN c = c + 1\r
 256 IF buf2(x - 1, y) = 1 THEN c = c + 1\r
 257 IF buf2(x + 1, y) = 1 THEN c = c + 1\r
 258 IF buf2(x - 1, y + 1) = 1 THEN c = c + 1\r
 259 IF buf2(x, y + 1) = 1 THEN c = c + 1\r
 260 IF buf2(x + 1, y + 1) = 1 THEN c = c + 1\r
 261 \r
 262 IF buf2(x, y) = 1 THEN\r
 263 IF c = 2 OR c = 3 THEN buf1(x, y) = 1 ELSE buf1(x, y) = 0\r
 264 ELSE\r
 265 IF c = 3 THEN buf1(x, y) = 1 ELSE buf1(x, y) = 0\r
 266 END IF\r
 267 NEXT x\r
 268 NEXT y\r
 269 \r
 270 mill = 0\r
 271 disp\r
 272 END IF\r
 273 \r
 274 END SUB\r
 275 \r
 276 SUB sel (x, y)\r
 277 x1 = x * 4 - 1\r
 278 y1 = y * 4 - 1\r
 279 x2 = x + 2\r
 280 y2 = y + 2\r
 281 \r
 282 6\r
 283 x3 = x2 * 4 + 3\r
 284 y3 = y2 * 4 + 3\r
 285 \r
 286 LINE (x1, y1)-(x3, y3), 14, B\r
 287 8\r
 288 a$ = INKEY$\r
 289 IF a$ = "" THEN GOTO 8\r
 290 LINE (x1, y1)-(x3, y3), 0, B\r
 291 \r
 292 IF a$ = CHR$(0) + "M" THEN x2 = x2 + 1\r
 293 IF a$ = CHR$(0) + "K" THEN x2 = x2 - 1\r
 294 IF a$ = CHR$(0) + "P" THEN y2 = y2 + 1\r
 295 IF a$ = CHR$(0) + "H" THEN y2 = y2 - 1\r
 296 \r
 297 IF a$ = "6" THEN x2 = x2 + 8\r
 298 IF a$ = "4" THEN x2 = x2 - 8\r
 299 IF a$ = "2" THEN y2 = y2 + 8\r
 300 IF a$ = "8" THEN y2 = y2 - 8\r
 301 \r
 302 IF a$ = CHR$(27) THEN GOTO 7\r
 303 IF a$ = "c" THEN\r
 304 bufxs = x2 - x\r
 305 bufys = y2 - y\r
 306 \r
 307 FOR y4 = y TO y2\r
 308 FOR x4 = x TO x2\r
 309 IF mill = 0 THEN c = buf1(x4, y4) ELSE c = buf2(x4, y4)\r
 310 buf3(x4 - x, y4 - y) = c\r
 311 NEXT x4\r
 312 NEXT y4\r
 313 shbuf\r
 314 END IF\r
 315 \r
 316 IF a$ = "x" THEN\r
 317 bufxs = x2 - x\r
 318 bufys = y2 - y\r
 319 \r
 320 FOR y4 = y TO y2\r
 321 FOR x4 = x TO x2\r
 322 IF mill = 0 THEN c = buf1(x4, y4): buf1(x4, y4) = 0 ELSE c = buf2(x4, y4): buf2(x4, y4) = 0\r
 323 buf3(x4 - x, y4 - y) = c\r
 324 NEXT x4\r
 325 NEXT y4\r
 326 shbuf\r
 327 disp\r
 328 END IF\r
 329 \r
 330 \r
 331 \r
 332 GOTO 6\r
 333 7\r
 334 \r
 335 END SUB\r
 336 \r
 337 SUB shbuf\r
 338 \r
 339 'PRINT bufxs\r
 340 'PRINT bufys\r
 341 \r
 342 x = bufxs\r
 343 IF x > 15 THEN x = 15\r
 344 y = bufys\r
 345 IF y > 15 THEN y = 15\r
 346 \r
 347 LINE (204, 99)-(319, 199), 0, BF\r
 348 LINE (204, 99)-(208 + 4 * bufxs, 103 + 4 * bufys), 14, B\r
 349 \r
 350 FOR y2 = 0 TO y\r
 351 FOR x2 = 0 TO x\r
 352 c = buf3(x2, y2)\r
 353 IF c = 0 THEN c = 1 ELSE c = 10\r
 354 LINE (x2 * 4 + 205, y2 * 4 + 100)-(x2 * 4 + 2 + 205, y2 * 4 + 2 + 100), c, BF\r
 355 NEXT x2\r
 356 NEXT y2\r
 357 \r
 358 \r
 359 END SUB\r
 360 \r
 361 SUB start\r
 362 SCREEN 13\r
 363 RANDOMIZE TIMER\r
 364 \r
 365 bufxs = 0\r
 366 bufys = 0\r
 367 \r
 368 cle\r
 369 \r
 370 END SUB\r
 371 \r
 372 SUB wri\r
 373 LOCATE 5, 27\r
 374 INPUT "file ", f$\r
 375 cl\r
 376 \r
 377 OPEN f$ FOR OUTPUT AS #1\r
 378 \r
 379 FOR y = 1 TO 50\r
 380 a$ = ""\r
 381 FOR x = 1 TO 50\r
 382 IF mill = 0 THEN c = buf1(x, y) ELSE c = buf2(x, y)\r
 383 IF c = 0 THEN a$ = a$ + "." ELSE a$ = a$ + "#"\r
 384 NEXT x\r
 385 PRINT #1, a$\r
 386 NEXT y\r
 387 \r
 388 CLOSE #1\r
 389 \r
 390 \r
 391 END SUB\r
 392 \r