mirror of
https://github.com/TheRealOwenRees/pgn_to_tex.git
synced 2026-07-23 03:56:57 +00:00
Transfer code (#1)
* copy project root files * import previously created code and rename where needed * fix license and lint * main is now just a JS wrapper * minified main.cjs rather than copying to a newly named file
This commit is contained in:
GitHub
+14
@@ -0,0 +1,14 @@
|
||||
module MoveMap = Map.Make (Int)
|
||||
|
||||
type tag = { key : string; value : string }
|
||||
|
||||
type item =
|
||||
| Move of string
|
||||
| Number of string
|
||||
| Clock of string
|
||||
| Nag of string
|
||||
| Comment of string
|
||||
| Result of string
|
||||
| Variation of item list
|
||||
|
||||
type game = { tags : tag list; content : item list; result : string option }
|
||||
@@ -1,2 +1,10 @@
|
||||
(library
|
||||
(name pgn_to_tex))
|
||||
(name pgn_logic)
|
||||
(public_name pgn_to_tex)
|
||||
(libraries sedlex menhirLib)
|
||||
(modules ast parser lexer parsing latex latex_helpers pgn2tex nag)
|
||||
(preprocess
|
||||
(pps sedlex.ppx)))
|
||||
|
||||
(menhir
|
||||
(modules parser))
|
||||
|
||||
+115
@@ -0,0 +1,115 @@
|
||||
open Ast
|
||||
open Latex_helpers
|
||||
|
||||
(* convert PGN headers to title tex *)
|
||||
let tags_to_tex tags =
|
||||
let get_tag_value key tags ~default =
|
||||
match List.find_opt (fun t -> t.key = key) tags with
|
||||
| Some t -> t.value
|
||||
| None -> default
|
||||
in
|
||||
|
||||
let white = get_tag_value "White" tags ~default:"" in
|
||||
let black = get_tag_value "Black" tags ~default:"" in
|
||||
let event = get_tag_value "Event" tags ~default:"" in
|
||||
let date = get_tag_value "Date" tags ~default:"" in
|
||||
let white_elo = get_tag_value "WhiteElo" tags ~default:"" in
|
||||
let black_elo = get_tag_value "BlackElo" tags ~default:"" in
|
||||
let site = get_tag_value "Site" tags ~default:"" in
|
||||
let title = get_tag_value "Title" tags ~default:"" in
|
||||
let subtitle = get_tag_value "Subtitle" tags ~default:"" in
|
||||
let author = get_tag_value "Author" tags ~default:"" in
|
||||
|
||||
let title_tex = build_title_string event title subtitle in
|
||||
let author_tex = build_author_string author white black white_elo black_elo in
|
||||
|
||||
title_tex ^ "\n" ^ author_tex ^ "\n"
|
||||
^ build_date_site_string date site
|
||||
^ "\\maketitle\n\\newchessgame"
|
||||
|
||||
let rec item_to_tex is_mainline ply ?(diagram_data = MoveMap.empty) = function
|
||||
| Number n -> if is_mainline then "\\textbf{" ^ n ^ "}" else n
|
||||
| Move m ->
|
||||
if is_mainline then "\\textbf{" ^ escape_tex m ^ "}" else escape_tex m
|
||||
| Comment c ->
|
||||
if is_mainline then "\\newline " ^ escape_tex c ^ "\\par"
|
||||
else escape_tex c
|
||||
| Result r -> "\\textbf{" ^ r ^ "}"
|
||||
| Variation v -> "( " ^ render_game false ~diagram_data v ^ " )"
|
||||
| Nag g -> " " ^ Nag.nag_to_tex g ^ "{}"
|
||||
| Clock c -> c
|
||||
|
||||
and render_game is_mainline ?(diagram_data = MoveMap.empty) ?(clock = false)
|
||||
items =
|
||||
let rec aux ply interrupted ?(white_time = "0:00") ?(black_time = "0:00") =
|
||||
function
|
||||
| [] -> ""
|
||||
| Comment c :: Move m :: tail when is_mainline && ply mod 2 != 0 ->
|
||||
let next_ply = ply + 1 in
|
||||
let rendered_comment = "\\newline " ^ escape_tex c ^ "\\par" in
|
||||
let rendered_move = "\\textbf{\\ldots{}" ^ escape_tex m ^ "}" in
|
||||
let diag_str =
|
||||
match get_diagram next_ply diagram_data with
|
||||
| Some s -> s
|
||||
| None -> ""
|
||||
in
|
||||
let has_diag = diag_str <> "" in
|
||||
rendered_comment ^ " " ^ rendered_move ^ diag_str ^ " "
|
||||
^ aux next_ply has_diag tail
|
||||
| head :: tail -> (
|
||||
match head with
|
||||
| Clock c ->
|
||||
if ply mod 2 = 0 then
|
||||
aux ply interrupted ~white_time ~black_time:c tail
|
||||
else aux ply interrupted ~white_time:c ~black_time tail
|
||||
| _ ->
|
||||
let is_move = match head with Move _ -> true | _ -> false in
|
||||
|
||||
let next_ply =
|
||||
match head with Move _ when is_mainline -> ply + 1 | _ -> ply
|
||||
in
|
||||
|
||||
let prefix =
|
||||
if is_move && is_mainline && next_ply mod 2 == 0 && interrupted
|
||||
then "\\ldots{}"
|
||||
else ""
|
||||
in
|
||||
|
||||
let rendered_head =
|
||||
let raw_head =
|
||||
item_to_tex is_mainline next_ply ~diagram_data head
|
||||
in
|
||||
if prefix <> "" && raw_head <> "" then
|
||||
"\\textbf{" ^ prefix ^ "}" ^ raw_head
|
||||
else raw_head
|
||||
in
|
||||
|
||||
let diag_str =
|
||||
if is_move && is_mainline then
|
||||
get_diagram next_ply diagram_data ~clock ~white_time ~black_time
|
||||
else None
|
||||
in
|
||||
|
||||
let diag_output = match diag_str with Some s -> s | None -> "" in
|
||||
let is_comment = match head with Comment _ -> true | _ -> false in
|
||||
let next_interrupted = diag_output <> "" || is_comment in
|
||||
let rest =
|
||||
aux next_ply next_interrupted ~white_time ~black_time tail
|
||||
in
|
||||
|
||||
if rendered_head = "" then rest
|
||||
else
|
||||
rendered_head ^ diag_output ^ if rest = "" then "" else " " ^ rest
|
||||
)
|
||||
in
|
||||
String.trim (aux 0 false items)
|
||||
|
||||
let game_to_tex game ~diagram_data ~clock =
|
||||
let header_tex = tags_to_tex game.tags in
|
||||
let content_tex = render_game true ~diagram_data ~clock game.content in
|
||||
|
||||
let result_tex =
|
||||
match game.result with Some r -> " \\textbf{" ^ r ^ "}" | None -> ""
|
||||
in
|
||||
|
||||
header_tex ^ "\n" ^ content_tex ^ result_tex
|
||||
@@ -0,0 +1,63 @@
|
||||
module MoveMap = Ast.MoveMap
|
||||
|
||||
(* escape strings for LaTeX *)
|
||||
let escape_tex s =
|
||||
let b = Buffer.create (String.length s) in
|
||||
String.iter
|
||||
(fun c ->
|
||||
match c with
|
||||
| '#' -> Buffer.add_string b "\\#"
|
||||
| '%' -> Buffer.add_string b "\\%"
|
||||
| '{' -> Buffer.add_string b "\\{"
|
||||
| '}' -> Buffer.add_string b "\\}"
|
||||
| '_' -> Buffer.add_string b "\\_"
|
||||
| '&' -> Buffer.add_string b "\\&"
|
||||
| _ -> Buffer.add_char b c)
|
||||
s;
|
||||
Buffer.contents b
|
||||
|
||||
(* ELO string builder *)
|
||||
let build_elo_string elo = if String.length elo > 0 then "(" ^ elo ^ ")" else ""
|
||||
|
||||
(* Author string builder *)
|
||||
let build_author_string author white black white_elo black_elo =
|
||||
match (author, white, black) with
|
||||
| "", "", "" -> "\\author{}"
|
||||
| "", white, black ->
|
||||
"\\author{" ^ escape_tex white ^ " " ^ build_elo_string white_elo ^ "\\\\"
|
||||
^ escape_tex black ^ " " ^ build_elo_string black_elo ^ "}"
|
||||
| author, "", "" -> "\\author{" ^ escape_tex author ^ "}"
|
||||
| _ -> ""
|
||||
|
||||
(* Title string builder *)
|
||||
let build_title_string event title subtitle =
|
||||
match (event, title, subtitle) with
|
||||
| event, "", "" -> "\\title{" ^ escape_tex event ^ "}"
|
||||
| _event, title, subtitle ->
|
||||
"\\title{" ^ title ^ "}\\\\[2ex]\\large{" ^ subtitle ^ "}"
|
||||
|
||||
(* Date and Site string builder *)
|
||||
let build_date_site_string date site =
|
||||
match (date, site) with
|
||||
| "", "" -> "\\date{}"
|
||||
| "", s -> "\\date{" ^ s ^ "}"
|
||||
| d, "" -> "\\date{" ^ d ^ "}"
|
||||
| d, s -> "\\date{" ^ d ^ ", " ^ s ^ "}"
|
||||
|
||||
(* generate a diagram with or without clock times from the passed in Map (JSON in JS) *)
|
||||
let get_diagram ?(clock = false) ?(white_time = "0:00") ?(black_time = "0:00")
|
||||
ply diagram_data =
|
||||
match MoveMap.find_opt ply diagram_data with
|
||||
| None -> None
|
||||
| Some fen ->
|
||||
if not clock then
|
||||
Some
|
||||
("\n\\par\\nobreak\\medskip\\chessboard[setfen=" ^ fen
|
||||
^ ", vmargin=false]\\par\\medskip\n")
|
||||
else
|
||||
Some
|
||||
("\\par\\medskip\\noindent" ^ "\\begin{minipage}{\\linewidth}"
|
||||
^ black_time ^ "\\par\\nopagebreak\\smallskip\n"
|
||||
^ "\\chessboard[setfen=" ^ fen
|
||||
^ ", vmargin=false]\\par\\nopagebreak\\vspace{1em}\n" ^ white_time
|
||||
^ "\\end{minipage}\\par\\medskip")
|
||||
+103
@@ -0,0 +1,103 @@
|
||||
open Sedlexing
|
||||
open Parser
|
||||
|
||||
let digit = [%sedlex.regexp? '0' .. '9']
|
||||
let letter = [%sedlex.regexp? 'a' .. 'z' | 'A' .. 'Z']
|
||||
let alphabetic = [%sedlex.regexp? letter]
|
||||
let move_char = [%sedlex.regexp? letter | digit | '+' | '#' | '=' | '-' | 'x']
|
||||
|
||||
let piece_square_char =
|
||||
[%sedlex.regexp? 'K' | 'Q' | 'R' | 'B' | 'N' | 'O' | 'a' .. 'h']
|
||||
|
||||
let clock_val = [%sedlex.regexp? Plus (digit | ':'), Opt ('.', Plus digit)]
|
||||
|
||||
let rec tokenize_header buf =
|
||||
match%sedlex buf with
|
||||
| Plus white_space -> tokenize_header buf
|
||||
| ']' -> TAG_CLOSE
|
||||
| '"' -> read_string (Buffer.create 16) buf
|
||||
| letter, Star (letter | digit | '_') -> HEADER (Utf8.lexeme buf)
|
||||
| eof -> EOF
|
||||
| _ -> failwith "Unexpected character in header"
|
||||
|
||||
and tokenize_game buf =
|
||||
match%sedlex buf with
|
||||
| Plus white_space -> tokenize_game buf
|
||||
| "[%clk " -> read_inline_clock buf
|
||||
| '[' -> TAG_OPEN
|
||||
| '{' -> read_comment (Buffer.create 32) buf
|
||||
| '(' -> LPAREN
|
||||
| ')' -> RPAREN
|
||||
| '$', Plus digit -> NAG (Utf8.lexeme buf)
|
||||
| Plus digit, Plus '.' -> NUMBER (Utf8.lexeme buf)
|
||||
| "1-0" | "0-1" | "1/2-1/2" | "*" -> RESULT (Utf8.lexeme buf)
|
||||
| "O-O" | "O-O-O" -> MOVE (Utf8.lexeme buf)
|
||||
| ('K' | 'Q' | 'R' | 'B' | 'N' | 'a' .. 'h'), Star move_char ->
|
||||
MOVE (Utf8.lexeme buf)
|
||||
| eof -> EOF
|
||||
| any -> tokenize_game buf
|
||||
| _ -> failwith "Unexpected character in game"
|
||||
|
||||
and read_string b buf =
|
||||
match%sedlex buf with
|
||||
| '"' -> STRING (Buffer.contents b)
|
||||
| '\\', '"' ->
|
||||
Buffer.add_char b '"';
|
||||
read_string b buf
|
||||
| any ->
|
||||
Buffer.add_string b (Utf8.lexeme buf);
|
||||
read_string b buf
|
||||
| _ -> failwith "Unterminated string"
|
||||
|
||||
and read_inline_clock buf =
|
||||
match%sedlex buf with
|
||||
| clock_val ->
|
||||
let time = Utf8.lexeme buf in
|
||||
begin match%sedlex buf with
|
||||
| ']' -> CLOCK time
|
||||
| _ -> failwith "Malformed inline clock: expected closing ']'"
|
||||
end
|
||||
| _ -> failwith "Malformed inline clock value"
|
||||
|
||||
and read_comment b buf =
|
||||
match%sedlex buf with
|
||||
| Plus white_space -> read_comment b buf
|
||||
| "[%clk " -> read_comment_clock buf
|
||||
| "[%" -> skip_bracket_tag buf b
|
||||
| '}' -> COMMENT (Buffer.contents b)
|
||||
| eof -> failwith "Unterminated comment"
|
||||
| any ->
|
||||
Buffer.add_string b (Utf8.lexeme buf);
|
||||
read_comment_content b buf
|
||||
| _ -> failwith "Malformed comment"
|
||||
|
||||
and read_comment_clock buf =
|
||||
match%sedlex buf with
|
||||
| clock_val ->
|
||||
let time = Utf8.lexeme buf in
|
||||
begin match%sedlex buf with
|
||||
| ']' -> begin
|
||||
match%sedlex buf with
|
||||
| Star white_space, '}' -> CLOCK time
|
||||
| _ -> failwith "Expected closing '}' after clock comment"
|
||||
end
|
||||
| _ -> failwith "Malformed clock in comment: expected ']'"
|
||||
end
|
||||
| _ -> failwith "Malformed clock value"
|
||||
|
||||
and read_comment_content b buf =
|
||||
match%sedlex buf with
|
||||
| "[%" -> skip_bracket_tag buf b
|
||||
| '}' -> COMMENT (String.trim (Buffer.contents b))
|
||||
| eof -> failwith "Unterminated comment"
|
||||
| any ->
|
||||
Buffer.add_string b (Utf8.lexeme buf);
|
||||
read_comment_content b buf
|
||||
| _ -> failwith "Malformed comment"
|
||||
|
||||
and skip_bracket_tag buf b =
|
||||
match%sedlex buf with
|
||||
| ']' -> read_comment_content b buf
|
||||
| eof -> failwith "Unterminated [% tag inside comment"
|
||||
| any -> skip_bracket_tag buf b
|
||||
| _ -> failwith "Malformed comment"
|
||||
+32
@@ -0,0 +1,32 @@
|
||||
let nag_to_tex nag =
|
||||
match nag with
|
||||
(* Move Assessments *)
|
||||
| "$1" -> "!" (* Good move *)
|
||||
| "$2" -> "?" (* Poor move *)
|
||||
| "$3" -> "!!" (* Very good move *)
|
||||
| "$4" -> "??" (* Very poor move *)
|
||||
| "$5" -> "!?" (* Speculative move *)
|
||||
| "$6" -> "?!" (* Questionable move *)
|
||||
(* | 7 -> "\\Box" Forced move *)
|
||||
(* | 8 -> "{\\tiny \\textceltel}" Singular move *)
|
||||
(* | 9 -> "{\\tiny !!}" Worst move *)
|
||||
(* Positional Assessments *)
|
||||
| "$10" -> "=" (* Drawish / Equal *)
|
||||
(* | 11 -> "=" Equal/Quiet *)
|
||||
| "$13" -> "\\infty" (* Unclear *)
|
||||
| "$14" -> "\\wbetter" (* White slight advantage *)
|
||||
| "$15" -> "\\bbetter" (* Black slight advantage *)
|
||||
| "$16" -> "\\ensuremath{\\pm}" (* White moderate advantage *)
|
||||
| "$17" -> "\\ensuremath{\\mp}" (* Black moderate advantage *)
|
||||
| "$18" -> "+-" (* White decisive advantage *)
|
||||
| "$19" -> "-+" (* Black decisive advantage *)
|
||||
(* Common Positional Symbols *)
|
||||
| "$22" -> "\\zugzwang"
|
||||
| "$32" -> "\\development"
|
||||
| "$36" -> "\\initiative"
|
||||
| "$40" -> "\\attack"
|
||||
| "$44" -> "\\compensation"
|
||||
| "$132" -> "\\counterplay"
|
||||
(* | 146 -> "N" Novelty *)
|
||||
(* Fallback for others: just print the $ number as a comment or ignore *)
|
||||
| n -> ""
|
||||
@@ -0,0 +1,35 @@
|
||||
%{
|
||||
open Ast
|
||||
%}
|
||||
|
||||
%token TAG_OPEN TAG_CLOSE LPAREN RPAREN EOF
|
||||
%token <string> HEADER STRING MOVE NUMBER COMMENT RESULT CLOCK NAG
|
||||
|
||||
%start <Ast.game> main
|
||||
|
||||
%%
|
||||
|
||||
main:
|
||||
| ts = tags; c = content; r = option(RESULT); EOF
|
||||
{ { tags = ts; content = c; result = r } }
|
||||
|
||||
tags:
|
||||
| TAG_OPEN; k = HEADER; v = STRING; TAG_CLOSE; rest = tags
|
||||
{ { key = k; value = v } :: rest }
|
||||
| (* empty *)
|
||||
{ [] }
|
||||
|
||||
content:
|
||||
| i = item; rest = content
|
||||
{ i :: rest }
|
||||
| (* empty *)
|
||||
{ [] }
|
||||
|
||||
item:
|
||||
| m = MOVE { Move m }
|
||||
| n = NUMBER { Number n }
|
||||
| c = CLOCK { Clock c }
|
||||
| g = NAG { Nag g }
|
||||
| c = COMMENT { Comment c }
|
||||
| r = RESULT { Result r }
|
||||
| LPAREN; v = content; RPAREN { Variation v }
|
||||
@@ -0,0 +1,42 @@
|
||||
open Ast
|
||||
|
||||
let in_header = ref false
|
||||
|
||||
let next_token buf =
|
||||
if !in_header then
|
||||
let tok = Lexer.tokenize_header buf in
|
||||
match tok with
|
||||
| Parser.TAG_CLOSE ->
|
||||
in_header := false;
|
||||
Parser.TAG_CLOSE
|
||||
| _ -> tok
|
||||
else
|
||||
let tok = Lexer.tokenize_game buf in
|
||||
match tok with
|
||||
| Parser.TAG_OPEN ->
|
||||
in_header := true;
|
||||
Parser.TAG_OPEN
|
||||
| _ -> tok
|
||||
|
||||
let parse_pgn s =
|
||||
let buf = Sedlexing.Utf8.from_string s in
|
||||
in_header := false;
|
||||
let provider () =
|
||||
let tok = next_token buf in
|
||||
let start_pos, end_pos = Sedlexing.lexing_positions buf in
|
||||
(tok, start_pos, end_pos)
|
||||
in
|
||||
try MenhirLib.Convert.Simplified.traditional2revised Parser.main provider
|
||||
with _ -> failwith "Parse error"
|
||||
|
||||
(* let parse_diagram_json json_str =
|
||||
let json = Yojson.Basic.from_string json_str in
|
||||
let json_assoc = Yojson.Basic.Util.to_assoc json in
|
||||
|
||||
List.fold_left
|
||||
(fun acc (key_str, json_value) ->
|
||||
let value_string = Yojson.Basic.Util.to_string json_value in
|
||||
match int_of_string_opt key_str with
|
||||
| Some k -> Pgn2tex.MoveMap.add k value_string acc
|
||||
| None -> acc)
|
||||
Pgn2tex.MoveMap.empty json_assoc *)
|
||||
@@ -0,0 +1,5 @@
|
||||
module MoveMap = Ast.MoveMap
|
||||
|
||||
let to_tex pgn ~diagram_data ~clock =
|
||||
let game = Parsing.parse_pgn pgn in
|
||||
Latex.game_to_tex game ~diagram_data ~clock
|
||||
Reference in New Issue
Block a user