|
| 1 | +{-# LANGUAGE CPP #-} |
| 2 | +{-# LANGUAGE OverloadedStrings #-} |
| 3 | +{-# LANGUAGE ScopedTypeVariables #-} |
| 4 | +module Skylighting.Format.Typst ( |
| 5 | + formatTypstInline |
| 6 | + , formatTypstBlock |
| 7 | + , styleToTypst |
| 8 | + ) where |
| 9 | + |
| 10 | +import Control.Monad (mplus) |
| 11 | +import Data.Char (isSpace) |
| 12 | +import Data.List (sort) |
| 13 | +import qualified Data.Map as Map |
| 14 | +import Data.Text (Text) |
| 15 | +import qualified Data.Text as Text |
| 16 | +import Skylighting.Types |
| 17 | +import Text.Printf |
| 18 | +#if !MIN_VERSION_base(4,11,0) |
| 19 | +import Data.Semigroup |
| 20 | +#endif |
| 21 | + |
| 22 | +formatTypst :: Bool -> [SourceLine] -> Text |
| 23 | +formatTypst inline = Text.intercalate (Text.singleton '\n') |
| 24 | + . map (sourceLineToTypst inline) |
| 25 | + |
| 26 | +-- | Formats tokens as Typst using custom commands inside |
| 27 | +-- @|@ characters. Assumes that @|@ is defined as a short verbatim |
| 28 | +-- command by the macros produced by 'styleToTypst'. |
| 29 | +-- A @KeywordTok@ is rendered using @\\KeywordTok{..}@, and so on. |
| 30 | +formatTypstInline :: FormatOptions -> [SourceLine] -> Text |
| 31 | +formatTypstInline _opts ls = "\\VERB|" <> formatTypst True ls <> "|" |
| 32 | + |
| 33 | +sourceLineToTypst :: Bool -> SourceLine -> Text |
| 34 | +sourceLineToTypst inline = mconcat . map (tokenToTypst inline) |
| 35 | + |
| 36 | +tokenToTypst :: Bool -> Token -> Text |
| 37 | +tokenToTypst inline (NormalTok, txt) |
| 38 | + | Text.all isSpace txt = escapeTypst inline txt |
| 39 | +tokenToTypst inline (toktype, txt) = Text.cons '\\' |
| 40 | + (Text.pack (show toktype) <> "{" <> escapeTypst inline txt <> "}") |
| 41 | + |
| 42 | +escapeTypst :: Bool -> Text -> Text |
| 43 | +escapeTypst inline = Text.concatMap escapeTypstChar |
| 44 | + where escapeTypstChar c = |
| 45 | + case c of |
| 46 | + '\\' -> "\\textbackslash{}" |
| 47 | + '{' -> "\\{" |
| 48 | + '}' -> "\\}" |
| 49 | + '|' | inline -> "\\VerbBar{}" -- used in inline verbatim |
| 50 | + '_' -> "\\_" |
| 51 | + '&' -> "\\&" |
| 52 | + '%' -> "\\%" |
| 53 | + '#' -> "\\#" |
| 54 | + '`' -> "\\textasciigrave{}" |
| 55 | + '\'' -> "\\textquotesingle{}" |
| 56 | + '-' -> "{-}" -- prevent ligatures |
| 57 | + '~' -> "\\textasciitilde{}" |
| 58 | + '^' -> "\\^{}" |
| 59 | + '>' -> "\\textgreater{}" |
| 60 | + '<' -> "\\textless{}" |
| 61 | + _ -> Text.singleton c |
| 62 | + |
| 63 | +-- Typst |
| 64 | + |
| 65 | +-- | Format tokens as a Typst @Highlighting@ environment inside a |
| 66 | +-- @Shaded@ environment. @Highlighting@ and @Shaded@ are |
| 67 | +-- defined by the macros produced by 'styleToTypst'. @Highlighting@ |
| 68 | +-- is a verbatim environment using @fancyvrb@; @\\@, @{@, and @}@ |
| 69 | +-- have their normal meanings inside this environment, so that |
| 70 | +-- formatting commands work. @Shaded@ is either nothing |
| 71 | +-- (if the style's background color is default) or a @snugshade@ |
| 72 | +-- environment from @framed@, providing a background color |
| 73 | +-- for the whole code block, even if it spans multiple pages. |
| 74 | +formatTypstBlock :: FormatOptions -> [SourceLine] -> Text |
| 75 | +formatTypstBlock opts ls = Text.unlines |
| 76 | + ["\\begin{Shaded}" |
| 77 | + ,"\\begin{Highlighting}[" <> |
| 78 | + (if numberLines opts |
| 79 | + then "numbers=left," <> |
| 80 | + (if startNumber opts == 1 |
| 81 | + then "" |
| 82 | + else ",firstnumber=" <> |
| 83 | + Text.pack (show (startNumber opts))) <> "," |
| 84 | + else Text.empty) <> "]" |
| 85 | + ,formatTypst False ls |
| 86 | + ,"\\end{Highlighting}" |
| 87 | + ,"\\end{Shaded}"] |
| 88 | + |
| 89 | +-- | Converts a 'Style' to a set of Typst macro definitions, |
| 90 | +-- which should be placed in the document's preamble. |
| 91 | +-- Note: default Typst setup doesn't allow boldface typewriter font. |
| 92 | +-- To make boldface work in styles, you need to use a different typewriter |
| 93 | +-- font. This will work for computer modern: |
| 94 | +-- |
| 95 | +-- > \DeclareFontShape{OT1}{cmtt}{bx}{n}{<5><6><7><8><9><10><10.95><12><14.4><17.28><20.74><24.88>cmttb10}{} |
| 96 | +-- |
| 97 | +-- Or, with xelatex: |
| 98 | +-- |
| 99 | +-- > \usepackage{fontspec} |
| 100 | +-- > \setmainfont[SmallCapsFont={* Caps}]{Latin Modern Roman} |
| 101 | +-- > \setsansfont{Latin Modern Sans} |
| 102 | +-- > \setmonofont[SmallCapsFont={Latin Modern Mono Caps}]{Latin Modern Mono Light} |
| 103 | +-- |
| 104 | +styleToTypst :: Style -> Text |
| 105 | +styleToTypst f = Text.unlines $ |
| 106 | + [ "\\usepackage{color}" |
| 107 | + , "\\usepackage{fancyvrb}" |
| 108 | + , "\\newcommand{\\VerbBar}{|}" |
| 109 | + , "\\newcommand{\\VERB}{\\Verb[commandchars=\\\\\\{\\}]}" |
| 110 | + , "\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}" |
| 111 | + , "% Add ',fontsize=\\small' for more characters per line" |
| 112 | + ] ++ |
| 113 | + (case backgroundColor f of |
| 114 | + Nothing -> ["\\newenvironment{Shaded}{}{}"] |
| 115 | + Just (RGB r g b) -> ["\\usepackage{framed}" |
| 116 | + ,Text.pack |
| 117 | + (printf "\\definecolor{shadecolor}{RGB}{%d,%d,%d}" r g b) |
| 118 | + ,"\\newenvironment{Shaded}{\\begin{snugshade}}{\\end{snugshade}}"]) |
| 119 | + ++ sort (map (macrodef (defaultColor f) (Map.toList (tokenStyles f))) |
| 120 | + (enumFromTo KeywordTok NormalTok)) |
| 121 | + |
| 122 | +macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> Text |
| 123 | +macrodef defaultcol tokstyles tokt = "\\newcommand{\\" |
| 124 | + <> Text.pack (show tokt) |
| 125 | + <> "}[1]{" |
| 126 | + <> Text.pack (co . ul . bf . it . bg $ "#1") |
| 127 | + <> "}" |
| 128 | + where tokf = case lookup tokt tokstyles of |
| 129 | + Nothing -> defStyle |
| 130 | + Just x -> x |
| 131 | + ul x = if tokenUnderline tokf |
| 132 | + then "\\underline{" <> x <> "}" |
| 133 | + else x |
| 134 | + it x = if tokenItalic tokf |
| 135 | + then "\\textit{" <> x <> "}" |
| 136 | + else x |
| 137 | + bf x = if tokenBold tokf |
| 138 | + then "\\textbf{" <> x <> "}" |
| 139 | + else x |
| 140 | + bcol = fromColor `fmap` tokenBackground tokf |
| 141 | + :: Maybe (Double, Double, Double) |
| 142 | + bg x = case bcol of |
| 143 | + Nothing -> x |
| 144 | + Just (r, g, b) -> |
| 145 | + printf "\\colorbox[rgb]{%0.2f,%0.2f,%0.2f}{%s}" r g b x |
| 146 | + col = fromColor `fmap` (tokenColor tokf `mplus` defaultcol) |
| 147 | + :: Maybe (Double, Double, Double) |
| 148 | + co x = case col of |
| 149 | + Nothing -> x |
| 150 | + Just (r, g, b) -> |
| 151 | + printf "\\textcolor[rgb]{%0.2f,%0.2f,%0.2f}{%s}" r g b x |
| 152 | + |
0 commit comments