;;;;***************************************************************************
;;;;
;;;; FILE IDENTIFICATION
-;;;;
+;;;;
;;;; Name: io-clim.lisp
;;;; Purpose: CLIM GUI for reversi
;;;; Programer: Kevin M. Rosenberg
;;;;
;;;; $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
(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))
(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)
(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))
(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)
(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
(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)
(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))))))))))
(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)
(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)
(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
(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)))
; :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*))
(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)))
(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))
))
(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+))))))))))))))
projects / reversi.git / blobdiff