shape liberty main working all done and passing reworked
This commit is contained in:
Dan
parent
da28f67955
commit
b5f322a3f9
68
board.lisp
68
board.lisp
|
|
@ -57,9 +57,8 @@
|
|||
|
||||
(defun get-2d-stone (board coord)
|
||||
(if (not (listp coord))
|
||||
(progn
|
||||
(format t "MASSIVE ERROR!~%trying to access coord:~a on board" coord))
|
||||
(aref (aref board (first coord)) (second coord))))
|
||||
(format t "MASSIVE ERROR!~%trying to access coord:~a on board" coord))
|
||||
(aref (aref board (first coord)) (second coord)))
|
||||
|
||||
(defun set-2d-stone (board coord val)
|
||||
(setf (aref (aref board (first coord)) (second coord)) val))
|
||||
|
|
@ -89,6 +88,9 @@
|
|||
(defmethod get-stone ((board basic-board) coords)
|
||||
(get-2d-stone (board board) coords))
|
||||
|
||||
(defmacro get-player (board coords)
|
||||
`(get-stone ,board ,coords))
|
||||
|
||||
|
||||
;(defgeneric (setf stone) (val coords
|
||||
|
||||
|
|
@ -148,7 +150,7 @@
|
|||
(rank-top-count
|
||||
:initarg rank-top-count
|
||||
:initform 0
|
||||
:accessor rank-top-count)))
|
||||
:accessor rank-top-count)))
|
||||
|
||||
(defmacro copy-slots (slots dst src)
|
||||
`(progn ,@(loop for slot in slots collect `(setf (,slot ,dst) (,slot ,src)))))
|
||||
|
|
@ -168,8 +170,10 @@
|
|||
(cons (car list) (insert (cdr list) comp var))))
|
||||
|
||||
|
||||
(defmethod set-stone :after ((board ranked-board) coords val)
|
||||
; (format t "~a ~a~%" coords val)
|
||||
(defgeneric insert-into-ranked-list (board coords val))
|
||||
|
||||
; so i can call it with "pass" as a coords and not have to "set-stone"
|
||||
(defmethod insert-into-ranked-list ((board ranked-board) coords val)
|
||||
(incf (rank-count board))
|
||||
(if (or (eql (rank-highest board) nil) (>= val (rank-highest board)))
|
||||
(progn
|
||||
|
|
@ -186,6 +190,10 @@
|
|||
(setf (rank-list board) `((,val ,coords)))
|
||||
(setf (rank-list board) (insert (rank-list board) #'(lambda (a b) (>= (first a) (first b))) `(,val ,coords))))))
|
||||
|
||||
(defmethod set-stone :after ((board ranked-board) coords val)
|
||||
; (format t "~a ~a~%" coords val)
|
||||
(insert-into-ranked-list board coords val))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -234,7 +242,10 @@
|
|||
(if (not (eql (get-stone focus-board coord) nil))
|
||||
(let ((newboard (make-instance (class-of board) :from-board board)))
|
||||
(set-stone newboard coord player)
|
||||
(set-stone score-board coord (first (genmove newboard (invert-player player):depth (1- depth))))))))
|
||||
(set-stone score-board coord (first (genmove newboard (invert-player player):depth (1- depth)))))))
|
||||
; test pass
|
||||
(let ((newboard (make-instance (class-of board) :from-board board)))
|
||||
(insert-into-ranked-list score-board "pass" (first (genmove newboard (invert-player player):depth (1- depth))))))
|
||||
|
||||
|
||||
(defgeneric score (board player)
|
||||
|
|
@ -248,9 +259,10 @@
|
|||
)
|
||||
|
||||
(defmethod select-move ((board ranked-board))
|
||||
(if (eql (rank-top-count board) 0)
|
||||
'(-1 (-1 -1))
|
||||
(car (nthcdr (random (rank-top-count board)) (rank-top-list board)))))
|
||||
;(if (eql (rank-top-count board) 0)
|
||||
;'(-1 (-1 -1))
|
||||
(pdebug "select-move ~%")
|
||||
(car (nthcdr (random (rank-top-count board)) (rank-top-list board))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -261,6 +273,7 @@
|
|||
`(make-instance ,class :boardsize (boardsize ,board) :board-def-type ,def-type))
|
||||
|
||||
(defmethod genmove ((board basic-board) player &key (depth 1))
|
||||
(pdebug "genmove ~a~%" depth)
|
||||
; (format t "genmove depth ~a player ~a~%" depth player)
|
||||
(if (= depth 0)
|
||||
`( ,(score board (invert-player player)) nil)
|
||||
|
|
@ -298,38 +311,3 @@
|
|||
(set-stone score-board coord (first (score newboard player))))))
|
||||
(board-to-analyze (board score-board)))))
|
||||
|
||||
|
||||
|
||||
;(defun make-move (board player)
|
||||
; (select-move (score board player)))
|
||||
|
||||
;(defun score (board player)
|
||||
; (let ((score-board (make-board (length board) 0)))
|
||||
; (dolist (slist *score-functions*)
|
||||
; (merge-score-board score-board (funcall (first slist) board player) (second slist)))
|
||||
; score-board))
|
||||
|
||||
;(defun merge-score-board (score-board scores weight)
|
||||
; (dotimes (x (length score-board))
|
||||
; (dotimes (y (length score-board))
|
||||
; (set-stone score-board `(,x ,y) (+ (get-stone score-board `(,x ,y)) (* weight (get-stone scores `(,x ,y))))))))
|
||||
|
||||
|
||||
;(defun select-move (board)
|
||||
; (let ((highest (get-stone board '(0 0)))
|
||||
; (coords (make-array 10 :fill-pointer 0 :adjustable t)))
|
||||
; (do ((x 0 (1+ x)))
|
||||
; ((>= x (length board)) (aref coords (random (length coords))))
|
||||
; (do ((y 0 (1+ y)))
|
||||
; ((>= y (length board)))
|
||||
; (let ((score (get-stone board `(,x ,y))))
|
||||
; (if (> score highest)
|
||||
; (progn
|
||||
; (setf highest score)
|
||||
; (setf coords (make-array 10 :fill-pointer 0 :adjustable t ))
|
||||
; (vector-push-extend `(,x ,y) coords))
|
||||
; (if (= score highest)
|
||||
; (if (= (random 2) 1)
|
||||
; (vector-push-extend `(,x ,y) coords)))))))))
|
||||
|
||||
|
||||
|
|
|
|||
23
gobot.lisp
23
gobot.lisp
|
|
@ -60,14 +60,20 @@
|
|||
(if (or (eql *passed* t) (eql *last-player* player))
|
||||
"pass"
|
||||
(let* ((move (genmove *board* player))
|
||||
(board-score (first move))
|
||||
(coord (coord-to-str (second move))))
|
||||
; (board-score (first move))
|
||||
(coord (second move)))
|
||||
;(format t "score: ~a for player ~a ~%" board-score player)
|
||||
(if (< board-score 0)
|
||||
"pass"
|
||||
(progn
|
||||
(do-play player coord)
|
||||
coord)))))
|
||||
(if (listp coord) ; string= coord "pass"))
|
||||
(let ((coord-str (coord-to-str coord)))
|
||||
(do-play player coord-str)
|
||||
coord-str)
|
||||
coord))))
|
||||
|
||||
;(if (< board-score 0)
|
||||
; "pass"
|
||||
; (progn
|
||||
; (do-play player coord)
|
||||
; coord)))))
|
||||
|
||||
|
||||
(defun analyze-score ()
|
||||
|
|
@ -81,3 +87,6 @@
|
|||
|
||||
(defun analyze-shape-liberties ()
|
||||
(liberty-shape-to-analyze *board*))
|
||||
|
||||
(defun analyze-shape-stone-liberties ()
|
||||
(liberty-shape-stone-to-analyze *board*))
|
||||
|
|
|
|||
3
gtp.lisp
3
gtp.lisp
|
|
@ -48,7 +48,7 @@
|
|||
|
||||
(defparameter *supported_commands* '("name" "version" "protocol_version" "komi" "boardsize" "clear_board" "play" "genmove" "cputime" "quit" "game_score" "list_commands" "known_command" "gogui-analyze_commands" ))
|
||||
|
||||
(defparameter *analyze_commands* '("gfx/Liberties/liberties" "gfx/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties"))
|
||||
(defparameter *analyze_commands* '("gfx/Liberties/liberties" "gfx/Shapes/shapes" "gfx/Shape-Liberties/shape-liberties" "gfx/Shape-Stone-Liberties/shape-stone-liberties"))
|
||||
|
||||
|
||||
|
||||
|
|
@ -90,6 +90,7 @@
|
|||
(liberties (string-trim #(#\newline) (analyze-liberty)))
|
||||
(shapes (string-trim #(#\newline) (analyze-shapes)))
|
||||
(shape-liberties (string-trim #(#\newline) (analyze-shape-liberties)))
|
||||
(shape-stone-liberties (string-trim #(#\newline) (analyze-shape-stone-liberties)))
|
||||
;(scores (string-trim #(#\newline)(analyze-score)))
|
||||
(quit (setf *quit?* t) "")
|
||||
(otherwise (concatenate 'string "? unknown command: " (string-downcase (first commands)))))))
|
||||
|
|
|
|||
|
|
@ -1,11 +1,24 @@
|
|||
(in-package :liberty-shape-board)
|
||||
|
||||
(defclass liberty-shape-board (liberty-board shape-board)
|
||||
((shapes-liberties
|
||||
(
|
||||
; stores lists (shape-liberties shape-libertirs-score)
|
||||
(shapes-liberties
|
||||
:initform nil
|
||||
:accessor shapes-liberties)
|
||||
; stores lists (shape-liberties shape-libertirs-score
|
||||
|
||||
; stores lists of free stones adjacent to shape
|
||||
(shapes-free-points
|
||||
:initform nil
|
||||
:accessor shapes-free-points)
|
||||
(shapes-free-scores
|
||||
:initform nil
|
||||
:accessor shapes-free-scores)
|
||||
(black-shape-stone-liberties
|
||||
:initform 0
|
||||
:accessor black-shape-stone-liberties)
|
||||
(white-shape-stone-liberties
|
||||
:initform 0
|
||||
:accessor white-shape-stone-liberties)
|
||||
(black-shape-liberties
|
||||
:initform 0
|
||||
:accessor black-shape-liberties)
|
||||
|
|
@ -16,11 +29,21 @@
|
|||
(defmethod initialize-instance :after ((board liberty-shape-board) &key from-board)
|
||||
(if (eql from-board nil)
|
||||
(progn
|
||||
(setf (shapes-liberties board) (make-array 1 :fill-pointer 0 :adjustable t)))
|
||||
(setf (shapes-liberties board) (make-array 1 :fill-pointer 0 :adjustable t))
|
||||
(setf (shapes-free-points board) (make-array 1 :fill-pointer 0 :adjustable t))
|
||||
(setf (shapes-free-scores board) (make-array 1 :fill-pointer 0 :adjustable t)))
|
||||
|
||||
(progn
|
||||
(setf (shapes-liberties board) (copy-array (shapes-liberties from-board)))
|
||||
(copy-slots (white-shape-liberties black-shape-liberties) board from-board))))
|
||||
(setf (shapes-free-points board) (copy-2d-array (shapes-free-points from-board)))
|
||||
(setf (shapes-free-scores board) (copy-array (shapes-free-scores from-board)))
|
||||
(copy-slots (white-shape-liberties black-shape-liberties black-shape-stone-liberties white-shape-stone-liberties) board from-board))))
|
||||
|
||||
(defmacro inc-player-shape-stone-liberty (board player delta)
|
||||
`(if (eql ,player #\B)
|
||||
(incf (black-shape-stone-liberties ,board) ,delta)
|
||||
(incf (white-shape-stone-liberties ,board) ,delta)))
|
||||
|
||||
(defmacro inc-player-shape-liberty (board player delta)
|
||||
`(if (eql ,player #\B)
|
||||
(incf (black-shape-liberties ,board) ,delta)
|
||||
|
|
@ -28,7 +51,7 @@
|
|||
|
||||
(defmethod convert-shape :before ((board liberty-shape-board) shape-id to-id)
|
||||
(let ((player (get-stone board (aref (aref (shapes-points board) shape-id) 0))))
|
||||
(inc-player-shape-liberty board player (- (second (aref (shapes-liberties board) shape-id))))
|
||||
(inc-player-shape-stone-liberty board player (- (second (aref (shapes-liberties board) shape-id))))
|
||||
(setf (aref (shapes-liberties board) shape-id) '(0 0))))
|
||||
|
||||
|
||||
|
|
@ -38,37 +61,126 @@
|
|||
(sid (shape-id board coords))
|
||||
(shape-liberties-score (aref (shapes-liberties board) sid))
|
||||
(old-score (second shape-liberties-score)))
|
||||
; (format t "sid @ ~a = ~a~%" sid coords)
|
||||
(inc-player-shape-liberty board player (- old-score))
|
||||
; (pdebug "calculate-shape-liberties for sid:~a score:~a~%" sid shape-liberties-score)
|
||||
(inc-player-shape-stone-liberty board player (- old-score))
|
||||
; (pdebug "loop add liberties~%")
|
||||
(loop for index from 0 to (1- (length (aref (shapes-points board) sid))) do
|
||||
; (pdebug "adding on ~a~%" index)
|
||||
(incf liberties (liberty board (aref (aref (shapes-points board) sid) index))))
|
||||
(let ((score (* liberties (size-of-shape board sid))))
|
||||
(let ((score (* liberties (shape-size board sid))))
|
||||
; (pdebug "sets shape-liberties for ~a (~a ~a)~%" sid liberties score)
|
||||
(setf (aref (shapes-liberties board) sid) `(,liberties ,score))
|
||||
(inc-player-shape-liberty board player score))))
|
||||
(inc-player-shape-stone-liberty board player score))))
|
||||
|
||||
(defmacro coords-eql (a b)
|
||||
`(and (eql (first ,a) (first ,b)) (eql (second ,a) (second ,b))))
|
||||
|
||||
|
||||
(defun add-free-point (board coord sid player)
|
||||
;(pdebug "1st (dec) inc score ~a by ~a " (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board)) (- (aref (shapes-free-scores board) sid)))
|
||||
(inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid)))
|
||||
;(pdebug " = ~a~%" (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board)))
|
||||
(let* ((found nil)
|
||||
(free-points (aref (shapes-free-points board) sid)))
|
||||
(loop for i from 0 to (1- (length free-points)) do
|
||||
(if (coords-eql coord (aref free-points i))
|
||||
(progn
|
||||
(setf found t)
|
||||
(return))))
|
||||
(if (eql found nil)
|
||||
(progn
|
||||
(vector-push-extend coord free-points)))
|
||||
; (inc-player-shape-liberty board player 1)))
|
||||
(let ((newscore (* (shape-size board sid) (length free-points))))
|
||||
; (format t "newscore ~a*~a = ~a~%" (shape-size board sid) (length free-points) newscore)
|
||||
; (pdebug "2nd inc score ~a by ~a " (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board)) newscore)
|
||||
(setf (aref (shapes-free-scores board) sid) newscore)
|
||||
; (format t "set shape-free-scores~%")
|
||||
(inc-player-shape-liberty board player newscore))))
|
||||
; (pdebug " = ~a~%" (if (eql player #\B) (black-shape-liberties board) (white-shape-liberties board))))))
|
||||
|
||||
(defun add-free-points-around (board nexus player)
|
||||
(let ((sid (shape-id board nexus)))
|
||||
(do-over-adjacent (coords-var board nexus)
|
||||
(if (eql (get-stone board coords-var) nil)
|
||||
(add-free-point board coords-var sid player)))))
|
||||
|
||||
(defun remove-free-point (board coord sid player)
|
||||
(let ((free-points (aref (shapes-free-points board) sid)))
|
||||
(if (> (length free-points) 0)
|
||||
(let ((tmp (aref free-points (1- (length free-points)))))
|
||||
; (pdebug "dec inc-player-shape-liberty~%")
|
||||
|
||||
;(pdebug "search for point~%")
|
||||
(loop for i from 0 to (1- (length free-points)) do
|
||||
; (pdebug "search ~a" i)
|
||||
(if (coords-eql coord (aref free-points i))
|
||||
(progn
|
||||
; (pdebug "found on ~a @ ~a" i (aref free-points i))
|
||||
(setf (aref free-points i) tmp)
|
||||
; (pdebug "do vector pop~%")
|
||||
(vector-pop free-points)
|
||||
; (pdebug "inc-player-shape-liberty~%")
|
||||
(inc-player-shape-liberty board player (- (aref (shapes-free-scores board) sid)))
|
||||
(inc-player-shape-liberty board player (* (length free-points) (shape-size board sid)))
|
||||
; (pdebug "set shapes-free-scores new score for ~a~%" sid)
|
||||
(setf (aref (shapes-free-scores board) sid) (* (length free-points) (shape-size board sid)))
|
||||
(return))))))))
|
||||
|
||||
|
||||
|
||||
(defmethod set-stone :after ((board liberty-shape-board) coords val)
|
||||
(while (not (eql (length (shapes-liberties board)) (next-shape-id board)))
|
||||
(vector-push-extend '(0 0) (shapes-liberties board))) ; new shape
|
||||
(vector-push-extend '(0 0) (shapes-liberties board)) ; new shape
|
||||
(vector-push-extend 0 (shapes-free-scores board))
|
||||
(vector-push-extend (make-array 1 :fill-pointer 0 :adjustable t) (shapes-free-points board)))
|
||||
(calculate-shape-liberties board coords val)
|
||||
; (pdebug "about to add-free-points~%")
|
||||
(add-free-points-around board coords val)
|
||||
;adjust neighebors
|
||||
; (pdebug "about to adjust neighbors~%")
|
||||
(let ((sid (shape-id board coords)))
|
||||
(do-over-adjacent (coords-var board coords)
|
||||
(let ((adj-sid (shape-id board coords-var)))
|
||||
(if (not (or (eql adj-sid sid) (eql adj-sid nil)))
|
||||
(calculate-shape-liberties board coords-var (get-stone board coords-var)))))))
|
||||
(let ((adj-sid (shape-id board coords-var))
|
||||
(adj-player (get-player board coords-var)))
|
||||
(if (not (eql adj-sid nil))
|
||||
(progn
|
||||
; (pdebug "adjusting: from coord:~a removing free: ~a and sid:~a player ~a~%" coords coords-var adj-sid adj-player)
|
||||
(remove-free-point board coords adj-sid adj-player)
|
||||
; (pdebug "remove-free-point done~%")
|
||||
(if (not(eql adj-sid sid))
|
||||
(calculate-shape-liberties board coords-var (get-stone board coords-var)))))))))
|
||||
|
||||
(defun liberty-shape-to-analyze (board)
|
||||
(defun liberty-shape-stone-to-analyze (board)
|
||||
(let ((lsb (make-2d-board (boardsize board) 0)))
|
||||
(do-over-board (coords board)
|
||||
(if (not (eql nil (shape-id board coords)))
|
||||
(set-2d-stone lsb coords (second (aref (shapes-liberties board) (shape-id board coords))))))
|
||||
(concatenate 'string (board-to-analyze lsb)
|
||||
'(#\newline) " TEXT blakc shape liberties: " (write-to-string (black-shape-liberties board))
|
||||
" white shape liberties: " (write-to-string (white-shape-liberties board)))))
|
||||
'(#\newline) " TEXT black shape stone liberties: " (write-to-string (black-shape-stone-liberties board))
|
||||
" white shape stone liberties: " (write-to-string (white-shape-stone-liberties board)))))
|
||||
|
||||
(defun shape-liberties-score (board sid)
|
||||
(* (shape-size board sid) (length (aref (shapes-free-points board) sid))))
|
||||
|
||||
(defun liberty-shape-to-analyze (board)
|
||||
(let ((lsb (make-2d-board (boardsize board) 0)))
|
||||
(do-over-board (coords board)
|
||||
(if (not (eql nil (shape-id board coords)))
|
||||
(set-2d-stone lsb coords (shape-liberties-score board (shape-id board coords)))))
|
||||
(concatenate 'string (board-to-analyze lsb)
|
||||
'(#\newline) " TEXT black shape liberties: " (write-to-string (black-shape-liberties board))
|
||||
" white shape liberties: " (write-to-string (white-shape-liberties board)))))
|
||||
|
||||
|
||||
|
||||
;(defmethod score + ((board liberty-shape-board) player)
|
||||
; (if (eql player #\B)
|
||||
; (- (black-shape-liberties board) (white-shape-liberties board))
|
||||
; (- (white-shape-liberties board) (black-shape-liberties board))))
|
||||
|
||||
|
||||
(defmethod score + ((board liberty-shape-board) player)
|
||||
(if (eql player #\B)
|
||||
(- (black-shape-liberties board) (white-shape-liberties board))
|
||||
(- (white-shape-liberties board) (black-shape-liberties board))))
|
||||
(- (black-shape-stone-liberties board) (white-shape-stone-liberties board))
|
||||
(- (white-shape-stone-liberties board) (black-shape-stone-liberties board))))
|
||||
|
|
@ -1,16 +1,19 @@
|
|||
(in-package macro-utils)
|
||||
|
||||
(defun test-while (n)
|
||||
(let ((i 0))
|
||||
(while (< i n)
|
||||
(format t "~a~%" i)
|
||||
(incf i))))
|
||||
;(defun test-while (n)
|
||||
; (let ((i 0))
|
||||
; (while (< i n)
|
||||
; (format t "~a~%" i)
|
||||
; (incf i))))
|
||||
|
||||
(defun test-until (n)
|
||||
(let ((i 0))
|
||||
(until (= i n)
|
||||
(format t "~a~%" i)
|
||||
(incf i))))
|
||||
;(defun test-until (n)
|
||||
; (let ((i 0))
|
||||
; (until (= i n)
|
||||
; (format t "~a~%" i)
|
||||
; (incf i))))
|
||||
|
||||
(defmacro pdebug (&body body)
|
||||
`(format *error-output* ,@body))
|
||||
|
||||
(defmacro while (test-case &body body)
|
||||
`(do ()
|
||||
|
|
@ -26,6 +29,8 @@
|
|||
`(let ,(loop for n in names collect `(,n (gensym)))
|
||||
,@body))
|
||||
|
||||
|
||||
|
||||
(defmacro once-only ((&rest names) &body body)
|
||||
(let ((gensyms (loop for n in names collect (gensym))))
|
||||
`(let (,@(loop for g in gensyms collect `(,g (gensym))))
|
||||
|
|
|
|||
|
|
@ -9,7 +9,8 @@
|
|||
(:export :with-gensyms
|
||||
:once-only
|
||||
:while
|
||||
:until))
|
||||
:until
|
||||
:pdebug))
|
||||
|
||||
(defpackage netpipe
|
||||
(:use :common-lisp)
|
||||
|
|
@ -29,6 +30,7 @@
|
|||
:ranked-board
|
||||
:get-stone
|
||||
:set-stone
|
||||
:get-player
|
||||
:coord-to-str
|
||||
:str-to-coord
|
||||
:genmove
|
||||
|
|
@ -70,7 +72,7 @@
|
|||
:shape-sizes
|
||||
:next-shape-id
|
||||
:convert-shape
|
||||
:size-of-shape))
|
||||
:shape-size))
|
||||
|
||||
(defpackage liberty-shape-board
|
||||
(:use :common-lisp
|
||||
|
|
@ -79,7 +81,8 @@
|
|||
:liberty-board
|
||||
:shape-board)
|
||||
(:export :liberty-shape-board
|
||||
:liberty-shape-to-analyze))
|
||||
:liberty-shape-to-analyze
|
||||
:liberty-shape-stone-to-analyze))
|
||||
|
||||
|
||||
(defpackage go-bot
|
||||
|
|
@ -104,6 +107,7 @@
|
|||
:analyze-liberty
|
||||
:analyze-shapes
|
||||
:analyze-shape-liberties
|
||||
:analyze-shape-stone-liberties
|
||||
))
|
||||
|
||||
(defpackage gtp-handler
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@
|
|||
(vector-push-extend coords (aref (shapes-points board) shape-id))
|
||||
(incf (aref (shape-sizes board) shape-id)))
|
||||
|
||||
(defmacro size-of-shape (board shape-id)
|
||||
(defmacro shape-size (board shape-id)
|
||||
`(aref (shape-sizes ,board) ,shape-id))
|
||||
|
||||
(defgeneric convert-shape (board shape-id to-id))
|
||||
|
|
@ -58,7 +58,7 @@
|
|||
(defmethod join-shapes ((board shape-board) nexus shapes-list)
|
||||
(let ((biggest-shape (first shapes-list)))
|
||||
(loop for shape-id in shapes-list do
|
||||
(if (> (size-of-shape board shape-id) (size-of-shape board biggest-shape))
|
||||
(if (> (shape-size board shape-id) (shape-size board biggest-shape))
|
||||
(setf biggest-shape shape-id)))
|
||||
|
||||
(loop for shape-id in shapes-list do
|
||||
|
|
|
|||
Loading…
Reference in New Issue