<commit_before>module AntsVis where

import Ants
import System.Random

import Graphics.UI.GLUT as G
import Data.Maybe (fromJust)

import Data.Vector (Vector)
import qualified Data.Vector as V

import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM

color4f :: Color4 GLfloat -> IO ()
color4f = color

vertex2f :: Vertex2 GLfloat -> IO ()
vertex2f = vertex :: Vertex2 GLfloat -> IO ()

colorVertex :: Color4 GLfloat -> Vertex2 GLfloat -> IO ()  
colorVertex c v = do
  color4f c
  vertex v

pos :: Vector (Int,Int)
pos = V.fromList [(y,x) | x <- [0..dim-1], y <- [0..dim-1]]

antBehave :: World -> (Int,Int) -> IO ()
antBehave world p = do
  gen <- newStdGen 
  newPos <- atomically $ behave gen world p                      
  _ <- threadDelay (antTick  * 1000)
  _ <- forkIO (antBehave world newPos)
  return ()

-- |Timeout in ms for the callback
tick :: Int
tick = 50

-- |Timeout for the ants 
antTick :: Int
antTick = 50

gridSize :: GLfloat
gridSize = 5

pherScale :: GLfloat
pherScale = 20.0

foodScale :: GLfloat
foodScale = 30.0

antInfo :: Direction -> (GLfloat,GLfloat,GLfloat,GLfloat)
antInfo N  = (2,0,2,4)
antInfo NE = (4,0,0,4)
antInfo E  = (4,2,0,2)
antInfo SE = (4,4,0,0)
antInfo Ants.S = (2,4,2,0) -- what is the S from Graphics.UI.Glut?
antInfo SW = (0,4,4,0)
antInfo W  = (0,2,4,2)
antInfo NW = (0,0,4,4)

displayFunc :: World -> DisplayCallback
displayFunc world = do
  clear [ColorBuffer]

  -- Draw the home area
  let h = fromIntegral homeOff * gridSize
      g = gridSize + gridSize * fromIntegral nantsSqrt
  renderPrimitive Quads $ do
                  colorVertex (Color4 0 0 1 0) (Vertex2 h h)
                  colorVertex (Color4 0 0 1 0) (Vertex2 (h+g) h)
                  colorVertex (Color4 0 0 1 0) (Vertex2 (h+g) (h+g))
                  colorVertex (Color4 0 0 1 0) (Vertex2 h (h+g))

  -- Then draw the relevant cells
  V.forM_ (V.zip pos (cells world)) (uncurry drawPlace) 
  swapBuffers

timerFunc :: World -> IO ()
timerFunc w = do
  postRedisplay Nothing
  atomically $ evaporate w
  addTimerCallback tick (timerFunc w)
  return ()

drawAnt :: (Int,Int) -> Ant -> IO ()
drawAnt (x,y) a = do
  let gray  = Color4 0.4 0.4 0.4 1 :: Color4 GLfloat
      red   = Color4 1 0 0 1 :: Color4 GLfloat
      (hx,hy,tx,ty) = antInfo (direction a)
      c = if hasFood a
          then red
          else gray
      x' = fromIntegral x * gridSize
      y' = fromIntegral y * gridSize
     
  renderPrimitive Lines $ do
                    colorVertex c (Vertex2 (hx + x') (hy + y'))
                    colorVertex c (Vertex2 (tx + x') (ty + y'))
  return ()

fillCell :: (Int,Int) -> Color4 GLfloat -> IO ()
fillCell (i,j) c = do
  let x = fromIntegral i *  gridSize
      y = fromIntegral j *  gridSize
  renderPrimitive Quads $ do
                     colorVertex c (Vertex2 x y)
                     colorVertex c (Vertex2 (x + gridSize) y)
                     colorVertex c (Vertex2 (x + gridSize) (y + gridSize))
                     colorVertex c (Vertex2 x (y + gridSize))

drawPlace :: (Int,Int) -> TCell -> IO ()
drawPlace loc tcell = do
  cell <- atomically $ readTVar tcell
  when (pheromone cell > 0)
       (fillCell loc (Color4 0 1 0 (realToFrac (pheromone cell) / pherScale)))
  when (food cell > 0)
       (fillCell loc (Color4 1 0 0 (fromIntegral (food cell) / foodScale)))
  when (hasAnt cell)
       (drawAnt loc (fromJust $ ant cell))

reshapeFunc :: ReshapeCallback
reshapeFunc size@(Size _ height) =
    unless (height == 0) $ do
      viewport $= (Position 0 0, size)
      matrixMode $= Projection
      loadIdentity
      ortho2D 0 400 0 400 
      clearColor $= Color4 0 0 0 1

main :: IO ()
main = do
  _ <- getArgsAndInitialize
  initialDisplayMode $= [DoubleBuffered,RGBAMode]
  initialWindowSize $= Size 512 512
  initialWindowPosition $= Position 0 0
  _ <- createWindow "Ants in Haskell."
  clearColor $= Color4 0 0 0 1

  gen <- getStdGen
  w <- mkWorld
  ants <- populateWorld gen w
  
  forM_ (take 10 ants) (antBehave w)

  displayCallback $= displayFunc w<commit_msg>Don't spawn unnecessary threads.  But do spawn necessary ones, namely not blocking the main fucking thread you moron jeff<commit_after>module AntsVis where

import Ants
import System.Random

import Graphics.UI.GLUT as G
import Data.Maybe (fromJust)

import Data.Vector (Vector)
import qualified Data.Vector as V

import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM

color4f :: Color4 GLfloat -> IO ()
color4f = color

vertex2f :: Vertex2 GLfloat -> IO ()
vertex2f = vertex :: Vertex2 GLfloat -> IO ()

colorVertex :: Color4 GLfloat -> Vertex2 GLfloat -> IO ()  
colorVertex c v = do
  color4f c
  vertex v

pos :: Vector (Int,Int)
pos = V.fromList [(y,x) | x <- [0..dim-1], y <- [0..dim-1]]

antBehave :: World -> (Int,Int) -> IO ()
antBehave world p = do
  gen <- newStdGen 
  newPos <- atomically $ behave gen world p                      
  _ <- threadDelay (antTick  * 1000)
  antBehave world newPos

-- |Timeout in ms for the callback
tick :: Int
tick = 100

-- |Timeout for the ants 
antTick :: Int
antTick = 150

gridSize :: GLfloat
gridSize = 5

pherScale :: GLfloat
pherScale = 20.0

foodScale :: GLfloat
foodScale = 30.0

antInfo :: Direction -> (GLfloat,GLfloat,GLfloat,GLfloat)
antInfo N  = (2,0,2,4)
antInfo NE = (4,0,0,4)
antInfo E  = (4,2,0,2)
antInfo SE = (4,4,0,0)
antInfo Ants.S = (2,4,2,0) -- what is the S from Graphics.UI.Glut?
antInfo SW = (0,4,4,0)
antInfo W  = (0,2,4,2)
antInfo NW = (0,0,4,4)

displayFunc :: World -> DisplayCallback
displayFunc world = do
  clear [ColorBuffer]

  -- Draw the home area
  let h = fromIntegral homeOff * gridSize
      g = gridSize + gridSize * fromIntegral nantsSqrt
  renderPrimitive Quads $ do
                  colorVertex (Color4 0 0 1 0) (Vertex2 h h)
                  colorVertex (Color4 0 0 1 0) (Vertex2 (h+g) h)
                  colorVertex (Color4 0 0 1 0) (Vertex2 (h+g) (h+g))
                  colorVertex (Color4 0 0 1 0) (Vertex2 h (h+g))

  -- Then draw the relevant cells
  V.forM_ (V.zip pos (cells world)) (uncurry drawPlace) 
  swapBuffers

timerFunc :: World -> IO ()
timerFunc w = do
  postRedisplay Nothing
  atomically $ evaporate w
  addTimerCallback tick (timerFunc w)
  return ()

drawAnt :: (Int,Int) -> Ant -> IO ()
drawAnt (x,y) a = do
  let gray  = Color4 0.4 0.4 0.4 1 :: Color4 GLfloat
      red   = Color4 1 0 0 1 :: Color4 GLfloat
      (hx,hy,tx,ty) = antInfo (direction a)
      c = if hasFood a
          then red
          else gray
      x' = fromIntegral x * gridSize
      y' = fromIntegral y * gridSize
     
  renderPrimitive Lines $ do
                    colorVertex c (Vertex2 (hx + x') (hy + y'))
                    colorVertex c (Vertex2 (tx + x') (ty + y'))
  return ()

fillCell :: (Int,Int) -> Color4 GLfloat -> IO ()
fillCell (i,j) c = do
  let x = fromIntegral i *  gridSize
      y = fromIntegral j *  gridSize
  renderPrimitive Quads $ do
                     colorVertex c (Vertex2 x y)
                     colorVertex c (Vertex2 (x + gridSize) y)
                     colorVertex c (Vertex2 (x + gridSize) (y + gridSize))
                     colorVertex c (Vertex2 x (y + gridSize))

drawPlace :: (Int,Int) -> TCell -> IO ()
drawPlace loc tcell = do
  cell <- atomically $ readTVar tcell
  when (pheromone cell > 0)
       (fillCell loc (Color4 0 1 0 (realToFrac (pheromone cell) / pherScale)))
  when (food cell > 0)
       (fillCell loc (Color4 1 0 0 (fromIntegral (food cell) / foodScale)))
  when (hasAnt cell)
       (drawAnt loc (fromJust $ ant cell))

reshapeFunc :: ReshapeCallback
reshapeFunc size@(Size _ height) =
    unless (height == 0) $ do
      viewport $= (Position 0 0, size)
      matrixMode $= Projection
      loadIdentity
      ortho2D 0 400 0 400 
      clearColor $= Color4 0 0 0 1

main :: IO ()
main = do
  _ <- getArgsAndInitialize
  initialDisplayMode $= [DoubleBuffered,RGBAMode]
  initialWindowSize $= Size 512 512
  initialWindowPosition $= Position 0 0
  _ <- createWindow "Ants in Haskell."
  clearColor $= Color4 0 0 0 1

  gen <- getStdGen
  w <- mkWorld
  ants <- populateWorld gen w
  
  forM_ (ants) (\x -> forkIO $ (antBehave w x >> return ()))

  displayCallback $= displayFunc w
{'fraction_non_alphanumeric': 0.11174610894941635, 'fraction_numerical': 0.03623540856031129, 'mean_word_length': 2.565236237537928, 'pattern_counts': {'":': 0, '<': 26, '<?xml version=': 0, '>': 42, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3658153', 'n_tokens_mistral': 3012, 'n_tokens_neox': 2782, 'n_words': 957}