{-#LANGUAGE BangPatterns #-}
module Math.SelfAssembly.Baggins (
  Tile,Program,runProgram,execProgram,simulate,
  -- * Initialization
  seed,
  -- * Basic moves
  movex,movey,discreteVect,
  -- * Combinators
  repete,pump,
  -- * Rembering specific tile types - equivalents to formal "let".
  Cur(..),currentTile,nextTile,prevTile,
  -- * Editing and branching - equivalents to the formal "bind" and "from".
  Dir(..),bind,rewindBy,rewindTo,eraseAfter,
  -- * Coloring tiles - tile decorations
  Color,setColor,red,green,blue,black,
  -- * Debugging and output
  plot,PlotOptions(..),defaultPlot,
  traceTile,tikzPlot
  ) where

import Control.Monad.State
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.IntSet as S
import Graphics.Rendering.Cairo hiding(scale)
import Foreign.Storable
import Data.Bits(shiftL,shiftR,(.&.),(.|.))
import System.IO
import Numeric
import Debug.Trace

-- | The tile datatype
data Tile=Tile {n::Int, s::Int, o::Int, e::Int,color::(Double,Double,Double)} deriving (Eq,Show)

sortTile::M.Map Int Tile -> (M.Map Int [Int], M.Map Int [Int], M.Map Int [Int], M.Map Int [Int])
sortTile t=
  M.foldlWithKey' (\(mn,ms,mo,me) k a->
                    let { addm f m=
                             case M.lookup (f a) m of {
                               Nothing->M.insert (f a) [k] m;
                               Just x->M.insert (f a) (k:x) m
                               }
                        }
                    in
                     (addm n mn,addm s ms,addm o mo,addm e me)
                  )
  (M.empty,M.empty,M.empty,M.empty) t


type Position=(Int,Int)
coup x y=(x,y)--(x`shiftL`(intlen*4)) .|. y;
uncoup p=p -- (p`shiftR`(intlen*4), p .&. ((1`shiftL`(intlen*4) - 1)));
incrx p=let (x,y)=uncoup p in coup (x+1) y
incry p=let (x,y)=uncoup p in coup x (y+1)
decrx p=let (x,y)=uncoup p in coup (x-1) y
decry p=let (x,y)=uncoup p in coup x (y-1)


posLookup=M.lookup
posInsert=M.insert
posFindWithDefault=M.findWithDefault
posFromList=M.fromList
posFoldlWithKey'=M.foldlWithKey'

-- | @simulate file margin w h showGlues seeds tiles@ simulates the given
-- tileset, with seeds at the given positions @(x,y,type)@, and
-- returns the maximal manhattan distance reached. The @showGlues@
-- argument indicates whether glues should be written in the output
-- file (results in bigger files).
simulate::Int->Int->[(Int,Int,Int)]->[(Int,Int)]->M.Map Int Tile->
          IO (Int,Int,Int,Int,M.Map Position Int)
simulate nw nh seeds blockers tiles_=do {
  let { (nn,ss,oo,ee)=sortTile tiles_;
        intlen=sizeOf (0::Int);
        coup x y=(x,y);--(x`shiftL`(intlen*4)) .|. y;
        uncoup p=p; -- (p`shiftR`(intlen*4), p .&. ((1`shiftL`(intlen*4) - 1)));
        incrx p=let (x,y)=uncoup p in coup (x+1) y;
        incry p=let (x,y)=uncoup p in coup x (y+1);
        decrx p=let (x,y)=uncoup p in coup (x-1) y;
        decry p=let (x,y)=uncoup p in coup x (y-1);
      };
  -- grid : positions remplies, p: position à considérer pour placer une tuile
  let { simu !x0 !y0 !x1 !y1 grid []=return (x0,y0,x1,y1,grid);
        simu !x0 !y0 !x1 !y1 grid (p:tl)=
          if any (==p) blockers then simu x0 y0 x1 y1 grid tl else do {
          let { (x,y)=uncoup p };
          case posLookup p grid>>=(\t->M.lookup t tiles_)  of {
            Nothing->simu (min x x0) (min y y0) (max x x1) (max y y1) grid tl;
            Just tt->do {
              let { deterministe l@(_:_:_)=
                       putStrLn $ "Non-deterministic choice at position "++show (x,y)++": "
                       ++show (map (\u->M.lookup u tiles_) l);
                    deterministe _=return () };
              (nt,gr0)<-if y>=(nh-1) then return ([],grid) else do {
                let { pos=case posLookup (incry p) grid of {
                         Nothing->posFindWithDefault [] (n tt) ss;
                         _->[]
                         }
                    };
                deterministe pos;
                case pos of {
                  []->return ([],grid);
                  (hh:_)->return ([(incry p)], posInsert (incry p) hh grid)
                  }
                };
              (st,gr1)<-if y<1 then return (nt,gr0) else do {
                let { pos=case posLookup (decry p) gr0 of {
                         Nothing->posFindWithDefault [] (s tt) nn;
                         _->[]
                         }
                    };
                deterministe pos;
                case pos of {
                  []->return (nt,gr0);
                  (hh:_)->return ((decry p):nt, posInsert (decry p) hh gr0)
                  }
                };
              (et,gr2)<-if x>=(nw-1) then return (st,gr1) else do {
                let { pos=case posLookup (incrx p) gr1 of {
                         Nothing->posFindWithDefault [] (e tt) oo;
                         _->[]
                         }
                    };
                deterministe pos;
                case pos of {
                  []->return (st,gr1);
                  (hh:_)->return ((incrx p):st, posInsert (incrx p) hh gr1)
                  }
                };
              (ot,gr3)<-if x<1 then return (et,gr2) else do {
                let { pos=case posLookup (decrx p) gr2 of {
                         Nothing->posFindWithDefault [] (o tt) ee;
                         _->[]
                         }
                    };
                deterministe pos;
                case pos of {
                  []->return (et,gr2);
                  (hh:_)->return ((decrx p):et, posInsert (decrx p) hh gr2)
                  }
                };
              simu (min x0 x) (min y0 y) (max x1 x) (max y1 y) gr3 $!
              tl++reverse ot
              };
            };
          }
      };
  simu nw nh 0 0 (posFromList [(coup a b,c)|(a,b,c)<-seeds]) [coup a b | (a,b,_)<-seeds];
  }

data PlotOptions=Plot { showGlues::Bool, showPaths::Bool, offset::Double, scale::Double, font::String, fontSize::Double }
defaultPlot=Plot { showGlues=True,offset=100,showPaths=False,scale=0.1, font="Arial",fontSize=0.18 }

plot::FilePath->PlotOptions->M.Map Int Tile->M.Map Position Int->IO()
plot file opts tiles_ grid=do {
  let { scal=scale opts;
        off=offset opts;
        (nw,nh)=M.foldlWithKey (\(x,y) (x',y') _->(max x x',max y y')) (0,0) grid;
        (w0,h0)=M.foldlWithKey (\(x,y) (x',y') _->(min x x',min y y')) (nw,nh) grid;
        h=(fromIntegral $ nh-h0+1)*scal+2*off;
        w=(fromIntegral $ nw-w0+1)*scal+2*off };
  withPDFSurface file w h $ \surface->renderWith surface $ do {
    translate (-fromIntegral w0*scal) (fromIntegral h0*scal);
    selectFontFace (font opts) FontSlantNormal FontWeightNormal;
    setFontSize $ fontSize opts*scal;
    let { drawPicture pos tt tset=do {
             let { (x,y)=uncoup pos };
             case M.lookup tt tiles_ of {
               Nothing->return ();
               Just t->do {
                 let {(a,b,c)=color t} in
                 {-
                 let {hue=(fromIntegral $ M.findIndex tt tiles_) / (fromIntegral $ M.size tiles_);
                      sat=0.9;
                      val=0.8;
                      col=hsv (360*hue) sat val;
                      a=channelRed col;b=channelGreen col;c=channelBlue col };
-}
                 setSourceRGB a b c;
                 rectangle (off+scal*fromIntegral x)
                 (h-off-scal - scal*fromIntegral y)
                 scal scal;
                 closePath;
                 setLineWidth 0.01;
                 stroke;
                 if showGlues opts then do {
                   let {glueN=if n t<0 then "" else show $ n t;
                        glueS=if s t<0 then "" else show $ s t;
                        glueE=if e t<0 then "" else show $ e t;
                        glueO=if o t<0 then "" else show $ o t};
                   ten<-textExtents glueN;
                   tes<-textExtents glueS;
                   tee<-textExtents glueE;
                   teo<-textExtents glueO;
                   if showPaths opts then do {
                     setLineWidth 1;
                     if (n t>=0 && s t>=0) || (e t>=0 && o t>=0) then do {
                       (toN,toS)<-
                          if n t>=0 && s t>=0 then do {
                            moveTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(fromIntegral y));
                            lineTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1+fromIntegral y));
                            return (False,False);
                            } else return (n t>=0,s t>=0);
                       (toE,toO)<-if e t>=0 && o t>=0 then do {
                         moveTo (off+scal*(fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         lineTo (off+scal*(1+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         return (False,False)
                         } else return (e t>=0, o t>=0);
                       if toN then do {
                         moveTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         lineTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1+fromIntegral y));
                         } else return ();
                       if toS then do {
                         moveTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         lineTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(fromIntegral y));
                         } else return ();
                       if toE then do {
                         moveTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         lineTo (off+scal*(1+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         } else return ();
                       if toO then do {
                         moveTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         lineTo (off+scal*(fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                         } else return ();
                       } else do {
                       if s t>=0 then
                         moveTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(fromIntegral y))
                       else
                         if n t>=0 then
                           moveTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1+fromIntegral y))
                         else
                           if e t>=0 then
                             moveTo (off+scal*(1+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y))
                           else
                             if o t>=0 then
                               moveTo (off+scal*(fromIntegral x)) (h-off-scal*(1/2+fromIntegral y))
                             else
                               return (); -- n'arrive jamais
                       lineTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y));
                       if e t>=0 then
                         lineTo (off+scal*(1+fromIntegral x)) (h-off-scal*(1/2+fromIntegral y))
                       else
                         if o t>=0 then
                           lineTo (off+scal*(fromIntegral x)) (h-off-scal*(1/2+fromIntegral y))
                         else
                           if n t>=0 then
                             lineTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(1+fromIntegral y))
                           else
                             if s t>=0 then
                               lineTo (off+scal*(1/2+fromIntegral x)) (h-off-scal*(fromIntegral y))
                             else
                               return (); -- n'arrive jamais
                       };
                       stroke;
                     setLineWidth 0.01;
                   } else return ();
                   moveTo (off+scal*(1/2+fromIntegral x)-textExtentsWidth ten/2)
                   (h-off-scal-scal*fromIntegral y+textExtentsHeight ten+0.1*scal);
                   showText glueN;

                   let { yoff=textExtentsYbearing tes+textExtentsHeight tes };
                   moveTo (off+scal*(1/2+fromIntegral x)-textExtentsWidth tes/2)
                   (h-off-scal-scal*(fromIntegral y-1) - yoff-0.1*scal);
                   showText glueS;

                   save;
                   --
                   moveTo (off+scal*(fromIntegral x)) (h-off-scal-scal*(fromIntegral y-1/2));
                   rotate $ -pi/2;
                   (cx,cy)<-getCurrentPoint;
                   moveTo (cx-textExtentsWidth teo/2) (cy+textExtentsHeight teo+0.1*scal);
                   showText glueO;
                   --
                   moveTo (cx-textExtentsWidth tee/2) (cy+scal-0.1*scal);
                   showText glueE;
                   --
                   restore;
                   } else return ()
                 };
               };
             return $ if tt>=0 then S.insert tt tset else tset
             }
        };
    tset<-posFoldlWithKey' (\m k a->do {
                              m_<-m;
                              drawPicture k a m_
                              }) (return S.empty) grid;
    if S.size tset < M.size tiles_ then
      liftIO $ putStrLn $ "Warning: only "++show (S.size tset)++" out of "++
      show (M.size tiles_)++" tiles used"
    else return ();
    };
  }

defaultTile::Tile
defaultTile=Tile { n= -1,s= -2, o= -1, e= -2, color=(0,0,0) }

-- lastGlue est la dernière glue utilisée
data St=State { lastGlue::Int, tiles::M.Map Int Tile, lastTile::Maybe Int, curColor::Color,
                seeds::[(Int,Int,Int)] }
       --deriving Show
empty::St
empty=State { lastGlue=0,tiles=M.empty,lastTile=Nothing, curColor=black,seeds=[] }
type Program=State St


-- | Adds a new seed to the program, at the given position. There may
-- be several seeds, and they will all be placed before anything else
-- is grown.
seed::Int->Int->Program ()
seed x y=do
  st<-get
  let s=if M.null $ tiles st then 0 else (1+(fst $ M.findMax $ tiles st))
  put $ st { seeds=(x,y,s):seeds st,
             lastTile=Just s,
             tiles=M.insert s defaultTile $ tiles st }

move_::Bool->Int->Program ()
move_ vertical m=do
  st<-get
  let (lg,tiles0,connected)=case lastTile st of {
        Nothing->(lastGlue st,tiles st,False);
        Just x->case M.lookup x $ tiles st of {
          Nothing->(lastGlue st,tiles st,False);
          Just y->
            if vertical then
              if m>=0 then
                (if n y<0 then lastGlue st+1 else n y,
                 M.insert x (y { n=if n y<0 then lastGlue st+1 else n y }) $ tiles st,
                 True)
              else
                (if s y<0 then lastGlue st+1 else s y,
                 M.insert x (y { s=if s y<0 then lastGlue st+1 else s y }) $ tiles st,
                 True)
            else
              if m>=0 then
                (if e y<0 then lastGlue st+1 else e y,
                M.insert x (y { e=if e y<0 then lastGlue st+1 else e y }) $ tiles st,
                True)
              else
                (if o y<0 then lastGlue st+1 else o y,
                 M.insert x (y { o=if o y<0 then lastGlue st+1 else o y }) $ tiles st,
                 True)
          }
        }
      t=if vertical then
          if m>=0 then
            [ defaultTile { n=if i==(lg+m-1) then (-1) else i+1,
                            s=if i==lg && not connected then (-2) else i,
                            color=curColor st } | i<-[lg..(lg+m-1)] ]
          else
            [ defaultTile { s=if i==(lg-m-1) then (-2) else i+1,
                            n=if i==lg && not connected then (-1) else i,
                            color=curColor st } | i<-[lg..(lg-m-1)] ]
        else
          if m>=0 then
            [ defaultTile { e=if i==(lg+m-1) then (-2) else i+1,
                            o=if i==lg && not connected then (-1) else i,
                            color=curColor st } | i<-[lg..(lg+m-1)] ]
          else
            [ defaultTile { o=if i==(lg-m-1) then (-1) else i+1,
                            e=if i==lg && not connected then (-2) else i,
                            color=curColor st } | i<-[lg..(lg-m-1)] ]
      nextTiles=foldl (\ts x->M.insert (if M.null ts then 0 else (1+fst (M.findMax ts))) x ts)
                tiles0 t

  put $ st { lastGlue=lg+abs m-1,
             lastTile=if M.null nextTiles then Nothing else (Just $ fst $ M.findMax nextTiles),
             tiles=nextTiles }

-- | Move by 1 tile along the y-axis
movey::Int->Program ()
movey=move_ True

-- | Move by 1 tile along the x-axis
movex::Int->Program ()
movex=move_ False

repeat_::Int->Program ()->Program ()
repeat_ k m=if k<=0 then return () else do
  m
  repeat_ (k-1) m

-- | Repeat a program a given number of times. If the original program
-- produces @n@ tile types, then repeating it @t@ times produces @mt@
-- tile types.
repete::Int->Program ()->Program ()
repete a b=do {
  st0<-get;
  repeat_ a b;
  st1<-get;
  put $ st1 { curColor=curColor st0 }
}

-- | Approximates a discrete vector, by walking as close as possible
-- to the corresponding straight line.
discreteVect::Int->Int->Program ()
discreteVect x0 y0=
  let disc x y=
        if x0==x then movey (y0-y) else
          if y0==y then movex (x0-x) else
            let xf=(fromIntegral x0/fromIntegral y0)*(fromIntegral y)
                xx0=(fromIntegral x0/fromIntegral y0)*(fromIntegral (y+1))::Double
            in
             if (abs $ xf-fromIntegral (x+1)) <= (abs $ fromIntegral x-xx0) then
              if x0>x then do { movex 1; disc (x+1) y }
              else do { movex (-1); disc (x-1) y }
            else
              if y0>y then do { movey 1; disc x (y+1) }
              else do { movey (-1); disc x (y-1) }
  in
   disc 0 0

-- | Pump a given program, that is, allowing its first tile to attach
-- to its last tile. It is up to the user to check that this is
-- possible; the assembly is likely to stop else.
pump::Program ()->Program ()
pump m=do
  -- À priori, assembler m deux fois devrait suffire.  Mais il y a un
  -- cas particulier bizarre quand on commence à pomper dès la
  -- première tuile du programme, et on doit l'assembler trois fois,
  -- puis conserver l'assemblage du milieu.
  st0<-get
  m
  st1<-get
  put $ st1 { lastGlue=lastGlue st0 }
  m
  st2<-get
  put $ st2 { lastGlue=lastGlue st0 }
  m
  st3<-get
  let { (max0,_)=M.findMax $ tiles st0;
        (max1,_)=M.findMax $ tiles st1;
        (max2,_)=M.findMax $ tiles st2;
        (m0,_)=M.split (max0+1) $ tiles st3;
        (_,m1)=M.split max1 $ tiles st3;
        (m2,_)=M.split (max2+1) m1;
        t=M.foldlWithKey' (\m3 k a->M.insert (k-max1+max0) a m3) m0 m2
      }
  put $ st3 { tiles=t,curColor=curColor st0,lastTile=Just $ fst $ M.findMax t }


-- | Tile colors
type Color=(Double,Double,Double)

red,green,blue,black::Color
red=(1,0,0)
green=(0,1,0)
blue=(0,0,1)
black=(0,0,0)

-- | Set the current color
setColor::Color->Program ()
setColor col=do
  st<-get
  put $ st { curColor=col }


newtype Cur=Cur Int

-- | Get the last tile placed (raises error if no tile has been placed).
currentTile::Program Cur
currentTile=do
  st<-get
  case lastTile st of
    Nothing->error "currentTile not defined"
    Just x->return $ Cur x

-- | Get the tile immediately following a given tile in program order.
nextTile::Cur->Program Cur
nextTile (Cur a)=do
  st<-get
  let (_,v)=M.split a $ tiles st
  if M.null v then error "no next tile defined" else return $ Cur $ fst $ M.findMin v

-- | Get the tile immediately following a given tile in program order.
prevTile::Cur->Program Cur
prevTile (Cur a)=do
  st<-get
  let (u,_)=M.split a $ tiles st
  if M.null u then error "no previous tile defined" else return $ Cur $ fst $ M.findMax u


-- | Go back to a specific tile.
rewindTo::Cur->Program ()
rewindTo (Cur t)=do
  st<-get
  put $ st { lastTile=Just t }

-- | Go back by the given amount of tile types.
rewindBy::Int->Program ()
rewindBy n0=if n0<0 then error "rewind by negative amount" else do
  st<-get
  if M.null $ tiles st then error "rewind on empty tileset" else do
    let { del i m k=
             if i<0 then k else
               let { ((a,_),m')=M.deleteFindMax m } in
               del (i-1) m' a;
          m0=case lastTile st of { Nothing->tiles st;
                                  Just a->fst $ M.partitionWithKey (\k _->k<=a) $ tiles st }
        }
    put $ st { lastTile=Just $ del n0 m0 0 }


-- | Directions, or sides of tiles
data Dir=N | S | O | E

-- | Binds the given tile to the given side of the current tile. This
-- function modifies the given tile if and only if the complementary
-- side was not used. This modification can result in unwanted
-- assemblies.
bind::Dir->Cur->Program ()
bind d (Cur t)=do
  st<-get
  case lastTile st of
    Nothing->return ()
    Just a->
      case (M.lookup a $ tiles st, M.lookup t $ tiles st) of
        (Just b, Just tt)->
          let (nextTiles,nextGlue)=case d of
                N->if s tt<0 then
                     (M.insert t (tt { s=lastGlue st+1 }) $
                      M.insert a (b { n=lastGlue st+1 }) $ tiles st,
                      lastGlue st+1)
                   else
                     (M.insert a (b { n=s tt }) $ tiles st,lastGlue st)
                S->if n tt<0 then
                     (M.insert t (tt { n=lastGlue st+1 }) $
                      M.insert a (b { s=lastGlue st+1 }) $ tiles st,
                      lastGlue st+1)
                   else
                     (M.insert a (b { s=n tt }) $ tiles st,lastGlue st)
                O->if e tt<0 then
                     (M.insert t (tt { e=lastGlue st+1 }) $
                      M.insert a (b { o=lastGlue st+1 }) $ tiles st,
                      lastGlue st+1)
                   else
                     (M.insert a (b { o=e tt }) $ tiles st,lastGlue st)
                E->if o tt<0 then
                     (M.insert t (tt { o=lastGlue st+1 }) $
                      M.insert a (b { e=lastGlue st+1 }) $ tiles st,
                      lastGlue st+1)
                   else
                     (M.insert a (b { e=o tt }) $ tiles st,lastGlue st)
          in
           put $ st { tiles=nextTiles, lastGlue=nextGlue }
        _->return ()

-- | Delete every tile produced after the given tile. Mostly useful in
-- combination with 'currentTile'.
eraseAfter::Cur->Program ()
eraseAfter (Cur a)=do
  st<-get
  put $ st { tiles=fst $ M.split (a+1) $ tiles st }

-- | Run the program, returning its return value, along with the produced tileset.
runProgram::Program a->(a,[(Int,Int,Int)],M.Map Int Tile)
runProgram p=
  let (a,b)=runState p empty in
  (a,seeds b,tiles b)

-- | Run the program, returning the produced tileset.
execProgram::Program ()->([(Int,Int,Int)],M.Map Int Tile)
execProgram p=
  let st=execState p empty in (seeds st,tiles st)


traceTile (Cur t)=do
  st<-get
  traceShow (M.lookup t $ tiles st) $ return ()


tikzTile::Tile->Double->Double->Double->String
tikzTile t sc x y=
  "\\draw"++show (sc*x,sc*y)++"rectangle"++(show $ (sc*(x+1),sc*(y+1)))++";"++
  (if o t>=0 then
     "\\draw"++show (sc*x,sc*(y+0.5))++"node[anchor=west]{"++(show $ o t)++"};"
   else "")++
  (if n t>=0 then
     "\\draw"++show (sc*(x+0.5),sc*(y+1))++"node[anchor=north]{"++(show $ n t)++"};"
   else "")++
  (if e t>=0 then
     "\\draw"++show (sc*(x+1),sc*(y+0.5))++"node[anchor=east]{"++(show $ e t)++"};"
   else "")++
  (if s t>=0 then
     "\\draw"++show (sc*(x+0.5),sc*y)++"node[anchor=south]{"++(show $ s t)++"};"
   else "")


tikzPlot::FilePath->PlotOptions->M.Map Int Tile->M.Map Position Int->IO()
tikzPlot file opts tiles_ grid=
  withFile file WriteMode $ \h->do {
    let { s=scale opts / (10/fontSize opts);
          s0=scale opts;
          (x0,y0,x1,y1)=M.foldlWithKey (\(a,b,c,d) (x,y) _->(min a x,min b y,max c x,max d y)) (maxBound,maxBound,minBound,minBound) grid;
          showf (x,y)="("++showFFloat (Just 4) x (","++showFFloat (Just 4) y ")")
          };
    --hPutStr h "\\begin{tikzpicture}";
    hPutStr h $ "\\draw[use as bounding box,draw=none,fill=none]";
    hPutStr h $ showf (fromIntegral x0*s0,fromIntegral y0*s0);
    hPutStr h $ "rectangle";
    hPutStr h $ showf (fromIntegral (x1+1)*s0,fromIntegral (y1+1)*s0);
    hPutStr h $ ";\\begin{scope}[transform canvas={scale="++show (1*s)++"}]";
    mapM_ (\((x,y),t)->
            case M.lookup t tiles_ of {
              Just tt->hPutStr h $ tikzTile tt (10/fontSize opts) (fromIntegral x) (fromIntegral y);
              Nothing->return ()
              }) $ M.toList grid;
    hPutStrLn h $ "\\end{scope}";
    --hPutStrLn h $ "\\end{tikzpicture}"
    }