1: TYPE BLOCK 2: cell AS INTEGER 3: x AS INTEGER 4: y AS INTEGER 5: up AS INTEGER 6: down AS INTEGER 7: left AS INTEGER 8: right AS INTEGER 9: upLeft AS INTEGER 10: upRight AS INTEGER 11: downleft AS INTEGER 12: downRight AS INTEGER 13: END TYPE 14: 15: TYPE regtype 16: ax AS INTEGER 17: bx AS INTEGER 18: cx AS INTEGER 19: dx AS INTEGER 20: bp AS INTEGER 21: si AS INTEGER 22: di AS INTEGER 23: flags AS INTEGER 24: ds AS INTEGER 25: es AS INTEGER 26: END TYPE 27: 28: DIM SHARED regs AS regtype 29: REDIM SHARED intrpt(1 TO 50) AS INTEGER 30: 31: CONST sz = 10 32: CONST elements = 64 * 35 33: CONST chance = 7 34: DIM SHARED node(elements) AS BLOCK 35: 36: DEF SEG = VARSEG(intrpt(1)) 37: address = VARPTR(intrpt(1)) 38: 39: FOR I% = 0 TO 99 40: READ a% 41: POKE address + I%, a% 42: NEXT I% 43: 44: '**************************************************************************** 45: 46: RANDOMIZE TIMER 47: CLS 48: CALL openScreen 49: CALL initNode 50: COLOR 7, 0 51: CLS 52: DO UNTIL done% 53: SCREEN 0 54: in$ = "" 55: pick% = mainMenu% 56: SCREEN 9, , 1, 0 57: SELECT CASE pick% 58: CASE 0 59: CALL patience 60: CALL getLit 61: CASE 1 62: CALL miceShow 63: CALL getUserLit 64: CALL patience 65: CASE 2 66: BEEP 67: in$ = "rerun" 68: CASE 3 69: done% = 1 70: in$ = "Done" 71: END SELECT 72: DO UNTIL in$ <> "" 73: CALL lightCell(in$) 74: CALL newAge(in$) 75: PCOPY 1, 0 76: LOOP 77: LOOP 78: 79: COLOR 7, 0 80: SCREEN 0 81: END 82: '**************************************************************************** 83: DATA 85 84: DATA 139,236 85: DATA 86 86: DATA 87 87: DATA 30 88: DATA 139,118,6 89: DATA 139,4 90: DATA 139,92,2 91: DATA 139,76,4 92: DATA 139,84,6 93: DATA 139,108,8 94: DATA 139,124,12 95: DATA 142,68,18 96: DATA 255,116,10 97: DATA 131,124,18,255 98: DATA 117,2 99: DATA 30 100: DATA 7 101: 102: DATA 131,124,16,255 103: DATA 116,3 104: DATA 142,92,16 105: 106: DATA 94 107: DATA 205,33 108: DATA 85 109: DATA 139,236 110: DATA 30 111: DATA 86 112: DATA 142,94,2 113: DATA 139,118,14 114: DATA 137,4 115: DATA 137,92,2 116: DATA 137,76,4 117: DATA 137,84,6 118: DATA 143,68,10 119: DATA 143,68,16 120: DATA 143,68,8 121: DATA 137,124,12 122: DATA 140,68,18 123: DATA 156 124: DATA 143,68,14 125: DATA 95 126: DATA 95 127: DATA 94 128: DATA 93 129: DATA 202,2,0 130: 131: FUNCTION getDown% (index%) 132: 133: forw% = index% + 64 134: 135: IF forw% <= elements THEN 136: getDown% = forw% 137: ELSE 138: getDown% = forw% - elements 139: END IF 140: 141: END FUNCTION 142: 143: FUNCTION getleft% (index%) 144: 145: col% = index% MOD 64 146: 147: IF col% <> 1 THEN 148: getleft% = index% - 1 149: ELSE 150: getleft% = index% + 63 151: END IF 152: 153: 154: END FUNCTION 155: 156: SUB getLit 157: 158: FOR count% = 1 TO elements 159: lit% = INT(RND * chance) 160: IF lit% = 0 THEN 161: node(count%).cell = -1 162: ELSE 163: node(count%).cell = 0 164: END IF 165: NEXT count% 166: 167: END SUB 168: 169: FUNCTION getNum% (x%, y%) 170: 171: x% = (x% + 10) \ 10 172: 173: y% = (y% \ 10) * 64 174: 175: getNum% = x% + y% 176: 177: END FUNCTION 178: 179: FUNCTION getRight% (index%) 180: 181: col% = index% MOD 64 182: 183: IF col% <> 0 THEN 184: getRight% = index% + 1 185: ELSE 186: getRight% = index% - 63 187: END IF 188: 189: END FUNCTION 190: 191: FUNCTION getUp% (index%) 192: 193: back% = index% - 64 194: 195: IF back% > 0 THEN 196: getUp% = back% 197: ELSE 198: getUp% = back% + elements 199: END IF 200: 201: END FUNCTION 202: 203: SUB getUserLit 204: FOR count% = 1 TO elements 205: node(count%).cell = 0 206: NEXT count% 207: 208: DO 209: press$ = INKEY$ 210: SELECT CASE LEN(press$) 211: CASE 0 212: CALL micePressed(buttonPress%, numTimes%, xMouse%, yMouse%) 213: IF numTimes% THEN 214: num% = getNum%(xMouse%, yMouse%) 215: CALL miceHide 216: IF node(num%).cell THEN 217: node(num%).cell = 0 218: LINE (node(num%).x, node(num%).y)-(node(num%).x + 10, node(num%).y + 10), 0, BF 219: PCOPY 1, 0 220: ELSE 221: node(num%).cell = -1 222: LINE (node(num%).x, node(num%).y)-(node(num%).x + 10, node(num%).y + 10), 15, BF 223: PCOPY 1, 0 224: END IF 225: CALL miceShow 226: END IF 227: CASE 1 228: IF press$ = CHR$(13) OR press$ = CHR$(27) THEN EXIT DO 229: END SELECT 230: LOOP 231: CALL miceHide 232: CLS 233: END SUB 234: 235: SUB initNode 236: 237: FOR count% = 0 TO 34 238: FOR cnt% = 0 TO 63 239: index% = index% + 1 240: node(index%).x = cnt% * sz 241: node(index%).y = count% * sz 242: node(index%).up = getUp%(index%) 243: node(index%).down = getDown%(index%) 244: node(index%).left = getleft%(index%) 245: node(index%).right = getRight%(index%) 246: node(index%).upLeft = getUp%(getleft%(index%)) 247: node(index%).upRight = getUp%(getRight%(index%)) 248: node(index%).downleft = getDown%(getleft%(index%)) 249: node(index%).downRight = getDown%(getRight%(index%)) 250: NEXT cnt% 251: NEXT count% 252: 253: END SUB 254: 255: SUB interrupt (intnum%, regs AS regtype) 256: 257: DEF SEG = VARSEG(intrpt(1)) 258: address = VARPTR(intrpt(1)) 259: POKE address + 51, intnum% 260: 261: CALL absolute(regs, address) 262: 263: END SUB 264: 265: SUB lightCell (in$) 266: 267: FOR count% = 1 TO elements 268: IF node(count%).cell THEN 269: LINE (node(count%).x, node(count%).y)-(node(count%).x + sz, node(count%).y + sz), 15, BF 270: ELSE 271: LINE (node(count%).x, node(count%).y)-(node(count%).x + sz, node(count%).y + sz), 0, BF 272: END IF 273: in$ = INKEY$ 274: IF in$ <> "" THEN EXIT SUB 275: NEXT count% 276: END SUB 277: 278: FUNCTION mainMenu% 279: 280: DIM choice(3) AS STRING 281: 282: heading$ = "QLIFE" 283: choice(0) = "Random Cell Selection" 284: choice(1) = "User Cell Selection " 285: choice(2) = " " 286: choice(3) = "Exit Program " 287: 288: row% = 9 289: 290: headLength% = LEN(heading$) 291: col% = (80 - LEN(choice(0))) / 2 292: 293: COLOR 7, 0 294: FOR count% = row% + 3 TO row% + 2 + UBOUND(choice) 295: num% = num% + 1 296: LOCATE row% + 2 + num%, col% 297: PRINT choice(num%) 298: NEXT count% 299: 300: COLOR 15, 0 301: LOCATE row%, (80 - headLength%) / 2: PRINT heading$ 302: 303: menuNum% = 0 304: row% = row% + 2 305: 306: COLOR 0, 7: LOCATE row%, col%: PRINT choice(0) 307: DO 308: keyPress$ = INKEY$ 309: SELECT CASE LEN(keyPress$) 310: CASE 1 311: IF keyPress$ = CHR$(13) THEN EXIT DO 312: CASE 2 313: SELECT CASE RIGHT$(keyPress$, 1) 314: CASE "P" 'down 315: IF menuNum% < 3 THEN 316: COLOR 7, 0 317: LOCATE row%, col% 318: PRINT choice(menuNum%) 319: COLOR 0, 7 320: row% = row% + 1 321: menuNum% = menuNum% + 1 322: LOCATE row%, col% 323: PRINT choice(menuNum%) 324: END IF 325: CASE "H" 'up 326: IF menuNum% > 0 THEN 327: COLOR 7, 0 328: LOCATE row%, col% 329: PRINT choice(menuNum%) 330: COLOR 0, 7 331: row% = row% - 1 332: menuNum% = menuNum% - 1 333: LOCATE row%, col% 334: PRINT choice(menuNum%) 335: END IF 336: END SELECT 337: END SELECT 338: LOOP 339: 340: mainMenu% = menuNum% 341: 342: COLOR 7, 0 343: 344: END FUNCTION 345: 346: SUB miceHide 347: 348: regs.ax = 2 349: regs.bx = 0 350: regs.cx = 0 351: regs.dx = 0 352: 353: CALL interrupt(&H33, regs) 354: 355: 356: END SUB 357: 358: SUB micePressed (buttonPress%, numTimes%, xMouse%, yMouse%) 359: 360: ' if buttonPress% passed as 0 then info returned applies to left button 361: ' if buttonPress% passed as 1 then info returned applies to right button 362: 363: 364: regs.ax = 5 365: regs.bx = buttonPress% 366: regs.cx = 0 367: regs.dx = 0 368: 369: CALL interrupt(&H33, regs) 370: 371: buttonPress% = regs.ax 'if 1 returned left pressed since last call 372: 'if 2 returned right pressed since last call 373: 'if 3 returned both pressed since last call 374: 375: numTimes% = regs.bx 'depends on buttonPress% passed as 0 (left) or 376: '1 (right) 377: 378: xMouse% = regs.cx ' see ^ 379: yMouse% = regs.dx ' see ^ 380: 381: END SUB 382: 383: FUNCTION miceReset% 384: 385: regs.ax = 0 386: regs.bx = 0 387: regs.cx = 0 388: regs.dx = 0 389: 390: CALL interrupt(&H33, regs) 391: 392: miceReset% = regs.ax 393: 394: END FUNCTION 395: 396: SUB miceShow 397: 398: regs.ax = 1 399: regs.bx = 0 400: regs.cx = 0 401: regs.dx = 0 402: 403: CALL interrupt(&H33, regs) 404: 405: END SUB 406: 407: SUB newAge (in$) 408: 409: DIM alive(1 TO elements) AS INTEGER 410: 411: FOR count% = 1 TO elements 412: in$ = INKEY$: IF in$ <> "" THEN EXIT SUB 413: IF node(node(count%).upLeft).cell THEN onn% = onn% + 1 414: IF node(node(count%).up).cell THEN onn% = onn% + 1 415: IF node(node(count%).upRight).cell THEN onn% = onn% + 1 416: IF node(node(count%).left).cell THEN onn% = onn% + 1 417: IF node(node(count%).right).cell THEN onn% = onn% + 1 418: IF node(node(count%).downleft).cell THEN onn% = onn% + 1 419: IF node(node(count%).down).cell THEN onn% = onn% + 1 420: IF node(node(count%).downRight).cell THEN onn% = onn% + 1 421: 422: 423: IF node(count%).cell THEN 424: IF onn% <> 2 AND onn% <> 3 THEN 425: alive(count%) = 0 426: ELSE 427: alive(count%) = -1 428: END IF 429: ELSE 430: IF onn% = 3 THEN alive(count%) = -1 431: END IF 432: onn% = 0 433: NEXT count% 434: 435: FOR count% = 1 TO elements 436: node(count%).cell = alive(count%) 437: NEXT count% 438: 439: END SUB 440: 441: SUB openScreen 442: title$ = "QLIFE.BAS" 443: by$ = "by" 444: me$ = "Jim Golston," 445: aol$ = "AOL screen-name: JimCG1" 446: freely$ = "Freely distributed without restriction." 447: 448: lenTitle% = LEN(title$) 449: lenBy% = LEN(by$) 450: lenMe% = LEN(me$) 451: lenAol% = LEN(aol$) 452: lenFreely% = LEN(freely$) 453: 454: COLOR 15, 1 455: CLS 456: LOCATE 8, (80 - lenTitle%) / 2: PRINT title$ 457: LOCATE 12, (80 - lenBy%) / 2: PRINT by$ 458: LOCATE 14, (80 - lenMe%) / 2: PRINT me$ 459: LOCATE 15, (80 - lenAol%) / 2: PRINT aol$ 460: LOCATE 25, (80 - lenFreely%) / 2: PRINT freely$; 461: 462: END SUB 463: 464: SUB patience 465: COLOR 7 466: line1$ = "Patience! It will take a fairly long time to initialize the screen grid." 467: line2$ = "Also, there will be a lengthy pause between each generation of cells." 468: line3$ = "This is only QBASIC code, after all!" 469: len1% = LEN(line1$) 470: len2% = LEN(line2$) 471: len3% = LEN(line3$) 472: 473: LOCATE 10, (80 - len1%) / 2: PRINT line1$ 474: LOCATE 11, (80 - len1%) / 2: PRINT line2$ 475: LOCATE 13, (80 - len3%) / 2: PRINT line3$ 476: 477: PCOPY 1, 0 478: END SUB 479: |