io-clim.lisp

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