Vous avez reçu un message "Your GitLab account has been locked ..." ? Pas d'inquiétude : lisez cet article https://docs.gricad-pages.univ-grenoble-alpes.fr/help/unlock/

Commit 67bf7e8c authored by Marc Coiffier's avatar Marc Coiffier
Browse files

Start adapting the Data.Font library for use in a center-based layout

parent 59cb33a0
......@@ -17,7 +17,7 @@ with all occurrences of x replaced by X".
Here are a few functions to help you get a feel of the language : `{x:
x}`{.curly}, the identity function; `{x _: x}`{.curly}, the constant function; `{f x
y: f y x}`{.curly}, a function to flip its first arguments parameters.
y: f y x}`{.curly}, a function to flip its first arguments' parameters.
Functions and operators
......@@ -233,3 +233,64 @@ locally, or imported from another module).
If a leaf symbol has a local name, then the local symbol of that name
is exported instead of the leaf's name.
### Definining system-specific values
Sometimes, in the interest of efficiency or portability, it can be
useful to have a symbol represent different implementations of a
function on different systems. To define such symbols, Curly provides
the `multi` pragma, with the following syntax :
This pragma define the multi-system symbol `SYMBOL`, with a system-specific
implementation for each `SYSTEM_NAME`, and a fallback implementation
defined in `DEFAULT_SYMBOL`.
#### Example: packaging an external C library
_Warning_: this is still a thought experiment. The Curly FFI is not yet
capable of integrating with C, although it will be very soon.
Imagine you have a C library called libX. You have the source for this
library, and maybe a C cross-compiling toolchain for several
systems. Using all this, you manage to compile libX into three dynamic
libraries, that each run on a different ABI and maybe a different
architecture. Let's call these `libX_arm-linux.so`,
`libX_x86-linux.so`, and `libX_x86_64-linux.so`.
You can now use Curly to create a library of bindings to libX, in a
portable way. First, mount each .so to a point in context, using the
"external" input source, along with a `libX.cy` source file :
#!/usr/bin/env curly
# A simple context file for libX
mount C libX arm = external libX_arm-linux.so
mount C libX x86 = external libX_x86-linux.so
mount C libX x86-64 = external libX_x86_64-linux.so
mount libX = source libX.cy
That `libX.cy` file can now define a multi-symbol for each function of
the libX library, handling each system accordingly :
module libX: Bindings to a library
# Since each library exports the same symbols, we have to rename them during import
import C.libX{
arm{f(arm'f) ...}
x86{f(x86'f) ...}
x86-64{f(x64'f) ...}
let defaultImpl = undefined
multi f = defaultImpl, linux-x86 x86'f, linux-arm arm'f, linux-x86-64 x64'f
export f ...
You can now import the `libX` module anywhere, and use its functions
on any of the three handled systems. The C binaries are no longer
needed once `libX` has been compiled.
......@@ -27,6 +27,6 @@ the heights of getting to compile this fine compiler, by running the
following commands :
git clone http://git.curly-lang.org/marc/curly
cd curly && stack build
git clone https://github.com/lih/BHR.git
cd BHR && stack build curly
[curly-install-script]: install-curly.sh
[curly-source]: https://git.curly-lang.org/marc/stack-libs/src/master/curly
[curly-source]: https://github.com/lih/BHR/src/master/curly
[curly-package]: pkg/curly.tar.xz
[curly-linux-x86-64]: pkg/curly.tar.xz
[curly-complaints]: http://git.curly-lang.org/marc/curly/issues
[curly-complaints]: http://github.com/lih/BHR/issues
......@@ -26,4 +26,12 @@ executable logos
main-is: Logos.hs
default-language: Haskell2010
executable svgfont
build-depends: base >=4.9 && <4.10,capricon >=0.10 && <0.11,definitive-base >=2.6 && <2.7,definitive-parser >=3.1 && <3.2,GLFW >=0.5 && <0.6,hreadline >=0.2 && <0.3,JuicyPixels >=3.2 && <3.3,logos >=0.1 && <0.2
default-extensions: TypeSynonymInstances, NoMonomorphismRestriction, StandaloneDeriving, GeneralizedNewtypeDeriving, TypeOperators, RebindableSyntax, FlexibleInstances, FlexibleContexts, FunctionalDependencies, TupleSections, MultiParamTypeClasses, Rank2Types, AllowAmbiguousTypes, RoleAnnotations, ViewPatterns, LambdaCase
hs-source-dirs: exe
ghc-options: -threaded
main-is: SVGFont.hs
default-language: Haskell2010
......@@ -62,10 +62,17 @@ data RenderParams = RenderParams {
renderSizeAlignment :: Int, -- ^ The alignment required for the sizes of the returned buffer (OpenGL needs it to be a multiple of 4)
renderMode :: RenderMode
data CellMetrics = CellMetrics {
cellLeftWidth, cellRightWidth,
cellBottomHeight, cellTopHeight :: Int
deriving Show
instance Semigroup CellMetrics where
CellMetrics lw rw bh th + CellMetrics lw' rw' bh' th' =
CellMetrics (lw+rw) (lw'+rw') (max bh bh') (max th th')
data CellCoords = CellCoords {
cellCenterX,cellCenterY :: Int
cellX,cellY :: Int,
cellMetrics :: CellMetrics
deriving Show
data StringImage = StringImage {
......@@ -78,20 +85,27 @@ data StringImage = StringImage {
defaultRenderParams :: RenderParams
defaultRenderParams = RenderParams 72 4 Grayscale
getCharIndices fcp str = for str $ \c -> FT.ft_Get_Char_Index fcp (fromIntegral $ fromEnum c)
getStringMetrics fcp slot indices = do
for indices $ \i -> do
throwOnError $ FT.ft_Load_Glyph fcp i FT.ft_LOAD_NO_BITMAP
-- putStrLn $ "Loading metrics for glyph "++show i
peek (FT.metrics slot)
renditionSize :: Int -> [FT.FT_Glyph_Metrics] -> (Int,Int)
renditionSize align metrics = (foldMap (fromIntegral . FT.horiAdvance) metrics & toPixels,
foldl1' max (map (fromIntegral . FT.height) metrics) & toPixels)
where toPixels x = let y = ((x+63)`div`64)+align-1 in y-(y`mod`align)
renderString :: Face -> RenderParams -> String -> IO StringImage
renderString fc (RenderParams sz align mode) str = withFacePtr fc $ \fcp -> do
slot <- peek (FT.glyph fcp)
throwOnError $ FT.ft_Set_Pixel_Sizes fcp (fromIntegral sz) (fromIntegral sz)
indices <- for str $ \c -> FT.ft_Get_Char_Index fcp (fromIntegral $ fromEnum c)
metrics <- for indices $ \i -> do
throwOnError $ FT.ft_Load_Glyph fcp i FT.ft_LOAD_NO_BITMAP
-- putStrLn $ "Loading metrics for glyph "++show i
peek (FT.metrics slot)
let (sizeX,sizeY) = (foldMap (fromIntegral . FT.horiAdvance) (debug metrics) & toPixels,
foldl1' max (map (fromIntegral . FT.height) metrics) & toPixels) :: (Int,Int)
toPixels x = let y = ((x+63)`div`64)+align-1 in y-(y`mod`align)
indices <- getCharIndices fcp str
metrics <- getStringMetrics fcp slot indices
let (sizeX,sizeY) = renditionSize align metrics
modeCode = case mode of
Monochromatic -> FT.ft_RENDER_MODE_MONO
......@@ -117,10 +131,10 @@ renderString fc (RenderParams sz align mode) str = withFacePtr fc $ \fcp -> do
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 adv h
(fromIntegral (FT.horiBearingX m)`div`64 + w`div`2)
(fromIntegral (FT.height m P.- FT.horiBearingY m)`div`64)) ret)
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)
return (StringImage sizeX sizeY (V.unsafeFromForeignPtr0 ret (sizeX*sizeY)) cs)
deriving instance Show FTBMP.FT_Bitmap
......@@ -38,7 +38,7 @@ mkdir -p public/doc && {
<div id="package-header">
<ul class="links">
<li><a href="https://git.curly-lang.org/marc/curly">Source repository</a></li>
<li><a href="https://github.com/lih/BHR/curly">Source repository</a></li>
<li><a href="../index.html">Back to the main page</a></li>
<div class="caption">Curly packages</div></div>
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment