module Viral where import qualified SOEGraphics as G import Monad import Random --TYPES-- type Tile = Strain type Column = [Tile] type Board = [Column] type Coords = (Int,Int) type Seed = Int type Strain = Int type Score = Int type TileCount = Int type Gamestate = (Board,Score) ------------------- -- viralt / viraltStep - Performs text rendering of the game ------------- viralt::Coords->Int->Seed->IO () viralt c i s = viraltStep (spawn c i s,0) viraltStep::Gamestate->IO() viraltStep (b,s)= do boardPrint (b,s) putStr "Please Enter New Coordinates:" k<-readLn let (b',s') = (\(b,tc)->(wither b, (toll tc) + s)) $ infector b k in if (prey b') then viraltStep (b',s') else do boardPrint (b',s') putStr "No Moves Remain\n" boardPrint :: (Board,Score)->IO () boardPrint (b,s) = do putStr $ matrixShow $ reverse $ twist b putStr $ "Score: " ++ show s ++ "\n" matrixShow :: (Show a) => [[a]]->String matrixShow [] = "" matrixShow (c:cs) = showCol c ++ matrixShow cs where showCol [] = "\n" showCol (t:ts) = show t ++ " " ++ showCol ts ------------------- -- viral / viralStep - Performs Graphical rendering of the game ------------- pps = 32 :: Int offsets=[0,pps..] viral0 = viral' 0 viral' s = viral (12,12) 6 s viral::Coords->Int->Seed->IO () viral c i s = let b = spawn c i s (bw,bh) = ((length b)*pps,(length (b!!1)) * pps) tt = length b * length (b!!1) in G.runGraphics $ do w <- G.openWindow "Viral" (bw+pps*2,bh+pps*2) G.drawInWindow w (G.withRGB (G.RGB 128 128 128) $ G.polygon $ rect (0,0) (bw+2*pps,bh+2*pps)) G.drawInWindow w (G.withRGB (G.RGB 192 192 192) $ G.polygon $ rect (pps-1,pps-1) (bw+3,bh+3)) G.drawInWindow w (G.withRGB (G.RGB 96 96 96) $ G.polygon $ rect (pps-3,pps-3) (bw+3,bh+3)) G.drawInWindow w (G.withRGB (G.RGB 0 0 0) $ G.polygon $ rect (pps-2,pps-2) (bw+3,bh+3)) viralStep w (b,0) tt viralStep::G.Window->Gamestate->TileCount->IO() viralStep w (b,s) tt= do drawScore w b (show s ++ " Points - " ++ show tt ++ " Tiles") drawBoard w (b,s) (x,y) <- G.getLBP w let (b',s',tt') = (\(b',tc)->if (tc > 1) then (wither b', (toll tc) + s,tt-tc) else (b,s,tt)) $ infector b (x `div` pps - 1, (length (b!!1)) - (y `div` pps)) in if (prey b') then viralStep w (b',s') tt' else do drawBoard w (b',s') drawScore w b' (show s' ++ " Points - " ++ show tt' ++ " Tiles") G.drawInWindow w (G.text (pps,8) "No Moves Remain") k<-G.getKey w G.closeWindow w ------------------- -- drawBoard - draws the tiles of the board -------------- drawBoard :: G.Window->Gamestate->IO() drawBoard w (b,s) = foldM (\_ x->G.drawInWindow w (x)) () (render b) ------------------- -- drawScore - draws message at the bottom (erasing with grey rectangle) -------------- drawScore :: G.Window->Board->String->IO() drawScore w b s = do G.drawInWindow w $ G.withRGB (G.RGB 128 128 128) $ G.polygon $ rect (pps,bh+3) (bw-pps,pps-4) G.drawInWindow w (G.text (pps,bh+8) s) where (bh,bw) = ((length (b!!1) + 1)*pps,(length b +1)* pps) ------------------- -- render - Converts the board into a list of graphics -------------- render :: Board -> [G.Graphic] -- Converts the board into a list of graphics render b = concat $ zipWith (\c dx->zipWith (\t dy->renderTile t (dx+pps,dy+pps)) (reverse c) offsets) b offsets where renderTile c (dx,dy) = G.withRGB (colors !! c) (square (dx,dy)) square (x,y) = G.polygon $ rect (x,y) (pps-1,pps-1) ------------------- -- rect - Simpler rectangle creator -------------- rect (x,y) (w,h) = [(x,y),(x+w,y),(x+w,y+h),(x,y+h)] ------------------- -- colors - The colors used in the game. The later ones get difficult to differentiate -------------- colors = [ G.RGB 0 0 0 , G.RGB 0 0 255 , G.RGB 0 255 0 , G.RGB 255 0 0 , G.RGB 0 255 255 , G.RGB 255 255 0 , G.RGB 255 0 255 , G.RGB 127 127 255 , G.RGB 127 255 127 , G.RGB 255 127 127 , G.RGB 191 255 255 , G.RGB 255 255 127 , G.RGB 255 127 255 , G.RGB 127 127 127 ] ---------------------------------------------------------------------- -- Board Manipulation Functions --------------------------------- ----------------- -- spawn - creates a new random board -------------- spawn::Coords->Strain->Seed->Board spawn (h,w) strain seed = slice h rs where rs = take (h*w) $ randomRs (1,strain) $ mkStdGen seed -------------- -- twist - rotates board 90 degrees (for testing neighbors and printing) -------------- twist::Board->Board twist b = case b of [] -> repeat [] (c:cs) -> zipWith (:) c (twist cs) ------------------- -- slice - splits a list into pieces. Each is x elements long. -------------- slice::Int->[a]->[[a]] slice _ [] = [] slice x as = a : (slice x as') where (a, as') = splitAt x as -------------------- -- infector - calculates the Strain of the selected tile and calls infect -- infect - sets all neighboring tiles to zero, processing their neighbors too ------------------ infector::Board->Coords->(Board,Int) --Returns Board and Number of tiles removed infector b (x,y) | (x<0 || y<0 || x>= length b || y>= (length $ head b)) = (b,0) -- Filters out invalid Coords infector b (x,y) = if (s'/=0) then infect (b,0) [(x,y)] s' else (b,0) where s' = ((!!) ((!!) b x) y) infect::(Board,Int)->[Coords]->Strain->(Board,Int) infect b' [] _ = b' infect (b,tc) ((x,y):vics) s | (x<0 || y<0 || x>= length b || y>= (length $ head b)) = infect (b,tc) vics s -- Filters out invalid neigbors infect (b,tc) ((x,y):vics) s = infect (b',tc') (vics ++ vics') s where (cpad,(c:cs)) = splitAt x b (tpad,(t:ts)) = splitAt y c c' = tpad ++ (t':ts) b' = cpad ++ (c':cs) (t', tc', vics') = if (t/=s) then (t,tc,[]) else (0,tc+1,spread (x,y)) spread (x,y) = [(x+1,y),(x-1,y),(x,y+1),(x,y-1)] --------------- -- prey - finds possible pairs to infect ---------------- prey::Board->Bool prey x = bPrey x || bPrey (twist x) where bPrey b = or $ map (cPrey) b cPrey c = or $ zipWith pair c (tail c) pair x y = if (x==0) then False else (x==y) ------------------ -- wither - collapses every column, moves empty columns to end --------------- wither::Board->Board wither b = case b of [] -> [] (c:cs) -> if ((foldl (+) 0 c)==0) then (cs' ++ [c]) else (c':cs') where cs' = wither cs c' = collapse c collapse x = case x of [] -> [] (0:ts) -> (collapse ts ++ [0]) (t:ts) -> (t:collapse ts) ----------------- -- toll - calculates the scored value from tiles removed -------------- toll::Int->Int toll i = if (i>2) then (i-2)*(i-2) else 0