io-clim.lisp

   1 ;;;;***************************************************************************
   2 ;;;;
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;;  Name:           io-clim.cl
   6 ;;;;  Purpose:        CLIM GUI for reversi
   7 ;;;;  Programer:      Kevin M. Rosenberg, M.D.
   8 ;;;;  Date Started:   1 Nov 2001
   9 ;;;;  CVS Id:         $Id: io-clim.lisp,v 1.1 2002/10/25 08:36:42 kevin Exp $
  10 ;;;;
  11 ;;;;***************************************************************************
  12
  13 (in-package :reversi)
  14
  15 (defparameter cell-inner-width 40)
  16 (defparameter cell-inner-height 40)
  17 (defparameter half-cell-inner-width 20)
  18 (defparameter half-cell-inner-height 20)
  19 (defparameter line-thickness 2)
  20 (defparameter piece-radius 16)
  21 (defparameter cell-width (+ line-thickness cell-inner-width))
  22 (defparameter cell-height (+ line-thickness cell-inner-height))
  23 (defparameter label-height 42)
  24 (defparameter label-width 42)
  25
  26 (defparameter board-width (+ 30 (* 8 cell-width)))
  27 (defparameter board-height (+ 30 (* 8 cell-height)))
  28
  29 (defparameter status-width 300)
  30
  31
  32 (defstruct (gui-player (:constructor make-gui-player-struct))
  33   id name searcher eval ply strategy start-time
  34   searcher-id eval-id)
  35
  36 (defun make-gui-player (&key id name strategy searcher-id eval-id ply)
  37   (let ((p (make-gui-player-struct :id id :ply ply
  38                                    :name name :strategy strategy
  39                                    :searcher-id searcher-id :eval-id eval-id))
  40         (search-func
  41          (cond
  42           ((eq searcher-id :human)
  43            #'human)
  44           ((eq searcher-id :minimax)
  45            #'minimax-searcher)
  46           ((eq searcher-id :alpha-beta)
  47            #'alpha-beta-searcher)
  48           ((eq searcher-id :alpha-beta2)
  49            #'alpha-beta-searcher2)
  50           ((eq searcher-id :alpha-beta3)
  51            #'alpha-beta-searcher3)
  52           ((eq searcher-id :random)
  53            #'random-strategy)))
  54         (eval-func
  55          (cond
  56           ((eq eval-id :difference)
  57            #'count-difference)
  58           ((eq eval-id :weighted)
  59            #'weighted-squares)
  60           ((eq eval-id :modified-weighted)
  61            #'modified-weighted-squares)
  62           ((eq eval-id :iago)
  63            #'iago-eval))))
  64     (unless strategy
  65       (cond
  66        ((eq search-func #'human)
  67         )
  68        ((eq search-func #'random-strategy)
  69         (setf (gui-player-strategy p) search-func))
  70        (t
  71         (setf (gui-player-strategy p)
  72           (funcall search-func ply eval-func)))))
  73     p))
  74
  75
  76 (defun gui-player-human? (gp)
  77   (eql (gui-player-searcher-id gp) :human))
  78
  79 (defun current-gui-player (frame)
  80     (if frame
  81         (aif (reversi-game frame)
  82              (cond
  83                ((null (player it))
  84                 nil)
  85                ((= (player it) black)
  86                 (black-player frame))
  87                ((= (player it) white)
  88                 (white-player frame))
  89                (t
  90                 nil))
  91              nil)
  92       nil))
  93
  94 (defun current-gui-player-human? (frame)
  95   #+ignore
  96   (aif (current-gui-player frame)
  97        (gui-player-human? it)
  98        nil)
  99   (gui-player-human? (current-gui-player frame))
 100   )
 101
 102 (define-application-frame reversi ()
 103   ((game :initform nil
 104          :accessor reversi-game)
 105    (minutes :initform 30
 106             :accessor minutes)
 107    (black-player :initform nil
 108                  :accessor black-player)
 109    (white-player :initform  nil
 110                  :accessor white-player)
 111    (debug-messages :initform nil
 112                    :accessor debug-messages)
 113    (msgbar-string :initform nil
 114              :accessor msgbar-string)
 115    (human-time-start :initform nil
 116                      :accessor reversi-human-time-start))
 117   (:panes
 118     (board :application
 119              :display-function 'draw-board
 120              :text-style '(:sans-serif :bold :very-large)
 121 ;;           :incremental-redisplay t
 122              :text-cursor nil
 123              :background +green+
 124              :borders nil
 125              :scroll-bars nil
 126              :width (+ label-width board-width)
 127              :height (+ label-height  board-height)
 128              :min-width board-width
 129              :min-height board-height
 130              :max-width +fill+
 131              :max-height +fill+
 132              )
 133     (status :application
 134              :display-function 'draw-status
 135              :text-style '(:sans-serif :bold :large)
 136              :incremental-redisplay t
 137              :text-cursor nil
 138              :background +white+
 139              :scroll-bars nil
 140              :width status-width
 141              :max-width +fill+
 142              :max-height +fill+
 143              :height :compute)
 144     (history :application
 145              :display-function 'draw-history
 146              :text-style '(:fix :roman :normal)
 147              :incremental-redisplay t
 148              :text-cursor nil
 149              :background +white+
 150              :width 220
 151              :height :compute
 152              :min-width 100
 153              :initial-cursor-visibility :on
 154              :scroll-bars :vertical
 155              :max-width +fill+
 156              :max-height +fill+
 157              :end-of-page-action :scroll
 158              :end-of-line-action :scroll)
 159     (debug-window :application
 160              :display-function 'draw-debug-window
 161              :text-style '(:serif :roman :normal)
 162              :incremental-redisplay t
 163              :text-cursor nil
 164              :background +white+
 165              :width :compute
 166              :height :compute
 167              :scroll-bars :vertical
 168              :max-width +fill+
 169              :max-height +fill+
 170              :end-of-page-action :scroll
 171              :end-of-line-action :scroll
 172              )
 173     (msgbar :application
 174              :display-function 'draw-msgbar
 175              :text-style '(:sans-serif :roman :normal)
 176              :incremental-redisplay t
 177              :text-cursor nil
 178              :background (make-rgb-color 0.75 0.75 0.75)
 179              :foreground +red+
 180              :scroll-bars nil
 181              :width :compute
 182              :height 25
 183              :max-width +fill+
 184              :max-height +fill+
 185              :end-of-page-action :scroll
 186              :end-of-line-action :scroll))
 187   (:pointer-documentation nil)
 188   (:command-table (reversi
 189                    :inherit-from (user-command-table
 190                                   reversi-game-table
 191                                   reversi-help-table)
 192                      :menu (("Game"
 193                              :menu reversi-game-table
 194                              :mnemonic #\G
 195                              :documentation "Game commands")
 196                             ("Help"
 197                              :menu reversi-help-table
 198                              :mnemonic #\H
 199                              :documentation "Help Commands"))))
 200   (:menu-bar t)
 201   (:layouts
 202    (default
 203        (horizontally   ()
 204            (vertically   ()
 205              (horizontally ()
 206                board status)
 207              msgbar
 208              debug-window)
 209            history)
 210        ))
 211   )
 212
 213  ;;(:spacing 3)
 214
 215 (defmethod frame-standard-input ((reversi reversi))
 216   (get-frame-pane reversi 'debug-window))
 217
 218 (defmethod frame-standard-output ((reversi reversi))
 219   (get-frame-pane reversi 'debug-window))
 220
 221 (defmethod run-frame-top-level :before ((reversi reversi) &key)
 222   (initialize-reversi reversi))
 223
 224
 225 (defmethod read-frame-command ((reversi reversi) &key (stream *standard-input*))
 226   (let ((abort-chars #+Genera '(#\Abort #\End)
 227                      #-Genera nil))
 228     (let ((command (read-command-using-keystrokes
 229                      (frame-command-table reversi) abort-chars
 230                      :stream stream)))
 231       (if (characterp command)
 232           (frame-exit reversi)
 233         command))))
 234
 235 (define-presentation-type reversi-cell ()
 236  :inherit-from '(integer 11 88))
 237
 238 #-lispworks
 239 (define-presentation-method highlight-presentation ((type reversi-cell)
 240                                                     record stream state)
 241   state
 242   (multiple-value-bind (xoff yoff)
 243       (convert-from-relative-to-absolute-coordinates
 244        stream (output-record-parent record))
 245     (with-bounding-rectangle* (left top right bottom) record
 246       (draw-rectangle* stream
 247                        (+ left xoff) (+ top yoff)
 248                        (+ right xoff) (+ bottom yoff)
 249                        :ink +flipping-ink+))))
 250
 251 (define-reversi-command com-select-cell ((move 'reversi-cell))
 252   (with-application-frame (frame)
 253     (with-slots (game) frame
 254       (let ((gui-player (current-gui-player frame)))
 255         (when (and game gui-player (gui-player-human? gui-player))
 256           (if (not (legal-p move (gui-player-id gui-player) (board game)))
 257               (set-msgbar frame
 258                           (format nil "Illegal move: ~a"
 259                                   (symbol-name (88->h8 move))))
 260             (progn
 261               (decf (elt (clock game) (player game))
 262                     (- (get-internal-real-time) (gui-player-start-time gui-player)))
 263               (make-move-gui game move (gui-player-id gui-player))
 264               (setf (player game) (next-to-play (board game) (player game)))
 265               (get-move-gui frame))))))))
 266
 267
 268 (define-presentation-to-command-translator select-cell
 269     (reversi-cell com-select-cell reversi
 270      :documentation "Select cell"
 271      :tester ((object frame window) (cell-selectable-p object frame window)))
 272     (object)
 273     (list object))
 274
 275 (defun cell-selectable-p (object frame window)
 276   (when (and (eq (get-frame-pane frame 'board) window)
 277              (reversi-game frame))
 278     (let ((game (reversi-game frame)))
 279       (if (legal-p object (player game) (board game))
 280           t
 281         nil))))
 282
 283
 284
 285 (defun new-game-gui (frame)
 286   (setf (reversi-game frame)
 287     (make-game
 288      (gui-player-strategy (black-player frame))
 289      (gui-player-strategy (white-player frame))
 290      :record-game t
 291      :print nil
 292      :minutes (minutes frame)))
 293   (set-msgbar frame "New Game")
 294   (get-move-gui frame))
 295
 296
 297
 298 (defmethod initialize-reversi ((reversi reversi))
 299   (setf (black-player reversi)
 300     (make-gui-player :id black :searcher-id :human)
 301     )
 302   (setf (white-player reversi)
 303     (make-gui-player :id white
 304                      :searcher-id :alpha-beta3
 305                      :eval-id :iago
 306                      :ply 5)))
 307
 308
 309 (defun square-number (row column)
 310   (declare (fixnum row column))
 311   (+ (* 10 (1+ row))
 312      (1+ column)))
 313
 314 (defmethod draw-status ((reversi reversi) stream &key max-width max-height)
 315   (declare (ignore max-width max-height))
 316   (let ((game (reversi-game reversi)))
 317     (when game
 318       (if (null (player game))
 319           (progn
 320             (setf (final-result game) (count-difference black (board game)))
 321             (format stream "Game Over~2%"))
 322         (format stream "Move Number ~d~2%" (move-number game)))
 323       (format stream "Pieces~%  ~a ~2d~%  ~a ~2d~%  Difference ~2d~2&"
 324               (title-of black) (count black (board game))
 325               (title-of white) (count white (board game))
 326               (count-difference black (board game)))
 327       (when (clock game)
 328         (format stream "Time Remaining~%  ~a ~a~%  ~a ~a~2%"
 329                 (title-of black) (time-string (elt (clock game) black))
 330                 (title-of white) (time-string (elt (clock game) white))))
 331       (let ((gui-player (current-gui-player reversi)))
 332         (when (and gui-player (gui-player-human? gui-player))
 333           (let ((legal-moves
 334                  (loop for move in (legal-moves (gui-player-id gui-player)
 335                                                 (board game))
 336                      collect (symbol-name (88->h8 move)))))
 337             (if legal-moves
 338                 (format stream "Valid Moves~%~A"
 339                         (list-to-delimited-string legal-moves #\space)))))
 340         (when (null (player game))
 341           (if (plusp (final-result game))
 342               (format stream "Black wins by ~d!" (final-result game))
 343             (format stream "White wins by ~d!" (- 0 (final-result game)))))))))
 344
 345
 346
 347 (defmethod add-debug ((reversi reversi) msg)
 348   (setf (debug-messages reversi) (append (debug-messages reversi) (list msg))))
 349
 350 (defmethod set-msgbar ((reversi reversi) msg)
 351   (setf (msgbar-string reversi) msg))
 352
 353 (defmethod draw-debug-window ((reversi reversi) stream &key max-width max-height)
 354   (declare (ignore max-width max-height))
 355   (filling-output (stream)
 356     (dolist (msg (debug-messages reversi))
 357       (princ msg stream)
 358       (terpri stream))))
 359
 360 (defmethod draw-msgbar ((reversi reversi) stream &key max-width max-height)
 361   (declare (ignore max-width max-height))
 362   (when (msgbar-string reversi)
 363     (princ (msgbar-string reversi) stream)))
 364
 365
 366 (defmethod draw-history ((reversi reversi) stream &key max-width max-height)
 367   (declare (ignore max-width max-height))
 368   (let ((game (reversi-game reversi)))
 369     (when (and game (> (move-number game) 1))
 370       (formatting-item-list (stream :move-cursor t :row-wise nil :n-columns 1)
 371         (dotimes (i (1- (move-number game)))
 372             (let ((state (aref (moves game) i)))
 373               (when state
 374                 (let ((str (format nil "~2d: ~5a ~2a"
 375                                    (1+ i) (title-of (state-player state))
 376                                    (88->h8 (state-move state)))))
 377                   (updating-output (stream :unique-id i :cache-value str)
 378                     (with-end-of-page-action (stream :scroll)
 379                       (formatting-cell (stream :align-x :right :align-y :top)
 380                         (format stream str)
 381                         (terpri stream))))))))))))
 382
 383 #+ignore
 384 (defmethod draw-history ((reversi reversi) stream &key max-width max-height)
 385   (declare (ignore max-width max-height))
 386   (let ((game (reversi-game reversi)))
 387     (when (and game (> (move-number game) 1))
 388       (formatting-item-list (stream :move-cursor t :row-wise nil :n-columns 2)
 389         (dotimes (i (1- (move-number game)))
 390             (let ((state (aref (moves game) i)))
 391               (when state
 392                 (let ((str (format nil "~2d: ~5a ~2a"
 393                                    (1+ i) (title-of (state-player state))
 394                                    (88->h8 (state-move state)))))
 395                   (updating-output (stream :unique-id i :cache-value str)
 396                     (with-end-of-page-action (stream :scroll)
 397                       (formatting-cell (stream :align-x :right :align-y :top)
 398                         (format stream str)
 399                         (terpri stream))))))))))))
 400
 401
 402 #|
 403       (let ((viewport (window-viewport stream)))
 404         (multiple-value-bind (x y) (stream-cursor-position stream)
 405           (add-debug reversi (format nil "~d ~d: ~s" x y viewport))
 406           (if (> y (bounding-rectangle-bottom viewport))
 407               (decf y (bounding-rectangle-bottom viewport)))
 408           (window-set-viewport-position stream 0 0))))))
 409   |#
 410
 411
 412
 413
 414 (defvar *reversi-frame* nil)
 415
 416 (eval-when (:compile-toplevel :load-toplevel :execute)
 417   (defparameter *force*
 418   #+(and os-threads microsoft-32)
 419   t
 420   #-(and os-threads microsoft-32)
 421   nil))
 422
 423 (defun g ()
 424  (greversi))
 425
 426 (defun greversi ()
 427   (unless (or *force* (null *reversi-frame*))
 428     (setq *reversi-frame* (make-application-frame 'reversi)))
 429   (setq *reversi-frame* (run-frame 'reversi *reversi-frame*)))
 430
 431
 432 (defun run-frame (frame-name frame)
 433   (flet ((do-it ()
 434            (when (or *force* (null frame))
 435              (setq frame (make-application-frame frame-name)))
 436            (run-frame-top-level frame)))
 437     #+allegro
 438     (mp:process-run-function (write-to-string frame-name) #'do-it)
 439     #-allegro
 440     (do-it))
 441   frame)
 442
 443
 444 (define-command-table reversi-game-table
 445     :menu (("New" :command com-reversi-new)
 446            ("Backup" :command (com-reversi-backup))
 447            ("Exit" :command (com-reversi-exit))))
 448
 449 (define-command-table reversi-help-table)
 450
 451
 452 (define-command (com-reversi-new :name "New Game"
 453                                  :command-table reversi-game-table
 454                                  :keystroke (:n :control)
 455                                  :menu ("New Game"
 456                                         :after :start
 457                                         :documentation "New Game"))
 458     ()
 459   (with-application-frame (frame)
 460     (new-game-gui frame)))
 461
 462 (define-command (com-reversi-recommend :name "Recommend Move"
 463                                        :command-table reversi-game-table
 464                                        :keystroke (:r :control)
 465                                        :menu ("Recommend Move"
 466                                               :after "New Game"
 467                                               :documentation "Recommend Move"))
 468     ()
 469   (with-application-frame (frame)
 470     (let ((game (reversi-game frame))
 471           (player (current-gui-player frame)))
 472       (when (and game player)
 473         (when (gui-player-human? player)
 474           (let* ((port (find-port))
 475                  (pointer (port-pointer port)))
 476             (when pointer
 477               (setf (pointer-cursor pointer) :busy))
 478           (set-msgbar frame "Thinking...")
 479           (let ((move (funcall (iago 8) (gui-player-id player)
 480                                (board game))))
 481             (when pointer
 482               (setf (pointer-cursor pointer) :default))
 483             (when move
 484               (set-msgbar frame
 485                           (format nil "Recommend move to ~a"
 486                                   (symbol-name (88->h8 move))))))))))))
 487
 488 (define-command (com-reversi-backup :name "Backup Move"
 489                                     :command-table reversi-game-table
 490                                     :keystroke (:b :control)
 491                                     :menu ("Backup Move"
 492                                            :after "Recommend Move"
 493                                            :documentation "Backup Move"))
 494     ()
 495   (with-application-frame (frame)
 496     (let ((game (reversi-game frame)))
 497       (when (and game (> (move-number game) 2))
 498         (reset-game game (- (move-number game) 2))))))
 499
 500
 501 (define-command (com-reversi-exit :name "Exit"
 502                                   :command-table reversi-game-table
 503                                   :keystroke (:q :control)
 504                                   :menu ("Exit"
 505                                          :after "Backup Move"
 506                                          :documentation "Quit application"))
 507     ()
 508   (clim:frame-exit clim:*application-frame*))
 509
 510
 511 (define-command (com-reversi-options :name "Game Options"
 512                                  :command-table reversi-game-table
 513                                  :menu ("Game Options" :documentation "Game Options"))
 514     ()
 515   (with-application-frame (frame)
 516     (game-dialog frame)))
 517
 518
 519
 520 ;(define-command-table reversi-game
 521 ;  :inherit-from (reversi-game-table)
 522 ;  :inherit-menu t)
 523
 524 ;(define-command-table reversi-help)
 525 ;    :inherit-from (reversi-help-commands)
 526 ;    :inherit-menu t)
 527
 528 (define-command (com-about :command-table reversi-help-table
 529                            :menu
 530                            ("About Reversi"
 531                             :after :start
 532                             :documentation "About Reversi"))
 533     ()
 534   t)
 535 ;;  (acl-clim::pop-up-about-climap-dialog *application-frame*))
 536
 537
 538
 539 (defun make-move-gui (game move player)
 540     (make-game-move game move player))
 541
 542 (defun get-move-gui (frame)
 543   (let ((gui-player (current-gui-player frame)))
 544     (when gui-player
 545       (if (gui-player-human? gui-player)
 546           (setf (gui-player-start-time gui-player) (get-internal-real-time))
 547         (computer-move gui-player frame)))))
 548
 549 (defun computer-move (gui-player frame)
 550   (let* ((game (reversi-game frame))
 551          (port (find-port))
 552          (pointer (port-pointer port)))
 553     (setq pointer nil) ;; pointer causes crash in CLIM. ? port value wrong
 554     (when pointer
 555       (setf (pointer-cursor pointer) :busy))
 556     (set-msgbar frame "Thinking...")
 557     (while (eq gui-player (current-gui-player frame))
 558            (setf (gui-player-start-time gui-player)
 559              (get-internal-real-time))
 560            (let ((move (funcall (gui-player-strategy gui-player)
 561                                 (player game)
 562                                 (replace-board *board* (board game)))))
 563              (when (and move (legal-p move (player game) (board game)))
 564                (decf (elt (clock game) (player game))
 565                      (- (get-internal-real-time)
 566                         (gui-player-start-time gui-player)))
 567                (make-move-gui game move (player game))
 568                (setf (player game)
 569                  (next-to-play (board game) (player game))))))
 570     (set-msgbar frame nil)
 571     (when pointer
 572       (setf (pointer-cursor pointer) :default)))
 573   (setq gui-player (current-gui-player frame))
 574
 575   (if (and gui-player (not (gui-player-human? gui-player)))
 576     (redisplay-frame-pane frame (get-frame-pane frame 'board)))
 577   (get-move-gui frame))
 578
 579
 580
 581
 582 (defun game-dialog (frame)
 583   (let* ((stream (get-frame-pane frame 'debug-window))
 584          ;;      (white-strategy-id (white-strategy-id frame)
 585          ;;      (black-strategy-id (black-strategy-id frame))
 586          (wh (white-player frame))
 587          (bl (black-player frame))
 588          (white-searcher (gui-player-searcher-id wh))
 589          (white-evaluator (gui-player-eval-id wh))
 590          (white-ply (gui-player-ply wh))
 591          (black-searcher (gui-player-searcher-id bl))
 592          (black-evaluator (gui-player-eval-id bl))
 593          (black-ply (gui-player-ply bl))
 594          (minutes (minutes frame)))
 595
 596     (accepting-values (stream :own-window t
 597                               :label "Reversi Parameters")
 598       (setq minutes
 599         (accept 'integer
 600                 :stream stream
 601                 :prompt "Maximum minutes" :default minutes))
 602       (terpri stream)
 603       (format stream "White Player~%")
 604       (setq white-searcher
 605         (accept '(member :human :random :minimax :alpha-beta3)
 606                 :stream stream
 607                 :prompt "White Player Search" :default white-searcher))
 608       (terpri stream)
 609       (setq white-evaluator
 610         (accept '(member :difference :weighted :modified-weighted :iago)
 611                 :stream stream
 612                 :prompt "White Player Evaluator" :default white-evaluator))
 613       (terpri stream)
 614       (setq white-ply
 615         (accept 'integer
 616                 :stream stream
 617                 :prompt "White Ply" :default white-ply))
 618       (terpri stream)
 619       (terpri stream)
 620       (format stream "Black Player~%")
 621       (terpri stream)
 622       (setq black-searcher
 623         (accept '(member :human :random :minimax :alpha-beta3)
 624                 :stream stream
 625                 :prompt "Black Player Search" :default black-searcher))
 626       (terpri stream)
 627       (setq black-evaluator
 628         (accept '(member :difference :weighted :modified-weighted :iago)
 629                 :stream stream
 630                 :prompt "Black Player Evaluator" :default black-evaluator))
 631       (terpri stream)
 632             (setq black-ply
 633               (accept 'integer
 634                       :stream stream
 635                       :prompt "Black Ply" :default black-ply))
 636       (terpri stream)
 637       )
 638     (setf (minutes frame) minutes)
 639     (setf (white-player frame) (make-gui-player :id white
 640                                          :searcher-id white-searcher
 641                                          :eval-id white-evaluator
 642                                          :ply white-ply))
 643     (setf (black-player frame) (make-gui-player :id black
 644                                          :searcher-id black-searcher
 645                                          :eval-id black-evaluator
 646                                          :ply black-ply))
 647     ))
 648
 649
 650 (defmethod draw-board ((reversi reversi) stream &key max-width max-height)
 651   "This should produce a checkerboard pattern."
 652   (declare (ignore max-width max-height))
 653   (let ((game (reversi-game reversi)))
 654     (dotimes (i 8)
 655       (draw-text stream
 656                  (elt "abcdefgh" i)
 657                  (make-point
 658                   (+ label-width (* cell-width i)
 659                      half-cell-inner-width)
 660                   0)
 661                  :align-x :center :align-y :top))
 662     (dotimes (i 8)
 663       (draw-text stream
 664                  (format nil "~d" (1+ i))
 665                  (make-point
 666                   0
 667                   (+ label-height (* cell-height i)
 668                        half-cell-inner-height))
 669                  :align-x :left :align-y :center))
 670     (stream-set-cursor-position stream label-width label-height)
 671     (surrounding-output-with-border (stream)
 672       (formatting-table (stream :y-spacing 0 :x-spacing 0)
 673         (dotimes (row 8)
 674           (formatting-row (stream)
 675             (dotimes (column 8)
 676               (let* ((cell-id (square-number row column))
 677                      (value
 678                       (if game
 679                           (bref (board game) cell-id)
 680                         empty)))
 681                 (updating-output (stream :unique-id cell-id
 682                                          :cache-value value)
 683                   (formatting-cell (stream :align-x :right :align-y :top)
 684                     (with-output-as-presentation (stream cell-id 'reversi-cell)
 685                       (draw-rectangle* stream 0 0 cell-width cell-height :filled t :ink +green+)
 686                       (draw-rectangle* stream 0 0 cell-width cell-height :filled nil)
 687                       (cond
 688                        ((= value black)
 689                         (draw-circle*
 690                          stream
 691                          half-cell-inner-width
 692                          half-cell-inner-height
 693                          piece-radius :filled t :ink +black+))
 694                        ((= value white)
 695                         (draw-circle*
 696                          stream
 697                          half-cell-inner-width
 698                          half-cell-inner-height
 699                          piece-radius :filled t :ink +white+))))))))))))))
 700
 701
 702