Lights Out

lightsout.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(defpackage :ros.script.lightsout.3667581499
  (:use :cl))
(in-package :ros.script.lightsout.3667581499)

(ql:quickload :sketch :silent t)
(use-package :sketch)

(defparameter *width* 400)
(defparameter *height* 400)
(defparameter *size* 5)
(defvar run t)

(defsketch lights-out (:title "Lights Out!"
                              :width *width*
                              :height *height*)
    ((cells (make-array `(,*size* ,*size*)
                        :initial-element t))
     (cell-width (/ *width* *size*))
     (cell-height (/ *height* *size*))
     (light (make-pen :fill (rgb 0.380 0.695 0.086)
                      :stroke (rgb 1 1 1)))
     (dark (make-pen :fill (rgb 0.3 0.3 0.33)
                     :stroke (rgb 0.5 0.5 0.5))))
  (dotimes (y *size*)
    (dotimes (x *size*)
      (with-pen (if (aref cells y x)
                    light dark)
        (rect (1+ (* cell-width x))
              (1+ (* cell-height y))
              (- cell-width 2)
              (- cell-height 2))))))

(defmacro notf (seq &rest subscripts)
  `(setf (aref ,seq ,@subscripts)
         (not (aref ,seq ,@subscripts))))

(defmethod kit.sdl2:mousebutton-event ((window lights-out) state ts b x y)
  (when (eq state :mousebuttondown)
    (with-slots (cells cell-width cell-height) window
      (let ((cy (truncate (/ y cell-height)))
            (cx (truncate (/ x cell-width))))
        (notf cells cy cx)
        (dolist (ny '(-1 +1))
          (let ((newy (+ cy ny)))
            (when (typep newy `(mod ,*size*))
              (notf cells newy cx))))
        (dolist (nx '(-1 +1))
          (let ((newx (+ cx nx)))
            (when (typep newx `(mod ,*size*))
              (notf cells cy newx))))))))

(defmethod kit.sdl2:textinput-event ((window lights-out) tx text)
  (when (string= text "q")
    (setf run nil)))

(defun main (&rest argv)
  (declare (ignorable argv))
  (format t "type 'q' to quit~%")
  (force-output)
  (make-instance 'lights-out)
  (loop while run
     do (sleep 0.01)))