1 module Rakka.Wiki.Interpreter.Image
10 import Rakka.SystemConfig
11 import Rakka.Wiki.Interpreter
15 interpreters :: [Interpreter]
16 interpreters = [ imageInterp
21 -- <img src="[PageName]"
22 -- alt="[Alternative]" -- 省略可能
23 -- link="[PageName]" -- 省略可能、省略時は画像そのものへのリンク
24 -- link="[Absolute URI]" -- 絶對 URI の場合はその URI へのリンク
25 -- link="" /> -- 空文字列の場合はリンク無し
27 -- <a href="..." class="inlineImage ...">
28 -- <img src="..." alt="..." />
30 imageInterp :: Interpreter
32 = InlineCommandInterpreter {
35 = \ ctx (InlineCommand _ attrs _) ->
36 do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
38 let name = case lookup "src" attrs of
40 Nothing -> error "\"src\" attribute is missing"
41 link = case lookup "link" attrs of
43 Just x -> if isURI x then
46 Just (uriToString id (mkPageURI baseURI x) "")
47 Nothing -> Just (uriToString id (mkPageURI baseURI name) "")
48 alt = lookup "alt" attrs
49 classAttr = case lookup "float" attrs of
50 Nothing -> "inlineImage"
51 Just "left" -> "inlineImage leftFloat"
52 Just "right" -> "inlineImage rightFloat"
53 Just others -> error ("unknown \"float\" attribute: " ++ others)
55 Nothing -> Span [("class", classAttr)] [Image (Right name) alt]
56 Just x -> Anchor [ ("class", classAttr)
57 , ("href" , x ) ] [Image (Right name) alt]
62 -- <div class="imageFrame ...">
63 -- <div class="imageData">
68 -- <div class="imageCaption">
72 imgFrameInterp :: Interpreter
74 = BlockCommandInterpreter {
77 = \ ctx (BlockCommand _ attrs inside) ->
78 do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
80 let name = case lookup "src" attrs of
82 Nothing -> error "\"src\" attribute is missing"
83 link = case lookup "link" attrs of
85 Just x -> if isURI x then
88 Just (uriToString id (mkPageURI baseURI x) "")
89 Nothing -> Just (uriToString id (mkPageURI baseURI name) "")
90 classAttr = case lookup "float" attrs of
91 Nothing -> ("class", "imageFrame")
92 Just "left" -> ("class", "imageFrame leftFloat")
93 Just "right" -> ("class", "imageFrame rightFloat")
94 Just others -> error ("unknown \"float\" attribute: " ++ others)
96 Nothing -> Image (Right name) Nothing
97 Just x -> Anchor [("href" , x)] [Image (Right name) Nothing]
99 return (Div [classAttr]
100 [ Block (Div [("class", "imageData")]
102 , Block (Div [("class", "imageCaption")]
103 [ Block x | x <- inside ])