update packages 'mdja' etc.

lib-satysfi/dist/md/mdja.satysfi-md

@@ -27,5 +27,6 @@
   "code": [
   ],
   "code-default": "\\code",
+  "url": "\\link",
   "err-inline": "\\error"
 }

lib-satysfi/dist/packages/gr.satyh

@@ -7,6 +7,8 @@ module Gr : sig
   val rectangle : point -> point -> path
   val rectangle-round       : length -> point -> point -> path
   val rectangle-round-left  : length -> point -> point -> path
+  val rectangle-round-left-lower : length -> point -> point -> path
+  val rectangle-round-left-upper : length -> point -> point -> path
   val rectangle-round-right : length -> point -> point -> path
   val poly-line : point -> point list -> path
   val polygon : point -> point list -> path
@@ -60,6 +62,34 @@ end = struct
         |> close-with-line
 
 
+  let rectangle-round-left-lower r (xA, yA) (xB, yB) =
+    let t = r *' 0.4 in
+    let x1 = length-min xA xB in
+    let x2 = length-max xA xB in
+    let y1 = length-min yA yB in
+    let y2 = length-max yA yB in
+      start-path                                 (x1, y1 +' r)
+        |> bezier-to (x1, y1 +' t) (x1 +' t, y1) (x1 +' r, y1)
+        |> line-to                               (x2, y1)
+        |> line-to                               (x2, y2)
+        |> line-to                               (x1, y2)
+        |> close-with-line
+
+
+  let rectangle-round-left-upper r (xA, yA) (xB, yB) =
+    let t = r *' 0.4 in
+    let x1 = length-min xA xB in
+    let x2 = length-max xA xB in
+    let y1 = length-min yA yB in
+    let y2 = length-max yA yB in
+      start-path                                 (x1, y1)
+        |> line-to                               (x2, y1)
+        |> line-to                               (x2, y2)
+        |> line-to                               (x1 +' r, y2)
+        |> bezier-to (x1 +' t, y2) (x1, y2 -' t) (x1, y1 -' t)
+        |> close-with-line
+
+
   let rectangle-round-right r (xA, yA) (xB, yB) =
     let t = r *' 0.4 in
     let x1 = length-min xA xB in

lib-satysfi/dist/packages/mdja.satyh

@@ -26,6 +26,7 @@ module MDJa : sig
   direct \code : [string] inline-cmd
   direct \emph : [inline-text] inline-cmd
   direct \bold : [inline-text] inline-cmd
+  direct \link : [string; inline-text] inline-cmd
   direct \hard-break : [] inline-cmd
   direct \error : [string] inline-cmd
 end = struct
@@ -49,6 +50,7 @@ end = struct
   let font-latin-roman  = (`Junicode`   , 1., 0.)
   let font-latin-italic = (`Junicode-it`, 1., 0.)
   let font-latin-sans   = (`lmsans`     , 1., 0.)
+  let font-latin-mono   = (`lmmono`     , 1., 0.)
 
   let font-cjk-gothic = (`ipaexg`, font-ratio-cjk, 0.)
   let font-cjk-mincho = (`ipaexm`, font-ratio-cjk, 0.)
@@ -182,7 +184,7 @@ end = struct
 
 
   let-block ctx +p it =
-    let indent-size = get-quad-size ctx in
+    let indent-size = 0pt in % get-quad-size ctx in
     line-break true true ctx
       (inline-skip indent-size ++ read-inline ctx it ++ inline-fil)
 
@@ -206,8 +208,8 @@ end = struct
 
   let-block ctx +quote it =
     let qsize = get-quad-size ctx in
-    let pads = (qsize *' 2., 0pt, 0pt, 0pt) in
-    let decoset = VDecoSet.empty in
+    let pads = (qsize, 0pt, 0pt, 0pt) in
+    let decoset = VDecoSet.quote-round 6pt 4pt (Gray(0.75)) in
     block-frame-breakable ctx pads decoset
       (fun ctx -> read-block ctx it)
 
@@ -235,6 +237,18 @@ end = struct
     {\Code.code(s);}
 
 
+  let-inline ctx \url s =
+    let ctx =
+      ctx |> set-latin-font font-latin-mono
+          |> set-cjk-font font-cjk-gothic
+    in
+    read-inline ctx (embed-string s)
+
+
+  let-inline \link s it =
+    {#it;(\url(s);)}
+
+
   let-inline ctx \hard-break =
     mandatory-break ctx
 

lib-satysfi/dist/packages/vdecoset.satyh

@@ -7,6 +7,7 @@ module VDecoSet : sig
   val simple-frame-stroke : length -> color -> deco-set
   val simple-frame : length -> color -> color -> deco-set
   val paper : deco-set
+  val quote-round : length -> length -> color -> deco-set
 
 end = struct
 
@@ -135,4 +136,23 @@ end = struct
     in
     (decoS, decoH, decoM, decoT)
 
+
+  let quote-round qw r color =
+    let decoS (x, y) _ h d =
+      [ fill color (Gr.rectangle-round-left r
+          (x, y -' d) (x +' qw, y +' h)); ]
+    in
+    let decoH (x, y) _ h d =
+      [ fill color (Gr.rectangle-round-left-upper r
+          (x, y -' d) (x +' qw, y +' h)); ]
+    in
+    let decoM (x, y) _ h d =
+      [ fill color (Gr.rectangle (x, y -' d) (x +' qw, y +' h)); ]
+    in
+    let decoT (x, y) _ h d =
+      [ fill color (Gr.rectangle-round-left-lower r
+          (x, y -' d) (x +' qw, y +' h)); ]
+    in
+    (decoS, decoH, decoM, decoT)
+
 end