simulation/life/life.bas

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