code.delx.au - gnu-emacs-elpa/blob - packages/arbitools/arbitools.el

   1 ;;; arbitools.el --- Package for chess tournaments administration
   2
   3 ;; Copyright 2016 Free Software Foundation, Inc.
   4
   5 ;; Author: David Gonzalez Gandara <dggandara@member.fsf.org>
   6 ;; Version: 0.55
   7 ;; Package-Requires: ((cl-lib "0.5"))
   8
   9 ;; This program is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13 ;;
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18 ;;
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; REQUIRES:
  25 ;; ---------------------------
  26 ;; Some functions require the arbitools python package, you can install
  27 ;; it by: "pip3 install arbitools"
  28 ;; "pdflatex" is necessary in case you want to get pdfs.
  29 ;;
  30 ;; USAGE:
  31 ;; ---------------------------
  32 ;; arbitools.el is an interface for the python package "arbitools",
  33 ;; designed to manage chess tournament reports.  If you don't install the
  34 ;; python package you can still have the syntax colouring and some native
  35 ;; functions. In the future, all the functions will be translated to ELISP.
  36 ;;
  37 ;; FEATURES:
  38 ;; ----------------------------
  39 ;; - Syntax colouring for the official trf FIDE files.  This facilitates
  40 ;; manual edition of the files.
  41 ;;
  42 ;; - Updating the players ratings. - with python
  43 ;;
  44 ;; - Adding players to an existing file. - with python
  45 ;;
  46 ;; - Getting standings from a tournament file. -with python
  47 ;;
  48 ;; - Getting IT3 Tournament report form. - with python
  49 ;;
  50 ;; - Deleting a round. - Native
  51 ;;
  52 ;; - Insert result. - Native
  53 ;;
  54 ;; - Insert player. - Native
  55 ;;
  56 ;; - Get the pairing or results of a round - Native
  57 ;;
  58 ;; - Get the list of the players - Native
  59 ;;
  60 ;; - Delete player. Adjust all rank numbers - Native
  61 ;;
  62 ;; - Adjust points for each player, according to results of rounds - Native
  63 ;;
  64 ;; - Print standings - Native
  65 ;;
  66 ;; TODO:
  67 ;; ---------------------------------
  68 ;;
  69 ;; - Automatically purge all players who didn't play any games.
  70 ;;
  71 ;; - Insert results from a results file created with a pairing program.
  72 ;;   Add the date in the "132" line and the results in the "001" lines.
  73 ;;
  74 ;; - Add empty round. Ask for date create empty space in the players lines.
  75 ;;   Add the date in the "132" line.
  76 ;;
  77 ;; - Add the rank number and the position automatically when adding players.
  78 ;;
  79 ;; - Add team.
  80 ;;
  81 ;; - Add player to team. Prompt for team and player number.
  82 ;;
  83 ;; - Generate pgn file for a round or the whole tournament.
  84 ;;
  85 ;; - Reorder the ranking
  86 ;;
  87 ;; - Reorder the players list
  88 ;;
  89 ;; You will find more information in www.ourenxadrez.org/arbitools.htm
  90
  91 ;;; Code:
  92
  93 (eval-when-compile (require 'cl-lib))
  94
  95 (defun arbitools-prepare-feda ()
  96   "Prepare file to FEDA: add carriage return at the end of lines."
  97   (interactive)
  98   (save-excursion
  99     (goto-char (point-min))
 100     (while (search-forward "\n" nil t)
 101       (replace-match "\r\n"))))
 102
 103 (defun arbitools-update (elolist)
 104   "Update the players ratings in a database file based on a elo list file."
 105   (interactive "selolist:")
 106   ;; FIXME: What if `list' is "foo; bar"?
 107   (call-process "arbitools-run.py" nil "Arbitools-output" nil "update" buffer-file-name "-l" elolist))
 108
 109 (defun arbitools-add (addfile)
 110   "Add players to an existing database file."
 111   (interactive "faddfile: ")
 112   ;; FIXME: What if `addlist' is "foo; bar"?
 113   (call-process "arbitools-add.py" nil "Arbitools-output" nil "-a" addfile "-i" buffer-file-name))
 114
 115 (defun arbitools-list-pairing (round)
 116   "Get the pairings and/or results of the given round"
 117   (interactive "sround: ")
 118   (goto-char (point-min))
 119   (arbitools-list-players)
 120   (save-excursion
 121     (re-search-forward "^012" nil t)
 122     (let* ((linestring (thing-at-point 'line))
 123           (tournamentnamestring (substring linestring 4)))
 124       (with-current-buffer "Pairings List"
 125         (erase-buffer)
 126         (insert (format "%s" tournamentnamestring)))))
 127   (with-current-buffer "Pairings List"
 128    (insert (format "Pairings for round %s\n\n" round)) )
 129   (let* ((paired '()))
 130
 131     (while (re-search-forward "^001" nil t)
 132        (let* ((namestring nil)
 133              (linestring (thing-at-point 'line))
 134              (playerlinestring nil)
 135              (opponentlinestring nil)
 136              opponentstring
 137              (rankstring (substring linestring 4 8))
 138              (opponent (substring linestring (+ 91 (* (- (string-to-number round) 1)10 ))
 139                        (+ 95(* (- (string-to-number round) 1)10 ))))
 140              (color (substring linestring (+ 96 (* (- (string-to-number round) 1)10 ))
 141                        (+ 97(* (- (string-to-number round) 1)10 ))))
 142              (result (substring linestring (+ 98 (* (- (string-to-number round) 1)10 ))
 143                        (+ 99(* (- (string-to-number round) 1)10 )))))
 144          (with-current-buffer "Arbitools-output"
 145            (insert (format "%s\n" paired))
 146            (insert (format "-%s-" rankstring))
 147            (insert (format "%s\n" (member "   1" paired))))
 148          (unless (or (member rankstring paired) (member opponent paired))
 149            (with-current-buffer "List of players"
 150                (goto-char (point-min))
 151                (re-search-forward (concat "^" (regexp-quote  rankstring)))
 152                (setq playerlinestring (thing-at-point 'line))
 153                (setq namestring (substring playerlinestring 4 37))
 154                (goto-char (point-min))
 155                (unless (or (string= opponent "0000") (string= opponent "    "))
 156                    (re-search-forward (concat "^" (regexp-quote opponent))))
 157                (setq opponentlinestring (thing-at-point 'line))
 158                (setq opponentstring (substring opponentlinestring 4 37))
 159                (when (or (string= opponent "0000")(string= opponent "    "))
 160                  (setq opponentstring "-"))
 161                (cl-pushnew rankstring paired :test #'equal))
 162            (with-current-buffer "Pairings List"
 163              (cond ((string= color "w") ;; TODO: change the ranknumber with the name
 164                      (cond ((string= result "1")
 165                            (insert (format "%s 1-0 %s\n" namestring opponentstring)))
 166                           ((string= result "0")
 167                            (insert (format "%s 0-1 %s\n" namestring opponentstring)))
 168                           ((string= result "+")
 169                            (insert (format "%s + - %s\n" namestring opponentstring)))
 170                           ((string= result "-")
 171                            (insert (format "%s - + %s\n" namestring opponentstring)))
 172                           ((string= result "=")
 173                            (insert (format "%s 1/2 %s\n" namestring opponentstring)))))
 174                    ((string= color "b")
 175                      (cond ((string= result "1")
 176                            (insert (format "%s 0-1 %s\n" opponentstring namestring)))
 177                           ((string= result "0")
 178                            (insert (format "%s 1-0 %s\n" opponentstring namestring)))
 179                           ((string= result "+")
 180                            (insert (format "%s - + %s\n" opponentstring namestring)))
 181                           ((string= result "-")
 182                            (insert (format "%s + - %s\n" opponentstring namestring)))
 183                           ((string= result "=")
 184                            (insert (format "%s 1/2 %s\n" opponentstring namestring))))))))))))
 185
 186
 187 (defun arbitools-standings ()
 188   "Get standings and report files from a tournament file."
 189   (interactive)
 190   ;; (shell-command (concat (expand-file-name "arbitools-standings.py") " -i " buffer-file-name))) ;this is to use the actual path
 191   (call-process "arbitools-run.py" nil "Arbitools-output" nil "standings" buffer-file-name))
 192
 193 (defun arbitools-list-players ()
 194   "Put the list of players in two buffers, one in plain text and another in a beautiful LaTeX"
 195   ;; TODO: the beautiful LaTeX
 196   (interactive)
 197   (save-excursion
 198    (goto-char (point-min))
 199    (while (re-search-forward "^001" nil t)
 200      (let* ((linestring (thing-at-point 'line))
 201            (rankstring (substring linestring 5 8)))
 202
 203        (with-current-buffer "List of players"
 204          (insert (format " %s " rankstring))))
 205
 206      (let* ((linestring (thing-at-point 'line))
 207            (namestring (substring linestring 14 47)))
 208
 209        (with-current-buffer "List of players"
 210          (insert (format "%s " namestring))))
 211
 212      (let* ((linestring (thing-at-point 'line))
 213             (elostring (substring linestring 48 52)))
 214
 215        (with-current-buffer "List of players"
 216          (insert (format "%s\n" elostring))))))
 217   (with-current-buffer "List of players"
 218     (remove-text-properties (point-min)(point-max) '(face nil))))
 219
 220 (defun arbitools-new-trf ()
 221   "Create an empty trf file"
 222   (interactive)
 223   (generate-new-buffer "New trf")
 224   (switch-to-buffer "New trf")
 225   (set-buffer "New trf")
 226   (arbitools-mode)
 227   (insert "012 NAME OF THE TOURNAMENT\n")
 228   (insert "022 PLACE\n")
 229   (insert "032 FEDERATION\n")
 230   (insert "042 STARTING DATE (YYYY/MM/DD)\n")
 231   (insert "052 ENDING DATE (YYYY/MM/DD)\n")
 232   (insert "062 NUMBER OF PLAYERS\n")
 233   (insert "072 NUMBER OF RATED PLAYERS\n")
 234   (insert "082 NUMBER OF TEAMS\n")
 235   (insert "092 TYPE OF TOURNAMENT\n")
 236   (insert "102 CHIEF ARBITER\n")
 237   (insert "112 DEPUTY CHIEF ARBITER\n")
 238   (insert "122 ALLOTED TIMES PER MOVE/GAME\n")
 239   (insert "132 DATES                                                                                  YY/MM/DD  YY/MM/DD\n")
 240   ;; (insert "001  000 GTIT NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN RAT. FED   0000000000 YYYY/MM/DD 00.0  RNK  0000 C R  0000 C R\n")
 241   ;; (insert "013 NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN  0000 0000\n")
 242 )
 243
 244  (defun arbitools-number-of-rounds ()
 245    "Get the number of rounds in the tournament. It has to be executed in the principal buffer."
 246    (let* ((numberofrounds 0))
 247      (save-excursion
 248       (goto-char (point-min))
 249       (re-search-forward "^132" nil t)
 250         (let* ((linestringrounds (thing-at-point 'line))
 251             ;; (actualround " ")
 252             (beginning-of-round 91)
 253             (end-of-round 99)
 254             (continue t))
 255
 256             ;; (with-current-buffer "Arbitools-output" (insert (format "rounds: %s" linestringrounds)))
 257             ;; (with-current-buffer "Arbitools-output" (insert (format "length: %s" (- (length linestringrounds) 4))))
 258            ;; For some reason, the length of the string is 4 characters longer than the real line
 259            (while continue
 260              (if (< end-of-round (length linestringrounds))
 261
 262                (progn
 263                   ;; (setq actualround (substring-no-properties linestringrounds beginning-of-round end-of-round))
 264                   (setq numberofrounds (+ numberofrounds 1))
 265                   (setq beginning-of-round (+ beginning-of-round 10))
 266                   (setq end-of-round (+ end-of-round 10)))
 267
 268                   (setq continue nil)))))
 269      numberofrounds))
 270
 271 (defun arbitools-calculate-points ()
 272   "Automatically calculate the points of each player"
 273   (interactive)
 274   (save-excursion
 275     (let ( (numberofrounds (arbitools-number-of-rounds))
 276            (pointsstring   "")
 277            (points         0.0)
 278            (pointstosum    0.0)
 279            (roundcount     1))
 280       (goto-char (point-min))
 281       (while (re-search-forward "^001" nil t)
 282         (setq points 0.0)
 283         (setq roundcount 1)
 284         (while (<= roundcount numberofrounds)
 285           (beginning-of-line)
 286           (forward-char (+ 98 (* (- roundcount 1) 10))) ;; go to where the result is for each round
 287           (setq pointsstring (thing-at-point 'symbol))
 288           (cond ((string= (thing-at-point 'symbol) "1") (setq pointstosum 1.0))
 289                 ((string= (thing-at-point 'symbol) "+") (setq pointstosum 1.0))
 290                 ((string= (thing-at-point 'symbol) "=") (setq pointstosum 0.5))
 291                 ((string= (thing-at-point 'symbol) "0") (setq pointstosum 0.0))
 292                 ((string= (thing-at-point 'symbol) "-") (setq pointstosum 0.0))
 293                 ((string= (thing-at-point 'symbol) nil) (setq pointstosum 0.0)))
 294           (setq points (+ points pointstosum))
 295           (setq roundcount (+ roundcount 1)))
 296         (beginning-of-line)
 297         (forward-char 84)
 298         (forward-char -3)
 299         (delete-char 3)
 300         (insert-char ?\s (- 3 (length (format "%s" points))))
 301         (insert (format "%s" points))))))
 302
 303 (defun arbitools-calculate-standings ()
 304   "Write the standings in the Standings buffer"
 305   (interactive)
 306   (arbitools-calculate-points) ;; make sure the points of each player are correct
 307   (save-excursion
 308     (with-current-buffer "Standings"
 309       (erase-buffer))
 310     (let ((datachunk ""))
 311       (goto-char (point-min))
 312       (while (re-search-forward "^001" nil t)
 313         (let* ((linestring (thing-at-point 'line)))
 314           (beginning-of-line)
 315           (forward-char 89) ;; get the POS field
 316           (setq datachunk (thing-at-point 'word))
 317           (with-current-buffer "Standings"
 318             (insert (format "%s" datachunk))
 319             (insert-char ?\s (- 3 (length datachunk)))
 320             (insert " "))
 321           (setq datachunk (substring-no-properties (thing-at-point 'line) 14 47)) ;; get name
 322           (with-current-buffer "Standings"
 323             (insert (format "%s " datachunk))
 324             (insert-char ?\s (- 33 (length datachunk))))
 325           (beginning-of-line)
 326           (forward-char 68)
 327           (setq datachunk (thing-at-point 'word)) ;; get idfide
 328           (with-current-buffer "Standings"
 329             (insert (format "%s " datachunk))
 330             (insert-char ?\s (- 10 (length datachunk))))
 331           (setq datachunk (substring-no-properties (thing-at-point 'line) 80 84)) ;; get points
 332           (with-current-buffer "Standings"
 333             (insert (format "%s " datachunk))
 334             (insert-char ?\s (- 4 (length datachunk))))
 335           (with-current-buffer "Standings"
 336             (insert "\n")
 337             (sort-columns 1 49 (- (point-max) 1))))))
 338     (let ((newpos 0)
 339           (idfide ""))
 340       (goto-char (point-min))
 341       (while (re-search-forward "^001" nil t)
 342         (beginning-of-line)
 343         (forward-char 68)
 344         (setq idfide (thing-at-point 'word))
 345         (with-current-buffer "Standings"
 346           (goto-char (point-min))
 347           (search-forward idfide nil t)
 348           (setq newpos (line-number-at-pos))) ;; the POS is in the beginning of the line in Standings
 349         (with-current-buffer "Arbitools-output"
 350           (insert (format "%s" newpos))
 351           (insert "\n"))
 352         (beginning-of-line)
 353         (forward-char 89) ;; go to POS field
 354         (forward-char -3)
 355         (delete-char 3)
 356         (insert-char ?\s (- 3 (length (format "%s" newpos))))
 357         (insert (format "%s" newpos))))))
 358
 359 (defun arbitools-delete-player (player)
 360    "Delete a player. Adjust all the rank numbers accordingly."
 361    (interactive "splayer: ")
 362    (let ((numberofrounds 0)
 363          (elo            ""))
 364
 365     (save-excursion
 366       (goto-char (point-min))
 367       (re-search-forward "^132" nil t)
 368         (let* ((linestringrounds   (thing-at-point 'line))
 369                ;; (actualround        " ")
 370                (beginning-of-round 91)
 371                (end-of-round       99)
 372                (continue           t))
 373            (while continue
 374              (if (< end-of-round (length linestringrounds))
 375                (progn
 376                   ;; (setq actualround (substring-no-properties linestringrounds beginning-of-round end-of-round))
 377                   (setq numberofrounds (+ numberofrounds 1))
 378                   (setq beginning-of-round (+ beginning-of-round 10))
 379                   (setq end-of-round (+ end-of-round 10)))
 380                (setq continue nil)))))
 381     (save-excursion
 382      (goto-char (point-min))
 383      (while (re-search-forward "^001" nil t)
 384        (let* ((linestring (thing-at-point 'line))
 385               (rankstring (substring linestring 5 8)))
 386          (when (= (string-to-number rankstring) (string-to-number player))
 387            (forward-char 1)
 388            (delete-char 4)
 389            (insert " DEL")
 390            (setq elo (substring linestring 48 52))
 391            (with-current-buffer "Arbitools-output" (insert (format "%s" elo))))
 392          (when (> (string-to-number rankstring)(string-to-number player))
 393            (forward-char 1)
 394            (delete-char 4)
 395            (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 396            (insert (format "%s" (- (string-to-number rankstring) 1)))
 397            (save-excursion
 398              (goto-char (point-min))
 399              (while (re-search-forward "^001" nil t)
 400                (let* ((roundcount          1))
 401                   (while (<= roundcount numberofrounds)
 402                     (beginning-of-line)
 403                     (forward-char (+ 95 (* (- roundcount 1) 10)))
 404                     (when (string= (format "%s" (string-to-number rankstring)) (thing-at-point 'word))
 405                       (forward-char -4) ;; go back to the beginning of the opponent's number
 406                       (delete-char 4) ;; remove the original opponent's number
 407                       (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 408                       (insert (format "%s" (- (string-to-number rankstring) 1))))
 409                     (setq roundcount (+ roundcount 1))))
 410                ;;(condition-case nil ;; TODO: fix teams info
 411                  (save-excursion
 412                    (while (re-search-forward "^013" nil t)
 413                     (let* ((linestringteam (thing-at-point 'line))
 414                           (actualintegrant (string-to-number (substring linestringteam 40 44)))
 415                           (integrantcount 0)
 416                           (members 0))
 417
 418                         ;; to find the end of the line, the number is length -2, for some reason
 419                         (setq members (/ (- (- (length linestringteam) 2) 34) 5)) ;; calculate number of members
 420
 421                       (while (< integrantcount members)
 422                        (beginning-of-line)
 423                        (forward-char (+ 40 (* (- integrantcount 1) 5)))
 424                        (when (string= (format "%s" (string-to-number rankstring)) (thing-at-point 'word))
 425                          (forward-char -4)
 426                          (delete-char 4)
 427                          (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 428                          (insert (format "%s" (- (string-to-number rankstring) 1))))
 429                        (setq integrantcount (+ integrantcount 1))))))))))))
 430
 431      (save-excursion  ;; Actually delete the player's line
 432        (goto-char (point-min))
 433        (while (re-search-forward "^001  DEL" nil t)
 434          (beginning-of-line)
 435          (let ((beg (point)))
 436            (forward-line 1)
 437            (delete-region beg (point)))))
 438      ;; TODO delete the rank from teams section
 439      ;; TODO change number of players and number of rated players
 440      (save-excursion
 441        (with-current-buffer "Arbitools-output" (insert (format "%s" elo)))
 442        (goto-char (point-min))
 443        (re-search-forward "^062 ")
 444        (let* ((linestring      (thing-at-point 'line))
 445               (numberofplayers (substring linestring 4)))
 446         (delete-char (length numberofplayers))
 447         (setq numberofplayers (string-to-number numberofplayers))
 448         (setq numberofplayers (- numberofplayers 1))
 449         (insert (concat (number-to-string numberofplayers) "\n")))
 450        (re-search-forward "^072 ")
 451        (let* ((linestring           (thing-at-point 'line))
 452               (numberofratedplayers (substring linestring 4)))
 453         (unless (< (length elo) 2) ;; if elo is 0 or nonexistent
 454           (delete-char (length numberofratedplayers))
 455           (setq numberofratedplayers (string-to-number numberofratedplayers))
 456           (setq numberofratedplayers (- numberofratedplayers 1))
 457           (insert (concat (number-to-string numberofratedplayers) "\n")))))))
 458
 459 (defun arbitools-delete-round (round)
 460    "Delete a round." ;; FIXME: it breaks when round is the last
 461    (interactive "sround: ")
 462    (save-excursion
 463     (goto-char (point-min))
 464     (while (re-search-forward "^001" nil t)
 465      (forward-char (+ 88 (* (- (string-to-number round) 1) 10)))
 466      (delete-char 10)
 467      (insert "          "))))
 468
 469 (defun arbitools-replace-empty ()
 470    "Replace non played games with spaces"
 471    (interactive)
 472    (save-excursion
 473     (goto-char (point-min))
 474     (while (search-forward "0000 - 0" nil t)
 475       (replace-match "        "))))
 476
 477 (defun arbitools-insert-player (sex title name elo fed idfide year)
 478    "Insert a player"
 479    ;; TODO: automatically insert the player in a team
 480    (interactive "ssex: \nstitle: \nsname: \nselo: \nsfed: \nsidfide: \nsyear: ")
 481   (let ((playerlinelength nil)
 482         (thislinelength nil))
 483      (save-excursion
 484        (goto-char (point-min))
 485        (re-search-forward "^001 ")
 486        (let* ((linestring (thing-at-point 'line)))
 487          (setq playerlinelength (length linestring))))
 488      (save-excursion
 489        (goto-char (point-min))
 490        (while (re-search-forward "^001" nil t))
 491        (let* ((linestring (thing-at-point 'line))
 492               (rankstring (substring linestring 5 8)))
 493
 494          (forward-line 1)
 495          (insert "\n")
 496          (forward-char -1)
 497          (insert (format "001 "))
 498          (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number rankstring) 1)))))
 499          (insert (format "%s" (+ (string-to-number rankstring) 1)))
 500          (insert (format " %s" sex))
 501          (when (= (length sex) 0) (insert " ")) ;; add extra space if the sex string is empty
 502          (insert-char ?\s (- 3 (length title)))
 503          (insert (format "%s " title))
 504          (insert (format "%s" name))
 505          (insert-char ?\s (- 34 (length name)))
 506          (insert (format "%s " elo))
 507          (when (= (length elo) 0) (insert "    ")) ;; add extra space if the elo is empty
 508          (when (= (length elo) 1) (insert "   ")) ;; add extra space if the elo is a "0"
 509          (insert (format "%s" fed))
 510          (when (= (length fed) 0) (insert "   ")) ;; add extra space if fed is empty
 511          (insert-char ?\s (- 12 (length idfide)))
 512          (insert (format "%s " idfide))
 513          (insert (format "%s      " year))
 514          (when (= (length year) 0) (insert "    ")) ;; TODO: improve this to make it support different data formats
 515          (insert (format "  0.0 "))
 516          (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number rankstring) 1)))))
 517          (insert (format "%s" (+ (string-to-number rankstring) 1)))
 518          (setq thislinelength (length (thing-at-point 'line)))
 519          (insert-char ?\s (- playerlinelength thislinelength)))))
 520   (save-excursion
 521     (goto-char (point-min))
 522     (re-search-forward "^062 ")
 523     (let* ((linestring (thing-at-point 'line))
 524            (numberofplayers (substring linestring 4)))
 525       (delete-char (length numberofplayers))
 526       (setq numberofplayers (string-to-number numberofplayers))
 527       (setq numberofplayers (+ 1 numberofplayers))
 528       (insert (concat (number-to-string numberofplayers) "\n")))
 529     (re-search-forward "^072 ")
 530     (let* ((linestring (thing-at-point 'line))
 531         (numberofratedplayers (substring linestring 4)))
 532       (unless (< (length elo) 2)
 533         (delete-char (length numberofratedplayers))
 534         (setq numberofratedplayers (string-to-number numberofratedplayers))
 535         (setq numberofratedplayers (+ 1 numberofratedplayers))
 536         (insert (concat (number-to-string numberofratedplayers) "\n"))))))
 537
 538 (defun arbitools-insert-result (round white black result)
 539    "Insert a result."
 540    (interactive "sround: \nswhite: \nsblack: \nsresult: ")
 541    (save-excursion
 542      (goto-char (point-min))
 543      (while (re-search-forward "^001" nil t)
 544        (forward-char 4) ;; rank number
 545        (when (string= white (thing-at-point 'word))
 546          ;;go to first round taking into account the cursor is in the rank number
 547          (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
 548          (insert "  ") ;; replace the first positions with spaces
 549          (delete-char 2) ;; delete the former characters
 550          ;; make room for bigger numbers
 551          (cond ((= 2 (length black))
 552            (backward-char 1))
 553            ((= 3 (length black))
 554            (backward-char 2)))
 555          (insert (format "%s w %s" black result))
 556          (delete-char 5)
 557          ;; adjust when numbers are longer
 558          (cond ((= 2 (length black)) (delete-char 1))
 559            ((= 3 (length black)) (delete-char 2))))
 560        (when (string= black (thing-at-point 'word))
 561          ;; go to first round taking into account the cursor is in the rank number
 562          (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
 563          (insert "  ") ;; replace the first positions with spaces
 564          (delete-char 2) ;; delete the former characters
 565          ;; make room for bigger numbers
 566          (cond ((= 2 (length white)) (backward-char 1))
 567            ((= 3 (length white)) (backward-char 2)))
 568          (cond ((string= "1" result) (insert (format "%s b 0" white)))
 569            ((string= "=" result) (insert (format "%s b =" white)))
 570            ((string= "+" result) (insert (format "%s b +" white)))
 571            ((string= "-" result) (insert (format "%s b -" white)))
 572            ((string= "0" result) (insert (format "%s b 1" white))))
 573          (delete-char 5)
 574          ;; adjust when numbers are longer
 575          (cond ((= 2 (length white)) (delete-char 1))
 576            ((= 3 (length white)) (delete-char 2)))))))
 577
 578 (defun arbitools-it3 ()
 579    "Get the IT3 tournament report. You will get a .tex file, and a pdf
 580     if you have pdflatex installed."
 581    (interactive)
 582    (call-process "arbitools-run.py" nil "Arbitools-output" nil "it3" buffer-file-name))
 583
 584 ;; TODO: New It3 function, usint it3.tex from home directory, replacing the data and pdflatex it
 585
 586 (defun arbitools-fedarating ()
 587    "Get the FEDA rating admin file."
 588    (interactive)
 589    (call-process "arbitools-run.py" nil "Arbitools-output" nil "fedarating" buffer-file-name))
 590
 591 (defvar arbitools-mode-map
 592   (let ((map (make-sparse-keymap)))
 593     (define-key map (kbd "C-c i") 'arbitools-it3)
 594     (define-key map (kbd "C-c r") 'arbitools-insert-result)
 595     (define-key map (kbd "C-c p") 'arbitools-insert-player)
 596     map)
 597   "Keymap for Arbitools major mode.")
 598
 599
 600 (easy-menu-define arbitools-mode-menu arbitools-mode-map
 601   "Menu for Arbitools mode"
 602   '("Arbitools"
 603     ["New Tournament" arbitools-new-trf]
 604     "---"
 605     ["Insert Player" arbitools-insert-player]
 606     ["Delete Player" arbitools-delete-player]
 607     ["Insert Result" arbitools-insert-result]
 608     ["Delete Round" arbitools-delete-round]
 609     "---"
 610     ["List Players" arbitools-list-players]
 611     ["List Pairings" arbitools-list-pairing]
 612     "---"
 613     ["Update Elo" arbitools-update]
 614     ["Get It3 form Report" arbitools-it3]
 615     ["Get FEDA Rating file" arbitools-fedarating]
 616     "---"
 617     ["Prepare for FEDA" arbitools-prepare-feda]
 618     ))
 619
 620
 621 (defvar arbitools-highlights
 622  '(("^001" . font-lock-function-name-face) ; name of the tournament
 623     ("^012.*" . font-lock-comment-face)
 624     ("\\(^022\\|^032\\|^042\\|^052\\|^062\\|^072\\|^082\\|^092\\|^102\\|^112\\|^122\\).*" . font-lock-constant-face)
 625     ("^132.*" . font-lock-warning-face) ;dates
 626     ("^013" . font-lock-warning-face) ;teams
 627     ("\\(^013.\\{1\\}\\)\\(.\\{31\\}\\)" 2 font-lock-comment-face) ;; teams
 628     ;; (" [0-9]\\{6,\\} " . font-lock-variable-name-face) ;FIDE ID
 629     ("\\(^001.\\{11\\}\\)\\(.\\{32\\}\\)" 2 font-lock-string-face)  ;; Name of the player (by position)
 630     ("\\(^001.\\{55\\}\\)\\(.\\{10\\}\\)" 2 font-lock-function-name-face) ;; FIDE ID
 631     ("\\(^001.\\{88\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face) ;; round 1 opponent
 632     ;; ("\\(^132.\\{88\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face) ;; round 1 date line
 633     ("\\(^001.\\{93\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face) ;; round 1 colour
 634     ("\\(^001.\\{95\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face) ;; round 1 result
 635     ;; rest of rounds
 636     ("\\(^001.\\{98\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 637     ;; ("\\(^132.\\{98\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 638     ("\\(^001.\\{103\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 639     ("\\(^001.\\{105\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 640     ("\\(^001.\\{108\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 641     ;; ("\\(^132.\\{108\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 642     ("\\(^001.\\{113\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 643     ("\\(^001.\\{115\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 644     ("\\(^001.\\{118\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 645     ;; ("\\(^132.\\{118\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 646     ("\\(^001.\\{123\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 647     ("\\(^001.\\{125\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 648     ("\\(^001.\\{128\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 649     ;; ("\\(^132.\\{128\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 650     ("\\(^001.\\{133\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 651     ("\\(^001.\\{135\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 652     ("\\(^001.\\{138\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 653     ;; ("\\(^132.\\{138\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 654     ("\\(^001.\\{143\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 655     ("\\(^001.\\{145\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 656     ("\\(^001.\\{148\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 657     ;; ("\\(^132.\\{148\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 658     ("\\(^001.\\{153\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 659     ("\\(^001.\\{155\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 660     ("\\(^001.\\{158\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 661     ;; ("\\(^132.\\{158\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 662     ("\\(^001.\\{163\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 663     ("\\(^001.\\{165\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 664     ("\\(^001.\\{168\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 665     ;; ("\\(^132.\\{168\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 666     ("\\(^001.\\{173\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 667     ("\\(^001.\\{175\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 668     ("\\(^001.\\{178\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 669     ;; ("\\(^132.\\{178\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 670     ("\\(^001.\\{183\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 671     ("\\(^001.\\{185\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 672     ("\\(^001.\\{188\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 673     ;; ("\\(^132.\\{188\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 674     ("\\(^001.\\{193\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 675     ("\\(^001.\\{195\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 676     ("\\(^001.\\{198\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 677     ;; ("\\(^132.\\{198\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 678     ("\\(^001.\\{203\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 679     ("\\(^001.\\{205\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)))
 680
 681 ;;;###autoload
 682 (define-derived-mode arbitools-mode
 683   fundamental-mode
 684   "Arbitools"
 685   "Major mode for Chess Tournament Management."
 686   ;(setq font-lock-defaults '(arbitools-highlights))
 687   (use-local-map arbitools-mode-map)
 688   (generate-new-buffer "Arbitools-output")
 689   (generate-new-buffer "List of players")
 690   (generate-new-buffer "Pairings List")
 691   (generate-new-buffer "Standings")
 692   (column-number-mode)
 693   (set (make-local-variable 'font-lock-defaults) '(arbitools-highlights)))
 694
 695 ;;;###autoload
 696 (add-to-list 'auto-mode-alist '("\\.trf?\\'" . arbitools-mode))
 697
 698 (provide 'arbitools)
 699
 700 ;;; arbitools.el ends here