emacs-darts-value/darts-value.el

;;; darts-value.el --- Library for dealing with darts

;; Copyright © 2012-2014 Alex Kost

;; Author: Alex Kost <alezost@gmail.com>
;; Created: 25 Jul 2012
;; URL: https://gitlab.com/alezost-emacs/darts-value

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This file may be useful only for those strange people (like me) who
;; play darts and do something with their darts results using Emacs.

;; The most useful function is probably `darts-throw-string-to-points',
;; which can be used like this:
;;
;; (darts-throw-string-to-points "20 + 5 + T19")  ; => 82
;; (darts-throw-string-to-points "25+t20+50")     ; => 135
;; (darts-throw-string-to-points "T19" t)         ; => 171

;;; Code:

(require 'cl-lib)


;;; Darts

(defun darts-dart-value (sector &optional segment)
  "Return dart value by the dart SECTOR and SEGMENT.
SECTOR is a number in the range [1..20, 25].
SEGMENT is a number in the range [1..3] (1 is default)."
  (or segment (setq segment 1))
  (or (and (>= segment 1) (<= segment 3))
      (error "%d is a wrong segment value" segment))
  (or (and (= sector 25) (/= segment 3))
      (and (>= sector 1) (<= sector 20))
      (error "%d is a wrong sector value" sector))
  (cons segment sector))

(defun darts-dart-segment (dart)
  "Return dart segment by DART value."
  (car dart))

(defun darts-dart-sector (dart)
  "Return dart sector by DART value."
  (cdr dart))

(defun darts-dart-points (dart)
  "Return number of points for DART value."
  (* (darts-dart-segment dart)
     (darts-dart-sector dart)))

(defun darts-darts-points (darts)
  "Return number of points for DARTS
DARTS is a list of dart values."
  (apply #'+ (mapcar #'darts-dart-points darts)))

(defun darts-dart-code (dart)
  "Return code value of DART."
  (+ (* 100 (darts-dart-segment dart))
     (darts-dart-sector dart)))

(defun darts-dart-string-to-value (string)
  "Return dart value by STRING denoting a dart.
STRING should be either \"50\" or be in a form:
\"<letter><number>\", where:

  <segment> should be one of the following:
    \"\" (empty) or \"s\" - single,
    \"d\" - double,
    \"t\" - treble;

  <sector> should be a number in the range [1..20, 25]
    (\"t25\" is invalid).

Examples of valid STRING values: \"12\", \"d20\", \"50\", \"T7\".
Return nil if STRING contains an invalid value."
  (let* ((string (if (string= string "50")
                     "d25"
                   (downcase string)))
         (first-char (aref string 0))
         (segment (cl-case first-char
                    (?s 1) (?d 2) (?t 3)))
         (sector (string-to-number
                  (if segment (substring string 1) string)))
         (segment (or segment 1)))
    (darts-dart-value sector segment)))

(defun darts-dart-string-to-points (string)
  "Return points of a dart STRING.
See `darts-dart-string-to-value' for the meaning of STRING."
  (darts-dart-points (darts-dart-string-to-value string)))

(defun darts-dart-string-to-code (string)
  "Return code value of a dart STRING.
See `darts-dart-string-to-value' for the meaning of STRING."
  (darts-dart-code (darts-dart-string-to-value string)))


;;; Throws

(defvar darts-special-throws
  '(("180" . "t20+t20+t20")
    ("177" . "t20+t20+t19")
    ("174" . "t20+t19+t19")
    ("171" . "t20+t19+t18"))
  "Alist of special strings for identifying throws.")

(defun darts-special-throw-string (string)
  "Convert special throw STRING into a normal throw string.
Return nil if STRING is not special."
  (cdr (assoc string darts-special-throws)))

(defun darts-throw-value (&rest darts)
  "Return throw value for a throw consisting of DARTS."
  darts)

(defun darts-throw-darts (throw)
  "Return darts of a THROW."
  throw)

(defun darts-throw-points (throw)
  "Return number of points for THROW value."
  (darts-darts-points (darts-throw-darts throw)))

(defun darts-throw-code (throw)
  "Return code value of THROW."
  (let* ((darts (darts-throw-darts throw))
         (dart-codes (mapcar #'darts-dart-code darts))
         (dart-codes (sort dart-codes #'>)))
    (mapconcat #'number-to-string dart-codes "")))

(defun darts-throw-string-to-value (string &optional duplicate)
  "Return throw value by STRING denoting a throw.
STRING should consist of 1, 2 or 3 darts (see
`darts-dart-string-to-value') separated by \"+\".  Also STRING
may be one of special values from `darts-special-throws'.
Examples: \"T17\", \"t20+t19+d7\", \"25+50\", \"177\".

If DUPLICATE is non-nil and STRING consists of only one dart, it
should be duplicated - i.e., the current throw is considered to
consist of 3 such darts."
  (let* ((string (replace-regexp-in-string " " "" string)) ; remove spaces
         (string (or (darts-special-throw-string string)
                     string))
         (dart-strings (split-string string "+"))
         (dart-count (length dart-strings)))
    (or (<= dart-count 3)
        (error "A throw should consist of 3 darts or less"))
    (let ((darts (mapcar #'darts-dart-string-to-value dart-strings)))
      (apply #'darts-throw-value
             (if (and duplicate (= 1 dart-count))
                 (make-list 3 (car darts))
               darts)))))

(defun darts-throw-string-to-points (string &optional duplicate)
  "Return points of a throw STRING.
See `darts-throw-string-to-value' for the meaning of arguments."
  (darts-throw-points (darts-throw-string-to-value string duplicate)))

(defun darts-throw-string-to-code (string &optional duplicate)
  "Return code value of a throw STRING.
See `darts-throw-string-to-value' for the meaning of arguments."
  (darts-throw-code (darts-throw-string-to-value string duplicate)))

(provide 'darts-value)

;;; darts-value.el ends here