ascii-holidays-0.1.0.1: BashTree.hs

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