mediawiki2latex-7.6: src/Font.hs

import Data.Tuple
import BaseFont
import Data.Maybe
import Control.Monad
import Data.Array
import Data.Char
import System.Cmd



findfont::[Font]->[Font]->Font
findfont (x:xs) f= if x `elem` f then x else findfont f xs
findfont [] f= GnuUnifont


getArray::Font->IO (Array Int Bool)
getArray f = do _<-system ("python font.py "++(getttf f)++"> "++name)
                text<-readFile filename
                return $ array (0,(length text) -1) (zip [0..((length text) -1)] (zt text))
  where
    zt::[Char]->[Bool]
    zt text=(map fun (zip [0..] text))
    fun::(Int,Char)->Bool 
    fun (_,'T') = True
    fun (i,_) = (chr i) `elem` "\n\r\t " 
    name=takeWhile (/='.') filename
    ext =dropWhile (/='.') filename
    filename = reverse ((takeWhile (/='/')) (reverse (getttf f)))
 



itbf s= [FontStyle{stylebase=s,bold=False,italic=False},FontStyle{stylebase=s,bold=True,italic=False},FontStyle{stylebase=s,bold=False,italic=True},FontStyle{stylebase=s,bold=True,italic=True}]

stylebasenext::FontStyleBase->FontStyleBase
stylebasenext Normal = Mono
stylebasenext Mono = Smallcaps
stylebasenext Smallcaps = Normal

styles =(itbf Normal)++(itbf Mono)++(itbf Smallcaps)

myfun as i fs = [f|(f,b)<-zip fonts (map (!i) as),b&&(fs==getstyle f)]

getdata::[Array Int Bool]->Int-> [([Font],FontStyle)]
getdata as i = zip (map (myfun as i) styles) styles


main = jjj

jjj = do arrs<-mapM getArray fonts
         let chrs=array (0,2^16-1) (zip [0..2^16-1] (map (getdata arrs) [0..2^16-1]))  
         print [(s, map (fromFontToChar.f) [0..2^16-1])|(s,f)<-zip styles (map  (getFont chrs) styles)] 




getFont::Array Int [([Font],FontStyle)]->FontStyle->Int->Font
getFont chars fontStyle i = if (mi<=i) && (i<=mx) then getf else def 
  where
    (mi,mx) = bounds chars
    def = GnuUnifont
    ch= chars!i
    swp = map swap ch
    ff sty = (lookup sty swp)
    gg sty = (ff sty) `mplus` (ff sty{italic= not (italic sty)}) `mplus` (ff sty{bold= not (bold sty)}) `mplus` (ff sty{italic= not (italic sty),bold= not (bold sty)})
    hh sty = (gg sty) `mplus` (gg sty{stylebase= stylebasenext .stylebase $sty}) `mplus` (gg sty{stylebase= stylebasenext.stylebasenext.stylebase$ sty})
    getf = fromMaybe def ((hh fontStyle)>>=return.(findfont fonts) )

module Main (main) where