Offcuts.hs

   1 -- This file is part of Intricacy
   2 -- Copyright (C) 2013 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 -- Functions which are no longer used anywhere
  12
  13 -- from Gamestate:
  14 delConnectionsAt :: Locus -> GameState -> GameState
  15 delConnectionsAt locus st =
  16     st {connections = filter
  17         (\conn -> locus `notElem` [connectionRoot conn, connectionEnd conn])
  18         $ connections st}
  19 collidePieces :: PlacedPiece -> PlacedPiece -> [HexPos]
  20 collidePieces pp pp' =
  21     plPieceFootprint pp `intersect` plPieceFootprint pp'
  22 piecesIntersect :: PlacedPiece -> PlacedPiece -> Bool
  23 piecesIntersect pp pp' = not $ null $ collidePieces pp pp'
  24 pieceIntersectsConnection :: GameState -> PlacedPiece -> Connection -> Bool
  25 pieceIntersectsConnection s pp c =
  26     not $ null $ intersect (plPieceFootprint pp) (connectionFootPrint s c)
  27 checkConnGraphAcyclicNaive :: GameState -> Bool
  28 checkConnGraphAcyclicNaive st = and [ idx `notElem` descendents idx
  29         | idx <- [0..Vector.length $ placedPieces st] ]
  30     where descendents idx = let childs = map (fst.connectionRoot) $ springsEndAtIdx st idx
  31             in concat (childs:map descendents childs)
  32
  33
  34 -- from SDLUI
  35 drawPaintSel :: UIM ()
  36 drawPaintSel = do
  37     pti <- getEffPaintTileIndex
  38     case paintTiles!!pti of
  39         Nothing -> return ()
  40         Just t -> renderToMain $ drawAtRel (tileGlyph t (dim $ colourWheel 5)) (periphery 0)
  41
  42 -- from GraphColouring.hs
  43 fourColour :: Ord a => Graph a -> Colouring a -> Colouring a
  44 fourColour (nodes,edges) lastCol =
  45     -- ^bruteforce
  46     if Map.keysSet lastCol == nodes && isColouring lastCol
  47         then lastCol
  48         else head $ filter isColouring colourings
  49     where
  50         isColouring mapping = and [
  51             Map.lookup s mapping /= Map.lookup e mapping |
  52                 edge <- Set.toList edges
  53                 , [s,e] <- [Set.toList edge] ]
  54         colourings = colourings' $ Set.toList nodes
  55         colourings' [] = [ Map.empty ]
  56         colourings' (n:ns) = [ Map.insert n c m |
  57             m <- colourings' ns
  58             , c <- [0..3] ]