QB / QB64 Discussion Forum     RULES     Other Subforums, Links and Downloads    Index of Threads

 

 Return to Index  

Life Simulation

November 10 2002 at 1:21 PM
XyzZyx  (no login)


Response to ProgramList XyzZyx

 
Controls:

If you want a random background to start with, type "random" on the command line, or specify a filename, or put nothing on the command line to start with a blank field.

(If you have QB1.1, fill in the COMMAND$ variable with "random", your filename, or "")

Press enter to toggle between running and editing. Use the mouse to change the pixels on the field. Press space to toggle between refresh and no refresh. Press Esc to quit.


REM $INCLUDE: 'QB.BI'
REM $DYNAMIC
DIM grid(0 TO 159, 0 TO 99, 0 TO 1) AS INTEGER
DIM graph(0 TO 11551) AS INTEGER
DIM mouse AS REGTYPE

w% = 0
nw% = 1
display% = 1

mouse.ax = 2
CALL interrupt(&H33, mouse, mouse)
mouse.ax = 3

SCREEN 13
FOR i% = 0 TO 9
  OUT &H3C8, i%
  OUT &H3C9, i% * (64 / 10)
  OUT &H3C9, i% * (64 / 10)
  OUT &H3C9, i% * (64 / 10)
NEXT
LOCATE 1, 22: COLOR 12: PRINT "COUNT:";
LOCATE 13, 22: COLOR 14: PRINT "GROWTH:";
LOCATE 25, 22: COLOR 15: PRINT "SPF:";
COLOR 15

IF COMMAND$ = "" THEN
  GOSUB alter
ELSEIF COMMAND$ = "RANDOM" THEN
  RANDOMIZE TIMER
  FOR y% = 0 TO 99
    FOR x% = 0 TO 159
      grid(x%, y%, 0) = INT(RND * 1.1)
      IF grid(x%, y%, 0) = 1 THEN ocount% = ocount% + 1
    NEXT
  NEXT
ELSE
  file% = FREEFILE
  OPEN COMMAND$ FOR BINARY AS #file%
    char$ = " "
    x% = 0
    y% = 0
    DO WHILE NOT EOF(1)
      GET #file%, , char$
      grid(x%, y%, w%) = ASC(char$) AND 1
      x% = x% + 1
      IF x% = 160 THEN
        x% = 0
        y% = y% + 1
        IF y% = 100 THEN
          EXIT DO
        END IF
      END IF
    LOOP
  CLOSE #file%
END IF

DO
  t! = TIMER
  ocount% = count%
  count% = 0
  FOR y% = 0 TO 99
    FOR x% = 0 TO 159
      GOSUB determine
      GOSUB update
      IF grid(x%, y%, nw%) > 0 THEN count% = count% + 1
    NEXT
  NEXT

  GET (169, 16)-(319, 91), graph(0)
  PUT (168, 16), graph(0), PSET
  LINE (319, 16)-(319, 91), 0
  LINE (319, 91)-(319, 91 - (count% / 128)), 12
  count$ = LTRIM$(RTRIM$(STR$(count%)))
  LOCATE 1, 32: PRINT SPACE$(8);
  LOCATE 1, 40 - LEN(count$) + 1: COLOR 12: PRINT count$;

  GET (169, 108)-(319, 183), graph(0)
  PUT (168, 108), graph(0), PSET
  LINE (319, 108)-(319, 183), 0
  LINE (319, 149)-(319, 149 - ((count% - ocount%) / 32)), 14
  growth$ = LTRIM$(RTRIM$(STR$(count% - ocount%)))
  LOCATE 13, 32: PRINT SPACE$(8);
  LOCATE 13, 40 - LEN(growth$) + 1: COLOR 14: PRINT growth$;

  spf$ = LTRIM$(RTRIM$(STR$(INT((TIMER - t!) * 1000) / 1000)))
  LOCATE 25, 32: PRINT SPACE$(8);
  LOCATE 25, 40 - LEN(spf$) + 1: COLOR 15: PRINT spf$;
   
  SWAP w%, nw%

  SELECT CASE INKEY$
    CASE CHR$(13): GOSUB alter
    CASE CHR$(27): EXIT DO
    CASE CHR$(32)
      SELECT CASE display%
        CASE 0: display% = 1
        CASE 1: display% = 0
      END SELECT
  END SELECT
LOOP
END

determine:
  neighboars% = 0
  FOR yoff% = -1 TO 1
    FOR xoff% = -1 TO 1
      nx% = x% + xoff%
      IF nx% < 0 THEN nx% = 159
      IF nx% > 159 THEN nx% = 0
      ny% = y% + yoff%
      IF ny% < 0 THEN ny% = 99
      IF ny% > 99 THEN ny% = 0
      IF grid(nx%, ny%, w%) > 0 THEN neighboars% = neighboars% + 1
    NEXT
  NEXT
  IF display% = 1 THEN
    PSET (x%, y%), neighboars%
  END IF
RETURN

update:
  IF neighboars% < 3 OR neighboars% > 6 THEN
    grid(x%, y%, nw%) = 0
    IF display% = 1 THEN
      PSET (x%, 100 + y%), 0
    END IF
  ELSE
    grid(x%, y%, nw%) = neighboars%
    IF display% = 1 THEN
      PSET (x%, 100 + y%), 15
    END IF
  END IF
RETURN

alter:
  mouse.ax = 1
  CALL interrupt(&H33, mouse, mouse)
  mouse.ax = 3
  DO
    obutton% = mouse.bx
    CALL interrupt(&H33, mouse, mouse)
    mouse.cx = mouse.cx / 2
    IF obutton% = 0 AND mouse.bx <> 0 THEN
      IF mouse.cx < 160 THEN
        IF mouse.dx > 99 THEN mouse.dx = mouse.dx - 100
        x% = mouse.cx
        y% = mouse.dx
        button% = mouse.bx
        mouse.ax = 2
        CALL interrupt(&H33, mouse, mouse)
        SELECT CASE button%
          CASE 1
            PSET (x%, y% + 100), 15
            grid(x%, y%, w%) = 1
          CASE 2
            PSET (x%, y% + 100), 0
            grid(x%, y%, w%) = 0
        END SELECT
        GOSUB determine
        mouse.ax = 3
      END IF
    END IF
    IF obutton% <> 0 AND mouse.bx <> 0 THEN
      IF mouse.cx < 160 THEN
        IF mouse.dx > 99 THEN mouse.dx = mouse.dx - 100
        x% = mouse.cx
        y% = mouse.dx
        button% = mouse.bx
        SELECT CASE button%
          CASE 1
            PSET (x%, y% + 100), 15
            grid(x%, y%, w%) = 1
          CASE 2
            PSET (x%, y% + 100), 0
            grid(x%, y%, w%) = 0
        END SELECT
        GOSUB determine
      END IF
    END IF
    IF obutton% <> 0 AND mouse.bx = 0 THEN
      mouse.ax = 1
      CALL interrupt(&H33, mouse, mouse)
      mouse.ax = 3
    END IF

    SELECT CASE INKEY$
      CASE CHR$(13): EXIT DO
    END SELECT
  LOOP
  mouse.ax = 2
  CALL interrupt(&H33, mouse, mouse)
RETURN


 
 Respond to this message   
Response TitleAuthorDate
 REM $INCLUDE: 'QB.BI' gives error message on QB1.0MacNov 11, 2002
  I took the liberty of converting it to Qb1.0AliphaNov 14, 2002
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement