1 module Rakka.Wiki.Interpreter.Image
8 import Rakka.SystemConfig
9 import Rakka.Wiki.Interpreter
13 interpreters :: [Interpreter]
14 interpreters = [ imageInterp
19 -- <img src="[PageName]"
20 -- alt="[Alternative]" -- 省略可能
21 -- link="[PageName]" -- 省略可能、省略時は画像そのものへのリンク
22 -- link="[Absolute URI]" -- 絶對 URI の場合はその URI へのリンク
23 -- link="" /> -- 空文字列の場合はリンク無し
25 -- <a href="..." class="inlineImage ...">
26 -- <img src="..." alt="..." />
28 imageInterp :: Interpreter
30 = InlineCommandInterpreter {
33 = \ ctx (InlineCommand _ attrs _) ->
34 do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
36 let name = case lookup "src" attrs of
38 Nothing -> error "\"src\" attribute is missing"
39 link = case lookup "link" attrs of
41 Just x -> if isURI x then
44 Just (uriToString id (mkPageURI baseURI x) "")
45 Nothing -> Just (uriToString id (mkPageURI baseURI name) "")
46 alt = lookup "alt" attrs
47 classAttr = case lookup "float" attrs of
48 Nothing -> "inlineImage"
49 Just "left" -> "inlineImage leftFloat"
50 Just "right" -> "inlineImage rightFloat"
51 Just others -> error ("unknown \"float\" attribute: " ++ others)
53 Nothing -> Span [("class", classAttr)] [Image (Right name) alt]
54 Just x -> Anchor [ ("class", classAttr)
55 , ("href" , x ) ] [Image (Right name) alt]
60 -- <div class="imageFrame ...">
61 -- <div class="imageData">
66 -- <div class="imageCaption">
70 imgFrameInterp :: Interpreter
72 = BlockCommandInterpreter {
75 = \ ctx (BlockCommand _ attrs inside) ->
76 do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
78 let name = case lookup "src" attrs of
80 Nothing -> error "\"src\" attribute is missing"
81 link = case lookup "link" attrs of
83 Just x -> if isURI x then
86 Just (uriToString id (mkPageURI baseURI x) "")
87 Nothing -> Just (uriToString id (mkPageURI baseURI name) "")
88 classAttr = case lookup "float" attrs of
89 Nothing -> ("class", "imageFrame")
90 Just "left" -> ("class", "imageFrame leftFloat")
91 Just "right" -> ("class", "imageFrame rightFloat")
92 Just others -> error ("unknown \"float\" attribute: " ++ others)
94 Nothing -> Image (Right name) Nothing
95 Just x -> Anchor [("href" , x)] [Image (Right name) Nothing]
97 return (Div [classAttr]
98 [ Block (Div [("class", "imageData")]
100 , Block (Div [("class", "imageCaption")]
101 [ Block x | x <- inside ])