packages feed

intricacy 0.4.3 → 0.5

raw patch · 12 files changed

+299/−193 lines, 12 files

Files

CursesUIMInstance.hs view
@@ -293,7 +293,7 @@     endPrompt = say "" >> (liftIO $ void $ Curses.cursSet Curses.CursorInvisible)     drawError = sayError -    showHelp mode 0 = do+    showHelp mode HelpPageInput = do 	bdgs <- nub <$> getBindings mode 	erase 	(h,w) <- liftIO Curses.scrSize@@ -316,6 +316,12 @@ 		(map (`divMod` (h-3)) [0..]) 	    , (x+1)*bdgWidth < w] 	refresh+	return True+    showHelp IMMeta HelpPageGame = do+	erase+	(h,w) <- liftIO Curses.scrSize+	sequence_ [drawStrCentred a0 white (CVec line $ w`div`2) str |+	    (line,str) <- zip [0..h-2] $ ["Intricacy",""] ++ metagameHelpText ] 	return True     showHelp _ _ = return False 
GameState.hs view
@@ -245,9 +245,10 @@  plPieceMap :: PlacedPiece -> Map HexPos Tile plPieceMap (PlacedPiece pos (Block pattern)) =-    Map.fromList [ (rel <+> pos, BlockTile adjs)+    let pattSet = Set.fromList pattern+    in Map.fromList [ (rel <+> pos, BlockTile adjs) 	| rel <- pattern-	, let adjs = filter (\dir -> rel <+> dir `elem` pattern) hexDirs ]+	, let adjs = filter (\dir -> (rel <+> dir) `Set.member` pattSet) hexDirs ] plPieceMap (PlacedPiece pos (Pivot arms)) =     let overarmed = length arms > 2 in     Map.fromList $ (pos, PivotTile $ if overarmed then (head arms) else zero ) :
Interact.hs view
@@ -121,10 +121,9 @@  processCommand' :: UIMonad uiM => InputMode -> Command -> MainStateT uiM () processCommand' im CmdHelp = lift $-    let showPage n = showHelp im n >>? do+    let showPage p = showHelp im p >>? do 	    void $ textInput "[press a key or RMB]" 1 False True Nothing Nothing-	    showPage $ n+1-    in showPage 0+    in sequence_ $ map showPage $ enumFrom HelpPageInput processCommand' im (CmdBind mcmd)= lift $ (>> endPrompt) $ runMaybeT $ do     cmd <- liftMaybe mcmd `mplus` do 	lift $ drawPrompt False "Command to bind: "@@ -412,10 +411,17 @@ 		mauth <- gets curAuth 		cbdg <- lift $ getUIBinding IMMeta $ CmdSelCodename Nothing 		rbdg <- lift $ getUIBinding IMMeta CmdRegister-		lift $ drawMessage $ if isNothing mauth-		    then "Tutorial completed! To play on the server, pick a codename ('"++cbdg++-			"') and register it ('"++rbdg++"')."-		    else "Tutorial completed!"+		if isNothing mauth+		    then do+			let showPage p = lift $ showHelp IMMeta p >>? do+				void $ textInput+				    "[Tutorial completed! Press a key or RMB to continue; you can review this help later with '?']"+				    1 False True Nothing Nothing+			showPage HelpPageGame+			lift $ drawMessage $ +			    "Tutorial completed! To play on the server, pick a codename ('"++cbdg+++			    "') and register it ('"++rbdg++"')."+		    else lift $ drawMessage $ "Tutorial completed!"     dotut i processCommand' IMMeta CmdShowRetired = void.runMaybeT $ do     name <- mgetCurName
MainState.hs view
@@ -56,7 +56,7 @@     drawPrompt :: Bool -> String -> m ()     endPrompt :: m ()     drawError :: String -> m ()-    showHelp :: InputMode -> Int -> m Bool+    showHelp :: InputMode -> HelpPage -> m Bool     getInput :: InputMode -> m [ Command ]     getChRaw :: m ( Maybe Char )     unblockInput :: m (IO ())@@ -127,6 +127,9 @@  type MainStateT = StateT MainState +data HelpPage = HelpPageInput | HelpPageGame+    deriving (Eq, Ord, Show, Enum)+ ms2im :: MainState -> InputMode ms2im mainSt = case mainSt of     PlayState {} -> IMPlay@@ -400,3 +403,28 @@ 	    lift $ drawMessage err 	    modify $ \ms -> ms {curAuth = Nothing} 	_ -> return ()++metagameHelpText :: [String]+metagameHelpText =+    [ "By ruthlessly guarded secret arrangement, the Council's agents can pick any lock in the city."+    , "The Guild produces the necessary locks - apparently secure, but with fatal hidden flaws."+    , "The ritual game known as \"Intricacy\" is played to determine the best designs."+    , "Players attempt to design locks which can be picked only by one who knows the secret,"+    , "and try to discover the secret flaws in the designs of their colleagues."+    , ""+    , "You may put forward up to three prototype locks. They will guard the secrets you discover."+    , "If you pick a colleague's lock, the rules require that a note be written describing your solution."+    , "The composition and deciphering of notes is an art in itself, whose details do not concern us here,"+    , "but a note proves that the author found a solution, while revealing as little detail as possible."+    , "To declare your success, you must secure your note behind a lock of your own."+    , "If you are able to unlock a lock, you automatically read all the notes it secures."+    , "If you read three notes on a lock, you will piece together the clues and work out how to solve it."+    , ""+    , "Players are judged relative to each of their peers. There are no absolute rankings."+    , "Your esteem relative to another player ranges from +3 (best) to -3 (worst), calculated thusly:"+    , "Take the number of their locks you can solve, and subtract the number of your locks they can solve."+    , "Undeclared solutions don't count. Empty lock slots are considered solved if all actual locks are."+    , ""+    , "If the secrets to one of your locks become widely disseminated, you may wish to replace it."+    , "Once replaced, a lock is \"retired\"; any notes it was securing are read by everyone."+    ]
NEWS view
@@ -1,14 +1,10 @@ This is an abbreviated summary; see the git log for gory details. -0.4.3:-    Metagame help page.-    Animation to indicate direction of rotation of pieces.-0.4.2:+0.5:     Adjustments to graphics, tutorial, and metagame UI, to increase clarity.-    Fix sound lag on Windows.-0.4.1:     Concurrency on server; no more freezes while it checks a solution.-    Misc minor UI fixes.+    Misc optimisations.+    Fix sound lag on Windows.      0.4:     Sound effects (thanks linley).
SDLRender.hs view
@@ -16,13 +16,18 @@ import Data.Monoid import Control.Monad import Control.Monad.IO.Class+import Control.Monad.Trans.State import Control.Monad.Trans.Reader import Control.Monad.Trans.Maybe import Control.Monad.Trans.Class+import Data.Map (Map) import qualified Data.Map as Map+import qualified Data.List as List import Data.List (maximumBy) import Data.Function (on) import GHC.Int (Int16)+import Control.Applicative hiding ((<*>))+import System.Random (randomRIO)  import Hex import GameState@@ -30,6 +35,7 @@ import BoardColouring import Physics import Command+import Util  -- aaPolygon seems to be a bit buggy in sdl-gfx-0.6.0 aaPolygon' surf verts col =@@ -49,10 +55,10 @@     return ()  circleAt surf centre@(SVec x y) rad col =-    aaCircle' surf (fromIntegral x) (fromIntegral y) (fromIntegral rad) col+    aaCircle' surf (fi x) (fi y) (fi rad) col  filledCircleAt surf centre@(SVec x y) rad col =-    filledCircle surf (fromIntegral x) (fromIntegral y) (fromIntegral rad) col+    filledCircle surf (fi x) (fi y) (fi rad) col  rimmedCircle surf centre@(SVec x y) rad fillCol rimCol = void $ do     filledCircleAt surf centre rad fillCol@@ -61,7 +67,7 @@ thickLine :: Surface -> (Int16,Int16) -> (Int16,Int16) -> Float -> Pixel -> IO () thickLine surf from@(x,y) to@(x',y') thickness col = do     let (dx,dy) = (x'-x,y'-y)-	[rdx,rdy] = map fromIntegral [dx,dy]+	[rdx,rdy] = map fi [dx,dy] 	s = thickness / (sqrt $ rdx^2 + rdy^2) 	perp@(px,py) = (round $ s*rdy, round $ s*(-rdx)) 	mperp = (-px,-py)@@ -77,13 +83,11 @@ thickPolygon surf verts thickness col =     thickLines surf (verts ++ take 1 verts) thickness col -type Glyph = SVec -> Int -> Surface -> IO ()- ysize :: Int -> Int-ysize size = round $ fromIntegral size / sqrt 3+ysize = (map (\size -> round $ fi size / sqrt 3) [0..] !!)  corner :: Integral i => SVec -> Int -> Int -> (i,i)-corner (SVec x y) size hextant = (fromIntegral $ x+dx, fromIntegral $ y+dy)+corner (SVec x y) size hextant = (fi $ x+dx, fi $ y+dy)     where 	[dx,dy] = f hextant 	f 0 = [size, -ysize size]@@ -94,7 +98,7 @@ 	    | otherwise = f (n`mod`6)  innerCorner :: Integral i => SVec -> Int -> HexDir -> (i,i)-innerCorner (SVec x y) size dir = (fromIntegral $ x+dx, fromIntegral $ y+dy)+innerCorner (SVec x y) size dir = (fi $ x+dx, fi $ y+dy)     where 	[dx,dy] = f dir 	f dir@@ -106,7 +110,7 @@ 	isize = size `div` 3  edge :: Integral i => SVec -> Int -> HexDir -> (i,i)-edge (SVec x y) size dir = (fromIntegral $ x+dx, fromIntegral $ y+dy)+edge (SVec x y) size dir = (fi $ x+dx, fi $ y+dy)     where 	[dx,dy] = f dir 	f dir@@ -116,9 +120,102 @@ 	    | not (isHexDir dir) = error "edge: not a hexdir" 	    | otherwise = map (\z -> -z) $ f $ neg dir -tileGlyph :: Tile -> Pixel -> Glyph+data ShowBlocks = ShowBlocksBlocking | ShowBlocksAll | ShowBlocksNone+    deriving (Eq, Ord, Show, Read) -tileGlyph (BlockTile adjs) col centre size surf =+data Glyph+    = TileGlyph Tile Pixel+    | BlockedArm HexDir TorqueDir Pixel+    | TurnedArm HexDir TorqueDir Pixel+    | BlockedBlock Tile HexDir Pixel+    | BlockedPush HexDir Pixel+    | CollisionMarker+    | HollowGlyph Pixel+    | HollowInnerGlyph Pixel+    | FilledHexGlyph Pixel+    | ButtonGlyph Pixel+    | UseFiveColourButton Bool+    | ShowBlocksButton ShowBlocks+    | ShowButtonTextButton Bool+    | UseSoundsButton Bool+    | WhsButtonsButton (Maybe WrHoSel)+    | FullscreenButton Bool+    | UnfreshGlyph+    deriving (Eq, Ord, Show)++type SizedGlyph = (Glyph,Int)+data CachedGlyphs = CachedGlyphs (Map SizedGlyph Surface) [SizedGlyph]+    deriving (Eq, Ord, Show)+emptyCachedGlyphs = CachedGlyphs Map.empty []+maxCachedGlyphs = 100++renderGlyphCaching :: Glyph -> SVec -> Int -> Surface -> RenderM ()+-- Glyph caching:+--  We aim to cache glyphs which are "currently" being regularly drawn, so+--  they can be blitted from RAM rather than being drawn afresh each time.+--  Rather than track statistics, we adopt the following probabilistic scheme.+renderGlyphCaching gl centre size surf = do+    CachedGlyphs cmap clist <- lift get+    let cacheFull = Map.size cmap >= maxCachedGlyphs+    let mcsurf = Map.lookup sgl cmap+    -- with probability 1 in (maxCachedGlyphs`div`2), we put this glyph at the+    -- head of the cached list, throwing away the tail to make room if needed.+    cacheIt <- (((cacheable &&) . (not cacheFull ||)) <$>) $+	liftIO $ (==0) <$> randomRIO (0::Int,maxCachedGlyphs`div`2)+    case mcsurf of+	Nothing -> if cacheIt+	    then do+		csurf <- newGlyphSurf+		renderOnCache csurf+		addToCache cacheFull csurf+		blitGlyph csurf+	    else+		liftIO $ renderGlyph gl centre size surf+	Just csurf -> do+	    when cacheIt promote+	    blitGlyph csurf+    where+	sgl = (gl,size)+	cacheable = case gl of+	    -- some glyphs need to be drawn with blending - those involving+	    -- anti-aliasing which bleed over the edge of the hex or which+	    -- may be drawn on top of an existing glyph.+	    -- TODO: we should find a way to deal with at least some of these;+	    -- springs in particular are common and expensive to draw.+	    -- Maybe we could truncate the spring glyphs to a hex?+	    TileGlyph (BlockTile adjs) _ -> null adjs+	    TileGlyph (SpringTile extn dir) _ -> False+	    FilledHexGlyph _ -> False+	    HollowGlyph _ -> False+	    BlockedBlock _ _ _ -> False+	    BlockedPush _ _ -> False+	    CollisionMarker -> False+	    _ -> True+	w = size*2 + 1+	h = ysize size*4 + 1+	newGlyphSurf = do+	    -- csurf <- liftIO $ createRGBSurface [] w h 32 0xff000000 0x00ff0000 0x0000ff00 0x000000ff+	    csurf <- liftIO $ createRGBSurface [] w h 16 0 0 0 0+	    liftIO $ setColorKey csurf [SrcColorKey,RLEAccel] $ Pixel 0+	    return csurf+	renderOnCache csurf =+	    liftIO $ renderGlyph gl (SVec (w`div`2) (h`div`2)) size csurf+	addToCache cacheFull csurf = do+	    CachedGlyphs cmap clist <- lift get+	    let cmap' = Map.insert sgl csurf cmap+	    lift $ put $ if cacheFull+		then CachedGlyphs (Map.delete (last clist) cmap') (sgl:List.init clist)+		else CachedGlyphs cmap' (sgl:clist)+	promote = do+	    CachedGlyphs cmap clist <- lift get+	    lift $ put $ CachedGlyphs cmap (sgl:List.delete sgl clist)+	blitGlyph csurf =+	    let SVec x y = centre+	    in void $ liftIO $ blitSurface csurf Nothing surf $ Just $+		Rect (x-w`div`2) (y-h`div`2) (w+1) (h+1)++renderGlyph :: Glyph -> SVec -> Int -> Surface -> IO ()+renderGlyph (TileGlyph (BlockTile adjs) col) centre size surf =     rimmedPolygon surf corners col $ bright col 	where 	    corners = concat [@@ -131,7 +228,7 @@ 		, let adjAt r = rotate r dir `elem` adjs 		] -tileGlyph (SpringTile extn dir) col centre size surf =+renderGlyph (TileGlyph (SpringTile extn dir) col) centre size surf =     thickLines surf points 1 $ brightness col 	where 	    n = 3*case extn of@@ -149,7 +246,7 @@ 		, let (x,y) = if i`mod`3==0 then (sx,sy) else (offx,offy) 		, let (dx,dy) = ((i*(ex-sx))`div`n, (i*(ey-sy))`div`n) ] -tileGlyph (PivotTile dir) col centre size surf = do+renderGlyph (TileGlyph (PivotTile dir) col) centre size surf = do     rimmedCircle surf centre rad col $ bright col     when (dir /= zero) 	$ void $ aaLine surf `uncurry` from `uncurry` to $ bright col@@ -159,19 +256,19 @@ 	    from = edge centre rad $ neg dir 	    to = edge centre rad dir -tileGlyph (ArmTile dir _) col centre size surf =+renderGlyph (TileGlyph (ArmTile dir _) col) centre size surf =     void $ thickLine surf from to 1 col 	where 	    dir' = if dir == zero then hu else dir 	    from = edge centre size $ neg dir' 	    to = innerCorner centre size dir' -tileGlyph HookTile col centre size surf =+renderGlyph (TileGlyph HookTile col) centre size surf =     rimmedCircle surf centre rad col $ bright col 	where 	    rad = (7*size)`div`8 -tileGlyph (WrenchTile mom) col centre size surf = do+renderGlyph (TileGlyph (WrenchTile mom) col) centre size surf = do     rimmedCircle surf centre (size`div`3) col $ bright col     when (mom /= zero) $ 	let@@ -187,38 +284,35 @@ 	    [ aaLine surf (fx+dx) (fy+dy) (tx+dx) (ty+dy) $ col 	    | [dx,dy] <- shifts ] -tileGlyph BallTile col centre size surf =+renderGlyph (TileGlyph BallTile col) centre size surf =     rimmedCircle surf centre rad (faint col) (obscure col)     where rad = (7*size)`div`8 -blockedArm,turnedArm :: HexDir -> TorqueDir -> Pixel -> Glyph-blockedArm armdir tdir col centre size surf =+renderGlyph (BlockedArm armdir tdir col) centre size surf =     void $ aaLine surf `uncurry` from `uncurry` to $ col 	where 	    from = innerCorner centre size $ rotate (2*tdir) armdir 	    to = edge centre size $ rotate tdir armdir -turnedArm armdir tdir col centre size surf =-    sequence_ [ arc surf (fromIntegral x) (fromIntegral y) (fromIntegral $ n*size `div` 4)+renderGlyph (TurnedArm armdir tdir col) centre size surf =+    sequence_ [ arc surf (fi x) (fi y) (fi $ n*size `div` 4) 	a1 a2 col | n <- [8,9] ]     where 	SVec x y = centre <+> hexVec2SVec size (neg armdir)-	a0 = fromIntegral $ -60*hextant armdir-	a1' = a0 + fromIntegral tdir * 10-	a2' = a0 + fromIntegral tdir * 30+	a0 = fi $ -60*hextant armdir+	a1' = a0 + fi tdir * 10+	a2' = a0 + fi tdir * 30 	a1 = min a1' a2' 	a2 = max a1' a2' -blockedBlock :: Tile -> HexDir -> Pixel -> Glyph-blockedBlock tile dir col centre size =-    tileGlyph tile col (shift <+> centre) size+renderGlyph (BlockedBlock tile dir col) centre size surf =+    renderGlyph (TileGlyph tile col) (shift <+> centre) size surf 	where 	    shift = SVec (x'-x) (y'-y) 	    (x,y) = innerCorner centre size dir 	    (x',y') = edge centre size dir -blockedPush :: HexDir -> Pixel -> Glyph-blockedPush dir col centre size surf = do+renderGlyph (BlockedPush dir col) centre size surf = do {-     void $ rimmedPolygon surf verts (obscure col) (dim col) 	where verts =@@ -233,7 +327,7 @@     where 	--base@(bx,by) = innerCorner centre size dir 	SVec bx' by' = centre-	base@(bx,by) = (fromIntegral bx',fromIntegral by')+	base@(bx,by) = (fi bx',fi by') 	tip@(tx,hy) = edge centre size dir 	arms = [(bx + (tx-bx)`div`2 + dir*(hy-by)`div`4, 	    by + (hy-by)`div`2 - dir*(tx-bx)`div`4) | dir <- [-1,1]]@@ -241,8 +335,7 @@ 	--from' = corner centre size $ hextant dir 	--to' = corner centre size $ (hextant dir) - 1 -collisionMarker :: Glyph-collisionMarker centre@(SVec x y) size surf = void $ do+renderGlyph CollisionMarker centre@(SVec x y) size surf = void $ do     -- rimmedCircle surf centre (size`div`3) (bright purple) $ bright purple     aaLine surf `uncurry` start `uncurry` end $ col     circleAt surf centre rad col@@ -251,72 +344,61 @@ 	rad = ysize size 	col = dim purple -hollowGlyph :: Pixel -> Glyph-hollowGlyph col centre size surf =+renderGlyph (HollowGlyph col) centre size surf =     aaPolygon' surf corners $ opaquify col     where corners = map (corner centre size) [0..5]-hollowInnerGlyph col centre size surf =+renderGlyph (HollowInnerGlyph col) centre size surf =     aaPolygon' surf corners $ opaquify col     where corners = [ innerCorner centre size dir | dir <- hexDirs ] -filledHexGlyph :: Pixel -> Glyph-filledHexGlyph col centre size surf =+renderGlyph (FilledHexGlyph col) centre size surf =     rimmedPolygon surf corners col $ brightish col     where corners = map (corner centre size) [0..5] -buttonGlyph :: Pixel -> Glyph-buttonGlyph = tileGlyph (BlockTile [])+renderGlyph (ButtonGlyph col) centre size surf =+    renderGlyph (TileGlyph (BlockTile []) col) centre size surf -useFiveColourButton :: Bool -> Glyph-useFiveColourButton using centre size surf = do-    mapM_ (\h -> tileGlyph (BlockTile [])-	    (dim $ colourWheel (if using then h`div`2 else 1))+renderGlyph (UseFiveColourButton using) centre size surf = do+    mapM_ (\h -> renderGlyph (TileGlyph (BlockTile [])+	    (dim $ colourWheel (if using then h`div`2 else 1))) 	    (SVec `uncurry` corner centre (size`div`2) h) (size`div`2) surf) 	[0,2,4] -data ShowBlocks = ShowBlocksBlocking | ShowBlocksAll | ShowBlocksNone-    deriving (Eq, Ord, Show, Read)--showBlocksButton :: ShowBlocks -> Glyph-showBlocksButton showing centre size surf = do-    tileGlyph (BlockTile []) (dim red) centre size surf+renderGlyph (ShowBlocksButton showing) centre size surf = do+    renderGlyph (TileGlyph (BlockTile []) (dim red)) centre size surf     when (showing == ShowBlocksAll) $-	blockedPush hu (bright orange) centre size surf+	renderGlyph (BlockedPush hu (bright orange)) centre size surf     when (showing /= ShowBlocksNone) $-	blockedPush hw (bright purple) centre size surf+	renderGlyph (BlockedPush hw (bright purple)) centre size surf -showButtonTextButton :: Bool -> Glyph-showButtonTextButton showing centre@(SVec x y) size surf = do-    buttonGlyph (dim yellow) (SVec `uncurry` edge centre (size`div`2) (neg hu)) (size`div`2) surf+renderGlyph (ShowButtonTextButton showing) centre@(SVec x y) size surf = do+    renderGlyph (ButtonGlyph (dim yellow)) (SVec `uncurry` edge centre (size`div`2) (neg hu)) (size`div`2) surf     when showing $-	sequence_ [ pixel surf (fromIntegral $ x+size`div`3+(i*size`div`4)) (fromIntegral $ y - size`div`4) (bright white)+	sequence_ [ pixel surf (fi $ x+size`div`3+(i*size`div`4)) (fi $ y - size`div`4) (bright white) 	    | i <- [-1..1] ] -useSoundsButton :: Bool -> Glyph-useSoundsButton use centre@(SVec x y) size surf = sequence_-    [ arc surf (fromIntegral $ x - (size`div`2)) (fromIntegral y) r (-20) 20+renderGlyph (UseSoundsButton use) centre@(SVec x y) size surf = sequence_+    [ arc surf (fi $ x - (size`div`2)) (fi y) r (-20) 20 	(if use then bright green else dim red)-    | r <- map fromIntegral $ map (*(size`div`3)) [1,2,3] ]+    | r <- map fi $ map (*(size`div`3)) [1,2,3] ] -whsButtonsButton :: Maybe WrHoSel -> Glyph-whsButtonsButton Nothing centre size surf =-    buttonGlyph (dim red) centre (size`div`3) surf-    >> sequence_ [ buttonGlyph (dim purple)+renderGlyph (WhsButtonsButton Nothing) centre size surf =+    renderGlyph (ButtonGlyph (dim red)) centre (size`div`3) surf+    >> sequence_ [ renderGlyph (ButtonGlyph (dim purple)) 	(SVec `uncurry` edge centre (size`div`2) dir) (size`div`3) surf 	| dir <- hexDirs ]-whsButtonsButton (Just whs) centre size surf = do+renderGlyph (WhsButtonsButton (Just whs)) centre size surf = do     when (whs /= WHSHook) $-	tileGlyph (WrenchTile zero) col (miniCentre 0) miniSize surf+	renderGlyph (TileGlyph (WrenchTile zero) col) (miniCentre 0) miniSize surf     when (whs /= WHSWrench) $ do-	tileGlyph HookTile col (miniCentre 4) miniSize surf-	tileGlyph (ArmTile hv False) col (miniCentre 2) miniSize surf+	renderGlyph (TileGlyph HookTile col) (miniCentre 4) miniSize surf+	renderGlyph (TileGlyph (ArmTile hv False) col) (miniCentre 2) miniSize surf     where 	miniSize = size `div` 2 	miniCentre h = SVec `uncurry` corner centre miniSize h 	col = dim white -fullscreenButton :: Bool -> Glyph-fullscreenButton fs centre size surf = do+renderGlyph (FullscreenButton fs) centre size surf = do     thickPolygon surf corners 1 $ activeCol (not fs)     thickPolygon surf corners' 1 $ activeCol fs     where@@ -327,17 +409,20 @@ 	    | dir <- hexDirs ] 	corners' = map (corner centre size') [0..5] -cursor :: Glyph-cursor = hollowGlyph $ bright white--unfreshGlyph centre@(SVec x y) size surf = do+renderGlyph (UnfreshGlyph) centre@(SVec x y) size surf = do     let col = bright red-    hollowInnerGlyph col centre size surf-    sequence_ [pixel surf (fromIntegral $ x+(i*size`div`4)) (fromIntegral y) col+    renderGlyph (HollowInnerGlyph col) centre size surf+    sequence_ [pixel surf (fi $ x+(i*size`div`4)) (fi y) col 	| i <- [-1..1] ] -playerGlyph col centre size surf = filledHexGlyph col centre size surf+playerGlyph col = FilledHexGlyph col +cursorGlyph = HollowGlyph $ bright white++ownedTileGlyph colouring highlight (owner,t) =+    let col = colourOf colouring owner+    in TileGlyph t $ (if owner `elem` highlight then bright else dim) col+ setPixelAlpha alpha (Pixel v) = Pixel $ v `div` 0x100 * 0x100 + alpha bright = setPixelAlpha 0xff brightish = setPixelAlpha 0xc0@@ -381,11 +466,6 @@ 	    Nothing -> white 	    Just n -> colourWheel n -ownedTileGlyph :: PieceColouring -> [PieceIdx] -> OwnedTile -> Glyph-ownedTileGlyph colouring highlight (owner,t) =-    let col = colourOf colouring owner-    in tileGlyph t $ (if owner `elem` highlight then bright else dim) col- data SVec = SVec { cx, cy :: Int }     deriving (Eq, Ord, Show) instance Monoid SVec where@@ -402,7 +482,7 @@ sVec2dHV :: Int -> SVec -> (Double,Double,Double) sVec2dHV size (SVec sx sy) =     let sx',sy',size' :: Double-	[sx',sy',size',ysize'] = map fromIntegral [sx,sy,size,ysize size]+	[sx',sy',size',ysize'] = map fi [sx,sy,size,ysize size] 	y' = -sy' / ysize' / 3 	x' = ((sx' / size') - y') / 2 	z' = -((sx' / size') + y') / 2@@ -415,7 +495,7 @@ 	rounded = Map.map round unrounded 	maxdiff = fst $ maximumBy (compare `on` snd) $ 	    [ (i, abs $ c'-c) | i <- [1..3],-		let c' = unrounded Map.! i, let c = fromIntegral $ rounded Map.! i]+		let c' = unrounded Map.! i, let c = fi $ rounded Map.! i] 	[x,y,z] = map snd $ Map.toList $ 	    Map.adjust (\x -> x - (sum $ Map.elems rounded)) maxdiff rounded     in HexVec x y z@@ -428,8 +508,11 @@     , renderSize :: Int     , renderFont :: Maybe TTF.Font     }-type RenderM = ReaderT RenderContext IO+type RenderM = ReaderT RenderContext (StateT CachedGlyphs IO) +runRenderM :: RenderM a -> CachedGlyphs -> RenderContext -> IO (a,CachedGlyphs)+runRenderM m cgs rc = runStateT (runReaderT m rc) cgs+ displaceRender :: SVec -> RenderM a -> RenderM a displaceRender disp = local displace     where displace rc = rc { renderSCentre = renderSCentre rc <+> disp }@@ -441,7 +524,7 @@  rescaleRender :: RealFrac n => n -> RenderM a -> RenderM a rescaleRender r = local resize-    where resize rc = rc { renderSize = round $ r * (fromIntegral $ renderSize rc) }+    where resize rc = rc { renderSize = round $ r * (fi $ renderSize rc) }  withFont :: Maybe TTF.Font -> RenderM a -> RenderM a withFont font = local refont@@ -460,21 +543,23 @@ 	mbgsurf  drawBasicBG :: Int -> RenderM ()-drawBasicBG maxR = sequence_ [ drawAtRel (hollowGlyph $ colAt v) v | v <- hexDisc maxR ]+drawBasicBG maxR = sequence_ [ drawAtRel (HollowGlyph $ colAt v) v | v <- hexDisc maxR ]     where 	colAt v@(HexVec hx hy hz) = let-		[r,g,b] = map (\h -> fromIntegral $ ((0xff*)$ 5 + abs h)`div`maxR) [hx,hy,hz]-		a = fromIntegral $ (0x90 * (maxR - abs (hexLen v)))`div`maxR+		[r,g,b] = map (\h -> fi $ ((0xff*)$ 5 + abs h)`div`maxR) [hx,hy,hz]+		a = fi $ (0x90 * (maxR - abs (hexLen v)))`div`maxR 	    in rgbaToPixel (r,g,b,a)  drawAt :: Glyph -> HexPos -> RenderM () drawAt gl pos = do 	centre <- asks renderHCentre 	drawAtRel gl (pos <-> centre)++drawAtRel :: Glyph -> HexVec -> RenderM () drawAtRel gl v = do 	(surf, scrCentre, size) <- asks $ liftM3 (,,) renderSurf renderSCentre renderSize 	let cpos = scrCentre <+> (hexVec2SVec size v)-	liftIO $ gl cpos size surf+	renderGlyphCaching gl cpos size surf  messageCol = white dimWhiteCol = Pixel 0xa0a0a000@@ -483,7 +568,7 @@  pixelToColor p =     let (r,g,b,_) = pixelToRGBA p-    in Color (fromIntegral r) (fromIntegral g) (fromIntegral b)+    in Color (fi r) (fi g) (fi b)  renderStrColAtLeft = renderStrColAt' False renderStrColAt = renderStrColAt' True@@ -505,11 +590,11 @@ 	liftM3 (,,) renderSurf renderSCentre renderSize     let SVec _ y = scrCentre <+> (hexVec2SVec size v) 	w = surfaceGetWidth surf-	h = ceiling $ fromIntegral (size * 3 `div` 2) * 2 / sqrt 3+	h = ceiling $ fi (size * 3 `div` 2) * 2 / sqrt 3     fillRectBG $ Just $ Rect 0 (y-h`div`2) w h  drawCursorAt :: Maybe HexPos -> RenderM ()-drawCursorAt (Just pos) = drawAt cursor pos+drawCursorAt (Just pos) = drawAt cursorGlyph pos drawCursorAt _ = return ()  drawBlocked :: GameState -> PieceColouring -> Bool -> Force -> RenderM ()@@ -519,13 +604,13 @@ 	    PlacedPiece pos (Hook arm _) -> (pos,[arm]) 	    _ -> (pos,[]) 	col = if blocking then bright $ purple else dim $ colourOf colouring idx-    sequence_ [ drawAt (blockedArm arm dir col) (arm <+> pos) |+    sequence_ [ drawAt (BlockedArm arm dir col) (arm <+> pos) | 	arm <- arms ] drawBlocked st colouring blocking (Push idx dir) = do     let footprint = plPieceFootprint $ getpp st idx 	fullfootprint = fullFootprint st idx 	col = bright $ if blocking then purple else orange-    sequence_ [ drawAt (blockedPush dir col) pos+    sequence_ [ drawAt (BlockedPush dir col) pos 	| pos <- footprint 	, (dir<+>pos) `notElem` fullfootprint ]     -- drawAt (blockedPush dir $ bright orange) $ placedPos $ getpp st idx@@ -537,7 +622,7 @@ 	    PlacedPiece pos (Hook arm _) -> (pos,[arm]) 	    _ -> (pos,[]) 	col = dim $ colourOf colouring idx-    sequence_ [ drawAt (turnedArm arm dir col) (arm <+> pos) |+    sequence_ [ drawAt (TurnedArm arm dir col) (arm <+> pos) | 	    arm <- arms ] drawApplied _ _ _ = return () 
SDLUI.hs view
@@ -55,6 +55,7 @@ data UIState = UIState { scrHeight::Int, scrWidth::Int     , gsSurface::Maybe Surface     , bgSurface::Maybe Surface+    , cachedGlyphs::CachedGlyphs     , lastDrawArgs::Maybe DrawArgs     , miniLocks::Map Lock Surface     , metaSelectables::Map HexVec Selectable@@ -81,7 +82,7 @@     }     deriving (Eq, Ord, Show) type UIM = StateT UIState IO-nullUIState = UIState 0 0 Nothing Nothing Nothing Map.empty Map.empty []+nullUIState = UIState 0 0 Nothing Nothing emptyCachedGlyphs Nothing Map.empty Map.empty []     defaultUIOptions Nothing Map.empty Nothing Nothing 0 0 Nothing Nothing Nothing     (zero,False) Nothing Nothing (PHS zero) Map.empty 0 Nothing 25 #ifdef SOUND@@ -99,7 +100,7 @@     , uiAnimTime::Word32     }     deriving (Eq, Ord, Show, Read)-defaultUIOptions = UIOptions False ShowBlocksBlocking Nothing True False True True 75+defaultUIOptions = UIOptions False ShowBlocksBlocking Nothing True False True True 100 modifyUIOptions f = modify $ \s -> s { uiOptions = f $ uiOptions s }  renderToMain :: RenderM a -> UIM a@@ -112,8 +113,10 @@     centre <- gets dispCentre     mfont <- gets dispFont     bgsurf <- gets bgSurface-    liftIO $ runReaderT m $ RenderContext surf bgsurf centre scrCentre size mfont-+    cgs <- gets cachedGlyphs+    (a,cgs') <- liftIO $ runRenderM m cgs $ RenderContext surf bgsurf centre scrCentre size mfont+    modify $ \s -> s { cachedGlyphs = cgs' }+    return a  refresh :: UIM () refresh = do@@ -344,19 +347,19 @@  -- non-uniform type, so can't use a list... uiOB1 = UIOptButton useFiveColouring (\v o -> o {useFiveColouring=v}) [True,False]-	(periphery 0 <+> 2 <*> hu) useFiveColourButton+	(periphery 0 <+> 2 <*> hu) UseFiveColourButton 	(\v -> if v then "Adjacent pieces get different colours" else 	"Pieces are coloured according to type") 	Nothing uiOB2 = UIOptButton showBlocks (\v o -> o {showBlocks=v}) [ShowBlocksBlocking,ShowBlocksAll,ShowBlocksNone]-	(periphery 0 <+> 2 <*> hu <+> 2 <*> neg hv) showBlocksButton+	(periphery 0 <+> 2 <*> hu <+> 2 <*> neg hv) ShowBlocksButton 	(\v -> case v of 	    ShowBlocksBlocking -> "Blocking forces are annotated" 	    ShowBlocksAll -> "Blocked and blocking forces are annotated" 	    ShowBlocksNone -> "Blockage annotations disabled") 	Nothing uiOB3 = UIOptButton whsButtons (\v o -> o {whsButtons=v}) [Nothing, Just WHSSelected, Just WHSWrench, Just WHSHook]-	(periphery 3 <+> 3 <*> hv) whsButtonsButton+	(periphery 3 <+> 3 <*> hv) WhsButtonsButton 	(\v -> case v of 	    Nothing -> "Showing mouse controls; click to show keyboard control buttons." 	    Just whs -> "Showing buttons for controlling " ++ case whs of@@ -365,17 +368,17 @@ 		WHSHook -> "hook") 	Nothing uiOB4 = UIOptButton showButtonText (\v o -> o {showButtonText=v}) [True,False]-	(periphery 0 <+> 2 <*> hu <+> 2 <*> hv) showButtonTextButton+	(periphery 0 <+> 2 <*> hu <+> 2 <*> hv) ShowButtonTextButton 	(\v -> if v then "Help text enabled" else 	"Help text disabled") 	Nothing uiOB5 = UIOptButton fullscreen (\v o -> o {fullscreen=v}) [True,False]-	(periphery 0 <+> 4 <*> hu <+> 2 <*> hv) fullscreenButton+	(periphery 0 <+> 4 <*> hu <+> 2 <*> hv) FullscreenButton 	(\v -> if v then "Fullscreen mode" else 	"Windowed mode") 	(Just $ const $ initVideo 0 0) uiOB6 = UIOptButton useSounds (\v o -> o {useSounds=v}) [True,False]-	(periphery 0 <+> 3 <*> hu <+> hv) useSoundsButton+	(periphery 0 <+> 3 <*> hu <+> hv) UseSoundsButton 	(\v -> if v then "Sound effects enabled" else 	"Sound effects disabled") 	Nothing@@ -394,7 +397,7 @@ drawUIOptionButton b = do     value <- gets $ (getUIOpt b).uiOptions     renderToMain $ mapM_ (\g -> drawAtRel g (uiOptPos b))-	[hollowGlyph $ obscure purple, uiOptGlyph b value]+	[HollowGlyph $ obscure purple, uiOptGlyph b value] describeUIOptionButton b = do     value <- gets $ (getUIOpt b).uiOptions     return $ uiOptDescr b value@@ -467,10 +470,10 @@     renderToMain $ sequence_ [ 	do 	    let gl = case paintTiles!!i of-		    Nothing -> hollowInnerGlyph $ dim purple-		    Just t -> tileGlyph t $ dim purple+		    Nothing -> HollowInnerGlyph $ dim purple+		    Just t -> TileGlyph t $ dim purple 	    drawAtRel gl pos-	    when selected $ drawAtRel cursor pos+	    when selected $ drawAtRel cursorGlyph pos 	| i <- take (length paintTiles) [0..] 	, let pos = paintButtonStart <+> i<*>hv 	, let selected = i == pti@@ -494,10 +497,10 @@     -- |size is the greatest integer such that     -- and [2*size*screenWidthHexes <= width     --	, 3*ysize size*screenHeightHexes <= height]-    --	where ysize size = round $ fromIntegral size / sqrt 3+    --	where ysize size = round $ fi size / sqrt 3     -- Minimum allowed size is 2 (get segfaults on SDL_FreeSurface with 1).     let size = max 2 $ minimum [ w`div`(2*screenWidthHexes)-	    , floor $ sqrt 3 * (0.5 + (fromIntegral $ h`div`(3*screenHeightHexes)))]+	    , floor $ sqrt 3 * (0.5 + (fi $ h`div`(3*screenHeightHexes)))]     return (scrCentre, size)  data DrawArgs = DrawArgs [PieceIdx] Bool [Alert] GameState UIOptions@@ -542,7 +545,7 @@ 		isGlobalAlert (AlertAppliedForce _) = False 		isGlobalAlert (AlertIntermediateState _) = False 		isGlobalAlert _ = True-	    let animAlertedStates =+	    let animAlertedStates = nub $ 		    let ass = splitAlerts [] transitoryAlerts 		    in if last ass == ([],st) then ass else ass ++ [([],st)] 	    let frames = length animAlertedStates@@ -576,7 +579,7 @@ 			| AlertBlockingForce force <- drawAlerts ] 		    -- ++ [ drawBlocked drawSt colouring True force | 		    -- AlertResistedForce force <- drawAlerts ]-		    ++ [ drawAt collisionMarker pos+		    ++ [ drawAt CollisionMarker pos 			| AlertCollision pos <- drawAlerts ] 		    ++ [ drawApplied drawSt colouring force 			| AlertAppliedForce force <- drawAlerts ]@@ -634,9 +637,9 @@ 	    (_, size) <- getGeom 	    let minisize = size `div` (ceiling $ lockSize lock % miniLocksize) 	    let width = size*2*(miniLocksize*2+1)-	    let height = ceiling $ fromIntegral size * sqrt 3 * fromIntegral (miniLocksize*2+1+1)+	    let height = ceiling $ fi size * sqrt 3 * fi (miniLocksize*2+1+1) 	    surf <- liftIO $ createRGBSurface [] width height 16 0 0 0 0-	    liftIO $ setColorKey surf [SrcColorKey] $ Pixel 0+	    liftIO $ setColorKey surf [SrcColorKey,RLEAccel] $ Pixel 0 	    uiopts <- gets uiOptions 	    let st = snd $ reframe lock 		coloured = colouredPieces False st@@ -645,7 +648,7 @@ 		    else pieceTypeColouring st coloured 		draw = sequence_ [ drawAt glyph pos | 		    (pos,glyph) <- Map.toList $ fmap (ownedTileGlyph colouring []) $ stateBoard st ]-	    liftIO $ runReaderT draw $+	    liftIO $ runRenderM draw emptyCachedGlyphs $ 		RenderContext surf Nothing (PHS zero) (SVec (width`div`2) (height`div`2)) minisize Nothing 	    clearOldMiniLocks 	    modify $ \ds -> ds { miniLocks = Map.insert lock surf $ miniLocks ds }@@ -657,7 +660,7 @@ clearMiniLocks = modify $ \ds -> ds { miniLocks = Map.empty}  drawEmptyMiniLock v =-    renderToMain $ recentreAt v $ rescaleRender 6 $ drawAtRel (hollowInnerGlyph $ dim white) zero+    renderToMain $ recentreAt v $ rescaleRender 6 $ drawAtRel (HollowInnerGlyph $ dim white) zero  getBindingStr :: InputMode -> UIM (Command -> String) getBindingStr mode = do@@ -674,7 +677,7 @@     showBT <- showButtonText <$> gets uiOptions     smallFont <- gets dispFontSmall     renderToMain $ sequence_ $ concat [ [ do-		drawAtRel (buttonGlyph col) v+		drawAtRel (ButtonGlyph col) v 		renderStrColAt buttonTextCol bdg v 		when showBT $ 		    withFont smallFont $ recentreAt v $ rescaleRender (1/4) $
SDLUIMInstance.hs view
@@ -252,7 +252,7 @@ 	    liftIO $ setCaption "intricacy" "intricacy" 	    w <- gets scrWidth 	    h <- gets scrHeight-	    liftIO $ warpMouse (fromIntegral $ w`div`2) (fromIntegral $ h`div`2)+	    liftIO $ warpMouse (fi $ w`div`2) (fi $ h`div`2) 	    renderToMain $ erase 	    liftIO $ enableUnicode True 	    liftIO $ enableKeyRepeat 250 30@@ -276,7 +276,7 @@ 	let pos = serverWaitPos 	return $ \ticks -> void $ flip runStateT curState $ do 	    when (ticks>2) $ renderToMain $ do-		mapM (drawAtRel (filledHexGlyph $ bright black)) [ pos <+> i<*>hu | i <- [0..3] ]+		mapM (drawAtRel (FilledHexGlyph $ bright black)) [ pos <+> i<*>hu | i <- [0..3] ] 		withFont (dispFontSmall curState) $ 		    renderStrColAtLeft errorCol ("waiting..."++replicate (ticks`mod`3) '.') $ pos 	    refresh@@ -285,7 +285,7 @@ 	(scrCentre, size) <- getGeom 	centre <- gets dispCentre 	let SVec x y = hexVec2SVec size (pos<->centre) <+> scrCentre-	liftIO $ warpMouse (fromIntegral x) (fromIntegral y)+	liftIO $ warpMouse (fi x) (fi y) 	lbp <- gets leftButtonDown 	rbp <- gets rightButtonDown 	let [lbp',rbp'] = fmap (fmap (\_ -> (pos<->centre))) [lbp,rbp]@@ -304,11 +304,15 @@     getInput mode = do 	fps <- gets fps 	events <- liftIO $ nubMouseMotions <$> getEventsTimeout (10^6`div`fps)-	oldUIState <- get-	cmds <- concat <$> mapM processEvent events-	setPaintFromCmds cmds-	addRefresh <- needRefresh oldUIState-	return $ cmds ++ if addRefresh then [CmdRefresh] else []+	(cmds,uiChanged) <- if null events then return ([],False) else do+	    oldUIState <- get+	    cmds <- concat <$> mapM processEvent events+	    setPaintFromCmds cmds+	    newUIState <- get+	    return (cmds,uistatesMayVisiblyDiffer oldUIState newUIState)+	now <- liftIO getTicks+	animFrameReady <- maybe False (<now) <$> gets nextAnimFrameAt+	return $ cmds ++ if uiChanged || animFrameReady then [CmdRefresh] else [] 	where 	    nubMouseMotions evs = 		-- drop all but last mouse motion event@@ -326,11 +330,6 @@ 			    pt' <- pt 			    CmdTile t <- Just cmd 			    guard $ ((==)`on`tileType) t pt') ]-	    needRefresh old = do-		new <- get-		now <- liftIO getTicks-		anim <- maybe False (<now) <$> gets nextAnimFrameAt-		return $ anim || uistatesMayVisiblyDiffer old new  	    uistatesMayVisiblyDiffer uis1 uis2 = 		uis1 { mousePos = (zero,False), lastFrameTicks=0 }@@ -359,7 +358,7 @@ 		    drag bp = do 			fromPos@(HexVec x y z) <- bp 			-- check we've dragged at least a full hex's distance:-			guard $ not.all (\(a,b) -> abs ((fromIntegral a) - b) < 1.0) $ [(x,sx),(y,sy),(z,sz)]+			guard $ not.all (\(a,b) -> abs ((fi a) - b) < 1.0) $ [(x,sx),(y,sy),(z,sz)] 			let dir = hexVec2HexDirOrZero $ mPos <-> fromPos 			guard $ dir /= zero 			return $ CmdDrag (fromPos<+>centre) dir@@ -478,10 +477,10 @@ 	    getMousePos = do 		(scrCentre, size) <- getGeom 		(x,y,_) <- lift getMouseState-		let sv = (SVec (fromIntegral x) (fromIntegral y)) <+> neg scrCentre+		let sv = (SVec (fi x) (fi y)) <+> neg scrCentre 		let mPos@(HexVec x y z) = sVec2HexVec size sv 		let (sx,sy,sz) = sVec2dHV size sv-		let isCentral = all (\(a,b) -> abs ((fromIntegral a) - b) < 0.5) $+		let isCentral = all (\(a,b) -> abs ((fi a) - b) < 0.5) $ 			[(x,sx),(y,sy),(z,sz)] 		return ((mPos,isCentral),(sx,sy,sz)) 	    updateMousePos mode newPos = do@@ -490,7 +489,7 @@ 		    modify $ \ds -> ds { mousePos = newPos } 		    updateHoverStr mode -    showHelp mode 0 = do+    showHelp mode HelpPageInput = do 	bdgs <- nub <$> getBindings mode 	smallFont <- gets dispFontSmall 	renderToMain $ do@@ -544,7 +543,7 @@ 		| (str,y) <- zip extraHelpStrs [keybindingsHeight..] ] 	refresh 	return True-    showHelp IMMeta 1 = do+    showHelp IMMeta HelpPageGame = do 	renderToMain $ do 	    erase 	    let headPos = (screenHeightHexes`div`4)<*>(hv<+>neg hw)@@ -555,28 +554,7 @@ 		      <+> (y`div`2)<*>(hw<+>neg hv) 		      <+> (y`mod`2)<*>hw 		| (y,str) <- zip [2..]-		    [ "By ruthlessly guarded secret arrangement, the Council's agents can pick any lock in the city."-		    , "The Guild maintains this by producing apparently secure locks with fatal, but hidden, flaws."-		    , "The ritual game known as \"Intricacy\" is played to determine the best designs."-		    , "Players attempt to design locks which can be picked only by one who knows the secret,"-		    , "and try to discover the secret flaws in the designs of their colleagues."-		    , ""-		    , "You may put forward up to three prototype locks. They will guard the secrets you discover."-		    , "If you pick a colleague's lock, the rules require that you write a note describing your solution."-		    , "The composition and deciphering of notes is an art in itself, whose details do not concern us here,"-		    , "but a note must prove that the author found a solution, while aiming not to explain it in full."-		    , "To declare your success, you must secure your note behind a lock of your own."-		    , "If you are able to unlock a lock, you automatically read all the notes it secures."-		    , "If you read three notes on a lock, you will piece together the clues and work out how to solve it."-		    , ""-		    , "Players are judged relative to each of their peers. There are no absolute rankings."-		    , "Your esteem relative to another player ranges from +3 (best) to -3 (worst), calculated thusly:"-		    , "Take the number of their locks you can solve, and subtract the number of your locks they can solve."-		    , "Undeclared solutions don't count. Empty lock slots are considered solved if all actual locks are."-		    , ""-		    , "If the secrets to one of your locks become widely disseminated, you may wish to replace it."-		    , "Once replaced, a lock is \"retired\"; any notes it secured become \"public\" and are read by all."-		    ]+		    metagameHelpText 		] 	return True     showHelp _ _ = return False@@ -610,13 +588,23 @@ 	    [ "Wheel: advance/regress time" ] 	shortMouseHelp _ = [] +-- waitEvent' : copy of SDL.Events.waitEvent, with the timeout increased+-- drastically to reduce CPU load when idling.+waitEvent' :: IO Event+waitEvent' = loop+    where loop = do pumpEvents+                    event <- pollEvent+                    case event of+                      NoEvent -> threadDelay 10000 >> loop+                      _ -> return event+ getEvents = do-    e <- waitEvent+    e <- waitEvent'     es <- pollEvents     return $ e:es  getEventsTimeout us = do-    es <- maybeToList <$> timeout us waitEvent+    es <- maybeToList <$> timeout us waitEvent'     es' <- pollEvents     return $ es++es' @@ -714,7 +702,7 @@     col <- nameCol name     drawNameWithCharAndCol name charcol char col pos drawNameWithCharAndCol name charcol char col pos = do-    size <- fromIntegral.snd <$> lift getGeom+    size <- fi.snd <$> lift getGeom     let up = SVec 0 $ - (ysize size - size`div`2)     let down = SVec 0 $ ysize size     smallFont <- lift $ gets dispFontSmall@@ -809,7 +797,7 @@ 		fillArea (accessedPos<+>neg hu) [ accessedPos <+> i<*>hu | i <- [-1..1] ] 		    $ take 3 $ [ \pos -> (lift $ registerSelectable pos 0 (SelReadNote note)) >> drawNote note pos 			| note <- read ] ++ (repeat $ \pos -> (lift $ registerSelectable pos 0 SelReadNoteSlot >>-				renderToMain (drawAtRel (hollowGlyph $ dim green) pos)))+				renderToMain (drawAtRel (HollowGlyph $ dim green) pos)))      lift $ do 	renderToMain $ displaceRender (SVec size 0) $ renderStrColAt (brightish white) "NOTES" $ notesPos <+> hv
Util.hs view
@@ -29,3 +29,7 @@ -- same precedence as ($), allowing e.g. foo bar >>! error $ "failed " ++ meep infixr 0 >>? infixr 0 >>!++-- |fi: just a straight abbreviation for fromIntegral+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral
intricacy.cabal view
@@ -1,5 +1,5 @@ name:                intricacy-version:             0.4.3+version:             0.5 synopsis:            A game of competitive puzzle-design homepage:            http://mbays.freeshell.org/intricacy license:             GPL-3
− tutorial-extra/4-hook.lock
@@ -1,11 +0,0 @@-       & & & & & &       -      & S S " " " & & &  -     & S S " %   " &   & -    & ~ ~     % ' " " " &-   & ~   ~     o     & & -  & ~   # %     ` % % &  - & &   7 %         % &   -& * ' 7 %     # # # &    - & @ & %     # # # &     -  & & & % C C C C &      -       & & & & & &       
tutorial/1-winning.text view
@@ -1,1 +1,1 @@-use your tools, the hook and the wrench, to pull the bolt aside, then Open the lock+use your tools, the hook and the wrench, to pull the bolt aside; then press 'O'.