Last active
December 21, 2019 11:24
-
-
Save monaqa/92675b167195fe2b4e2a3cfc13efac83 to your computer and use it in GitHub Desktop.
Blockless SLyDIFi
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
@import: slydifi-blockless | |
let-inline ctx \gray it = | |
let ctx2 = ctx |> set-text-color (SlydifiColor.html-color 0xAAAAAA) in | |
read-inline ctx2 it | |
in | |
Slydifi.document(| | |
draft-mode = false; | |
fonts = (| | |
frame-title-cjk = `mplus-sans-b`; % 自分が持っているフォントに変えること | |
normal-text-cjk = `mplus-sans-r`; % 自分が持っているフォントに変えること | |
frame-title-latin = `mplus-sans-b`; % 自分が持っているフォントに変えること | |
normal-text-latin = `mplus-sans-r`; % 自分が持っているフォントに変えること | |
mono-text-latin = `mplus-mono-r`; % 自分が持っているフォントに変えること | |
font-ratio-cjk = 1.0; | |
|); | |
|)[ | |
frame-anime(5){Overlay 機能のテスト}[ | |
p{こんなふうに,任意の段落の表示切り替えを好きに制御できる.}; | |
p-switch(Range(2, 4)){☆★★★☆:2–4のとき有効.}{\gray{☆★★★☆:2–4のとき有効.}}; | |
p-switch(Only(3) ){☆☆★☆☆:3 枚目だけ有効.}{\gray{☆☆★☆☆:3 枚目だけ有効.}}; | |
p-switch(Before(2) ){★★☆☆☆:2 枚目まで有効.}{\gray{★★☆☆☆:2 枚目まで有効.}}; | |
p-switch(After(3) ){☆☆★★★:3 枚目以降有効.}{\gray{☆☆★★★:3 枚目以降有効.}}; | |
p-switch(GeneralRange(fun i -> (i mod 2) == 1)) | |
{★☆★☆★:奇数枚目のみ有効.}{\gray{★☆★☆★:奇数枚目のみ有効.}}; | |
p-ghost(Only(5)){終わり.}; | |
]; | |
] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{"pagecount":"5"} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
% vim: foldmethod=marker | |
@require: gr | |
@require: math | |
@require: list | |
@require: annot | |
@require: satysfi-base/block | |
@import: slydifi-color | |
type block = context -> block-boxes | |
type cel = int -> block | |
type celRange = | |
| Always of unit | |
| Only of int | |
| Before of int | |
| After of int | |
| Range of int * int | |
| GeneralRange of int -> bool | |
let phantom-block bb = block-skip (get-natural-length bb) | |
let-inline ctx \SLyDiFi = | |
let size = get-font-size ctx in | |
let f = read-inline ctx in | |
let fd = ctx |> set-manual-rising (0pt -' (size *' 0.25)) |> read-inline in | |
let fI = ctx |> set-font-size (size *' 0.72) | |
|> set-manual-rising (size *' 0.2) | |
|> read-inline | |
in | |
let ib = | |
f {SL} ++ kern(size *' 0.05) ++ fd{Y} ++ kern(size *' 0.03) ++ f{DIF} | |
++ kern(size *' 0.05) ++ fd{I} | |
in | |
script-guard Latin (no-break ib) | |
module Slydifi : sig | |
% Signature {{{ | |
val document: 'a -> block list -> document | |
constraint 'a :: (| | |
fonts: (| | |
frame-title-cjk : string; | |
normal-text-cjk : string; | |
frame-title-latin : string; | |
normal-text-latin : string; | |
mono-text-latin : string; | |
font-ratio-cjk : float; | |
|); | |
draft-mode : bool; | |
|) | |
val paper-width : length | |
val paper-height : length | |
direct \emph : [inline-text] inline-cmd | |
direct \textbf : [inline-text] inline-cmd | |
direct \text-color : [color; inline-text] inline-cmd | |
direct \br : [] inline-cmd | |
direct \link : [inline-text?; string] inline-cmd | |
val frame-anime : int -> inline-text -> cel list -> block | |
val frame : inline-text -> cel list -> block | |
val p-ghost : celRange -> inline-text -> cel | |
val p-switch : celRange -> inline-text -> inline-text -> cel | |
val p : inline-text -> cel | |
% }}} | |
end = struct | |
% blockless satysfi | |
let block-list-to-block-boxes ctx b = | |
b |> List.map (fun b -> b ctx) | |
|> Block.concat | |
let cel-list-to-block-boxes ctx c cel-num = | |
c |> List.map (fun c -> c cel-num ctx) | |
|> Block.concat | |
% 文書設定 {{{1 | |
let font-size-normal = 20pt | |
let font-size-frame-title = 28pt | |
let font-size-header-footer = 12pt | |
let font-size-title = 32pt | |
let font-size-author = 20pt | |
let font-size-date = 18pt | |
let font-size-institute = 20pt | |
let font-size-section = 28pt | |
let font-size-footnote = 12pt | |
% PowerPoint の文書サイズに合わせる | |
% let paper-width = 12.8cm | |
% let paper-height = 9.6cm | |
let paper-width = 25.4cm | |
let paper-height = 14.29cm | |
% let header-height = 12pt | |
let header-height = 24pt | |
let footer-height = 24pt | |
let text-horizontal-margin = 30pt | |
let text-vertical-margin = font-size-normal *' 1.0 | |
let text-height = paper-height -' text-vertical-margin *' 2. | |
let text-width = paper-width -' text-horizontal-margin *' 2. | |
let relwid relx = paper-width *' relx | |
let relht rely = paper-height *' rely | |
let relpt relx rely = (relwid relx, relht rely) | |
let font-ratio-latin = 1. | |
let font-latin-roman = (`Junicode` , font-ratio-latin, 0.) | |
let font-latin-italic = (`Junicode-it`, font-ratio-latin, 0.) | |
let font-latin-sans = (`lmsans` , font-ratio-latin, 0.) | |
let font-latin-mono = (`lmmono` , font-ratio-latin, 0.) | |
let font-cjk-mincho = (`ipaexm` , 1.0 , 0.) | |
let font-cjk-gothic = (`ipaexg` , 1.0 , 0.) | |
let set-cjk-font font ctx = | |
ctx |> set-font HanIdeographic font | |
|> set-font Kana font | |
% grid | |
let main-grid-size = 50pt | |
let sub-grid-size = 10pt | |
% page | |
let-mutable is-first-page <- true | |
% colors | |
let color-title = SlydifiColor.html-color 0x076678 | |
let color-bg = SlydifiColor.html-color 0xF9F5D7 | |
let color-fg = SlydifiColor.html-color 0x282828 | |
let color-emph = SlydifiColor.html-color 0xCC241D | |
let color-link = SlydifiColor.html-color 0x8F3F71 | |
let color-footer = SlydifiColor.inner-color color-bg color-fg 0.5 | |
let main-grid-color = SlydifiColor.inner-color color-bg color-fg 0.7 | |
let sub-grid-color = SlydifiColor.inner-color color-bg color-fg 0.9 | |
% options {{{ | |
let-mutable fonts-frame-title-cjk <- ` ` | |
let-mutable fonts-frame-title-latin <- ` ` | |
let-mutable fonts-normal-text-cjk <- ` ` | |
let-mutable fonts-normal-text-latin <- ` ` | |
let-mutable fonts-mono-text-latin <- ` ` | |
let-mutable fonts-font-ratio-cjk <- 1.0 | |
let-mutable draft-mode <- false | |
% }}} | |
% }}} | |
% document command {{{ | |
let clear-page-or-nil is-first-page = | |
match !is-first-page with | |
| true -> | |
let () = is-first-page <- false in | |
block-nil | |
| false -> clear-page | |
let get-standard-context wid = | |
get-initial-context wid (command \math) | |
|> set-dominant-wide-script Kana | |
|> set-language Kana Japanese | |
|> set-language HanIdeographic Japanese | |
|> set-dominant-narrow-script Latin | |
|> set-language Latin English | |
|> set-font Kana font-cjk-mincho | |
|> set-font HanIdeographic font-cjk-mincho | |
|> set-font Latin font-latin-roman | |
|> set-font-size font-size-normal | |
|> set-math-font `lmodern` | |
|> set-hyphen-penalty 100 | |
|> set-leading (font-size-normal *' 1.4) | |
|> set-paragraph-margin (font-size-normal *' 0.6) (font-size-normal *' 0.6) | |
|> set-text-color color-fg | |
let document record inner = | |
let page = UserDefinedPaper (paper-width, paper-height) in | |
let () = fonts-frame-title-cjk <- record#fonts#frame-title-cjk in | |
let () = fonts-frame-title-latin <- record#fonts#frame-title-latin in | |
let () = fonts-normal-text-cjk <- record#fonts#normal-text-cjk in | |
let () = fonts-normal-text-latin <- record#fonts#normal-text-latin in | |
let () = fonts-font-ratio-cjk <- record#fonts#font-ratio-cjk in | |
let () = fonts-mono-text-latin <- record#fonts#mono-text-latin in | |
let () = draft-mode <- record#draft-mode in | |
let ctx-doc = (get-standard-context text-width) | |
|> set-font Kana (record#fonts#normal-text-cjk, !fonts-font-ratio-cjk, 0.) | |
|> set-font HanIdeographic (record#fonts#normal-text-cjk, !fonts-font-ratio-cjk, 0.) | |
|> set-font Latin (record#fonts#normal-text-latin, font-ratio-latin, 0.) | |
in | |
let bb-main = block-list-to-block-boxes ctx-doc inner in | |
let pagecontf _ = | |
(| | |
text-origin = (text-horizontal-margin, text-vertical-margin); | |
text-height = text-height; | |
|) | |
in | |
let pagepartsf pbinfo = | |
let footer = | |
let ctx = get-standard-context paper-width | |
|> set-font Latin (record#fonts#normal-text-latin, font-ratio-latin, 0.) | |
|> set-font-size font-size-header-footer | |
|> set-text-color color-footer | |
in | |
let it-pageno = embed-string (arabic pbinfo#page-number) in | |
let it-count = match get-cross-reference `pagecount` with | |
| None -> {??} | |
| Some(i) -> embed-string i | |
in | |
line-break true true ctx (inline-fil ++ (read-inline ctx {#it-pageno;/#it-count;}) ++ inline-skip 20pt) | |
in | |
(| | |
header-origin = (0pt, 0pt); | |
header-content = block-nil; | |
footer-origin = (0pt, paper-height -' footer-height); | |
footer-content = footer; | |
|) | |
in | |
let hook = line-break false false (get-standard-context 0pt) | |
(hook-page-break (fun pbInfo _ -> ( | |
let numpages = pbInfo#page-number in | |
register-cross-reference `pagecount` (arabic numpages) | |
))) | |
in | |
page-break page pagecontf pagepartsf (bb-main +++ hook) | |
% }}} | |
% common function in slides {{{ | |
let-rec range n1 n2 = | |
let-rec aux min max = | |
if min == max then [min] else min :: (aux (min + 1) max) | |
in | |
if n1 < n2 then (aux n1 n2) else (aux n2 n1) | |
let ib-bg = | |
let rect-bg = | |
fill color-bg (Gr.rectangle (0pt, 0pt) (paper-width, paper-height)) | |
in | |
inline-graphics 0pt 0pt 0pt (fun _ -> [rect-bg]) | |
let bg-grids grid-wid grid-ht grid-color = | |
let n-grid-vertical = round(paper-width /' grid-wid) in | |
let n-grid-horizontal = round(paper-height /' grid-ht) in | |
let vlines = | |
List.map ( | |
fun n -> Gr.line (grid-wid *' float(n), 0pt) (grid-wid *' float(n), paper-height) | |
) (range 1 n-grid-vertical) in | |
% [Gr.line (grid-wid, 0pt) (grid-wid, paper-height)] in | |
let hlines = | |
List.map ( | |
fun n -> Gr.line (0pt, grid-ht *' float(n)) (paper-width, grid-ht *' float(n)) | |
) (range 1 n-grid-horizontal) in | |
% let hlines = [Gr.line (0pt, grid-ht) (paper-width, grid-ht)] in | |
let lines = List.append vlines hlines in | |
let grid = List.map (stroke 1pt grid-color) lines in | |
let ib = inline-graphics 0pt 0pt 0pt (fun _ -> grid) in | |
ib | |
let make-grids dmode = | |
let main-grid = bg-grids main-grid-size main-grid-size main-grid-color in | |
let sub-grid = bg-grids sub-grid-size sub-grid-size sub-grid-color in | |
if dmode then (sub-grid ++ main-grid) else inline-nil | |
let bb-bg ctx dmode = | |
let ctx-phantom = | |
ctx |> set-font-size 0pt | |
|> set-paragraph-margin 0pt 0pt | |
|> set-leading 0pt | |
in | |
(line-break true true ctx-phantom (ib-bg ++ (make-grids dmode) ++ inline-fil)) | |
% Overlay | |
% celRange 型を, | |
% layer 番号 i が, celRange で定まる範囲に入っているかどうかを表す | |
% int -> bool 型に変換する. | |
let-rec is-in-range : celRange -> int -> bool | cel-range i = | |
match cel-range with | |
| Always() -> true | |
| Only(n) -> (i == n) | |
| Before(n) -> (i <= n) | |
| After(n) -> (i >= n) | |
| Range(m, n) -> (i >= m) && (i <= n) | |
| GeneralRange(f) -> (f i) | |
% cel-num (cel number) が crange (cel range) に入っているときだけ | |
% 具現化され,それ以外は phantom となる block-box. | |
let ghost-block crange cel-num bb = | |
if is-in-range crange cel-num then bb else phantom-block bb | |
% cel-num が crange に入っているときだけ bb-true が使われ, | |
% それ以外は bb-false に擬態する block-box. | |
let block-switch crange cel-num bb-true bb-false = | |
if is-in-range crange cel-num then bb-true else bb-false | |
% }}} | |
% frame{} function {{{ | |
let placeholder height (origX, origY) = | |
[fill Color.white (Gr.rectangle (origX, origY) (origX, origY +' height))] | |
let make-frame-title ctx = | |
ctx |> set-font-size font-size-frame-title | |
|> set-font Latin (!fonts-frame-title-latin, 1.0, 0.) | |
|> set-cjk-font (!fonts-frame-title-cjk, !fonts-font-ratio-cjk, 0.) | |
|> set-text-color color-title | |
let make-placeholder ctx glue-height = | |
let ht = length-max 0pt glue-height in | |
let ctx2 = ctx |> set-paragraph-margin 0pt 0pt in | |
line-break true false ctx2 (inline-graphics 0pt ht 0pt (placeholder ht) ++ inline-fil) | |
let frame-anime max-frame title inner ctx = | |
let ctx-title = make-frame-title ctx in | |
let title-padding = 12pt in | |
let deco (x, y) wid hgt dpt = | |
let path1 = | |
let xL = x -' text-horizontal-margin +' title-padding in | |
let yT = y +' text-vertical-margin in | |
let xR = xL +' paper-width -' title-padding *' 2.0 in | |
let yB = yT -' 3pt in | |
Gr.rectangle (xL, yT) (xR, yB) | |
in | |
[ | |
(fill color-title path1); | |
] | |
in | |
let bb-title cel-num = | |
let it-number = | |
if max-frame == 1 then {} | |
else | |
let it-cel-num = embed-string(arabic cel-num) in | |
let it-max-frame = embed-string(arabic max-frame) in | |
{ (#it-cel-num;/#it-max-frame;)} | |
in | |
let ib-title = read-inline ctx-title {#title;#it-number;} in | |
block-frame-breakable | |
(ctx |> set-paragraph-margin 0pt 0pt) | |
(title-padding -' text-horizontal-margin, title-padding, | |
title-padding -' text-vertical-margin, title-padding +' text-vertical-margin) | |
(deco, deco, deco, deco) | |
(fun ctx -> | |
line-break true true (make-frame-title ctx) (ib-title ++ inline-fil) | |
) | |
in | |
let ib-inner cel-num = embed-block-top ctx text-width (fun ctx -> cel-list-to-block-boxes ctx inner cel-num) in | |
let bb-inner cel-num = line-break false false ctx (ib-inner cel-num) in | |
let-rec content n = | |
if n == 0 | |
then block-nil | |
else | |
(content (n - 1)) +++ | |
(clear-page-or-nil is-first-page) +++ | |
(bb-bg ctx !draft-mode) +++ (bb-title n) +++ (bb-inner n) | |
in | |
content max-frame | |
let frame = frame-anime 1 | |
let frame-anime-nt max-frame inner ctx = | |
let ib-inner cel-num = embed-block-top ctx text-width (fun ctx -> cel-list-to-block-boxes ctx inner cel-num) in | |
let bb-inner cel-num = line-break false false ctx (ib-inner cel-num) in | |
let-rec content n = | |
if n == 0 | |
then block-nil | |
else | |
(content (n - 1)) +++ | |
(clear-page-or-nil is-first-page) +++ | |
(bb-bg ctx !draft-mode) +++ (bb-inner n) | |
in | |
content max-frame | |
let frame-nt = frame-anime-nt 1 | |
% }}} | |
% 文書構造 {{{ | |
let p-ghost crange it cel-num ctx = | |
ghost-block crange cel-num | |
(line-break true true ctx (read-inline ctx it ++ inline-fil)) | |
let p-switch crange it1 it2 cel-num ctx = | |
let ib-paragraph it = | |
line-break true true ctx (read-inline ctx it ++ inline-fil) | |
in | |
block-switch crange cel-num (ib-paragraph it1) (ib-paragraph it2) | |
let p = p-ghost (Always()) | |
% }}} | |
% インラインテキスト装飾 {{{ | |
let-inline ctx \emph it = | |
let ctx2 = ctx |> set-text-color color-emph | |
|> set-font Latin (!fonts-frame-title-latin, 1.0, 0.) | |
|> set-cjk-font (!fonts-frame-title-cjk, !fonts-font-ratio-cjk, 0.) | |
in | |
(read-inline ctx2 it) | |
let-inline ctx \text-color clr it = | |
let ctx2 = ctx |> set-text-color clr in | |
(read-inline ctx2 it) | |
let-inline ctx \textbf it = | |
let ctx2 = ctx |> set-font Latin (!fonts-frame-title-latin, 1.0, 0.) | |
|> set-cjk-font (!fonts-frame-title-cjk, !fonts-font-ratio-cjk, 0.) | |
in | |
(read-inline ctx2 it) | |
let-inline ctx \link ?:it url = | |
let ctx2 = ctx |> set-text-color color-link in | |
let ctx-link = match it with | |
| None -> ctx2 |> set-font Latin (!fonts-mono-text-latin, 1.0, 0.) | |
| Some(v) -> ctx2 | |
in | |
let text = match it with | |
| None -> (embed-string url) | |
| Some(v) -> v | |
in | |
read-inline ctx-link {\href(url){#text;}} | |
let-inline ctx \br = | |
discretionary (- 1000) inline-nil inline-fil inline-nil | |
% }}} | |
end | |
let frame-anime = Slydifi.frame-anime | |
let frame = Slydifi.frame | |
let p-ghost = Slydifi.p-ghost | |
let p-switch = Slydifi.p-switch | |
let p = Slydifi.p |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
@require: color | |
module SlydifiColor : sig | |
val gray : float -> color | |
val rgb : float -> float -> float -> color | |
val html-color : int -> color | |
val black : color | |
val white : color | |
val red : color | |
val yellow : color | |
val orange : color | |
val blue : color | |
% val are : color * color -> color | |
val rgb-value : color -> (float * float * float) | |
val inner-color : color -> color -> float -> color | |
end = struct | |
let gray x = Gray(x) | |
let rgb r g b = RGB(r, g, b) | |
let html-color rgb = | |
let r = rgb / 65536 in | |
let g = (rgb - r * 65536) / 256 in | |
let b = rgb mod 256 in | |
RGB(float r /. 255. , float g /. 255. , float b /. 255.) | |
let rgb-value clr = | |
match clr with | |
| RGB(r, g, b) -> (r, g, b) | |
| Gray(z) -> (z, z, z) | |
| CMYK(c, m, y, k) -> (0., 0., 0.) | |
let inner-color clr1 clr2 r = | |
let (r1, g1, b1) = rgb-value clr1 in | |
let (r2, g2, b2) = rgb-value clr2 in | |
let inner-division f1 f2 r = f1 *. r +. f2 *. (1. -. r) in | |
RGB(inner-division r1 r2 r, inner-division g1 g2 r, inner-division b1 b2 r) | |
let black = gray 0. | |
let white = gray 1. | |
let red = rgb 1. 0. 0. | |
let yellow = rgb 1. 1. 0. | |
let orange = rgb 1. 0.5 0. | |
let blue = rgb 0. 0. 1. | |
end |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment