Compare commits
2 commits
09adcaa3ea
...
51eceb205e
| Author | SHA1 | Date | |
|---|---|---|---|
| 51eceb205e | |||
| a464f1cfc4 |
4 changed files with 146 additions and 34 deletions
55
cg-bridge.el
55
cg-bridge.el
|
|
@ -46,6 +46,7 @@
|
|||
(require 'cl-lib)
|
||||
(require 'eieio)
|
||||
(require 'cg-core)
|
||||
(require 'cg-svg)
|
||||
|
||||
(defconst cg-bridge-ranks
|
||||
["2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K" "A"]
|
||||
|
|
@ -481,6 +482,24 @@ vulnerability, and TRICKS the declarer side's trick count. Keys:
|
|||
out))
|
||||
(if out (mapconcat #'identity (nreverse out) " ") "(no calls yet)")))
|
||||
|
||||
(defcustom cg-bridge-svg-cards t
|
||||
"When non-nil, draw cards as SVG images on a graphical display."
|
||||
:type 'boolean :group 'card-games)
|
||||
|
||||
(defun cg-bridge--spec (card)
|
||||
"Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
|
||||
(cons (aref cg-bridge-ranks (cdr card)) (car card)))
|
||||
|
||||
(cl-defun cg-bridge--svg-row (cards &key cursor hints)
|
||||
"Return a one-image SVG row for CARDS with CURSOR and HINTS indices."
|
||||
(propertize "*" 'display
|
||||
(cg-svg-image
|
||||
(cg-svg-hand-svg (mapcar #'cg-bridge--spec cards)
|
||||
:cursor cursor :hints hints
|
||||
:overlap (if (> (length cards) 11)
|
||||
(max 0 (- cg-svg-card-width 26)) 0))
|
||||
(cg-scale))))
|
||||
|
||||
(cl-defmethod cg-render ((game cg-bridge-game))
|
||||
"Return a propertized depiction of the Bridge GAME."
|
||||
(let* ((out '()) (phase (cg-get game :phase)) (cursor (cg-get game :cursor)))
|
||||
|
|
@ -511,16 +530,22 @@ vulnerability, and TRICKS the declarer side's trick count. Keys:
|
|||
(cg-get game :tricks))
|
||||
out)
|
||||
(when (and (cg-get game :exposed) (cg-get game :dummy))
|
||||
(push (format "\n Dummy (%s):\n%s"
|
||||
(aref cg-bridge-seat-names (cg-get game :dummy))
|
||||
(cg-bridge--hand-by-suit (cg-bridge--hand game (cg-get game :dummy))))
|
||||
out))
|
||||
(push (format "\n Dummy (%s):\n "
|
||||
(aref cg-bridge-seat-names (cg-get game :dummy))) out)
|
||||
(if (and cg-bridge-svg-cards (display-graphic-p))
|
||||
(push (cg-bridge--svg-row
|
||||
(cg-bridge--sort (cg-bridge--hand game (cg-get game :dummy)))) out)
|
||||
(push (cg-bridge--hand-by-suit (cg-bridge--hand game (cg-get game :dummy))) out)))
|
||||
(push "\n Trick: " out)
|
||||
(if (cg-get game :trick)
|
||||
(dolist (p (reverse (cg-get game :trick)))
|
||||
(cond
|
||||
((null (cg-get game :trick)) (push "(empty)" out))
|
||||
((and cg-bridge-svg-cards (display-graphic-p))
|
||||
(push (concat (mapconcat (lambda (p) (aref cg-bridge-seat-names (car p)))
|
||||
(reverse (cg-get game :trick)) " ") " ") out)
|
||||
(push (cg-bridge--svg-row (mapcar #'cdr (reverse (cg-get game :trick)))) out))
|
||||
(t (dolist (p (reverse (cg-get game :trick)))
|
||||
(push (format "%s:%s " (aref cg-bridge-seat-names (car p))
|
||||
(cg-bridge-card-string (cdr p))) out))
|
||||
(push "(empty)" out))
|
||||
(cg-bridge-card-string (cdr p))) out))))
|
||||
(push "\n" out)))
|
||||
;; the human's hand (South), or the seat being played from when it is dummy
|
||||
(let* ((act (if (and (eq phase 'play) (memq (cg-get game :turn)
|
||||
|
|
@ -533,7 +558,15 @@ vulnerability, and TRICKS the declarer side's trick count. Keys:
|
|||
((= act 0) " (you)")
|
||||
(t " (dummy, you play)")))
|
||||
out)
|
||||
(if (eq phase 'play)
|
||||
(cond
|
||||
((and (eq phase 'play) cg-bridge-svg-cards (display-graphic-p))
|
||||
(let ((hi '()) (i 0))
|
||||
(dolist (c hand)
|
||||
(when (and (= (cg-get game :turn) act) (cg-bridge--legal-play-p game act c))
|
||||
(push i hi))
|
||||
(setq i (1+ i)))
|
||||
(push (cg-bridge--svg-row hand :cursor cursor :hints hi) out)))
|
||||
((eq phase 'play)
|
||||
(let ((i 0))
|
||||
(dolist (c hand)
|
||||
(let ((cs (cg-bridge-card-string c)) (faces nil))
|
||||
|
|
@ -542,8 +575,8 @@ vulnerability, and TRICKS the declarer side's trick count. Keys:
|
|||
(cg-bridge--legal-play-p game act c)) (push 'cg-hint faces))
|
||||
(when (= i cursor) (push 'cg-cursor faces))
|
||||
(push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
|
||||
(setq i (1+ i))))
|
||||
(push (cg-bridge--hand-by-suit hand) out)))
|
||||
(setq i (1+ i)))))
|
||||
(t (push (cg-bridge--hand-by-suit hand) out))))
|
||||
(push (format "\n\n %s\n" (cg-get game :message)) out)
|
||||
(apply #'concat (nreverse out))))
|
||||
|
||||
|
|
|
|||
32
cg-rummy.el
32
cg-rummy.el
|
|
@ -48,6 +48,7 @@
|
|||
(require 'cl-lib)
|
||||
(require 'eieio)
|
||||
(require 'cg-core)
|
||||
(require 'cg-svg)
|
||||
|
||||
(defconst cg-rummy-ranks
|
||||
["A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K"]
|
||||
|
|
@ -278,10 +279,37 @@ NDECKS defaults to 1 and JOKERS to 0."
|
|||
(sb (if (cg-rummy-joker-p b) 99 (car b))))
|
||||
(if (= sa sb) (< (cdr a) (cdr b)) (< sa sb))))))
|
||||
|
||||
(defcustom cg-rummy-svg-cards t
|
||||
"When non-nil, draw cards as SVG images on a graphical display.
|
||||
Set to nil to force the plain-text card row everywhere."
|
||||
:type 'boolean :group 'card-games)
|
||||
|
||||
(defun cg-rummy--card-spec (card)
|
||||
"Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
|
||||
(if (cg-rummy-joker-p card) (cons "" 'joker)
|
||||
(cons (aref cg-rummy-ranks (cdr card)) (car card))))
|
||||
|
||||
(defun cg-rummy--svg-row (cards cursor marks hint-fn)
|
||||
"Return a one-image SVG row for CARDS with CURSOR, MARKS and HINT-FN."
|
||||
(let* ((specs (mapcar #'cg-rummy--card-spec cards))
|
||||
(hints (when hint-fn
|
||||
(let ((hs '()) (i 0))
|
||||
(dolist (c cards) (when (funcall hint-fn c) (push i hs))
|
||||
(setq i (1+ i)))
|
||||
hs)))
|
||||
(cur (and (integerp cursor) (>= cursor 0) cursor))
|
||||
(overlap (if (> (length cards) 11) (max 0 (- cg-svg-card-width 24)) 0))
|
||||
(svg (cg-svg-hand-svg specs :cursor cur :hints hints
|
||||
:marks marks :overlap overlap)))
|
||||
(propertize "*" 'display (cg-svg-image svg (cg-scale)))))
|
||||
|
||||
(defun cg-rummy--render-cards (cards cursor marks &optional hint-fn)
|
||||
"Return a propertized row of CARDS.
|
||||
CURSOR is the highlighted index, MARKS a list of marked indices, and
|
||||
HINT-FN an optional predicate marking playable cards."
|
||||
HINT-FN an optional predicate marking playable cards. Draws SVG cards on
|
||||
a graphical display (see `cg-rummy-svg-cards'), else a plain-text row."
|
||||
(if (and cg-rummy-svg-cards (display-graphic-p))
|
||||
(cg-rummy--svg-row cards cursor marks hint-fn)
|
||||
(let ((i 0) (out '()))
|
||||
(dolist (c cards)
|
||||
(let ((cs (cg-rummy-card-string c)) (faces nil))
|
||||
|
|
@ -292,7 +320,7 @@ HINT-FN an optional predicate marking playable cards."
|
|||
(when (eql i cursor) (push 'cg-cursor faces))
|
||||
(push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
|
||||
(setq i (1+ i)))
|
||||
(apply #'concat (nreverse out))))
|
||||
(apply #'concat (nreverse out)))))
|
||||
|
||||
(defun cg-rummy--melds-string (melds)
|
||||
"Return a one-line depiction of MELDS (a list of card-lists)."
|
||||
|
|
|
|||
19
cg-svg.el
19
cg-svg.el
|
|
@ -384,5 +384,24 @@ targets. PAD is the margin around the grid."
|
|||
(svg-print svg)
|
||||
(buffer-string)))
|
||||
|
||||
(cl-defun cg-svg-hand-svg (specs &key cursor hints marks (overlap 0) (pad 8))
|
||||
"Return an svg drawing SPECS as a left-to-right hand.
|
||||
CURSOR is the index to ring as the cursor; HINTS and MARKS are lists of
|
||||
indices to ring as playable and as marked; OVERLAP fans the cards."
|
||||
(let* ((w cg-svg-card-width) (h cg-svg-card-height)
|
||||
(step (max 1 (- (+ w cg-svg-card-gap) overlap)))
|
||||
(n (length specs))
|
||||
(width (+ (* 2 pad) (if (> n 0) (+ (* (1- n) step) w) w)))
|
||||
(height (+ (* 2 pad) h))
|
||||
(svg (svg-create width height))
|
||||
(x pad) (i 0))
|
||||
(dolist (spec specs)
|
||||
(cg-svg--draw-spec svg x pad spec (eql i cursor) (and (memq i hints) t))
|
||||
(when (memq i marks)
|
||||
(svg-rectangle svg (- x 3) (- pad 3) (+ w 6) (+ h 6)
|
||||
:rx 7 :fill "none" :stroke "#4a90d9" :stroke-width 3))
|
||||
(setq x (+ x step) i (1+ i)))
|
||||
svg))
|
||||
|
||||
(provide 'cg-svg)
|
||||
;;; cg-svg.el ends here
|
||||
|
|
|
|||
42
cg-trick.el
42
cg-trick.el
|
|
@ -42,6 +42,7 @@
|
|||
(require 'cl-lib)
|
||||
(require 'eieio)
|
||||
(require 'cg-core)
|
||||
(require 'cg-svg)
|
||||
|
||||
;;;; Cards
|
||||
|
||||
|
|
@ -528,6 +529,24 @@
|
|||
(if bid (format " bid %d" bid) "")
|
||||
(if won (format " won %d" won) ""))))
|
||||
|
||||
(defcustom cg-trick-svg-cards t
|
||||
"When non-nil, draw cards as SVG images on a graphical display."
|
||||
:type 'boolean :group 'card-games)
|
||||
|
||||
(defun cg-trick--spec (card)
|
||||
"Return the cg-svg display spec (RANK-STRING . SUIT) for CARD."
|
||||
(cons (aref cg-trick-ranks (cdr card)) (car card)))
|
||||
|
||||
(cl-defun cg-trick--svg-row (cards &key cursor marks hints)
|
||||
"Return a one-image SVG row for CARDS with CURSOR, MARKS, HINTS indices."
|
||||
(propertize "*" 'display
|
||||
(cg-svg-image
|
||||
(cg-svg-hand-svg (mapcar #'cg-trick--spec cards)
|
||||
:cursor cursor :marks marks :hints hints
|
||||
:overlap (if (> (length cards) 11)
|
||||
(max 0 (- cg-svg-card-width 24)) 0))
|
||||
(cg-scale))))
|
||||
|
||||
(cl-defmethod cg-render ((game cg-trick-game))
|
||||
"Return a propertized string depicting GAME for a text display."
|
||||
(let* ((out (list))
|
||||
|
|
@ -544,15 +563,28 @@
|
|||
(push (cg-trick--seat-line game s) out))
|
||||
;; current trick
|
||||
(push "\n Trick: " out)
|
||||
(if (cg-get game :trick)
|
||||
(dolist (play (reverse (cg-get game :trick)))
|
||||
(cond
|
||||
((null (cg-get game :trick)) (push "(empty)" out))
|
||||
((and cg-trick-svg-cards (display-graphic-p))
|
||||
(push (concat (mapconcat (lambda (p) (aref cg-trick-seat-names (car p)))
|
||||
(reverse (cg-get game :trick)) " ") " ")
|
||||
out)
|
||||
(push (cg-trick--svg-row (mapcar #'cdr (reverse (cg-get game :trick)))) out))
|
||||
(t (dolist (play (reverse (cg-get game :trick)))
|
||||
(push (format "%s:%s " (aref cg-trick-seat-names (car play))
|
||||
(let ((cs (cg-trick-card-string (cdr play))))
|
||||
(if (cg-trick-red-p (cdr play))
|
||||
(propertize cs 'face 'cg-red-suit) cs)))
|
||||
out))
|
||||
(push "(empty)" out))
|
||||
out))))
|
||||
(push "\n\n Your hand (South):\n " out)
|
||||
(if (and cg-trick-svg-cards (display-graphic-p))
|
||||
(let ((mi '()) (hi '()) (i 0)
|
||||
(legalp (and (eq (cg-get game :phase) 'play) (= (cg-get game :turn) 0))))
|
||||
(dolist (c hand)
|
||||
(when (member c marks) (push i mi))
|
||||
(when (and legalp (cg-trick--legal-p game 0 c)) (push i hi))
|
||||
(setq i (1+ i)))
|
||||
(push (cg-trick--svg-row hand :cursor cursor :marks mi :hints hi) out))
|
||||
(let ((i 0))
|
||||
(dolist (c hand)
|
||||
(let* ((cs (cg-trick-card-string c))
|
||||
|
|
@ -561,7 +593,7 @@
|
|||
(when (member c marks) (push 'cg-hint faces))
|
||||
(when (= i cursor) (push 'cg-cursor faces))
|
||||
(push (propertize (format "%4s" cs) 'face (or faces 'default)) out))
|
||||
(setq i (1+ i))))
|
||||
(setq i (1+ i)))))
|
||||
(push (format "\n\n %s\n" (cg-get game :message)) out)
|
||||
(apply #'concat (nreverse out))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue