module BashTree (drawBashTree) where import Util bashTriHeight, bashTrunkHeight, bashTreeHeight, bashNumOrnaments :: Int bashTriHeight = 10 -- 38 bashTrunkHeight = 2 bashTreeHeight = bashTriHeight + bashTrunkHeight bashNumOrnaments = 35 drawBashTree :: IO () drawBashTree = do g <- newStdGen nextYear <- getNextYear term <- setupTermFromEnv let Just width = getCapability term termColumns centerCol = width `div` 2 writeAt <- getWriteAt term mapM_ writeAt $ bashTri centerCol ++ bashTrunk centerCol ++ [ Write (bashTreeHeight + 2) (centerCol - 8) Bold Red "MERRY CHRISTMAS" , Write (bashTreeHeight + 3) (centerCol - 12) Bold Red $ "And lots of CODE in " ++ show nextYear ] forM_ (zip (cycle builtInColors) (randPoss centerCol g)) $ \(c, (oldPos, (newRow, newCol))) -> do case oldPos of Nothing -> pure () -- "Clean up" an ornament: Just (a, b) -> writeAt $ Write a b Bold Green "*" -- Place a new ornament: writeAt $ Write newRow newCol Bold c "o" forM_ (zip "CODE" [centerCol ..]) $ \(char, row) -> do writeAt $ Write (bashTriHeight + bashTrunkHeight + 3) row Bold c [char] threadDelay (10^(5::Int)) allBashTreePositions :: Int -> [(Int, Int)] allBashTreePositions centerCol = (`concatMap` [1..bashTriHeight]) $ \n -> [ (n+1, col) | col <- take ((n*2)-1) [centerCol - n ..]] pickPos :: Int -> Int -> (Int, Int) pickPos centerCol n = poss !! (abs n `mod` (length::[x]->Int) poss) where poss = allBashTreePositions centerCol bashTri, bashTrunk :: Int -> [Write] bashTri centerCol = [ Write row col Bold Green "*" | (row, col) <- allBashTreePositions centerCol ] bashTrunk centerCol = [ Write col (centerCol - 2) Plain Yellow "mWm" | col <- take bashTrunkHeight [bashTriHeight + 2 ..] ] -- The way it works in the other one is they lay down some number of 'lights', then after that number is present, they remove the oldest first each time they add a new one -- The fst Maybe is the ornament that we may want to clean up -- TODO: keep a list of all that are on - each time you add a new one, remove one. don't select the same one twice. use shuffle or 'pick', should be easy. randPoss :: RandomGen g => Int -> g -> [(Maybe (Int, Int), (Int, Int))] randPoss centerCol g = zip (replicate bashNumOrnaments Nothing ++ map Just randPos) randPos where randPos :: [(Int, Int)] randPos = map (pickPos centerCol) $ randoms g