Last active
April 3, 2016 06:22
-
-
Save glider-gun/862bd661f9910f08e0ab to your computer and use it in GitHub Desktop.
Conway's lifegame on terminal, using braille to show dots
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/bin/sh | |
#|-*- mode:lisp -*-|# | |
#| | |
exec ros -Q -- $0 "$@" | |
|# | |
(ql:quickload :cl-charms :silent t) | |
(defpackage :ros.script.braille_life.3667932619 | |
(:use :cl :charms/ll)) | |
(in-package :ros.script.braille_life.3667932619) | |
;; (declaim (optimize (speed 3) (debug 0))) | |
(defun make-board (w h) | |
(make-array (list w h) | |
:element-type 'bit | |
:initial-element 0)) | |
(defun randomize-board (board) | |
(dotimes (i (array-total-size board)) | |
(setf (row-major-aref board i) (random 2))) | |
board) | |
(defun print-board-no-curses (board) | |
"print status of board to `*standard-output*`." | |
(destructuring-bind (w h) (array-dimensions board) | |
(dotimes (y h) | |
(fresh-line) | |
(dotimes (x w) | |
(princ (if (plusp (aref board x y)) "o" "_"))) | |
(terpri)))) | |
(defun board-by-braille-at (board x0 y0) | |
"return a braille character, corresponding to | |
4x2 area beginning at (`x0`, `y0`) of `board`." | |
(declare (type (simple-array bit) board) | |
(type fixnum x0 y0)) | |
(let ((shift | |
(+ (* (aref board (+ x0 0) (+ y0 0)) 1) | |
(* (aref board (+ x0 0) (+ y0 1)) 2) | |
(* (aref board (+ x0 0) (+ y0 2)) 4) | |
(* (aref board (+ x0 1) (+ y0 0)) 8) | |
(* (aref board (+ x0 1) (+ y0 1)) 16) | |
(* (aref board (+ x0 1) (+ y0 2)) 32) | |
(* (aref board (+ x0 0) (+ y0 3)) 64) | |
(* (aref board (+ x0 1) (+ y0 3)) 128))) | |
(base #x2800)) | |
(code-char (+ base shift)))) | |
(defun print-board-curses-braille (board window) | |
"display `board` into `window`, using braille" | |
(declare (type (simple-array bit) board)) | |
(destructuring-bind (w h) (array-dimensions board) | |
(declare (type fixnum w h)) | |
(let ((buf (make-string (ash w -1)))) | |
(dotimes (y (ash h -2)) | |
(dotimes (x (ash w -1)) | |
(setf (char buf x) | |
(board-by-braille-at board (* x 2) (* y 4)))) | |
(wmove window y 0) | |
(waddstr window buf))))) | |
(defun step-board (board) | |
"return a new board, representing the next generation of `board`." | |
(destructuring-bind (w h) (array-dimensions board) | |
(let ((new-board (make-board w h))) | |
(declare (type (simple-array bit) board new-board)) | |
(labels ((population-at (board x y) | |
(declare (type fixnum x y w h)) | |
(if (and (< -1 x w) | |
(< -1 y h)) | |
(aref board x y) | |
0)) | |
(count-neighbor (board x y) | |
(+ (population-at board (1- x) (1- y)) | |
(population-at board (1- x) y) | |
(population-at board (1- x) (1+ y)) | |
(population-at board x (1- y)) | |
(population-at board x (1+ y)) | |
(population-at board (1+ x) (1- y)) | |
(population-at board (1+ x) y) | |
(population-at board (1+ x) (1+ y)))) | |
(get-next-state (board x y) | |
(if (or (and (= (population-at board x y) 1) | |
(member (count-neighbor board x y) '(2 3))) | |
(and (= (population-at board x y) 0) | |
(= (count-neighbor board x y) 3))) | |
1 0))) | |
(declare (type fixnum w h)) | |
(dotimes (y h) | |
(dotimes (x w) | |
(setf (aref new-board x y) | |
(get-next-state board x y)))) | |
new-board)))) | |
(defun count-population (board) | |
"count alive cell in `board`." | |
(let ((count 0)) | |
(dotimes (i (array-total-size board)) | |
(incf count (row-major-aref board i))) | |
count)) | |
(defun run () | |
(cbreak) | |
(noecho) | |
(curs-set 0) | |
(keypad *stdscr* TRUE) | |
(nodelay *stdscr* TRUE) | |
(let ((main-window (newwin (1- *lines*) *cols* 1 0)) | |
(status-window (newwin 1 *cols* 0 0))) | |
(do ((ch (getch) (getch)) | |
(generation 0 (1+ generation)) | |
(board (randomize-board (make-board (* 2 *cols*) (* 4 (1- *lines*)))) | |
(step-board board))) | |
((= ch (char-code #\q))) | |
(when (= ch (char-code #\r)) | |
(setf board (randomize-board board) | |
generation 0)) | |
(wclear status-window) | |
(wprintw status-window " generation %4d | %4d cells alive | q to quit, r to restart" | |
:int generation | |
:int (count-population board)) | |
(wrefresh status-window) | |
(wclear main-window) | |
(print-board-curses-braille board main-window) | |
(wrefresh main-window) | |
;; (wnoutrefresh main-window) | |
;; (doupdate) | |
(sleep 0.05)) | |
(delwin main-window) | |
(delwin status-window))) | |
(defun main (&rest argv) | |
(declare (ignorable argv)) | |
(initscr) | |
(unwind-protect | |
(run) | |
(endwin))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment