Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Marc Coiffier
BHR
Commits
46445ee7
Commit
46445ee7
authored
Mar 25, 2019
by
Marc Coiffier
Browse files
Start offering basic SVG generation of formulae with the %g format in CaPriCon
parent
67bf7e8c
Changes
4
Hide whitespace changes
Inline
Side-by-side
capricon/src/CaPriCon/Run.hs
View file @
46445ee7
...
...
@@ -199,6 +199,7 @@ runCOCBuiltin COCB_Format = do
ex
<-
runExtraState
get
let
format
(
'%'
:
's'
:
s
)
(
StackSymbol
h
:
t
)
=
first
(
h
+
)
(
format
s
t
)
format
(
'%'
:
'v'
:
s
)
(
x
:
t
)
=
first
(
showStackVal
doc2raw
(
ex
^.
showDir
)
(
ex
^.
context
)
x
+
)
(
format
s
t
)
format
(
'%'
:
'g'
:
s
)
(
x
:
t
)
=
first
(
showStackVal
doc2svg
(
ex
^.
showDir
)
(
ex
^.
context
)
x
+
)
(
format
s
t
)
format
(
'%'
:
'l'
:
s
)
(
x
:
t
)
=
first
(
showStackVal
doc2latex
(
ex
^.
showDir
)
(
ex
^.
context
)
x
+
)
(
format
s
t
)
format
(
c
:
s
)
t
=
first
(
fromString
[
c
]
+
)
(
format
s
t
)
format
""
t
=
(
""
,
t
)
...
...
capricon/src/Data/CaPriCon.hs
View file @
46445ee7
...
...
@@ -8,7 +8,7 @@ module Data.CaPriCon(
StringPattern
,
NodeDir
(
..
),
AHDir
(
..
),
ApDir
,
findPattern
,
freshContext
,
-- * Showing nodes
ListBuilder
(
..
),
NodeDoc
(
..
),
doc2raw
,
doc2latex
,
showNode
,
showNode'
ListBuilder
(
..
),
NodeDoc
(
..
),
doc2raw
,
doc2latex
,
doc2svg
,
showNode
,
showNode'
)
where
import
Definitive
...
...
@@ -379,6 +379,7 @@ data NodeDoc str = DocSeq [NodeDoc str]
|
DocParen
(
NodeDoc
str
)
|
DocMu
(
NodeDoc
str
)
|
DocSubscript
(
NodeDoc
str
)
(
NodeDoc
str
)
|
DocSuperscript
(
NodeDoc
str
)
(
NodeDoc
str
)
|
DocAssoc
str
(
NodeDoc
str
)
|
DocVarName
str
|
DocText
str
...
...
@@ -393,6 +394,7 @@ instance Functor NodeDoc where
map
f
(
DocParen
x
)
=
DocParen
(
map
f
x
)
map
f
(
DocMu
x
)
=
DocMu
(
map
f
x
)
map
f
(
DocSubscript
x
y
)
=
DocSubscript
(
map
f
x
)
(
map
f
y
)
map
f
(
DocSuperscript
x
y
)
=
DocSuperscript
(
map
f
x
)
(
map
f
y
)
map
f
(
DocAssoc
v
x
)
=
DocAssoc
(
f
v
)
(
map
f
x
)
map
f
(
DocText
x
)
=
DocText
(
f
x
)
map
f
(
DocVarName
x
)
=
DocVarName
(
f
x
)
...
...
@@ -405,6 +407,7 @@ doc2raw (DocSeq l) = fold (map doc2raw l)
doc2raw
(
DocParen
p
)
=
"("
+
doc2raw
p
+
")"
doc2raw
(
DocMu
m
)
=
"μ("
+
doc2raw
m
+
")"
doc2raw
(
DocSubscript
v
x
)
=
doc2raw
v
+
doc2raw
x
doc2raw
(
DocSuperscript
v
x
)
=
doc2raw
v
+
"^"
+
doc2raw
x
doc2raw
(
DocAssoc
x
v
)
=
"("
+
x
+
" : "
+
doc2raw
v
+
")"
doc2raw
DocArrow
=
" -> "
doc2raw
(
DocText
x
)
=
x
...
...
@@ -416,12 +419,40 @@ doc2latex (DocSeq l) = fold (map doc2latex l)
doc2latex
(
DocParen
p
)
=
"("
+
doc2latex
p
+
")"
doc2latex
(
DocMu
m
)
=
"
\\
mu("
+
doc2latex
m
+
")"
doc2latex
(
DocSubscript
v
x
)
=
doc2latex
v
+
"_{"
+
doc2latex
x
+
"}"
doc2latex
(
DocSuperscript
v
x
)
=
doc2latex
v
+
"^{"
+
doc2latex
x
+
"}"
doc2latex
(
DocAssoc
x
v
)
=
"("
+
latexName
x
+
":"
+
doc2latex
v
+
")"
doc2latex
DocArrow
=
"
\\
rightarrow "
doc2latex
(
DocText
x
)
=
x
doc2latex
(
DocVarName
x
)
=
latexName
x
doc2latex
DocSpace
=
"
\\
,"
doc2svg
::
IsCapriconString
str
=>
NodeDoc
str
->
str
doc2svg
=
\
x
->
snd
$
(
go
x
^.
from
state
)
(
0
::
Double
)
where
sym
s
=
get
>>=
\
x
->
if
x
==
0
then
return
s
else
(
"<tspan dy=
\"
"
+
fromString
(
show
x
)
+
"em
\"
>"
+
s
+
"</tspan>"
)
<$
put
0
go
(
DocSeq
l
)
=
fold
<$>
traverse
go
l
go
(
DocParen
p
)
=
liftA3
(
\
x
y
z
->
x
+
y
+
z
)
(
sym
"("
)
(
go
p
)
(
sym
")"
)
go
(
DocMu
m
)
=
liftA3
(
\
x
y
z
->
x
+
y
+
z
)
(
sym
"μ("
)
(
go
m
)
(
sym
")"
)
go
(
DocSubscript
v
x
)
=
sub
(
go
v
)
(
go
x
)
go
(
DocSuperscript
v
x
)
=
super
(
go
v
)
(
go
x
)
go
(
DocAssoc
x
v
)
=
fold
<$>
sequence
[
sym
"("
,
svgName
x
,
sym
":"
,
go
v
,
sym
")"
]
go
DocArrow
=
sym
" → "
go
(
DocText
x
)
=
sym
x
go
(
DocVarName
x
)
=
svgName
x
go
DocSpace
=
sym
" "
super
mv
mx
=
liftA2
(
\
x
y
->
x
+
"<tspan dy=
\"
-0.5em
\"
><tspan class=
\"
small
\"
>"
+
y
+
"</tspan></tspan>"
)
mv
(
mx
<*
put
(
0.5
))
sub
mv
mx
=
liftA2
(
\
x
y
->
x
+
"<tspan dy=
\"
0.3em
\"
><tspan class=
\"
small
\"
>"
+
y
+
"</tspan></tspan>"
)
mv
(
mx
<*
put
(
-
0.3
))
svgName
s
=
map
(
\
x
->
"<tspan class=
\"
variable
\"
>"
+
x
+
"</tspan>"
)
$
nm
$
toString
s
where
nm
(
'.'
:
t
)
=
super
(
nm
t
)
(
sym
"P"
)
nm
x
=
let
(
n
,
y
)
=
span
(
\
c
->
c
>=
'0'
&&
c
<=
'9'
)
(
reverse
x
)
in
case
n
of
""
->
sym
(
fromString
(
reverse
y
))
_
->
sub
(
sym
(
fromString
(
reverse
y
)))
(
sym
(
fromString
(
reverse
n
)))
latexName
::
IsCapriconString
str
=>
str
->
str
latexName
s
=
fromString
$
go
$
toString
s
where
go
(
'.'
:
t
)
=
go
t
+
"^P"
...
...
curly/data/emacs/curly-utils.el
View file @
46445ee7
...
...
@@ -64,6 +64,33 @@
)
args
""
))
(
_
args
)))
(
princ
(
curly-lambda-match
((
:many
.
e
)
(
concat
"\\(?:"
(
apply
'curly-re-construct
e
)
"\\)*"
))
((
:optional
.
e
)
(
concat
"\\(?:"
(
apply
'curly-re-construct
e
)
"\\)?"
))
((
:sep-by
sep
.
e
)
(
concat
(
apply
'curly-re-construct
e
)
"\\(?:"
(
curly-re-construct
sep
)
(
apply
'curly-re-construct
e
)
"\\)*"
))
((
:or
.
e
)
(
concat
"\\(?:"
(
mapconcat
'curly-re-construct
e
"\\|"
)
"\\)"
))
((
:capture
.
e
)
(
concat
"\\("
(
apply
'curly-re-construct
e
)
"\\)"
))
((
:partial
e
)
(
curly-re-construct
e
))
((
:partial
e
.
es
)
(
concat
(
curly-re-construct
e
)
(
curly-re-construct
`
(
:optional
(
:partial
.
,
es
)))))
(
:bol
"^"
)
(
:eol
"$"
)
(
:bow
"\\<"
)
(
:eow
"\\>"
)
(
:word
"\\<\\sw*[^[:blank:]:=]"
)
(
:spc
"\\s-*"
)
(
:nbsp
"\\s-+"
)
((
@
l
(
_
.
_
))
(
apply
'curly-re-construct
l
))
(
x
x
)
))
(
defmacro
curly-regex
(
&rest
args
)
(
curly-re-construct
args
))
(
defmacro
curly-keyword
(
re
&rest
args
)
""
(
declare
(
indent
1
))
...
...
logos/src/Data/Font.hs
View file @
46445ee7
...
...
@@ -72,7 +72,8 @@ instance Semigroup CellMetrics where
CellMetrics
(
lw
+
rw
)
(
lw'
+
rw'
)
(
max
bh
bh'
)
(
max
th
th'
)
data
CellCoords
=
CellCoords
{
cellX
,
cellY
::
Int
,
cellMetrics
::
CellMetrics
cellMetrics
::
CellMetrics
,
glyphMetrics
::
CellMetrics
}
deriving
Show
data
StringImage
=
StringImage
{
...
...
@@ -126,14 +127,20 @@ renderString fc (RenderParams sz align mode) str = withFacePtr fc $ \fcp -> do
start
|
incr
>
0
=
FTBMP
.
buffer
bmp
`
plusPtr
`((
h
-
1
)
*
incr
)
|
otherwise
=
FTBMP
.
buffer
bmp
rowPtrs
=
iterate
(`
plusPtr
`
negate
incr
)
start
adv
=
fromIntegral
(
FT
.
horiAdvance
m
`
div
`
64
)
-- putStrLn $ "Copying rows of size "++show w++" from "++show start++" to "++show (pret`plusPtr`dx)++" (size "++show (sizeX-dx)++")"
for_
(
take
h
rowPtrs
`
zip
`
iterate
(`
plusPtr
`
sizeX
)
(
pret
`
plusPtr
`
dx
))
$
\
(
rowsrc
,
rowdst
)
->
do
copyArray
rowdst
rowsrc
w
k
(
dx
+
adv
)
(
insert
c
(
CellCoords
dx
0
(
CellMetrics
adv
h
(
fromIntegral
(
FT
.
horiBearingX
m
)`
div
`
64
+
w
`
div
`
2
)
(
fromIntegral
(
FT
.
height
m
P
.-
FT
.
horiBearingY
m
)`
div
`
64
)))
ret
)
let
adv
=
fromIntegral
(
FT
.
horiAdvance
m
`
div
`
64
)
bearX
=
fromIntegral
(
FT
.
horiBearingX
m
`
div
`
64
)
bearY
=
fromIntegral
(
FT
.
horiBearingX
m
`
div
`
64
)
mh
=
fromIntegral
(
FT
.
height
m
`
div
`
64
)
mw
=
fromIntegral
(
FT
.
width
m
`
div
`
64
)
k
(
dx
+
adv
)
(
insert
c
(
CellCoords
dx
0
(
let
lw
=
bearX
+
mw
`
div
`
2
in
CellMetrics
lw
(
adv
-
lw
)
(
mh
-
bearY
)
bearY
)
(
let
lw
=
mw
`
div
`
2
in
CellMetrics
lw
(
mw
-
lw
)
(
mh
-
bearY
)
bearY
))
ret
)
return
(
StringImage
sizeX
sizeY
(
V
.
unsafeFromForeignPtr0
ret
(
sizeX
*
sizeY
))
cs
)
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment