Re: Conway's Game of Life with SDL and Lush

(libload "sdl/libsdl")

(setq WIDTH 600)
(setq HEIGHT 600)
(setq CONST_255 (ubyte-matrix))
(CONST_255 255)

(de makewrappable (m)
	((-idx2- (-ubyte-)) m)
	(let* ((real-height (idx-dim m 0))
		(real-width (idx-dim m 1)))
		((-int-) real-height real-width)

		;; Basically I'm faking wraping the rows / cols by having a matrix with
		;; 2 extra rows, and 2 extra columns, one on each side. This allows me to
		;; simply offset the idx, add, then re-shift the idx.
		(idx-copy (select m 0 1) (select m 0 (- real-height 1)))
		(idx-copy (select m 0 (- real-height 2)) (select m 0 0))
		(idx-copy (select m 1 1) (select m 1 (- real-width 1)))
		(idx-copy (select m 1 (- real-width 2)) (select m 1 0))))

(de lifesim (m r)
  ((-idx2- (-ubyte-)) m r)
  (let* ((real-height (idx-dim m 0))
         (real-width (idx-dim m 1)))
    ((-int-) real-height real-width)
    
    ;; Clear the accumulation matrix and copy around the columns to make it 'wrappable'
    (idx-clear r)
    (makewrappable m)
    
    ;; Shift the matrix around and add them all up to count the number of neighbors.
    (idx-add (narrow (narrow m 0 (- real-height 2) 0) 1 (- real-width 2) 0)
             (narrow (narrow m 0 (- real-height 2) 0) 1 (- real-width 2) 1) r)
    (idx-add (narrow (narrow m 0 (- real-height 2) 0) 1 (- real-width 2) 2) r r)
    (idx-add (narrow (narrow m 0 (- real-height 2) 1) 1 (- real-width 2) 2) r r)
    (idx-add (narrow (narrow m 0 (- real-height 2) 2) 1 (- real-width 2) 2) r r)
    (idx-add (narrow (narrow m 0 (- real-height 2) 2) 1 (- real-width 2) 1) r r)
    (idx-add (narrow (narrow m 0 (- real-height 2) 2) 1 (- real-width 2) 0) r r)
    (idx-add (narrow (narrow m 0 (- real-height 2) 1) 1 (- real-width 2) 0) r r)
    
    (idx-bloop ((rrow r)
                (mrow (narrow (narrow m 0 (- real-height 2) 1) 1 (- real-width 2) 1)))
      ((-idx1- (-ubyte-)) rrow mrow)
      (idx-bloop ((neighbors rrow) (cellstatus mrow))
        ((-idx0- (-ubyte-)) neighbors cellstatus)
        (if (or (and (= (cellstatus) 0) (= (neighbors) 3))
                (and (= (cellstatus) 1) (or (= (neighbors) 2) (= (neighbors) 2))))
            (cellstatus 1)
          (cellstatus 0)))
      )))

(de randomize (m)
  ((-idx2- (-ubyte-)) m)
  (idx-bloop ((row m))
    (idx-bloop ((col row))
      (col (int (rand 0 1.2))))))

(de life ()
  (sdl-initialize)
  (let*
      ((display (ubyte-matrix HEIGHT WIDTH 3))
       (accum (ubyte-matrix HEIGHT WIDTH))
       (cells (ubyte-matrix (+ HEIGHT 2) (+ WIDTH 2)))
       (scr (new sdlidx-screen display "Game of Life"))
       (event (new sdl-event))
       (xyk (int-matrix 3))
       (stop ()) )
    
    ;; initialize cells
    (randomize cells)
    
    (while (not stop)
      
      ;; Draw the cells matrix to the display matrix
      (idx-copy (idx-dotm0 (narrow (narrow cells 0 HEIGHT 1) 1 WIDTH 1) CONST_255) 
                (select display 2 0))
      
      ;; Perform the simulation
      (lifesim cells accum)
      
      ;; Check the keys for interesting keypresses and respond accordingly
      (==> event get-arrows xyk)
      (when (= (xyk 2) @@SDLK_q)
        (setq stop t))
      (when (= (xyk 2) @@SDLK_r)
        (randomize cells))
      
      ;; Flip the buffer
      (==> scr flip)
      )))

(dhc-make () makewrappable lifesim randomize )

(life)