draw-chessboard.lisp

;;;; draw-chessboard.lisp --- Drawing a chessboard using McCLIM
;;;; Screenshot: https://i.imgur.com/6Dne4jz.png

(ql:quickload "mcclim")
;; (asdf:load-system :mcclim)
;; (require :mcclim)

(defpackage "ODAI-PT12-840-CHESSBOARD"
  (:use "CLIM" "CLIM-LISP"))
(in-package "ODAI-PT12-840-CHESSBOARD")

(defconstant square-size 50)

(defconstant max-file 8)
(defconstant max-rank 8)
(defconstant canvas-width
  (+ (* square-size max-file) (* square-size 2)))
(defconstant canvas-height
  (+ (* square-size max-rank) (* square-size 2)))

(defconstant light-square-color clim:+blanched-almond+)
(defconstant dark-square-color
  (make-rgb-color (/ 91 255) (/ 58 255) (/ 49 255)))
(defconstant canvas-background-color clim:+saddle-brown+)
(defconstant coordinates-text-color clim:+gray10+)

(define-application-frame chessboard ()
  ()
  (:menu-bar nil)
  (:panes (canvas :application-pane
                  :width canvas-width
                  :height canvas-height
                  :display-function 'draw-canvas))
  (:layouts (default
             (vertically ()
               canvas))))

(defun draw-square* (sheet x y &key (background-color clim:+light-grey+)
                                    (text-color clim:+black+)
                                    character)
  (draw-rectangle* sheet
                   #1=(* x square-size)
                   #2=(* y square-size)
                   (+ #1# square-size)
                   (+ #2# square-size)
                   :filled t
                   :ink background-color)
  (when character
    (draw-text* sheet
                (string character)
                (+ (* x square-size) (/ square-size 2))
                (+ (* y square-size) (/ square-size 2))
                :align-x :center
                :align-y :center
                :text-size (/ square-size 2)
                :ink text-color)))

(defun draw-canvas (frame sheet)
  (declare (ignore frame))
  (draw-rectangle* sheet
                   0 0 canvas-width canvas-height
                   :filled t
                   :ink canvas-background-color)
  (loop for index from 0
        for x from 0 upto max-file
        do (loop for y from 0 upto (1+ max-rank)
                 do (cond ((and (= x 0)
                                (> y 0))
                           (draw-square* sheet x y
                                         :background-color canvas-background-color
                                         :character (aref " 123456789"
                                                          (- (1+ max-rank) y))
                                         :text-color coordinates-text-color))
                          ((and (> x 0)
                                (= y (1+ max-rank)))
                           (draw-square* sheet x y
                                         :background-color canvas-background-color
                                         :character (aref " abcdefghi" x)
                                         :text-color coordinates-text-color))
                          ((and (< 0 x (1+ max-file))
                                (< 0 y (1+ max-rank)))
                           (draw-square* sheet x y
                                         :background-color
                                         (if (oddp (+ index y))
                                             dark-square-color
                                             light-square-color)))))))

(run-frame-top-level (make-application-frame 'chessboard :pretty-name "Chessboard"))