eratostenes

Main.purs

module Main where

import Prelude

import Concur.Core (Widget)
import Concur.React (HTML)
import Concur.React.DOM as D
import Concur.React.Props as P
import Concur.React.Run (runWidgetInDom)
import Concur.React.SVG as S
import Data.Array ((..), uncons, (:), elem)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.String (length)
import Data.Tuple.Nested ((/\), type (/\))
import Effect (Effect)

limit :: Int
limit = 30

dx = 50 :: Int
dy = 50 :: Int

text :: forall a. Int -> Int -> String -> Widget HTML a
text x y str = 
  let dx = case length str of
            1 -> 5
            3 -> -5
            _ -> 0
  in S.text [ P.unsafeMkProp "x" $ x + dx
            , P.unsafeMkProp "y" y
            , P.unsafeMkProp "fontSize" 30
            , P.fill "#000000"
    ] [D.text str]

circle :: forall a. String -> Int /\ Int -> Widget HTML a
circle color (x/\y) = 
  S.circle [ P.unsafeMkProp "cx" x
         , P.unsafeMkProp "cy" y
         , P.unsafeMkProp "r" 25
         , P.stroke color
         , P.strokeWidth 3
        , P.fill "none"
    ] []

line :: forall a. Int /\ Int -> Widget HTML a
line (x/\y) = 
  S.line [ P.unsafeMkProp "x1" $ x - 10
         , P.unsafeMkProp "y1" $ y - 10
         , P.unsafeMkProp "x2" $ x + 10
         , P.unsafeMkProp "y2" $ y + 10
         , P.stroke "#FF0000"
         , P.strokeWidth 3
    ] []

toGrid :: Int -> Int /\ Int
toGrid n =
  let j = n `mod` 10
      i = (n - j) / 10
    in j/\i
   
grid :: forall a. Array (Widget HTML a)
grid = 
  (\n -> 
    let i/\j = toGrid n
     in text (32 + i * dx) (60 + j * dy)  (show $ 1 + 10 * j + i) )
        <$> 0 .. (limit - 1)

type Model = { index :: Array Int
             , parsed ::Array (Either Int Int)
             }

head :: Array Int -> Int
head xs = case (uncons xs) of
  Just { head, tail} -> head
  _ -> 2

tail :: Array Int -> Array Int
tail xs = case (uncons xs) of
  Just { head, tail} -> tail
  _ -> []

value :: Either Int Int -> Int
value (Left x) = x
value (Right x) = x

nextIndex :: Model -> Int
nextIndex m =
  let p = head m.index
      vs = value <$> m.parsed
      f n = 
        if n `elem` vs
          then f (n+1)
          else n
  in f (p + 1)
  
modelInit :: Model
modelInit = { index: [2]
            , parsed: [Right 2, Left 1]
            }

display :: forall a. Model -> Array (Widget HTML a)
display model = 
  grid <> 
    ( 
      (\e -> case e of
        Left n -> 
          let x/\y = toGrid $ n - 1
          in line ((50 + x * dx)/\ (50 + y * dy))
        Right n -> 
          let x/\y = toGrid $ n - 1
          in circle "#00FF00" ((48 + x * dx)/\(50 + y * dy))
      ) <$> model.parsed
    ) <> 
    ( 
    let x/\y = toGrid $ head model.index - 1
    in if nextIndex model <= limit
      then [circle "#FF0000" ((48 + x * dx)/\(50 + y * dy))]
      else []
    )

modelWidget :: Model -> Widget HTML Model
modelWidget model = do
  newModel <- 
    D.div 
      [ 
      ] 
      [ D.button 
        [ (\m -> 
          let p = head m.index
              n = head $ value <$> m.parsed
              i = nextIndex m
          in case unit of
            unit | n `mod` p == 0 && n + p <= limit -> 
                      m { parsed = Left (n+p) : m.parsed}
                 | n `mod` p == 0 && i <= limit -> 
                      m { index = i : m.index
                        , parsed = Right i : m.parsed}
                 | otherwise -> m
          
          ) model <$ P.onClick
        , P.disabled $ nextIndex model > limit
        ] 
        [ D.text $ if nextIndex model <= limit
                      then "poursuivre"
                      else "terminé"]
      , S.svg 
        [ P.width "600"
        , P.height "500"
        , P.viewBox "6 6 606 506"  
        ] $ display model
      ]
                             
  modelWidget newModel
    
main :: Effect Unit
main = runWidgetInDom "main" 
           $ modelWidget modelInit