Sophie

Sophie

distrib > Fedora > 14 > x86_64 > media > updates > by-pkgid > 39fccafb9cc33eb5e2c44828f5a62bff > files > 26

lush-2.0-1.fc14.x86_64.rpm

#!/bin/sh
exec lush2 "$0" "$@"
!#


;; A basic implementation of Conway's Game of Life using SDL
;; Keir Mierle, Jan 2003.
;; http://keir.mierle.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; process command line arguments

(setq prob 0.2)

(cond
 ((or (member "-h" argv)
      (member "--help" argv))
  (writing "$stderr" 
	   (render-brace-text 0 72
		'{<p> Synopsis: ,,(basename (or (car argv) "")) [-h] [-p prob] {<br>}
		A simple implementation of Conway's Game of Life.
		{<ul>
		{<li> "-h": show this message}
		{<li> "-p prob": set the probability of an on cell to "prob"
		for the random initialization. "prob" should be a real
		number between 0 and 1 (the default value is 0.2)}}
		While the program is running, press the "r" key
		to restart from a random configuration, and
		press "q" to quit.
		}))
  (exit 0))
 ((setq zz (member "-p" argv))
  (if (not (cadr zz))
      (progn
	(writing "$stderr" (printf "probability value missing\n"))
	(exit 1))
    (setq zz (val (cadr zz)))
    (if (and zz (<= zz 1) (>= zz 0))
	(setq prob zz) 
      (writing "$stderr" (printf "illegal probability\n"))
      (exit 1))))) )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; run life

;; the compiled functions are in a separate file.
;; We don't have to tell lush where to find the
;; file because the directory of the file being
;; loaded (i.e. the present file) is always searched first.

(libload "lushlife.lsh")

(setq WIDTH 640)
(setq HEIGHT 480)
(setq CONST_255 (ubyte-array))
(CONST_255 255)

(de life ()
    (new-window WIDTH HEIGHT)
    (let* ((evlock (new EventLock window))
	   (event ())
	   (accum (ubyte-array HEIGHT WIDTH))
	   (cells (ubyte-array (+ HEIGHT 2) (+ WIDTH 2)))
	   (stop ()))
      
      ;; initialize cells
      (randomize cells prob)
      
      (while (and window (not stop))
	
	;; Perform the simulation
	(lifesim cells accum)

	;; Draw the cells matrix to the display matrix
	(graphics-batch
	 (rgb-draw-matrix 0 0 
	   (idx-dotm0 (narrow (narrow cells 0 HEIGHT 1) 1 WIDTH 1) CONST_255)) )
	
	(while (setq event (==> evlock check-event))
	  (selectq (car event)
		   (("q" delete) (setq stop t))
		   ("r" (randomize cells prob)) ) ) ) ) )

(writing "$stderr" (printf "Press 'r' to restart. Press 'q' to quit\n"))
(life)