X-Git-Url: http://git.kpe.io/?p=reversi.git;a=blobdiff_plain;f=io-clim.lisp;h=bc6a24d09a3ffae4d81ef62c5e5f12cb7a258239;hp=79718dea0be0c376c43f730f759ce7c7ded8da63;hb=a8b65e823b3a59faba717887aee3a8a4a8cf0a28;hpb=062d6c95c94ac969bd49083dea184c9bb81d6fea diff --git a/io-clim.lisp b/io-clim.lisp index 79718de..bc6a24d 100644 --- a/io-clim.lisp +++ b/io-clim.lisp @@ -2,7 +2,7 @@ ;;;;*************************************************************************** ;;;; ;;;; FILE IDENTIFICATION -;;;; +;;;; ;;;; Name: io-clim.lisp ;;;; Purpose: CLIM GUI for reversi ;;;; Programer: Kevin M. Rosenberg @@ -10,7 +10,7 @@ ;;;; ;;;; $Id$ ;;;; -;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg +;;;; This file is Copyright (c) 2001-2003 by Kevin M. Rosenberg ;;;; ;;;; Reversi users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -44,41 +44,41 @@ (defun make-gui-player (&key id name strategy searcher-id eval-id (ply 0)) (let ((p (make-gui-player-struct :id id :ply ply - :name name :strategy strategy - :searcher-id searcher-id :eval-id eval-id)) - (search-func - (cond - ((eq searcher-id :human) - #'human) - ((eq searcher-id :minimax) - #'minimax-searcher) - ((eq searcher-id :alpha-beta) - #'alpha-beta-searcher) - ((eq searcher-id :alpha-beta2) - #'alpha-beta-searcher2) - ((eq searcher-id :alpha-beta3) - #'alpha-beta-searcher3) - ((eq searcher-id :random) - #'random-strategy))) - (eval-func - (cond - ((eq eval-id :difference) - #'count-difference) - ((eq eval-id :weighted) - #'weighted-squares) - ((eq eval-id :modified-weighted) - #'modified-weighted-squares) - ((eq eval-id :iago) - #'iago-eval)))) + :name name :strategy strategy + :searcher-id searcher-id :eval-id eval-id)) + (search-func + (cond + ((eq searcher-id :human) + #'human) + ((eq searcher-id :minimax) + #'minimax-searcher) + ((eq searcher-id :alpha-beta) + #'alpha-beta-searcher) + ((eq searcher-id :alpha-beta2) + #'alpha-beta-searcher2) + ((eq searcher-id :alpha-beta3) + #'alpha-beta-searcher3) + ((eq searcher-id :random) + #'random-strategy))) + (eval-func + (cond + ((eq eval-id :difference) + #'count-difference) + ((eq eval-id :weighted) + #'weighted-squares) + ((eq eval-id :modified-weighted) + #'modified-weighted-squares) + ((eq eval-id :iago) + #'iago-eval)))) (unless strategy (cond ((eq search-func #'human) - ) + ) ((eq search-func #'random-strategy) - (setf (gui-player-strategy p) search-func)) + (setf (gui-player-strategy p) search-func)) (t - (setf (gui-player-strategy p) - (funcall search-func ply eval-func))))) + (setf (gui-player-strategy p) + (funcall search-func ply eval-func))))) p)) @@ -87,17 +87,17 @@ (defun current-gui-player (frame) (if frame - (aif (reversi-game frame) - (cond - ((null (player it)) - nil) - ((= (player it) black) - (black-player frame)) - ((= (player it) white) - (white-player frame)) - (t - nil)) - nil) + (aif (reversi-game frame) + (cond + ((null (player it)) + nil) + ((= (player it) black) + (black-player frame)) + ((= (player it) white) + (white-player frame)) + (t + nil)) + nil) nil)) (defun current-gui-player-human? (frame) @@ -110,116 +110,116 @@ (define-application-frame reversi () ((game :initform nil - :accessor reversi-game) + :accessor reversi-game) (minutes :initform 30 - :accessor minutes) + :accessor minutes) (black-player :initform nil - :accessor black-player) + :accessor black-player) (white-player :initform nil - :accessor white-player) + :accessor white-player) (debug-messages :initform nil - :accessor debug-messages) + :accessor debug-messages) (msgbar-string :initform nil - :accessor msgbar-string) + :accessor msgbar-string) (human-time-start :initform nil - :accessor reversi-human-time-start)) + :accessor reversi-human-time-start)) (:panes (board :application - :display-function 'draw-board - :text-style '(:sans-serif :bold :very-large) -;; :incremental-redisplay t - :text-cursor nil - :background +green+ - :borders nil - :scroll-bars nil - :width (+ label-width board-width) - :height (+ label-height board-height) - :min-width board-width - :min-height board-height - :max-width +fill+ - :max-height +fill+ - ) + :display-function 'draw-board + :text-style '(:sans-serif :bold :very-large) +;; :incremental-redisplay t + :text-cursor nil + :background +green+ + :borders nil + :scroll-bars nil + :width (+ label-width board-width) + :height (+ label-height board-height) + :min-width board-width + :min-height board-height + :max-width +fill+ + :max-height +fill+ + ) (status :application - :display-function 'draw-status - :text-style '(:sans-serif :bold :large) - :incremental-redisplay t - :text-cursor nil - :background +white+ - :scroll-bars nil - :width status-width - :max-width +fill+ - :max-height +fill+ - :height :compute) + :display-function 'draw-status + :text-style '(:sans-serif :bold :large) + :incremental-redisplay t + :text-cursor nil + :background +white+ + :scroll-bars nil + :width status-width + :max-width +fill+ + :max-height +fill+ + :height :compute) (history :application - :display-function 'draw-history - :text-style '(:fix :roman :normal) - :incremental-redisplay t - :text-cursor nil - :background +white+ - :width 220 - :height :compute - :min-width 100 - :initial-cursor-visibility :on - :scroll-bars :vertical - :max-width +fill+ - :max-height +fill+ + :display-function 'draw-history + :text-style '(:fix :roman :normal) + :incremental-redisplay t + :text-cursor nil + :background +white+ + :width 220 + :height :compute + :min-width 100 + :initial-cursor-visibility :on + :scroll-bars :vertical + :max-width +fill+ + :max-height +fill+ :end-of-page-action :scroll - :end-of-line-action :scroll) + :end-of-line-action :scroll) (debug-window :application - :display-function 'draw-debug-window - :text-style '(:serif :roman :normal) - :incremental-redisplay t - :text-cursor nil - :background +white+ - :width :compute - :height :compute - :scroll-bars :vertical - :max-width +fill+ - :max-height +fill+ - :end-of-page-action :scroll - :end-of-line-action :scroll - ) + :display-function 'draw-debug-window + :text-style '(:serif :roman :normal) + :incremental-redisplay t + :text-cursor nil + :background +white+ + :width :compute + :height :compute + :scroll-bars :vertical + :max-width +fill+ + :max-height +fill+ + :end-of-page-action :scroll + :end-of-line-action :scroll + ) (msgbar :application - :display-function 'draw-msgbar - :text-style '(:sans-serif :roman :normal) - :incremental-redisplay t - :text-cursor nil - :background (make-rgb-color 0.75 0.75 0.75) - :foreground +red+ - :scroll-bars nil - :width :compute - :height 25 - :max-width +fill+ - :max-height +fill+ - :end-of-page-action :scroll - :end-of-line-action :scroll)) + :display-function 'draw-msgbar + :text-style '(:sans-serif :roman :normal) + :incremental-redisplay t + :text-cursor nil + :background (make-rgb-color 0.75 0.75 0.75) + :foreground +red+ + :scroll-bars nil + :width :compute + :height 25 + :max-width +fill+ + :max-height +fill+ + :end-of-page-action :scroll + :end-of-line-action :scroll)) (:pointer-documentation nil) (:command-table (reversi - :inherit-from (user-command-table - reversi-game-table - reversi-help-table) - :menu (("Game" - :menu reversi-game-table - :keystroke #\G - :documentation "Game commands") - ("Help" - :menu reversi-help-table - :keystroke #\H - :documentation "Help Commands")))) + :inherit-from (user-command-table + reversi-game-table + reversi-help-table) + :menu (("Game" + :menu reversi-game-table + :keystroke #\G + :documentation "Game commands") + ("Help" + :menu reversi-help-table + :keystroke #\H + :documentation "Help Commands")))) (:menu-bar t) (:layouts - (default - (horizontally () - (vertically () - (horizontally () - board status) - msgbar - debug-window) - history) + (default + (horizontally () + (vertically () + (horizontally () + board status) + msgbar + debug-window) + history) )) ) - ;;(:spacing 3) + ;;(:spacing 3) (defmethod frame-standard-input ((reversi reversi)) (get-frame-pane reversi 'debug-window)) @@ -233,49 +233,49 @@ (defmethod read-frame-command ((reversi reversi) &key (stream *standard-input*)) (let ((abort-chars #+Genera '(#\Abort #\End) - #-Genera nil)) + #-Genera nil)) (let ((command (read-command-using-keystrokes - (frame-command-table reversi) abort-chars - :stream stream))) + (frame-command-table reversi) abort-chars + :stream stream))) (if (characterp command) - (frame-exit reversi) - command)))) + (frame-exit reversi) + command)))) (define-presentation-type reversi-cell () :inherit-from '(integer 11 88)) #-lispworks -(define-presentation-method highlight-presentation ((type reversi-cell) - record stream state) +(define-presentation-method highlight-presentation ((type reversi-cell) + record stream state) state (multiple-value-bind (xoff yoff) - (clim::convert-from-relative-to-absolute-coordinates + (clim::convert-from-relative-to-absolute-coordinates stream (output-record-parent record)) (with-bounding-rectangle* (left top right bottom) record (draw-rectangle* stream - (+ left xoff) (+ top yoff) - (+ right xoff) (+ bottom yoff) - :ink +flipping-ink+)))) + (+ left xoff) (+ top yoff) + (+ right xoff) (+ bottom yoff) + :ink +flipping-ink+)))) -(define-reversi-command com-select-cell ((move 'reversi-cell)) +(define-reversi-command com-select-cell ((move 'reversi-cell)) (with-application-frame (frame) (with-slots (game) frame (let ((gui-player (current-gui-player frame))) - (when (and game gui-player (gui-player-human? gui-player)) - (if (not (legal-p move (gui-player-id gui-player) (board game))) - (set-msgbar frame - (format nil "Illegal move: ~a" - (symbol-name (88->h8 move)))) - (progn - (decf (elt (clock game) (player game)) - (- (get-internal-real-time) (gui-player-start-time gui-player))) - (make-move-gui game move (gui-player-id gui-player)) - (setf (player game) (next-to-play (board game) (player game))) - (get-move-gui frame)))))))) - + (when (and game gui-player (gui-player-human? gui-player)) + (if (not (legal-p move (gui-player-id gui-player) (board game))) + (set-msgbar frame + (format nil "Illegal move: ~a" + (symbol-name (88->h8 move)))) + (progn + (decf (elt (clock game) (player game)) + (- (get-internal-real-time) (gui-player-start-time gui-player))) + (make-move-gui game move (gui-player-id gui-player)) + (setf (player game) (next-to-play (board game) (player game))) + (get-move-gui frame)))))))) + (define-presentation-to-command-translator select-cell - (reversi-cell com-select-cell reversi + (reversi-cell com-select-cell reversi :documentation "Select cell" :tester ((object frame window) (cell-selectable-p object frame window))) (object) @@ -283,17 +283,17 @@ (defun cell-selectable-p (object frame window) (when (and (eq (get-frame-pane frame 'board) window) - (reversi-game frame)) + (reversi-game frame)) (let ((game (reversi-game frame))) (if (legal-p object (player game) (board game)) - t - nil)))) + t + nil)))) (defun new-game-gui (frame) - (setf (reversi-game frame) - (make-game + (setf (reversi-game frame) + (make-game (gui-player-strategy (black-player frame)) (gui-player-strategy (white-player frame)) :record-game t @@ -303,16 +303,16 @@ (get-move-gui frame)) - + (defmethod initialize-reversi ((reversi reversi)) - (setf (black-player reversi) + (setf (black-player reversi) (make-gui-player :id black :searcher-id :human) ) (setf (white-player reversi) - (make-gui-player :id white - :searcher-id :alpha-beta3 - :eval-id :iago - :ply 5))) + (make-gui-player :id white + :searcher-id :alpha-beta3 + :eval-id :iago + :ply 5))) (defun square-number (row column) @@ -325,35 +325,35 @@ (let ((game (reversi-game reversi))) (when game (if (null (player game)) - (progn - (setf (final-result game) (count-difference black (board game))) - (format stream "Game Over~2%")) - (format stream "Move Number ~d~2%" (move-number game))) + (progn + (setf (final-result game) (count-difference black (board game))) + (format stream "Game Over~2%")) + (format stream "Move Number ~d~2%" (move-number game))) (format stream "Pieces~% ~a ~2d~% ~a ~2d~% Difference ~2d~2&" - (title-of black) (count black (board game)) - (title-of white) (count white (board game)) - (count-difference black (board game))) + (title-of black) (count black (board game)) + (title-of white) (count white (board game)) + (count-difference black (board game))) (when (clock game) - (format stream "Time Remaining~% ~a ~a~% ~a ~a~2%" - (title-of black) (time-string (elt (clock game) black)) - (title-of white) (time-string (elt (clock game) white)))) + (format stream "Time Remaining~% ~a ~a~% ~a ~a~2%" + (title-of black) (time-string (elt (clock game) black)) + (title-of white) (time-string (elt (clock game) white)))) (let ((gui-player (current-gui-player reversi))) - (when (and gui-player (gui-player-human? gui-player)) - (let ((legal-moves - (loop for move in (legal-moves (gui-player-id gui-player) - (board game)) - collect (symbol-name (88->h8 move))))) - (if legal-moves - (format stream "Valid Moves~%~A" - (list-to-delimited-string legal-moves #\space))))) - (when (null (player game)) - (cond - ((zerop (final-result game)) - (format stream "It's a draw!")) - ((plusp (final-result game)) - (format stream "Black wins by ~d!" (final-result game))) - (t - (format stream "White wins by ~d!" (- 0 (final-result game)))))))))) + (when (and gui-player (gui-player-human? gui-player)) + (let ((legal-moves + (loop for move in (legal-moves (gui-player-id gui-player) + (board game)) + collect (symbol-name (88->h8 move))))) + (if legal-moves + (format stream "Valid Moves~%~A" + (list-to-delimited-string legal-moves #\space))))) + (when (null (player game)) + (cond + ((zerop (final-result game)) + (format stream "It's a draw!")) + ((plusp (final-result game)) + (format stream "Black wins by ~d!" (final-result game))) + (t + (format stream "White wins by ~d!" (- 0 (final-result game)))))))))) @@ -381,17 +381,17 @@ (let ((game (reversi-game reversi))) (when (and game (> (move-number game) 1)) (formatting-item-list (stream :move-cursor t :row-wise nil :n-columns 1) - (dotimes (i (1- (move-number game))) - (let ((state (aref (moves game) i))) - (when state - (let ((str (format nil "~2d: ~5a ~2a" - (1+ i) (title-of (state-player state)) - (88->h8 (state-move state))))) - (updating-output (stream :unique-id i :cache-value str) - (with-end-of-page-action (stream :scroll) - (formatting-cell (stream :align-x :right :align-y :top) - (format stream str) - (terpri stream)))))))))))) + (dotimes (i (1- (move-number game))) + (let ((state (aref (moves game) i))) + (when state + (let ((str (format nil "~2d: ~5a ~2a" + (1+ i) (title-of (state-player state)) + (88->h8 (state-move state))))) + (updating-output (stream :unique-id i :cache-value str) + (with-end-of-page-action (stream :scroll) + (formatting-cell (stream :align-x :right :align-y :top) + (format stream str) + (terpri stream)))))))))))) #+ignore (defmethod draw-history ((reversi reversi) stream &key max-width max-height) @@ -399,29 +399,29 @@ (let ((game (reversi-game reversi))) (when (and game (> (move-number game) 1)) (formatting-item-list (stream :move-cursor t :row-wise nil :n-columns 2) - (dotimes (i (1- (move-number game))) - (let ((state (aref (moves game) i))) - (when state - (let ((str (format nil "~2d: ~5a ~2a" - (1+ i) (title-of (state-player state)) - (88->h8 (state-move state))))) - (updating-output (stream :unique-id i :cache-value str) - (with-end-of-page-action (stream :scroll) - (formatting-cell (stream :align-x :right :align-y :top) - (format stream str) - (terpri stream)))))))))))) + (dotimes (i (1- (move-number game))) + (let ((state (aref (moves game) i))) + (when state + (let ((str (format nil "~2d: ~5a ~2a" + (1+ i) (title-of (state-player state)) + (88->h8 (state-move state))))) + (updating-output (stream :unique-id i :cache-value str) + (with-end-of-page-action (stream :scroll) + (formatting-cell (stream :align-x :right :align-y :top) + (format stream str) + (terpri stream)))))))))))) #| (let ((viewport (window-viewport stream))) - (multiple-value-bind (x y) (stream-cursor-position stream) - (add-debug reversi (format nil "~d ~d: ~s" x y viewport)) - (if (> y (bounding-rectangle-bottom viewport)) - (decf y (bounding-rectangle-bottom viewport))) - (window-set-viewport-position stream 0 0)))))) - |# - - + (multiple-value-bind (x y) (stream-cursor-position stream) + (add-debug reversi (format nil "~d ~d: ~s" x y viewport)) + (if (> y (bounding-rectangle-bottom viewport)) + (decf y (bounding-rectangle-bottom viewport))) + (window-set-viewport-position stream 0 0)))))) + |# + + (defvar *reversi-frame* nil) @@ -441,9 +441,9 @@ (defun run-frame (frame-name frame) (flet ((do-it () - (when (or *force* (null frame)) - (setq frame (make-application-frame frame-name))) - (run-frame-top-level frame))) + (when (or *force* (null frame)) + (setq frame (make-application-frame frame-name))) + (run-frame-top-level frame))) #+allegro (mp:process-run-function (write-to-string frame-name) #'do-it) #-allegro @@ -453,74 +453,74 @@ (define-command-table reversi-game-table :menu (("New" :command com-reversi-new) - ("Backup" :command (com-reversi-backup)) - ("Exit" :command (com-reversi-exit)))) + ("Backup" :command (com-reversi-backup)) + ("Exit" :command (com-reversi-exit)))) (define-command-table reversi-help-table) (define-command (com-reversi-new :name "New Game" - :command-table reversi-game-table - :keystroke (:n :control) - :menu ("New Game" - :after :start - :documentation "New Game")) + :command-table reversi-game-table + :keystroke (:n :control) + :menu ("New Game" + :after :start + :documentation "New Game")) () (with-application-frame (frame) (new-game-gui frame))) (define-command (com-reversi-recommend :name "Recommend Move" - :command-table reversi-game-table - :keystroke (:r :control) - :menu ("Recommend Move" - :after "New Game" - :documentation "Recommend Move")) + :command-table reversi-game-table + :keystroke (:r :control) + :menu ("Recommend Move" + :after "New Game" + :documentation "Recommend Move")) () (with-application-frame (frame) (let ((game (reversi-game frame)) - (player (current-gui-player frame))) + (player (current-gui-player frame))) (when (and game player) - (when (gui-player-human? player) - (let* ((port (find-port)) - (pointer (port-pointer port))) - (when pointer - (setf (pointer-cursor pointer) :busy)) - (set-msgbar frame "Thinking...") - (let ((move (funcall (iago 8) (gui-player-id player) - (board game)))) - (when pointer - (setf (pointer-cursor pointer) :default)) - (when move - (set-msgbar frame - (format nil "Recommend move to ~a" - (symbol-name (88->h8 move)))))))))))) + (when (gui-player-human? player) + (let* ((port (find-port)) + (pointer (port-pointer port))) + (when pointer + (setf (pointer-cursor pointer) :busy)) + (set-msgbar frame "Thinking...") + (let ((move (funcall (iago 8) (gui-player-id player) + (board game)))) + (when pointer + (setf (pointer-cursor pointer) :default)) + (when move + (set-msgbar frame + (format nil "Recommend move to ~a" + (symbol-name (88->h8 move)))))))))))) (define-command (com-reversi-backup :name "Backup Move" - :command-table reversi-game-table - :keystroke (:b :control) - :menu ("Backup Move" - :after "Recommend Move" - :documentation "Backup Move")) + :command-table reversi-game-table + :keystroke (:b :control) + :menu ("Backup Move" + :after "Recommend Move" + :documentation "Backup Move")) () (with-application-frame (frame) (let ((game (reversi-game frame))) (when (and game (> (move-number game) 2)) - (reset-game game (- (move-number game) 2)))))) + (reset-game game (- (move-number game) 2)))))) (define-command (com-reversi-exit :name "Exit" - :command-table reversi-game-table - :keystroke (:q :control) - :menu ("Exit" - :after "Backup Move" - :documentation "Quit application")) + :command-table reversi-game-table + :keystroke (:q :control) + :menu ("Exit" + :after "Backup Move" + :documentation "Quit application")) () (clim:frame-exit clim:*application-frame*)) (define-command (com-reversi-options :name "Game Options" - :command-table reversi-game-table - :menu ("Game Options" :documentation "Game Options")) + :command-table reversi-game-table + :menu ("Game Options" :documentation "Game Options")) () (with-application-frame (frame) (game-dialog frame))) @@ -536,10 +536,10 @@ ; :inherit-menu t) (define-command (com-about :command-table reversi-help-table - :menu - ("About Reversi" - :after :start - :documentation "About Reversi")) + :menu + ("About Reversi" + :after :start + :documentation "About Reversi")) () t) ;; (acl-clim::pop-up-about-climap-dialog *application-frame*)) @@ -548,35 +548,35 @@ (defun make-move-gui (game move player) (make-game-move game move player)) - + (defun get-move-gui (frame) (let ((gui-player (current-gui-player frame))) (when gui-player (if (gui-player-human? gui-player) - (setf (gui-player-start-time gui-player) (get-internal-real-time)) - (computer-move gui-player frame))))) + (setf (gui-player-start-time gui-player) (get-internal-real-time)) + (computer-move gui-player frame))))) (defun computer-move (gui-player frame) (let* ((game (reversi-game frame)) - (port (find-port)) - (pointer (port-pointer port))) + (port (find-port)) + (pointer (port-pointer port))) (setq pointer nil) ;; pointer causes crash in CLIM. ? port value wrong (when pointer (setf (pointer-cursor pointer) :busy)) (set-msgbar frame "Thinking...") (while (eq gui-player (current-gui-player frame)) - (setf (gui-player-start-time gui-player) - (get-internal-real-time)) - (let ((move (funcall (gui-player-strategy gui-player) - (player game) - (replace-board *board* (board game))))) - (when (and move (legal-p move (player game) (board game))) - (decf (elt (clock game) (player game)) - (- (get-internal-real-time) - (gui-player-start-time gui-player))) - (make-move-gui game move (player game)) - (setf (player game) - (next-to-play (board game) (player game)))))) + (setf (gui-player-start-time gui-player) + (get-internal-real-time)) + (let ((move (funcall (gui-player-strategy gui-player) + (player game) + (replace-board *board* (board game))))) + (when (and move (legal-p move (player game) (board game))) + (decf (elt (clock game) (player game)) + (- (get-internal-real-time) + (gui-player-start-time gui-player))) + (make-move-gui game move (player game)) + (setf (player game) + (next-to-play (board game) (player game)))))) (set-msgbar frame nil) (when pointer (setf (pointer-cursor pointer) :default))) @@ -586,74 +586,74 @@ (redisplay-frame-pane frame (get-frame-pane frame 'board))) (get-move-gui frame)) - + (defun game-dialog (frame) (let* ((stream (get-frame-pane frame 'debug-window)) - ;; (white-strategy-id (white-strategy-id frame) - ;; (black-strategy-id (black-strategy-id frame)) - (wh (white-player frame)) - (bl (black-player frame)) - (white-searcher (gui-player-searcher-id wh)) - (white-evaluator (gui-player-eval-id wh)) - (white-ply (gui-player-ply wh)) - (black-searcher (gui-player-searcher-id bl)) - (black-evaluator (gui-player-eval-id bl)) - (black-ply (gui-player-ply bl)) - (minutes (minutes frame))) - + ;; (white-strategy-id (white-strategy-id frame) + ;; (black-strategy-id (black-strategy-id frame)) + (wh (white-player frame)) + (bl (black-player frame)) + (white-searcher (gui-player-searcher-id wh)) + (white-evaluator (gui-player-eval-id wh)) + (white-ply (gui-player-ply wh)) + (black-searcher (gui-player-searcher-id bl)) + (black-evaluator (gui-player-eval-id bl)) + (black-ply (gui-player-ply bl)) + (minutes (minutes frame))) + (accepting-values (stream :own-window t - :label "Reversi Parameters") + :label "Reversi Parameters") (setq minutes - (accept 'integer - :stream stream - :prompt "Maximum minutes" :default minutes)) + (accept 'integer + :stream stream + :prompt "Maximum minutes" :default minutes)) (terpri stream) (format stream "White Player~%") (setq white-searcher - (accept '(member :human :random :minimax :alpha-beta3) - :stream stream - :prompt "White Player Search" :default white-searcher)) + (accept '(member :human :random :minimax :alpha-beta3) + :stream stream + :prompt "White Player Search" :default white-searcher)) (terpri stream) (setq white-evaluator - (accept '(member :difference :weighted :modified-weighted :iago) - :stream stream - :prompt "White Player Evaluator" :default white-evaluator)) + (accept '(member :difference :weighted :modified-weighted :iago) + :stream stream + :prompt "White Player Evaluator" :default white-evaluator)) (terpri stream) - (setq white-ply - (accept 'integer - :stream stream - :prompt "White Ply" :default white-ply)) + (setq white-ply + (accept 'integer + :stream stream + :prompt "White Ply" :default white-ply)) (terpri stream) (terpri stream) (format stream "Black Player~%") (terpri stream) (setq black-searcher - (accept '(member :human :random :minimax :alpha-beta3) - :stream stream - :prompt "Black Player Search" :default black-searcher)) + (accept '(member :human :random :minimax :alpha-beta3) + :stream stream + :prompt "Black Player Search" :default black-searcher)) (terpri stream) (setq black-evaluator - (accept '(member :difference :weighted :modified-weighted :iago) - :stream stream - :prompt "Black Player Evaluator" :default black-evaluator)) + (accept '(member :difference :weighted :modified-weighted :iago) + :stream stream + :prompt "Black Player Evaluator" :default black-evaluator)) (terpri stream) - (setq black-ply - (accept 'integer - :stream stream - :prompt "Black Ply" :default black-ply)) + (setq black-ply + (accept 'integer + :stream stream + :prompt "Black Ply" :default black-ply)) (terpri stream) ) (setf (minutes frame) minutes) - (setf (white-player frame) (make-gui-player :id white - :searcher-id white-searcher - :eval-id white-evaluator - :ply white-ply)) - (setf (black-player frame) (make-gui-player :id black - :searcher-id black-searcher - :eval-id black-evaluator - :ply black-ply)) + (setf (white-player frame) (make-gui-player :id white + :searcher-id white-searcher + :eval-id white-evaluator + :ply white-ply)) + (setf (black-player frame) (make-gui-player :id black + :searcher-id black-searcher + :eval-id black-evaluator + :ply black-ply)) )) @@ -662,51 +662,51 @@ (declare (ignore max-width max-height)) (let ((game (reversi-game reversi))) (dotimes (i 8) - (draw-text stream - (elt "abcdefgh" i) - (make-point - (+ label-width (* cell-width i) - half-cell-inner-width) - 0) - :align-x :center :align-y :top)) + (draw-text stream + (elt "abcdefgh" i) + (make-point + (+ label-width (* cell-width i) + half-cell-inner-width) + 0) + :align-x :center :align-y :top)) (dotimes (i 8) - (draw-text stream - (format nil "~d" (1+ i)) - (make-point - 0 - (+ label-height (* cell-height i) - half-cell-inner-height)) - :align-x :left :align-y :center)) + (draw-text stream + (format nil "~d" (1+ i)) + (make-point + 0 + (+ label-height (* cell-height i) + half-cell-inner-height)) + :align-x :left :align-y :center)) (stream-set-cursor-position stream label-width label-height) (surrounding-output-with-border (stream) (formatting-table (stream :y-spacing 0 :x-spacing 0) - (dotimes (row 8) - (formatting-row (stream) - (dotimes (column 8) - (let* ((cell-id (square-number row column)) - (value - (if game - (bref (board game) cell-id) - empty))) - (updating-output (stream :unique-id cell-id - :cache-value value) - (formatting-cell (stream :align-x :right :align-y :top) - (with-output-as-presentation (stream cell-id 'reversi-cell) - (draw-rectangle* stream 0 0 cell-width cell-height :filled t :ink +green+) - (draw-rectangle* stream 0 0 cell-width cell-height :filled nil) - (cond - ((= value black) - (draw-circle* - stream - half-cell-inner-width - half-cell-inner-height - piece-radius :filled t :ink +black+)) - ((= value white) - (draw-circle* - stream - half-cell-inner-width - half-cell-inner-height - piece-radius :filled t :ink +white+)))))))))))))) + (dotimes (row 8) + (formatting-row (stream) + (dotimes (column 8) + (let* ((cell-id (square-number row column)) + (value + (if game + (bref (board game) cell-id) + empty))) + (updating-output (stream :unique-id cell-id + :cache-value value) + (formatting-cell (stream :align-x :right :align-y :top) + (with-output-as-presentation (stream cell-id 'reversi-cell) + (draw-rectangle* stream 0 0 cell-width cell-height :filled t :ink +green+) + (draw-rectangle* stream 0 0 cell-width cell-height :filled nil) + (cond + ((= value black) + (draw-circle* + stream + half-cell-inner-width + half-cell-inner-height + piece-radius :filled t :ink +black+)) + ((= value white) + (draw-circle* + stream + half-cell-inner-width + half-cell-inner-height + piece-radius :filled t :ink +white+))))))))))))))