@@ 1,7 1,8 @@
{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.Preprocessor.Text.CounterStyle(CounterStyle(..), CounterSystem(..),
- defaultCounter, decimalCounter, isValid, parseCounterStyle, CounterStore'(..),
- counterRender, counterRenderMarker, ranges', speakAs', parseCounter) where
+ defaultCounter, decimalCounter, simpChineseInformal, cjkDecimal,
+ isValid, parseCounterStyle, CounterStore'(..), parseCounter,
+ counterRender, counterRenderMarker, ranges', speakAs') where
import Data.CSS.Syntax.Tokens
import Data.CSS.Syntax.StyleSheet
@@ 26,10 27,10 @@ data CounterStyle = CounterStyle {
additiveSymbols :: [(Int, Text)],
speakAs :: Maybe Text
}
-data CounterSystem =
- Cyclic | Fixed Int | Symbolic | Alphabetic | Numeric | Additive
+data CounterSystem = Cyclic | Fixed Int | Symbolic | Alphabetic | Numeric
+ | Additive | Chinese { isSimplified :: Bool }
-defaultCounter, decimalCounter :: CounterStyle
+defaultCounter, decimalCounter, simpChineseInformal, cjkDecimal :: CounterStyle
defaultCounter = CounterStyle {
system = Symbolic,
negativePrefix = "-",
@@ 49,9 50,27 @@ decimalCounter = defaultCounter {
symbols = ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"],
fallback = Nothing
}
+-- These are here mostly for testing...
+cjkDecimal = defaultCounter {
+ system = Numeric,
+ ranges = Just [(0, maxBound)],
+ symbols = ["〇", "一", "二", "三", "四", "五", "六", "七", "八", "九"],
+ suffix = "、"
+}
+simpChineseInformal = defaultCounter {
+ system = Chinese True,
+ negativePrefix = "负",
+ symbols = ["零", "一", "二", "三", "四", "五", "六", "七", "八", "九"],
+ additiveSymbols = [(0, ""), (10, "十"), (100, "百"), (1000, "千")],
+ suffix = "、",
+ fallback = Just cjkDecimal
+}
isValid :: CounterStyle -> Bool
isValid CounterStyle { system = Additive, additiveSymbols = [] } = False
+isValid self@CounterStyle {
+ system = Chinese _, symbols = syms, additiveSymbols = markers
+ } = length syms == 10 && length markers >= 4 && ranges self == Nothing
isValid CounterStyle { symbols = [] } = False
isValid _ = True
@@ 68,6 87,8 @@ parseCounterProperty _ ("system", [Ident "alphabetic"]) self =
self { system = Alphabetic }
parseCounterProperty _ ("system", [Ident "numeric"]) self =
self { system = Numeric }
+parseCounterProperty _ ("system", [Ident "-argo-chinese", Ident x]) self =
+ self { system = Chinese (x == "simplified") }
-- Handled by caller so property overrides work correctly.
parseCounterProperty _ ("system", [Ident "extends", Ident _]) self = self
@@ 198,15 219,43 @@ counterRenderCore CounterStyle { system = Additive, additiveSymbols = syms } w
reps = quot x weight
x' = x - weight * reps
inner [] _ = "\0" -- Run fallback counter!
+-- Following https://w3c.github.io/csswg-drafts/css-counter-styles-3/#limited-chinese
+-- 1. If the counter value is 0, the representation is the character for 0
+-- specified for the given counter style. Skip the rest of this algorithm.
+counterRenderCore CounterStyle { system = Chinese _, symbols = (sym:_) } 0 = sym
+counterRenderCore CounterStyle {
+ system = Chinese simplified, symbols = syms, additiveSymbols = markers
+ } x = Txt.concat $ map renderDigit $ collapse0s $
+ reverse $ enumerate $ decimalDigits x
+ where
+ -- Implements step 4.
+ collapse0s ((i, 0):digits) = inner digits
+ where
+ inner ((_, 0):digits') = inner digits'
+ -- Drop trailing 0s
+ inner [] = []
+ -- Collapse any remaining (consecutive?) zeroes into a single 0 digit.
+ inner digits' = (i, 0):collapse0s digits'
+ collapse0s (digit:digits) = digit:collapse0s digits
+ collapse0s [] = []
+ renderDigit (_, 0) = syms !! 0 -- Don't append digit marker for zero, step 2.
+ -- 3. For the informal styles, if the counter value is between 10 and 19,
+ -- remove the 10s digit (leave the digit marker).
+ renderDigit (1,1) | simplified, [_, _] <- decimalDigits x = markers' !! 1
+ -- Select characters per steps 2 & 5
+ renderDigit (place, digit) = Txt.concat [syms !! digit, markers' !! place]
+ markers' = map snd markers
+decimalDigits :: Int -> [Int]
+decimalDigits 0 = []
+decimalDigits x = rem x 10:decimalDigits (quot x 10)
+enumerate :: [a] -> [(Int, a)]
+enumerate = zip $ enumFrom 0
counterRenderMarker :: CounterStyle -> Int -> Text
counterRenderMarker = counterRender True
counterRender :: Bool -> CounterStyle -> Int -> Text
counterRender isMarker self x
- | isMarker && x < 0 = Txt.concat [prefix self, negativePrefix self,
- inner self $ -x, negativeSuffix self, suffix self]
| isMarker = Txt.concat [prefix self, inner self x, suffix self]
- | x<0 = Txt.concat [negativePrefix self,inner self $ -x,negativeSuffix self]
| otherwise = inner self x
where
inner :: CounterStyle -> Int -> Text
@@ 214,6 263,11 @@ counterRender isMarker self x
| not $ inRange x $ ranges' this = inner self' x'
| counterRenderCore this x == fallbackSym = inner self' x'
inner self' x'
+ | x' < 0 = Txt.concat [
+ negativePrefix self',
+ inner self' { fallback = Nothing } $ -x',
+ negativeSuffix self'
+ ]
| text == fallbackSym = Txt.pack $ show x' -- NOTE: Shouldn't happen
| n < padLength self' =
Txt.replicate (padLength self' - n) (padChar self') `Txt.append` text
@@ 236,6 290,7 @@ ranges' CounterStyle { system = Fixed _ } = infiniteRange
ranges' CounterStyle { system = Alphabetic } = [(1, maxBound)]
ranges' CounterStyle { system = Symbolic } = [(1, maxBound)]
ranges' CounterStyle { system = Additive } = [(0, maxBound)]
+ranges' CounterStyle { system = Chinese _ } = [(-9999, 9999)]
speakAs' :: CounterStyle -> Text
speakAs' CounterStyle { speakAs = Just ret } = ret
@@ 1047,3 1047,38 @@
additive-symbols: 1000 '\4D', 900 '\43\4D', 500 '\44', 400 '\43\44', 100 '\43', 90 '\58\43', 50 '\4C', 40 '\58\4C', 10 '\58', 9 '\49\58', 5 '\56', 4 '\49\56', 1 '\49';
/* additive-symbols: 1000 'M', 900 'CM', 500 'D', 400 'CD', 100 'C', 90 'XC', 50 'L', 40 'XL', 10 'X', 9 'IX', 5 'V', 4 'IV', 1 'I'; */
}
+
+/* Counters defined under https://w3c.github.io/csswg-drafts/css-counter-styles-3/#complex-predefined-counters
+ Uses special CSS extensions. */
+@counter-style simp-chinese-informal {
+ system: -argo-chinese simplified;
+ negative: 负;
+ symbols: 零 一 二 三 四 五 六 七 八 九;
+ additive-symbols: 0 "", 10 十, 100 百, 1000 千;
+ suffix: "、";
+ fallback: cjk-decimal;
+}
+@counter-style simp-chinese-formal {
+ system: -argo-chinese formal;
+ negative: 负;
+ symbols: 零 壹 贰 叁 肆 伍 陆 柒 捌 玖;
+ additive-symbols: 0 "", 10 拾, 100 佰, 1000 仟;
+ suffix: "、";
+ fallback: cjk-decimal;
+}
+@counter-style trad-chinese-informal {
+ system: -argo-chinese simplified;
+ negative: 負;
+ symbols: 零 一 二 三 四 五 六 七 八 九;
+ additive-symbols: 0 "", 10 十, 100 百, 1000 千;
+ suffix: "、";
+ fallback: cjk-decimal;
+}
+@counter-style trad-chinese-formal {
+ system: -argo-chinese formal;
+ negative: 負;
+ symbols: 零 壹 貳 參 肆 伍 陸 柒 捌 玖;
+ additive-symbols: 0 "", 10 拾, 100 佰, 1000 仟;
+ suffix: "、";
+ fallback: cjk-decimal;
+}