From 6f866d5383a5ff01964b17f524d976598fbd9c09 Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Fri, 22 Mar 2013 02:24:14 +0000 Subject: [PATCH] Initial commit. --- .gitignore | 2 + atoms.lisp | 1157 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ atoms.png | Bin 0 -> 3380 bytes atoms.svgz | Bin 0 -> 1781 bytes 4 files changed, 1159 insertions(+) create mode 100644 .gitignore create mode 100644 atoms.lisp create mode 100644 atoms.png create mode 100644 atoms.svgz diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..85552a5 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.x86f +*.fasl diff --git a/atoms.lisp b/atoms.lisp new file mode 100644 index 0000000..e1c331c --- /dev/null +++ b/atoms.lisp @@ -0,0 +1,1157 @@ +;;; -*-lisp-*- +;;; +;;; Atoms game +;;; +;;; (c) 2007 Mark Wooding +;;; + +;;;----- Licensing notice --------------------------------------------------- +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 of the License, or +;;; (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software Foundation, +;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +(cl:defpackage #:atoms + (:use #:cl + #+cmu #:ext + #+sbcl #:sb-ext + #+clisp #:ext) + #+clisp (:shadow #:map-dependents #:add-dependent #:remove-dependent) + (:export #:start-atom-game)) +(cl:in-package #:atoms) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (asdf:operate 'asdf:load-op :gtk)) + +(clg:clg-init) + +;;; Before we start, I should probably point out that the first version of +;;; this program was written in Smalltalk, which may explain its slight +;;; object-ravioli nature. + +;;;-------------------------------------------------------------------------- +;;; Dependent management. + +;; Protocol. + +(defgeneric notify (dependent model aspect &key &allow-other-keys) + (:method-combination progn) + (:method progn (dependent model aspect &rest arguments) + (declare (ignore arguments)) + nil)) + +(defgeneric map-dependents (model function)) +(defgeneric add-dependent (model dependent)) +(defgeneric remove-dependent (model dependent)) + +(defgeneric changed (model &optional aspect &key &allow-other-keys) + (:method (model &optional aspect &rest arguments) + (map-dependents model + (lambda (dependent) + (apply #'notify dependent model aspect arguments))))) + +;; Generic implementation. + +(defclass model () + ((dependents :type list :initform nil))) + +(defun clean-up-danglies (model) + (with-slots (dependents) model + (setf dependents + (delete-if-not (lambda (weak) + (nth-value 1 (weak-pointer-value weak))) + dependents)))) + +(defmethod map-dependents ((model model) function) + (with-slots (dependents) model + (let ((danglies nil)) + (dolist (dependent dependents) + (multiple-value-bind (object foundp) + (weak-pointer-value dependent) + (if foundp + (funcall function object) + (setf danglies t)))) + (when danglies (clean-up-danglies model)) + nil))) + +(defmethod add-dependent ((model model) dependent) + (let ((foundp (block nil + (map-dependents model + (lambda (dep) + (when (eql dependent dep) + (return t))))))) + (unless foundp + (push (make-weak-pointer dependent) + (slot-value model 'dependents))))) + +(defmethod remove-dependent ((model model) dependent) + (with-slots (dependents) model + (setf dependents (delete dependent dependents + :key #'weak-pointer-value)) + (clean-up-danglies model))) + +;;;-------------------------------------------------------------------------- +;;; Undo and redo. + +(defclass undoable () + ((undo-list :type list :reader undo-list :initform nil) + (redo-list :type list :reader redo-list :initform nil))) + +(defgeneric snapshot (object)) +(defgeneric restore (object snapshot)) +(defgeneric store-undo-snapshot (object snapshot)) +(defgeneric undo (object)) +(defgeneric redo (object)) +(defgeneric reset-undo-state (object)) + +(defmethod store-undo-snapshot ((object undoable) snapshot) + (push snapshot (slot-value object 'undo-list)) + (setf (slot-value object 'redo-list) nil)) + +(defmacro with-undo-snapshot ((object) &body body) + (let ((snap (gensym "SNAPSHOT")) + (obj (gensym "OBJECT"))) + `(let* ((,obj ,object) + (,snap (snapshot ,obj))) + (multiple-value-prog1 (progn ,@body) + (store-undo-snapshot ,obj ,snap))))) + +(defun undo-redo (object from to) + (let ((from-list (slot-value object from))) + (assert from-list) + (let ((undo-snap (car from-list)) + (here-snap (snapshot object))) + (restore object undo-snap) + (push here-snap (slot-value object to)) + (pop (slot-value object from))))) + +(defmethod undo ((object undoable)) + (undo-redo object 'undo-list 'redo-list)) + +(defmethod redo ((object undoable)) + (undo-redo object 'redo-list 'undo-list)) + +(defmethod reset-undo-state ((object undoable)) + (setf (slot-value object 'undo-list) nil + (slot-value object 'redo-list) nil)) + +(defclass undoable-model (undoable model) + ()) + +(defmethod undo :after ((object undoable-model)) + (changed object :undo)) + +(defmethod redo :after ((object undoable-model)) + (changed object :redo)) + +;;;-------------------------------------------------------------------------- +;;; Main game logic. + +;; Protocol. + +(defclass atom-cell () + ((owner :reader cell-owner :initform nil :type (or fixnum null)) + (count :reader cell-count :initform 0 :type fixnum) + (pending :initform 0 :type fixnum) + (neighbours :reader cell-neighbours :type list :initform nil) + (x :reader cell-x :initarg :x :type fixnum) + (y :reader cell-y :initarg :y :type fixnum))) + +(defgeneric cell-played (cell player)) +(defgeneric cell-critical-p (cell)) +(defgeneric cell-explode (cell)) +(defgeneric cell-apply-pending-updates (cell)) +(defun cell-position (cell) (vector (cell-x cell) (cell-y cell))) + +(defun make-atoms-grid (width height) + (let ((grid (make-array (list height width) :element-type 'atom-cell))) + (dotimes (j height) + (dotimes (i width) + (setf (aref grid j i) (make-instance 'atom-cell :x i :y j)))) + (dotimes (j height) + (dotimes (i width) + (setf (slot-value (aref grid j i) 'neighbours) + (nconc (and (> j 0) (list (aref grid (1- j) i))) + (and (> i 0) (list (aref grid j (1- i)))) + (and (< i (1- width)) (list (aref grid j (1+ i)))) + (and (< j (1- height)) (list (aref grid (1+ j) i))))))) + grid)) + +(defclass player () + ((name :accessor player-name :initarg :name :type string) + (score :accessor player-score :initform 0 :type fixnum) + (state :accessor player-state :initform :starting + :type (member :starting :playing :ready :losing :winning)) + (colour :accessor player-colour :initarg :colour :type gdk:color))) + +(defclass human-player (player) ()) + +(defgeneric player-cell-selected (game player i j) + (:method (game player i j) nil)) +(defgeneric player-turn-begin (game player) + (:method (game player) nil)) + +(defclass atom-game (undoable-model) + ((grid :accessor game-grid :initarg :grid :type (array atom-cell (* *))) + (players :accessor game-players :initarg :players :type vector) + (player-index :accessor game-player-index :initform 0 :type fixnum) + (timeout-id :initform nil))) + +(defgeneric game-cell-selected (game i j)) +(defgeneric play-cell (game player i j)) + +;; Implementation. + +(defmethod cell-played ((cell atom-cell) player) + (with-slots (owner count) cell + (cond ((zerop count) (setf owner player count 1) t) + ((eql owner player) (incf count) t) + (t nil)))) + +(defmethod cell-critical-p ((cell atom-cell)) + (with-slots (count neighbours) cell + (>= count (length neighbours)))) + +(defmethod cell-explode ((cell atom-cell)) + (with-slots (count neighbours owner pending) cell + (multiple-value-bind (spill left) (floor count (length neighbours)) + (and (plusp spill) + (progn + (dolist (neighbour neighbours) + (incf (slot-value neighbour 'pending) spill) + (setf (slot-value neighbour 'owner) owner)) + (setf count left) + (when (zerop left) + (setf owner nil)) + (cons cell (copy-list neighbours))))))) + +(defmethod cell-apply-pending-updates ((cell atom-cell)) + (with-slots (count pending) cell + (incf count pending) + (setf pending 0))) + +(deftype cell-snapshot () '(unsigned-byte 16)) + +(defmethod snapshot ((cell atom-cell)) + (with-slots (count owner) cell + (cond ((null owner) 0) + (t (assert (and (<= 0 count 255) + (<= 0 owner 255))) + (logior (ash owner 8) + (ash count 0)))))) + +(defmethod restore ((cell atom-cell) (snapshot integer)) + (declare (type cell-snapshot snapshot)) + (with-slots (count owner) cell + (setf (values count owner) + (if (zerop snapshot) + (values 0 nil) + (values (ldb (byte 8 0) snapshot) + (ldb (byte 8 8) snapshot)))))) + +(defmethod player-cell-selected (game (player human-player) i j) + (and (eql (player-state player) :ready) + (play-cell game player i j))) + +(defmethod snapshot ((player player)) + (list (player-score player) (player-state player))) + +(defmethod restore ((player player) (list list)) + (destructuring-bind (score state) list + (setf (player-score player) score + (player-state player) state))) + +(defmethod game-update-scores (game) + (let ((players (game-players game)) + (grid (game-grid game))) + (dotimes (i (length players)) + (setf (player-score (aref players i)) 0)) + (dotimes (i (array-total-size grid)) + (let* ((cell (row-major-aref grid i)) + (owner (cell-owner cell)) + (player (and owner (aref players owner))) + (count (cell-count cell))) + (when (and player (plusp count)) + (incf (player-score player) count)))) + (let ((remaining 0) (found nil)) + (dotimes (i (length players)) + (let* ((player (aref players i)) + (score (player-score player)) + (state (player-state player))) + (cond ((and (zerop score) (eql state :playing)) + (setf (player-state player) :losing)) + ((member state '(:playing :starting)) + (incf remaining) + (setf found player))))) + (changed game :scores :players players) + (when (= remaining 1) + (setf (player-state found) :winning) + (changed game :finished :victor found))))) + +(defmethod game-next-player (game) + (let ((players (game-players game)) + (player-index (game-player-index game))) + (dotimes (i (length players)) + (let* ((j (mod (+ player-index i 1) (length players))) + (player (aref players j))) + (when (member (player-state player) '(:starting :playing)) + (setf (game-player-index game) j + (player-state player) :ready) + (player-turn-begin game player) + (changed game :start-turn :player player) + (return)))))) + +(defvar *cells-remaining* nil) + +(defun perform-pending-explosions (game cells) + (let ((affected (delete-duplicates + (mapcan #'cell-explode cells)))) + (mapc #'cell-apply-pending-updates affected) + (perform-explosions game affected))) + +(defvar *explosion-time* 100) + +(defun perform-explosions (game cells) + (game-update-scores game) + (changed game :cell-update :cells cells) + (let ((critical (delete-if-not #'cell-critical-p cells))) + (setf *cells-remaining* critical) + (cond ((null critical) (game-next-player game) t) + (t (with-slots (timeout-id) game + (setf timeout-id (glib:timeout-add + *explosion-time* + (lambda () + (setf timeout-id nil) + (perform-pending-explosions game critical) + nil)))))) + t)) + +(defun game-cancel-timeout (game) + (with-slots (timeout-id) game + (when timeout-id + (glib:source-remove timeout-id) + (setf timeout-id nil)))) + +(defmethod game-player ((game atom-game)) + (aref (game-players game) (game-player-index game))) + +(defmethod game-cell-selected ((game atom-game) i j) + (player-cell-selected game (game-player game) i j)) + +(defmethod initialize-instance :after ((game atom-game) &key) + (setf (player-state (game-player game)) :ready)) + +(defmethod play-cell ((game atom-game) player i j) + (with-slots (grid players player-index) game + (assert (and (<= 0 i) (< i (array-dimension grid 1)) + (<= 0 j) (< j (array-dimension grid 0)))) + (let ((cell (aref grid j i)) + (player (aref players player-index))) + (block escape + (with-undo-snapshot (game) + (unless (cell-played cell player-index) + (return-from escape)) + (setf (player-state player) :playing) + (perform-explosions game (list cell))) + (changed game :processing-move))))) + +(defmethod restart-game ((game atom-game) &key grid players) + (game-cancel-timeout game) + (setf (game-grid game) + (or grid + (let ((old (game-grid game))) + (make-atoms-grid (array-dimension old 1) + (array-dimension old 0))))) + (if players + (setf (game-players game) players) + (setf players (game-players game))) + (reset-undo-state game) + (dotimes (i (length players)) + (let ((player (aref players i))) + (setf (player-score player) 0 + (player-state player) (if (zerop i) :ready :starting)))) + (setf (game-player-index game) 0) + (changed game :refresh)) + +;;;-------------------------------------------------------------------------- +;;; Snapshots and undo. + +(defclass atom-game-snapshot () + ((grid :type (array cell-snapshot (* *)) :initarg :grid) + (players :type list :initarg :players) + (player-index :type fixnum :initarg :player-index))) + +(defmethod snapshot ((game atom-game)) + (let* ((grid (game-grid game)) + (grid-snapshot (make-array (array-dimensions grid) + :element-type 'cell-snapshot + :initial-element 0))) + (dotimes (i (array-total-size grid)) + (setf (row-major-aref grid-snapshot i) + (snapshot (row-major-aref grid i)))) + (make-instance 'atom-game-snapshot + :players (map 'list #'snapshot (game-players game)) + :player-index (game-player-index game) + :grid grid-snapshot))) + +(defmethod restore ((game atom-game) (snapshot atom-game-snapshot)) + (let ((snap-grid (slot-value snapshot 'grid)) + (snap-players (slot-value snapshot 'players)) + (grid (game-grid game)) + (players (game-players game))) + (dotimes (i (array-total-size grid)) + (restore (row-major-aref grid i) + (row-major-aref snap-grid i))) + (loop for player across players + for snap-player in snap-players + do (restore player snap-player)) + (setf (game-player-index game) (slot-value snapshot 'player-index)) + (changed game :refresh))) + +;;;-------------------------------------------------------------------------- +;;; The interactive board. + +(defclass atoms-board (gtk:drawing-area) + ((game :accessor board-game :initarg :game :type atom-game) + (cache :initform nil :accessor board-cache)) + (:metaclass glib:gobject-class)) + +(defmethod board-grid ((board atoms-board)) + (game-grid (board-game board))) + +(defgeneric paint (widget event)) + +(defun paint-atoms (cr count colour) + (let* ((centrep (and (oddp count) (/= count 3))) + (surround (if centrep (1- count) count)) + (angle (and (plusp surround) (/ (* 2 pi) surround))) + (theta (case count + ((0 1 2 3) (/ pi 2)) + (t (/ (- pi angle) 2)))) + (radius 0.15) + (sep (cond ((and centrep (<= surround 6)) (* 2 radius)) + ((<= surround 2) radius) + (t (/ radius (sin (/ angle 2))))))) + (when centrep + (cairo:new-sub-path cr) + (cairo:arc cr 0 0 radius 0 (* 2 pi))) + (dotimes (i surround) + (cairo:new-sub-path cr) + (cairo:arc cr + (* sep (cos theta)) + (- (* sep (sin theta))) + radius + 0 + (* 2 pi)) + (incf theta angle)) + (gdk:cairo-set-source-color cr (gdk:ensure-color colour)) + (cairo:fill cr t) + (setf (cairo:line-width cr) + (max 0.02 (cairo:device-to-user-distance cr 1))) + (cairo:set-source-color cr 0 0 0) + (cairo:stroke cr nil))) + +(defparameter cache-limit 8) + +(defun make-cached-atom-surfaces (board colour) + (multiple-value-bind (width height) (gtk:widget-get-size-allocation board) + (let* ((vector (make-array cache-limit)) + (grid (board-grid board)) + (surface-width (floor width (array-dimension grid 1))) + (surface-height (floor height (array-dimension grid 0)))) + (dotimes (i (length vector)) + (let* ((surface (make-instance 'cairo:image-surface + :width surface-width + :height surface-height + :format :argb32)) + (cr (make-instance 'cairo:context :target surface))) + (cairo:scale cr surface-width surface-height) + (cairo:translate cr 0.5 0.5) + (paint-atoms cr (1+ i) colour) + (setf (aref vector i) surface))) + vector))) + +(defun cached-atom-surface (board count colour) + (let ((cache (board-cache board))) + (unless cache + (setf cache (make-hash-table) + (board-cache board) cache)) + (let ((vector (gethash colour cache))) + (unless vector + (setf vector (make-cached-atom-surfaces board colour) + (gethash colour cache) vector)) + (and (< 0 count) (<= count (length vector)) + (aref vector (1- count)))))) + +(defmethod paint ((widget atoms-board) event) + (multiple-value-bind (width height) (gtk:widget-get-size-allocation widget) + (let* ((style (gtk:widget-style widget)) + (grid (board-grid widget)) + (vsq (array-dimension grid 0)) + (hsq (array-dimension grid 1)) + (game (board-game widget)) + (players (game-players game)) + lo-hsq hi-hsq lo-vsq hi-vsq + (display (gtk:widget-get-display widget)) + (region (make-instance 'gdk:region)) + (redraw-map (make-array (list vsq hsq) + :element-type 'bit + :initial-element 0))) + + (loop (let* ((loh (floor (* (gdk:event-x event) hsq) width)) + (hih (ceiling (* (+ (gdk:event-x event) + (gdk:event-width event)) + hsq) + width)) + (lov (floor (* (gdk:event-y event) vsq) height)) + (hiv (ceiling (* (+ (gdk:event-y event) + (gdk:event-height event)) + vsq) + height))) + (gdk:region-union region + (vector (gdk:event-x event) + (gdk:event-y event) + (gdk:event-width event) + (gdk:event-height event))) + (when (or (null lo-hsq) (< loh lo-hsq)) (setf lo-hsq loh)) + (when (or (null hi-hsq) (< hih hi-vsq)) (setf hi-hsq hih)) + (when (or (null lo-vsq) (< lov lo-hsq)) (setf lo-vsq lov)) + (when (or (null hi-vsq) (< hiv hi-vsq)) (setf hi-vsq hiv)) + (do ((j lov (1+ j))) ((>= j hiv)) + (do ((i loh (1+ i))) ((>= i hih)) + (setf (bit redraw-map j i) 1))) + (when (zerop (gdk:event-count event)) + (return)) + (setf event (gdk:display-get-event display)))) + + (gdk:with-cairo-context (cr (gtk:widget-window widget)) + (cairo:reset-clip cr) + (gdk:cairo-region cr region) + (cairo:clip cr) + (cairo:with-context (cr) + (gdk:cairo-set-source-color cr (gtk:style-fg style :normal)) + (cairo:translate cr 1/2 1/2) + (setf (cairo:line-width cr) 1 + (cairo:antialias cr) :none) + (let ((h (1- height)) (w (1- width))) + (do ((j lo-vsq (1+ j))) ((> j hi-vsq)) + (let ((y (round (* j h) vsq))) + (cairo:move-to cr 0 y) + (cairo:line-to cr w y))) + (do ((i lo-hsq (1+ i))) ((> i hi-hsq)) + (let ((x (round (* i w) hsq))) + (cairo:move-to cr x 0) + (cairo:line-to cr x h)))) + (cairo:stroke cr)) + (do ((j lo-vsq (1+ j))) ((>= j hi-vsq)) + (do ((i lo-hsq (1+ i))) ((>= i hi-hsq)) + (when (plusp (bit redraw-map j i)) + (let* ((cell (aref grid j i)) + (count (cell-count cell)) + (colour (and (plusp count) (cell-owner cell) + (player-colour + (aref players + (cell-owner cell))))) + (surface (and colour + (cached-atom-surface widget + count colour)))) + (cond ((or (zerop count) (null (cell-owner cell))) + nil) + ((null surface) + (cairo:with-context (cr) + (cairo:scale cr (/ width hsq) (/ height vsq)) + (cairo:translate cr (+ i 0.5) (+ j 0.5)) + (paint-atoms cr count colour))) + (t + (cairo:set-source-surface cr surface + (round (* i width) hsq) + (round (* j height) vsq)) + (cairo:paint cr))))))))))) + +(defun board-set-size-request (board) + (when (slot-boundp board 'game) + (let ((grid (board-grid board))) + (gtk:widget-set-size-request board + (* 50 (array-dimension grid 1)) + (* 50 (array-dimension grid 0)))))) + +(defmethod (setf board-game) :before (game (board atoms-board)) + (when (slot-boundp board 'game) + (remove-dependent (board-game board) board))) + +(defmethod (setf board-game) :after (game (board atoms-board)) + (board-set-size-request board) + (add-dependent game board)) + +(defmethod resized ((board atoms-board) allocation) + (setf (board-cache board) nil) + nil) + +(defmethod notify progn + ((board atoms-board) (game atom-game) (aspect (eql :cell-update)) + &key cells) + (unless (slot-boundp board 'gtk:window) (return-from notify)) + (multiple-value-bind (width height) (gtk:widget-get-size-allocation board) + (let* ((region (make-instance 'gdk:region)) + (grid (board-grid board)) + (hsq (array-dimension grid 1)) + (vsq (array-dimension grid 0))) + (dolist (cell cells) + (gdk:region-union region + (vector (floor (* (cell-x cell) width) hsq) + (floor (* (cell-y cell) height) vsq) + (ceiling width hsq) + (ceiling height vsq)))) + (gdk:window-invalidate-region (gtk:widget-window board) region nil)))) + +(defmethod notify progn + ((board atoms-board) (game atom-game) (aspect (eql :refresh)) &key) + (board-set-size-request board) + (setf (board-cache board) nil) + (gtk:widget-queue-draw board)) + +(defmethod button-press ((widget atoms-board) event) + (case (gdk:event-class-type (class-of event)) + (:button-press + (case (gdk:event-button event) + (1 (multiple-value-bind (width height) + (gtk:widget-get-size-allocation widget) + (let* ((grid (board-grid widget)) + (x (floor (* (gdk:event-x event) (array-dimension grid 1)) + width)) + (y (floor (* (gdk:event-y event) (array-dimension grid 0)) + height))) + (game-cell-selected (board-game widget) x y) + t))))))) + +(defmethod initialize-instance :after ((board atoms-board) &key) + (gtk:signal-connect board :expose-event #'paint :object t) + (setf (gtk:widget-events board) (list :button-press)) + (gtk:signal-connect board :button-press-event #'button-press :object t) + (gtk:signal-connect board :size-allocate #'resized :object t) + (when (slot-boundp board 'game) (add-dependent (board-game board) board)) + (board-set-size-request board)) + +;;;-------------------------------------------------------------------------- +;;; Tree view utilities. + +(defun add-tree-view-column (view title &rest args) + (let ((column (apply #'make-instance + 'gtk:tree-view-column + :title title + args))) + (gtk:tree-view-append-column view column) + column)) + +(defun add-cell-renderer + (view column attrs + &key (type 'gtk:cell-renderer-text) pack-args renderer-args) + (let ((renderer (apply #'make-instance type renderer-args)) + (store (gtk:tree-view-model view))) + (apply #'gtk:cell-layout-pack column renderer pack-args) + (loop for (attribute col-name) on attrs by #'cddr + do (gtk:cell-layout-add-attribute + column renderer attribute + (gtk:tree-model-column-index store col-name))) + renderer)) + +;;;-------------------------------------------------------------------------- +;;; The player list. + +(defvar *player-list*) +(defvar *player-list-view*) + +(defclass player-list (gtk:tree-view) + ((store :initform (make-instance + 'gtk:list-store + :column-names '(colour name score state) + :column-types '(gdk:color string integer string)) + :type gtk:list-store) + (game :initarg :game :type atom-game)) + (:metaclass glib:gobject-class)) + +(defun update-player-list (list game) + (let ((store (slot-value list 'store)) + (players (game-players game))) + (gtk:list-store-clear store) + (loop for player across players + for i from 0 + do (gtk:list-store-append store + (vector (player-colour player) + (player-name player) + (player-score player) + (case (player-state player) + (:losing "out") + (:winning "winner!") + (:ready "<<<") + (t ""))))))) + +(defmethod initialize-instance :after ((list player-list) &key) + (let ((store (slot-value list 'store))) + (setf (gtk:tree-view-model list) store) + (flet ((add-column (&rest args) + (apply #'add-tree-view-column list args)) + (add-renderer (&rest args) + (apply #'add-cell-renderer list args))) + (add-renderer (add-column "" + :expand nil + :sizing :fixed + :fixed-width 20) + '(:cell-background-gdk colour) + :renderer-args '(:cell-background-set t)) + (add-renderer (add-column "Name" :resizable t :expand t) '(:text name)) + (add-renderer (add-column "Score" :resizable t) '(:text score)) + (add-renderer (add-column "State" :resizable t) '(:text state))) + (setf (gtk:tree-selection-mode (gtk:tree-view-selection list)) :none) + (when (slot-boundp list 'game) + (with-slots (game) list + (add-dependent game list) + (update-player-list list game))))) + +(defmethod notify progn ((list player-list) (game atom-game) aspect &key) + (case aspect + ((:cell-update :start-turn :refresh) + (update-player-list list game)))) + +;;;-------------------------------------------------------------------------- +;;; New game dialogue. + +(defparameter *player-colours* + (vector "red" "blue" "green" "orange" "magenta" "white" "black")) + +(defclass new-game-dialogue (gtk:dialog) + ((game :initarg :game :type atom-game) + (width-adjustment :type gtk:adjustment + :initform (make-instance 'gtk:adjustment + :lower 1 :upper 99 + :step-increment 1)) + (height-adjustment :type gtk:adjustment + :initform (make-instance 'gtk:adjustment + :lower 1 :upper 99 + :step-increment 1)) + (count-adjustment :type gtk:adjustment + :initform (make-instance 'gtk:adjustment + :lower 2 :upper 20 + :step-increment 1)) + (players :type gtk:list-store + :initform (make-instance 'gtk:list-store + :column-types '(gdk:color string) + :column-names '(colour name)))) + (:default-initargs + :title "New game" + :default-height 360 + :has-separator nil) + (:metaclass glib:gobject-class)) + +(defun choose-player-colour (window path) + (let* ((players (slot-value window 'players)) + (colour-dialogue (make-instance 'gtk:color-selection-dialog)) + (coloursel (gtk:color-selection-dialog-colorsel colour-dialogue)) + (colour (gtk:tree-model-value players path 'colour))) + (unwind-protect + (progn + (setf (gtk:color-selection-current-color coloursel) colour + (gtk:color-selection-previous-color coloursel) colour) + (case (gtk:dialog-run colour-dialogue) + (:ok (setf (gtk:tree-model-value players path 'colour) + (gtk:color-selection-current-color coloursel))))) + (gtk:widget-destroy colour-dialogue)))) + +(defun insert-or-remove-players (window) + (let* ((players (slot-value window 'players)) + (current-count (gtk:tree-model-iter-n-children players)) + (new-count (floor (gtk:adjustment-value + (slot-value window 'count-adjustment))))) + (if (> current-count new-count) + (let ((iter (make-instance 'gtk:tree-iter))) + (gtk:tree-model-get-iter players (vector new-count) iter) + (dotimes (i (- current-count new-count)) + (gtk:list-store-remove players iter))) + (loop with iter = (make-instance 'gtk:tree-iter) + for i from current-count below new-count + for colour = (if (< i (length *player-colours*)) + (gdk:color-parse (aref *player-colours* i)) + (make-instance 'gdk:color + :red (random 1.0) + :green (random 1.0) + :blue (random 1.0))) + for name = (format nil "Player ~A" (1+ i)) + do (gtk:list-store-append players + (vector colour name) + iter))))) + +(defun start-new-game (window) + (with-slots (game width-adjustment height-adjustment players) window + (let ((grid (make-atoms-grid + (floor (gtk:adjustment-value width-adjustment)) + (floor (gtk:adjustment-value height-adjustment)))) + (new-players (let ((iter (make-instance 'gtk:tree-iter))) + (gtk:tree-model-get-iter players #(0) iter) + (loop for row = (gtk:tree-model-row-data players + iter) + collect (make-instance 'human-player + :colour (aref row 0) + :name (aref row 1)) + while (gtk:tree-model-iter-next players + iter))))) + (restart-game game :grid grid :players (coerce new-players 'vector)) + (gtk:widget-destroy window)))) + +(defmethod initialize-instance :after ((window new-game-dialogue) &key) + (with-slots (width-adjustment height-adjustment count-adjustment players) + window + (let* ((game (slot-value window 'game)) + (grid (game-grid game))) + + (setf (gtk:container-border-width window) 4) + (gtk:dialog-add-button window "gtk-cancel" + #'gtk:widget-destroy :object t) + (gtk:dialog-add-button window "gtk-ok" + (lambda () (start-new-game window)) + :default t) + + (setf (gtk:adjustment-value width-adjustment) + (array-dimension grid 1) + (gtk:adjustment-value height-adjustment) + (array-dimension grid 0) + (gtk:adjustment-value count-adjustment) + (length (game-players game))) + + (let* ((frame (make-instance 'gtk:frame :label "Board size")) + (table (make-instance 'gtk:table + :parent frame + :border-width 4 + :n-columns 2 :n-rows 2 + :row-spacing 4 :column-spacing 4))) + (loop for row from 0 + for (adj-slot label) on '(width-adjustment "Width" + height-adjustment "Height") by #'cddr + do (make-instance 'gtk:label + :label label + :xalign 1 + :parent (list table + :top-attach row + :bottom-attach (1+ row) + :left-attach 0 + :right-attach 1 + :x-options '(:fill))) + do (make-instance 'gtk:spin-button + :numeric t + :width-chars 2 + :adjustment (slot-value window adj-slot) + :xalign 1 + :activates-default t + :parent (list table + :top-attach row + :bottom-attach (1+ row) + :left-attach 1 + :right-attach 2 + :x-options '(:expand :fill)))) + (gtk:container-add window frame :fill nil :expand nil) + (gtk:widget-show-all frame)) + + (let* ((frame (make-instance 'gtk:frame :label "Players")) + (vbox (make-instance 'gtk:v-box + :parent frame :spacing 4 + :border-width 4)) + (view (make-instance 'gtk:tree-view + :model players))) + (make-instance 'gtk:h-box + :spacing 4 + :parent (list vbox :expand nil :fill nil) + :child (list (make-instance 'gtk:label + :label "Number of players" + :xalign 1) + :expand nil :fill nil) + :child (list (make-instance 'gtk:spin-button + :adjustment + count-adjustment + :numeric t + :width-chars 2 + :activates-default t + :xalign 1) + :expand t :fill t)) + (make-instance 'gtk:scrolled-window + :hscrollbar-policy :automatic + :vscrollbar-policy :automatic + :shadow-type :in + :child view + :parent vbox) + (add-cell-renderer view + (add-tree-view-column view "" + :sizing :fixed + :fixed-width 20) + (list :cell-background-gdk 'colour) + :renderer-args '(:cell-background-set t)) + (let ((renderer (add-cell-renderer view + (add-tree-view-column view "Name") + (list :text 'name) + :renderer-args '(:editable t)))) + (gtk:signal-connect renderer :edited + (lambda (path new-text) + (setf (gtk:tree-model-value + players + path + 'name) + new-text)))) + (gtk:signal-connect view :row-activated + (lambda (path column) + (when (eql (position column + (gtk:tree-view-columns + view)) + 0) + (choose-player-colour window path)))) + (loop for player across (game-players game) + do (gtk:list-store-append players + (vector (player-colour player) + (player-name player)))) + (gtk:signal-connect count-adjustment + :value-changed + #'insert-or-remove-players :args (list window)) + (gtk:container-add window frame :fill t :expand t) + (gtk:widget-show-all frame))))) + +;;;-------------------------------------------------------------------------- +;;; About this program. + +(defparameter atoms-logo-pixbuf + (gdk:pixbuf-load #p"/home/mdw/src/atoms/atoms.png")) + +(defparameter licence-text + (format nil + "This program is free software; you can redistribute it and/or modify ~ + it under the terms of the GNU General Public License as published by ~ + the Free Software Foundation; either version 2 of the License, or ~ + (at your option) any later version.~2%~ + ~ + This program is distributed in the hope that it will be useful, ~ + but WITHOUT ANY WARRANTY; without even the implied warranty of ~ + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ~ + GNU General Public License for more details.~2%~ + ~ + You should have received a copy of the GNU General Public License ~ + along with this program; if not, write to the Free Software Foundation, ~ + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.")) + +(let ((about nil)) + (defun action-about (window) + (declare (ignore window)) + (unless about + (setf about (make-instance + 'gtk:about-dialog + :name "Atoms" + :version "1.0.0" + :copyright "Copyright (c) 2007 Mark Wooding" + :website "http://www.distorted.org.uk/" + :website-label "Homepage" + :authors (list "Mark Wooding ") + :comments "May contain trace quantities of Lisp." + :license licence-text + :wrap-license t + :logo atoms-logo-pixbuf + :signal (list :destroy (lambda () (setf about nil))) + :signal (list :cancel (lambda () + (gtk:widget-destroy about)))))) + (gtk:window-present about))) + +;;;-------------------------------------------------------------------------- +;;; Application window. + +(defclass atom-game-window (gtk:window) + ((game :type atom-game) + (board :type atoms-board) + (player-list :type player-list) + (actions :type gtk:action-group) + (ui :type gtk:ui-manager) + (new-game :type (or new-game-dialogue null) :initform nil)) + (:default-initargs :title "Atoms game" :allow-shrink t :show-children t) + (:metaclass glib:gobject-class)) + +(defun action-quit (window) + (gtk:widget-destroy window)) + +(defun action-new-game (window) + (with-slots (new-game game) window + (if new-game + (gtk:window-present new-game) + (progn + (setf new-game (make-instance 'new-game-dialogue + :game game + :transient-for window)) + (gtk:widget-show-all new-game) + (gtk:signal-connect new-game :destroy + (lambda () (setf new-game nil))))))) + +(defun update-undo-redo-sensitivity (window) + (with-slots (actions game) window + (setf (gtk:action-sensitive-p + (gtk:action-group-get-action actions "undo")) + (undo-list game) + (gtk:action-sensitive-p + (gtk:action-group-get-action actions "redo")) + (redo-list game)))) + +(defmethod notify progn + ((window atom-game-window) (game atom-game) aspect &key) + (case aspect + ((:undo :redo :refresh :processing-move) + (update-undo-redo-sensitivity window)))) + +(defun action-undo (window) + (undo (slot-value window 'game))) + +(defun action-redo (window) + (redo (slot-value window 'game))) + +(defmethod destroyed ((window atom-game-window)) + (with-slots (new-game) window + (when new-game (gtk:widget-destroy new-game)))) + +(defun build-player-vector (player-spec) + (flet ((make-player (spec i) + (etypecase spec + (player spec) + ((or string list) + (destructuring-bind + (name &key colour) + (if (listp spec) spec (list spec)) + (cond (colour) + ((< i (length *player-colours*)) + (setf colour (aref *player-colours* i))) + (t (setf colour + (make-instance 'gdk:color + :red (random 1.0) + :green (random 1.0) + :blue (random 1.0))))) + (make-instance 'human-player + :name name + :colour (gdk:ensure-color colour))))))) + (let ((i 0)) + (map 'vector + (lambda (spec) + (make-player spec (prog1 i (incf i)))) + (etypecase player-spec + (sequence player-spec) + ((or integer null) + (loop for i from 1 upto (or player-spec 4) + collect (format nil "Player ~A" i)))))))) + +(defmethod shared-initialize :after + ((window atom-game-window) slot-names + &key + (width 7) (height width) players) + (declare (ignore slot-names)) + (let* ((vbox (make-instance 'gtk:v-box :parent window)) + (paned (make-instance 'gtk:h-paned + :parent (list vbox :pack-type :end))) + (aspect (make-instance 'gtk:aspect-frame + :parent (list paned :resize t :shrink t) + :obey-child t + :frame :none + :shadow-type :none)) + (scrolled (make-instance 'gtk:scrolled-window + :parent (list paned :resize nil :shrink t) + :shadow-type :in + :hscrollbar-policy :automatic + :vscrollbar-policy :automatic)) + (action-list (mapcar (lambda (item) + (destructuring-bind + (name callback &rest args) item + (apply #'make-instance 'gtk:action + :name name + :callback + (and callback + (list callback + :args (list window))) + args))) + `(("file" nil :label "_File") + ("edit" nil :label "_Edit") + ("help" nil :label "_Help") + ("quit" ,#'action-quit + :stock-id "gtk-close" + :tooltip "Close this window." + :accelerator "W") + ("undo" ,#'action-undo + :stock-id "gtk-undo" + :tooltip "Take back the most recent move." + :sensitive nil + :accelerator "Z") + ("redo" ,#'action-redo + :stock-id "gtk-redo" + :sensitive nil + :tooltip "Revert an undone move." + :accelerator "Z") + ("about" ,#'action-about + :tooltip "Show information about this game." + :stock-id "gtk-about") + ("new-game" ,#'action-new-game + :label "_New game..." + :stock-id "gtk-new" + :tooltip "Start a new game." + :accelerator "N"))))) + + (with-slots (game board player-list ui actions) window + (setf actions (make-instance 'gtk:action-group + :name "actions" + :actions action-list) + ui (make-instance 'gtk:ui-manager + :add-tearoffs t + :action-group actions + :ui '((:menubar "menu-bar" + (:menu "file" + (:menuitem "new-game") + (:menuitem "quit")) + (:menu "edit" + (:menuitem "undo") + (:menuitem "redo")) + (:menu "help" + (:menuitem "about"))) + (:toolbar "toolbar" + (:toolitem "new-game") + :separator + (:toolitem "undo") + (:toolitem "redo"))))) + (gtk:window-add-accel-group window (gtk:ui-manager-accel-group ui)) + (setf (gtk:toolbar-show-arrow-p + (gtk:ui-manager-get-widget ui "/toolbar")) nil) + (dolist (name '("/menu-bar" "/toolbar")) + (make-instance 'gtk:handle-box + :child (gtk:ui-manager-get-widget ui name) + :parent (list vbox :expand nil))) + (gtk:signal-connect window :destroy #'destroyed :object t) + (setf game (make-instance 'atom-game + :grid (make-atoms-grid width height) + :players (build-player-vector players)) + board (make-instance 'atoms-board :game game :parent aspect) + player-list (make-instance 'player-list + :game game + :width-request 160 + :parent scrolled)) + + (add-dependent game window)))) + +;;;-------------------------------------------------------------------------- +;;; Useful things. + +(defvar *window* nil) + +(defun start-atom-game (&rest initargs) + (when *window* + (gtk:widget-destroy *window*) + (setf *window* nil)) + (setf *window* (apply #'make-instance 'atom-game-window initargs)) + (gtk:widget-show-all *window*)) + +(start-atom-game :width 7 :players (list "Mark" "Vicky")) + +;;;----- That's all, folks -------------------------------------------------- diff --git a/atoms.png b/atoms.png new file mode 100644 index 0000000000000000000000000000000000000000..e95dcc5c80f55ac508074a9fe72da792a5db0616 GIT binary patch literal 3380 zcmV-44a@S0P)K~!jgy_#!`T~~F-e`}v}?%X@?mp$W}U>wH|cH@N9!H_sK z35ckI21QX@QZ-epHnas*RTMSq3snLkRS}O6RG?DT2Bk$xkWkgCluxB;p{c+Ij2%0+ zV;ehuj>j|OJ2Us5dmekQe%Slox#JfzcG@K!-8&Dhwb$Bf{rCE>eMD8cSrHKd3{U~K z0q+Lx0oDSCfS&++fN3BH3ZMj>-s}QY^`@S%@LL4_$%v$Y0@`CDyQWgL?VkZP$XVc% zz-_=7&;yv8u`f3h01=6RCydCK5;6Ucy?v9}J~GbMp;0#U_9ITIw^9zwUgThXmRByG z(*upV06zjg4eSMGfK*lO4Xxou9T1UGffp1$a`)I;efGZh%Z8z0LMA+l_%eI4{;^IL=gy} ziYqO)v-pfM%_v(fie`)BbF+Nv_&$!Li`K!XfNufEgA=RTiB&rg3iellm;dxV@8c6Y z?<1~Oh$;yZMTiK_I$YtSUbZsIv_+Bn#TU(#ypb}uu)q_Cf1q_+%sTip;J<;BKyx*P zZC15Bn#jMH!5i!8CM$E`_AN;VXRC|c4JtVzVDg%AgMuw>L z_Yzktm^j8n5n=?tY2Biz!p_h*!LzmHuPM{dJ|fiS6TS zan={9$#cK{q5u*9`>ddBWfW=VYoL{3vz#)^y@MS`3)V#ydd1LGcMI?i-~ccsBE?E- zVZ{yvc{jk;!BK20M-bFnOqL_YZ>Cy@Ela=PmPel=6mi>`GRr8l99Me4*__napErgb zOajBKq7GK$fB|+G5xuRaPx3~JElQ#!Mq-aXC^%<5gyuzvdT^qZQ8t&*$Yyy*@#dt) zzPwSv7xW;$B{9Iygw)kIAi!vkF-j|w+&N4V3NInf2DA)UIVUm_Gl zU`SyA-(p-|`EQ8>2UBa!@#$$c3=Cr8sDu4L#{muX;SaJrq?6wbweAYVN6VB*#5tey zF%bP_QseuC~xAMxjJCGY+hHc z>wt(D5lMh5um$)P;8Eb;1ey6<{j{F7`Sny>RTTL8;st)3FXDtnlsX(Ks`<>$`^|&vH+Y;^ z{3&ZKE}XJumUHaVEKeWU&G|gV`JLgGxWbmCmthlgtVlUhrYt%SsYZlPY8aY?E@M1enx`2Oi~?p&lT z-#0Z=@@C3~dY#`qyjvGtIi>I?p)O7VX**d*A~7#)85z^3?|+cWKp)k?{y-B4sSOX( zGuTh1ua~5^O5EcY5hXDuj{FlDb_|U2$lzMUx5Xu}Ta<}P6h+TH{D@Qs`>76f(a({f zxBu#TC5kX6Vzj5qQxh9Sz20T?GY&=jS?U8ZxW^*OurbD)aO zqRvrM;bQ}nIJ8$_*Orkn{f#^C4!h)cs{M(AYL~8#P8aCs^6!5zunyi zv#P!CnOwiDP^FcH4pMMs$o;fMnPr_8+2%!Pn>`P38#Wh=0?EcXDB7hO7+IQE!{Sra8p+u{~He||m2PXyRDJW8469mKJD(TS4h zzX2iAr8!U8=Dcmb8))K)i5W66byr3|KRo938eg!kC_4i%KR+tFkjH~Un~Gkp8{qb& z#*8fn9sC?H8Us7};>4|stEOnCIO}238woHM5U7I`t=t<+Ta--YVA znc;tZtgvChImYt}xJ+v(6iTZRP@7;_4FlU&f!8 z=w~}c+dIKE=)fCAihxy5KWz;B&>NcOZKVm(Ujks&E+{KYY*}8Fn0LzsThMTp2+@O= zX5~ZGkuLgqgh$`2N#P#Hd`2qkI zZS76xtLeg`M959+JzZv8awP~Up7_)akU8|FS6X%UWZp1gdvCL8+T~iMI%q3UqUoV_p**M@T@~_QV_GBHJcpTUd{0->h zXX~dl(-lohu8^Ze%8QFr;K~09ltaJ~;9`W|9f!YcTYs|5w*4qyWP7EL0TZprK&pMvpK2BnrLOSTLu2PIm5H_r*NpM@FvP${B6!Y z;9{E(7(A)o4E&Kn9*;$mC;KP)aPR1Kx$eHa!RO~sbI}&4kRlw%@nhgS_`dxjFb@2h zL7q}{=+WMBeye}&RjFrNrfkmV=g;t3-tdtZPUF~zpNf1Jcmr7IW@HKea$yVb0fCPx ztgne-b5dh-T;sN+MokPy%ao%<%Hbkq&XpL!IbjCnILd2b;d_9e0!{pYU?cEef!_!2 zibU8LSJ@ob*qqc@8zr15GmaK1M~WtAZH^%7MCb8o^E$8__yInB=2W%lc0llR`C(uK za0l=haF>B`g{pQ<5R8a*exBLHv!jz?@q2;S>AE@8Ypvk3VAF< z=0r%FWtZ21bJs#Ty(8@OCSYCAI|^h$Z!^q_E`(h?jK7AR0vdFUSFSY|itsb~!C-Ja zq}OnWWD<j^q*;deIZOoQGm=(ShV`!g@P zrE?8Q+aVLayYA;k-a6@Wru%8bdgn!v>jvZoUp0`Meof{r()+(Pb-I_oaAoxX0000< KMNUMnLSTYNpMVPh literal 0 HcmV?d00001 diff --git a/atoms.svgz b/atoms.svgz new file mode 100644 index 0000000000000000000000000000000000000000..31bc1124b8906609ed12bbfed9f48068d2b9caf0 GIT binary patch literal 1781 zcmVo)MfI+otU zlODb&E0d9m)+}k%C&>`W(sd67Pxh_^IdL3YHnI>h0AWBJYtd1___gTufOWlj)YD==smaAo!E_K))l8esxLY0qgx(%z-IAnRg=}6|N+D2${ zC@JH{I?IW0Z>d{bx+B&u-CGq)EX?VyYW_FNVlyjyNK1%aJg@jTWGeSlnyhd&Z*78X z{AzsY@~q6znwK^ILJpi1%@!fjgRo1s5K}b$1{7SUWL*hGO@PJ9lMG-%c@WHAGn{5{ zA{tNw8*?HQI;{*yRh*U`7X0VO9Gn(JBcVBEi?j6_2ROQtBnnlK@#Dg|(t8=YURMMX zZx3iP`yc_fTwSxCZfzAfAxfTL&6&66D{I%*c-t)%DuxrLqSNIA%;zKly*S_FW2KZI zmO7jm$3b4?+p!|IrSF&sd2whX#W>F6yTdUR5WY7)MP3;7d0CU!xUQ-U7r*5-8|?Kl zk40G1TXLUaF6$~XBR}vx+j|hOv4O~o>_O-nkJ^<8AkHU+^=Rlszglb=f&O|nQ-Z?? zj7@+up<-`Z;-@0x&`9fwun(dc{ZV|X$OQF~;i7`hw_EBv%vp9ghio9^Km;yrGl;z) zjGRjYZVPC?K@$=>(x^N1hvBDD_ndH(2_P@GS*zOPnfB0u_QB z-?VKn>O-7B9k?-sKJ@KCQP;EB^(>Y__wh_GLMZBL`q~obUH(#iMl_l9J|p|SDTof$ zswwe?$b$tLSj$h#SW%V|*0BQl8L`^4*LPkKVkml=6NqpEr&a_|vFa=(BVNm(tG}Q$ z<~XW+gpbOaZO-zmEl%kkg7=X5l~TyGF-2E5>XVFDNIcV5e{Wyz&K7AxY*?6AP%!9a}`gy zUr%wrJlssRrF+4E9)NRID{6~^Wt224gb-)-6d;*!h=zyxO}2xxB4)~8VYGv8p%^1DKbE9d z+Nka3h?hWi4_#@uqeUf6w6c};`p>r( zGHq+DUAUa_oZP$+qm;IRj;G~xL*)h=&Ik-aB{wi#hlU*+2uYZvjZo4N%5DZ8i+#M< zs8M0+z&p(Dw9iyNdFHH(7CqG=kq^vCoXGAl+ixGnaFFot3g0+2C1H@i>e1B9y_4RP zlF_tI#3(Vz`Hv{R%__K^SM{u7M*gldkoZ@cf2SM*@^hUfEW4L+7b&ZLuD>6)n2{HG zb~p9;$Mnk8OK6|N0o>~Atef=)edpThx{_RNCN~4E%N=NJFTSq%r4KGbC6MD4$;CvH z=iOY`&irXsl^_GJPca#GEpRiO3Hw*oX}ONeXU9I@M;?rQ;!mv%1T(k`gC0zQ2$_-V zc+o{acGtu6r>1t>N2VK~eri{jedu|n9eeGgcjAovnM3nAk0R5LP!ReseEP2Gp(yk& z20~)TU>qRBL47nsi+~Jx$MKWvAeMtnZ^pW%@Swa(%(uh3QWK@<^Z;jxK4LfFhj&4~ zI1{6@ZC{DS;E@Ign%)t~g-^R|Zs&#Lm|+|vcoqd615P7hc?Mq#ucM_HCOyU=zXdHw zN9|3FvwzjRQWkJkouBn@sEd)~@@*)`M}2m?a!L$*GlT~aIsp+AfQw8N!9!sl!o+OW zWH>s3IG#X&fA2Kc_e|HdLrvMyUT7V>|6ywm{Ao@Yn((4=y~`)TXOw>(xiDL>u^G!x zbg6z_j62j1l#oo>^wD?m{Waw}aD<;;Q