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.71
   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            (points         0.0)
 277            (pointstosum    0.0)
 278            (roundcount     1))
 279       (goto-char (point-min))
 280       (while (re-search-forward "^001" nil t)
 281         (setq points 0.0)
 282         (setq roundcount 1)
 283         (while (<= roundcount numberofrounds)
 284           (beginning-of-line)
 285           (forward-char (+ 98 (* (- roundcount 1) 10))) ;; go to where the result is for each round
 286           (cond ((string= (thing-at-point 'symbol) "1") (setq pointstosum 1.0))
 287                 ((string= (thing-at-point 'symbol) "+") (setq pointstosum 1.0))
 288                 ((string= (thing-at-point 'symbol) "=") (setq pointstosum 0.5))
 289                 ((string= (thing-at-point 'symbol) "0") (setq pointstosum 0.0))
 290                 ((string= (thing-at-point 'symbol) "-") (setq pointstosum 0.0))
 291                 ((string= (thing-at-point 'symbol) nil) (setq pointstosum 0.0)))
 292           (setq points (+ points pointstosum))
 293           (setq roundcount (+ roundcount 1)))
 294         (beginning-of-line)
 295         (forward-char 84)
 296         (forward-char -3)
 297         (delete-char 3)
 298         (insert-char ?\s (- 3 (length (format "%s" points))))
 299         (insert (format "%s" points))))))
 300
 301 (defun arbitools-calculate-standings ()
 302   "Write the standings in the Standings buffer"
 303   (interactive)
 304   (arbitools-calculate-points) ;; make sure the points of each player are correct
 305   (save-excursion
 306     (with-current-buffer "Standings"
 307       (erase-buffer))
 308     (let ((datachunk ""))
 309       (goto-char (point-min))
 310       (while (re-search-forward "^001" nil t)
 311         (let* ()
 312           (beginning-of-line)
 313           (forward-char 89) ;; get the POS field
 314           (setq datachunk (thing-at-point 'word))
 315           (with-current-buffer "Standings"
 316             (insert (format "%s" datachunk))
 317             (insert-char ?\s (- 3 (length datachunk)))
 318             (insert " "))
 319           (setq datachunk (substring-no-properties (thing-at-point 'line) 14 47)) ;; get name
 320           (with-current-buffer "Standings"
 321             (insert (format "%s " datachunk))
 322             (insert-char ?\s (- 33 (length datachunk))))
 323           (beginning-of-line)
 324           (forward-char 68)
 325           (setq datachunk (thing-at-point 'word)) ;; get idfide
 326           (with-current-buffer "Standings"
 327             (insert (format "%s " datachunk))
 328             (insert-char ?\s (- 10 (length datachunk))))
 329           (setq datachunk (substring-no-properties (thing-at-point 'line) 80 84)) ;; get points
 330           (with-current-buffer "Standings"
 331             (insert (format "%s " datachunk))
 332             (insert-char ?\s (- 4 (length datachunk))))
 333           (with-current-buffer "Standings"
 334             (insert "\n")
 335             (sort-columns 1 49 (- (point-max) 1))))))
 336     (let ((newpos 0)
 337           (idfide ""))
 338       (goto-char (point-min))
 339       (while (re-search-forward "^001" nil t)
 340         (beginning-of-line)
 341         (forward-char 68)
 342         (setq idfide (thing-at-point 'word))
 343         (with-current-buffer "Standings"
 344           (goto-char (point-min))
 345           (search-forward idfide nil t)
 346           (setq newpos (line-number-at-pos))) ;; the POS is in the beginning of the line in Standings
 347         (with-current-buffer "Arbitools-output"
 348           (insert (format "%s" newpos))
 349           (insert "\n"))
 350         (beginning-of-line)
 351         (forward-char 89) ;; go to POS field
 352         (forward-char -3)
 353         (delete-char 3)
 354         (insert-char ?\s (- 3 (length (format "%s" newpos))))
 355         (insert (format "%s" newpos))))))
 356
 357 (defun arbitools-delete-player (player)
 358    "Delete a player. Adjust all the rank numbers accordingly."
 359    (interactive "splayer: ")
 360    (let ((numberofrounds 0)
 361          (elo            ""))
 362
 363     (save-excursion
 364       (goto-char (point-min))
 365       (re-search-forward "^132" nil t)
 366         (let* ((linestringrounds   (thing-at-point 'line))
 367                ;; (actualround        " ")
 368                (beginning-of-round 91)
 369                (end-of-round       99)
 370                (continue           t))
 371            (while continue
 372              (if (< end-of-round (length linestringrounds))
 373                (progn
 374                   ;; (setq actualround (substring-no-properties linestringrounds beginning-of-round end-of-round))
 375                   (setq numberofrounds (+ numberofrounds 1))
 376                   (setq beginning-of-round (+ beginning-of-round 10))
 377                   (setq end-of-round (+ end-of-round 10)))
 378                (setq continue nil)))))
 379     (save-excursion
 380      (goto-char (point-min))
 381      (while (re-search-forward "^001" nil t)
 382        (let* ((linestring (thing-at-point 'line))
 383               (rankstring (substring linestring 5 8)))
 384          (when (= (string-to-number rankstring) (string-to-number player))
 385            (forward-char 1)
 386            (delete-char 4)
 387            (insert " DEL")
 388            (setq elo (substring linestring 48 52))
 389            (with-current-buffer "Arbitools-output" (insert (format "%s" elo))))
 390          (when (> (string-to-number rankstring)(string-to-number player))
 391            (forward-char 1)
 392            (delete-char 4)
 393            (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 394            (insert (format "%s" (- (string-to-number rankstring) 1)))
 395            (save-excursion
 396              (goto-char (point-min))
 397              (while (re-search-forward "^001" nil t)
 398                (let* ((roundcount          1))
 399                   (while (<= roundcount numberofrounds)
 400                     (beginning-of-line)
 401                     (forward-char (+ 95 (* (- roundcount 1) 10)))
 402                     (when (string= (format "%s" (string-to-number rankstring)) (thing-at-point 'word))
 403                       (forward-char -4) ;; go back to the beginning of the opponent's number
 404                       (delete-char 4) ;; remove the original opponent's number
 405                       (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 406                       (insert (format "%s" (- (string-to-number rankstring) 1))))
 407                     (setq roundcount (+ roundcount 1))))
 408                ;;(condition-case nil ;; TODO: fix teams info
 409                  (save-excursion
 410                    (while (re-search-forward "^013" nil t)
 411                     (let* ((linestringteam (thing-at-point 'line))
 412                           (integrantcount 0)
 413                           (members 0))
 414
 415                         ;; to find the end of the line, the number is length -2, for some reason
 416                         (setq members (/ (- (- (length linestringteam) 2) 34) 5)) ;; calculate number of members
 417
 418                       (while (< integrantcount members)
 419                        (beginning-of-line)
 420                        (forward-char (+ 40 (* (- integrantcount 1) 5)))
 421                        (when (string= (format "%s" (string-to-number rankstring)) (thing-at-point 'word))
 422                          (forward-char -4)
 423                          (delete-char 4)
 424                          (insert-char ?\s (- 4 (length (format "%s" (- (string-to-number rankstring) 1)))))
 425                          (insert (format "%s" (- (string-to-number rankstring) 1))))
 426                        (setq integrantcount (+ integrantcount 1))))))))))))
 427
 428      (save-excursion  ;; Actually delete the player's line
 429        (goto-char (point-min))
 430        (while (re-search-forward "^001  DEL" nil t)
 431          (beginning-of-line)
 432          (let ((beg (point)))
 433            (forward-line 1)
 434            (delete-region beg (point)))))
 435      ;; TODO delete the rank from teams section
 436      ;; TODO change number of players and number of rated players
 437      (save-excursion
 438        (with-current-buffer "Arbitools-output" (insert (format "%s" elo)))
 439        (goto-char (point-min))
 440        (re-search-forward "^062 ")
 441        (let* ((linestring      (thing-at-point 'line))
 442               (numberofplayers (substring linestring 4)))
 443         (delete-char (length numberofplayers))
 444         (setq numberofplayers (string-to-number numberofplayers))
 445         (setq numberofplayers (- numberofplayers 1))
 446         (insert (concat (number-to-string numberofplayers) "\n")))
 447        (re-search-forward "^072 ")
 448        (let* ((linestring           (thing-at-point 'line))
 449               (numberofratedplayers (substring linestring 4)))
 450         (unless (< (length elo) 2) ;; if elo is 0 or nonexistent
 451           (delete-char (length numberofratedplayers))
 452           (setq numberofratedplayers (string-to-number numberofratedplayers))
 453           (setq numberofratedplayers (- numberofratedplayers 1))
 454           (insert (concat (number-to-string numberofratedplayers) "\n")))))))
 455
 456 (defun arbitools-delete-round (round)
 457    "Delete a round."
 458    (interactive "sround: ")
 459    (save-excursion
 460     (goto-char (point-min))
 461     (while (re-search-forward "^001" nil t)
 462      (forward-char (+ 88 (* (- (string-to-number round) 1) 10)))
 463      (delete-char 8)
 464      (insert "        "))))
 465
 466 (defun arbitools-replace-empty ()
 467    "Replace non played games with spaces"
 468    (interactive)
 469    (save-excursion
 470     (goto-char (point-min))
 471     (while (search-forward "0000 - 0" nil t)
 472       (replace-match "        "))))
 473
 474 (defun arbitools-insert-player (sex title name elo fed idfide year)
 475    "Insert a player"
 476    ;; TODO: automatically insert the player in a team
 477    (interactive "ssex: \nstitle: \nsname: \nselo: \nsfed: \nsidfide: \nsyear: ")
 478   (let ((playerlinelength nil)
 479         (thislinelength nil))
 480      (save-excursion
 481        (goto-char (point-min))
 482        (re-search-forward "^001 ")
 483        (let* ((linestring (thing-at-point 'line)))
 484          (setq playerlinelength (length linestring))))
 485      (save-excursion
 486        (goto-char (point-min))
 487        (while (re-search-forward "^001" nil t))
 488        (let* ((linestring (thing-at-point 'line))
 489               (rankstring (substring linestring 5 8)))
 490
 491          (forward-line 1)
 492          (insert "\n")
 493          (forward-char -1)
 494          (insert (format "001 "))
 495          (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number rankstring) 1)))))
 496          (insert (format "%s" (+ (string-to-number rankstring) 1)))
 497          (insert (format " %s" sex))
 498          (when (= (length sex) 0) (insert " ")) ;; add extra space if the sex string is empty
 499          (insert-char ?\s (- 3 (length title)))
 500          (insert (format "%s " title))
 501          (insert (format "%s" name))
 502          (insert-char ?\s (- 34 (length name)))
 503          (when (= (length elo) 4) (insert (format "%s " elo)))
 504          (when (= (length elo) 0) (insert "     ")) ;; add extra space if the elo is empty
 505          (when (= (length elo) 1) (insert "   0 ")) ;; add extra space if the elo is a "0"
 506          (insert (format "%s" fed))
 507          (when (= (length fed) 0) (insert "   ")) ;; add extra space if fed is empty
 508          (insert-char ?\s (- 12 (length idfide)))
 509          (insert (format "%s " idfide))
 510          (insert (format "%s      " year))
 511          (when (= (length year) 0) (insert "    ")) ;; TODO: improve this to make it support different data formats
 512          (insert (format "  0.0 "))
 513          (insert-char ?\s (- 4 (length (format "%s" (+ (string-to-number rankstring) 1)))))
 514          (insert (format "%s" (+ (string-to-number rankstring) 1)))
 515          (setq thislinelength (length (thing-at-point 'line)))
 516          (insert-char ?\s (- playerlinelength thislinelength)))))
 517   (save-excursion
 518     (goto-char (point-min))
 519     (re-search-forward "^062 ")
 520     (let* ((linestring (thing-at-point 'line))
 521            (numberofplayers (substring linestring 4)))
 522       (delete-char (length numberofplayers))
 523       (setq numberofplayers (string-to-number numberofplayers))
 524       (setq numberofplayers (+ 1 numberofplayers))
 525       (insert (concat (number-to-string numberofplayers) "\n")))
 526     (re-search-forward "^072 ")
 527     (let* ((linestring (thing-at-point 'line))
 528         (numberofratedplayers (substring linestring 4)))
 529       (unless (< (length elo) 2)
 530         (delete-char (length numberofratedplayers))
 531         (setq numberofratedplayers (string-to-number numberofratedplayers))
 532         (setq numberofratedplayers (+ 1 numberofratedplayers))
 533         (insert (concat (number-to-string numberofratedplayers) "\n"))))))
 534
 535 (defun arbitools-insert-result (round white black result)
 536    "Insert a result."
 537    (interactive "sround: \nswhite: \nsblack: \nsresult: ")
 538    (save-excursion
 539      (goto-char (point-min))
 540      (while (re-search-forward "^001" nil t)
 541        (forward-char 4) ;; rank number
 542        (when (string= white (thing-at-point 'word))
 543          ;;go to first round taking into account the cursor is in the rank number
 544          (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
 545          (insert "  ") ;; replace the first positions with spaces
 546          (delete-char 2) ;; delete the former characters
 547          ;; make room for bigger numbers
 548          (cond ((= 2 (length black))
 549            (backward-char 1))
 550            ((= 3 (length black))
 551            (backward-char 2)))
 552          (insert (format "%s w %s" black result))
 553          (delete-char 5)
 554          ;; adjust when numbers are longer
 555          (cond ((= 2 (length black)) (delete-char 1))
 556            ((= 3 (length black)) (delete-char 2))))
 557        (when (string= black (thing-at-point 'word))
 558          ;; go to first round taking into account the cursor is in the rank number
 559          (forward-char (+ 85 (* (- (string-to-number round) 1) 10)))
 560          (insert "  ") ;; replace the first positions with spaces
 561          (delete-char 2) ;; delete the former characters
 562          ;; make room for bigger numbers
 563          (cond ((= 2 (length white)) (backward-char 1))
 564            ((= 3 (length white)) (backward-char 2)))
 565          (cond ((string= "1" result) (insert (format "%s b 0" white)))
 566            ((string= "=" result) (insert (format "%s b =" white)))
 567            ((string= "+" result) (insert (format "%s b +" white)))
 568            ((string= "-" result) (insert (format "%s b -" white)))
 569            ((string= "0" result) (insert (format "%s b 1" white))))
 570          (delete-char 5)
 571          ;; adjust when numbers are longer
 572          (cond ((= 2 (length white)) (delete-char 1))
 573            ((= 3 (length white)) (delete-char 2)))))))
 574
 575 (defun arbitools-it3 ()
 576    "Get the IT3 tournament report. You will get a .tex file, and a pdf
 577     if you have pdflatex installed."
 578    (interactive)
 579    (call-process "arbitools-run.py" nil "Arbitools-output" nil "it3" buffer-file-name))
 580
 581 ;; TODO: New It3 function, usint it3.tex from home directory, replacing the data and pdflatex it
 582
 583 (defun arbitools-fedarating ()
 584    "Get the FEDA rating admin file."
 585    (interactive)
 586    (call-process "arbitools-run.py" nil "Arbitools-output" nil "fedarating" buffer-file-name))
 587
 588 (defvar arbitools-mode-map
 589   (let ((map (make-sparse-keymap)))
 590     (define-key map (kbd "C-c i") 'arbitools-it3)
 591     (define-key map (kbd "C-c r") 'arbitools-insert-result)
 592     (define-key map (kbd "C-c p") 'arbitools-insert-player)
 593     map)
 594   "Keymap for Arbitools major mode.")
 595
 596
 597 (easy-menu-define arbitools-mode-menu arbitools-mode-map
 598   "Menu for Arbitools mode"
 599   '("Arbitools"
 600     ["New Tournament" arbitools-new-trf]
 601     "---"
 602     ["Insert Player" arbitools-insert-player]
 603     ["Delete Player" arbitools-delete-player]
 604     ["Insert Result" arbitools-insert-result]
 605     ["Delete Round" arbitools-delete-round]
 606     "---"
 607     ["List Players" arbitools-list-players]
 608     ["List Pairings" arbitools-list-pairing]
 609     "---"
 610     ["Update Elo" arbitools-update]
 611     ["Get It3 form Report" arbitools-it3]
 612     ["Get FEDA Rating file" arbitools-fedarating]
 613     "---"
 614     ["Prepare for FEDA" arbitools-prepare-feda]
 615     ))
 616
 617
 618 (defvar arbitools-highlights
 619  '(("^001" . font-lock-function-name-face) ; name of the tournament
 620     ("^012.*" . font-lock-comment-face)
 621     ("\\(^022\\|^032\\|^042\\|^052\\|^062\\|^072\\|^082\\|^092\\|^102\\|^112\\|^122\\).*" . font-lock-constant-face)
 622     ("^132.*" . font-lock-warning-face) ;dates
 623     ("^013" . font-lock-warning-face) ;teams
 624     ("\\(^013.\\{1\\}\\)\\(.\\{31\\}\\)" 2 font-lock-comment-face) ;; teams
 625     ;; (" [0-9]\\{6,\\} " . font-lock-variable-name-face) ;FIDE ID
 626     ("\\(^001.\\{11\\}\\)\\(.\\{32\\}\\)" 2 font-lock-string-face)  ;; Name of the player (by position)
 627     ("\\(^001.\\{55\\}\\)\\(.\\{10\\}\\)" 2 font-lock-function-name-face) ;; FIDE ID
 628     ("\\(^001.\\{88\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face) ;; round 1 opponent
 629     ;; ("\\(^132.\\{88\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face) ;; round 1 date line
 630     ("\\(^001.\\{93\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face) ;; round 1 colour
 631     ("\\(^001.\\{95\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face) ;; round 1 result
 632     ;; rest of rounds
 633     ("\\(^001.\\{98\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 634     ;; ("\\(^132.\\{98\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 635     ("\\(^001.\\{103\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 636     ("\\(^001.\\{105\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 637     ("\\(^001.\\{108\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 638     ;; ("\\(^132.\\{108\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 639     ("\\(^001.\\{113\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 640     ("\\(^001.\\{115\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 641     ("\\(^001.\\{118\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 642     ;; ("\\(^132.\\{118\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 643     ("\\(^001.\\{123\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 644     ("\\(^001.\\{125\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 645     ("\\(^001.\\{128\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 646     ;; ("\\(^132.\\{128\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 647     ("\\(^001.\\{133\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 648     ("\\(^001.\\{135\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 649     ("\\(^001.\\{138\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 650     ;; ("\\(^132.\\{138\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 651     ("\\(^001.\\{143\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 652     ("\\(^001.\\{145\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 653     ("\\(^001.\\{148\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 654     ;; ("\\(^132.\\{148\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 655     ("\\(^001.\\{153\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 656     ("\\(^001.\\{155\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 657     ("\\(^001.\\{158\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 658     ;; ("\\(^132.\\{158\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 659     ("\\(^001.\\{163\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 660     ("\\(^001.\\{165\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 661     ("\\(^001.\\{168\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 662     ;; ("\\(^132.\\{168\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 663     ("\\(^001.\\{173\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 664     ("\\(^001.\\{175\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 665     ("\\(^001.\\{178\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 666     ;; ("\\(^132.\\{178\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 667     ("\\(^001.\\{183\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 668     ("\\(^001.\\{185\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 669     ("\\(^001.\\{188\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 670     ;; ("\\(^132.\\{188\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 671     ("\\(^001.\\{193\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 672     ("\\(^001.\\{195\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)
 673     ("\\(^001.\\{198\\}\\)\\(.\\{4\\}\\)" 2 font-lock-comment-face)
 674     ;; ("\\(^132.\\{198\\}\\)\\(.\\{8\\}\\)" 2 font-lock-string-face)
 675     ("\\(^001.\\{203\\}\\)\\(.\\{1\\}\\)" 2 font-lock-string-face)
 676     ("\\(^001.\\{205\\}\\)\\(.\\{1\\}\\)" 2 font-lock-function-name-face)))
 677
 678 ;;;###autoload
 679 (define-derived-mode arbitools-mode
 680   fundamental-mode
 681   "Arbitools"
 682   "Major mode for Chess Tournament Management."
 683   ;(setq font-lock-defaults '(arbitools-highlights))
 684   (use-local-map arbitools-mode-map)
 685   (generate-new-buffer "Arbitools-output")
 686   (generate-new-buffer "List of players")
 687   (generate-new-buffer "Pairings List")
 688   (generate-new-buffer "Standings")
 689   (column-number-mode)
 690   (set (make-local-variable 'font-lock-defaults) '(arbitools-highlights)))
 691
 692 ;;;###autoload
 693 (add-to-list 'auto-mode-alist '("\\.trf?\\'" . arbitools-mode))
 694
 695 (provide 'arbitools)
 696
 697 ;;; arbitools.el ends here