extra/flip-text/flip-text.factor

   1 ! Copyright (C) 2010 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: assocs kernel sequences ;
   5
   6 IN: flip-text
   7
   8 <PRIVATE
   9
  10 CONSTANT: CHARS H{
  11     { CHAR: A   0x2200 }
  12     { CHAR: B   0x10412 }
  13     { CHAR: C   0x03FD }
  14     { CHAR: D   0x15E1 }
  15     { CHAR: E   0x018E }
  16     { CHAR: F   0x2132 }
  17     { CHAR: G   0x2141 }
  18     ! { CHAR: H   CHAR: H }
  19     ! { CHAR: I   CHAR: I }
  20     { CHAR: J   0x148B }
  21     { CHAR: K   0x004B }
  22     { CHAR: L   0x2142 }
  23     { CHAR: M   CHAR: W   }
  24     ! { CHAR: N   CHAR: N }
  25     ! { CHAR: O   CHAR: O }
  26     { CHAR: P   0x0500 }
  27     { CHAR: Q   0x038C }
  28     { CHAR: R   0x1D1A }
  29     ! { CHAR: S   CHAR: S }
  30     { CHAR: T   0x22A5 }
  31     { CHAR: U   0x0548 }
  32     { CHAR: V   0x039B }
  33     { CHAR: W   CHAR: M   }
  34     ! { CHAR: X   CHAR: X }
  35     { CHAR: Y   0x2144 }
  36     ! { CHAR: Z   CHAR: Z }
  37     { CHAR: a   0x0250 }
  38     { CHAR: b   CHAR: q   }
  39     { CHAR: c   0x0254 }
  40     { CHAR: d   CHAR: p   }
  41     { CHAR: e   0x01DD }
  42     { CHAR: f   0x025F }
  43     { CHAR: g   0x1D77 } ! or 0183
  44     { CHAR: h   0x0265 }
  45     { CHAR: i   0x1D09 } ! or 0131
  46     { CHAR: j   0x027E } ! or 1E37
  47     { CHAR: k   0x029E }
  48     { CHAR: l   0x0283 } ! or 237
  49     { CHAR: m   0x026F }
  50     { CHAR: n   CHAR: u   }
  51     ! { CHAR: o   CHAR: o }
  52     { CHAR: p   CHAR: d   }
  53     { CHAR: q   CHAR: b   }
  54     { CHAR: r   0x0279 }
  55     ! { CHAR: s   CHAR: s }
  56     { CHAR: t   0x0287 }
  57     { CHAR: u   CHAR: n   }
  58     { CHAR: v   0x028C }
  59     { CHAR: w   0x028D }
  60     { CHAR: y   0x028E }
  61     ! { CHAR: z   CHAR: z }
  62     ! { CHAR: 0   CHAR: 0 }
  63     { CHAR: 1   0x21C2 }
  64     { CHAR: 2   0x1105 }
  65     { CHAR: 3   0x0190 } ! or 1110
  66     { CHAR: 4   0x152D }
  67     ! { CHAR: 5   CHAR: 5 }
  68     { CHAR: 6   CHAR: 9   }
  69     { CHAR: 7   0x2C62 }
  70     ! { CHAR: 8   CHAR: 8 }
  71     { CHAR: 9   CHAR: 6   }
  72     { CHAR: &   0x214B }
  73     { CHAR: !   0x00A1 }
  74     { CHAR: "   0x201E }
  75     { CHAR: .   0x02D9 }
  76     { CHAR: ;   0x061B }
  77     { CHAR: [   CHAR: ]   }
  78     { CHAR: (   CHAR: )   }
  79     { CHAR: {   CHAR: }   }
  80     { CHAR: ?   0x00BF }
  81     { CHAR: !   0x00A1 }
  82     { CHAR: '   CHAR: ,   }
  83     { CHAR: <   CHAR: >   }
  84     { CHAR: _   0x203E }
  85     { 0x203F 0x2040 }
  86     { 0x2045 0x2046 }
  87     { 0x2234 0x2235 }
  88     { CHAR: \r CHAR: \n   }
  89 }
  90
  91 CHARS [ CHARS set-at ] assoc-each
  92
  93 : ch>flip ( ch -- ch' )
  94     dup CHARS at [ nip ] when* ;
  95
  96 PRIVATE>
  97
  98 : flip-text ( str -- str' )
  99     [ ch>flip ] map reverse ;
 100
 101