0.14 version of Lib.elm

Lib.elm

import Set
import Array
import Text
import Time
import Mouse
import Keyboard
import Graphics.Collage
import Graphics.Element
import Graphics.Input
import Html
import Color
import List
import List ((::))
import Maybe
import Signal
import Signal (Signal, (<~), sampleOn, constant, foldp, map, map2, merge)

---------------------------------
-- write program here













---------------------------------
-- ignore everything below here


gridsize = 20

makeGrid x1 y1 x2 y2 =
  let
    x_ = (x1 + x2) / 2
    xh = x_ - x1
    y_ = (y1 + y2) / 2
    yh = y_ - y1
  in
   group
   [ group <|
     List.map (\i -> let x = toFloat i * gridsize - x_ in path' (dotted (Color.greyscale 0.15)) [ (x,-yh), (x,yh) ])
              [ ceiling (x1/gridsize) .. floor (x2/gridsize) ]
   , group <|
     List.map (\j -> let y = toFloat j * gridsize - y_ in path' (dotted (Color.greyscale 0.15)) [ (-xh,y), (xh,y) ])
              [ ceiling (y1/gridsize) .. floor (y2/gridsize) ]
   , move (-x_,-y_) (Graphics.Collage.filled red (Graphics.Collage.circle 2))
   ]

type Timing = Every Float | FPS Float | AnimationFrame

display' : (Int,Int) -> (Int,Int) -> ((Float,Float) -> Float -> Picture) -> Maybe Timing -> Signal Graphics.Element.Element
display' p1 p2 f =
  displayWithState' p1 p2 (\p t _ -> f p t) () (\_ _ _ -> identity)

displayWithState' : (Int,Int) -> (Int,Int) -> ((Float,Float) -> Float -> a -> Picture) -> a -> (Event -> (Float,Float) -> Float -> a -> a) -> Maybe Timing -> Signal Graphics.Element.Element
displayWithState' (x1,y1) (x2,y2) f =
  let
    x2_ = max (x1 + 1) x2
    y2_ = max (y1 + 1) y2
    d = (toFloat (-x1 - x2_) / 2, toFloat (-y1 - y2_) / 2) 
  in
   toScreen x1 y2_ (\_ p t s -> Graphics.Collage.collage (x2_ - x1) (y2_ - y1) [ move d (f p t s) ]) []

display : (Int,Int) -> (Int,Int) -> ((Float,Float) -> Float -> Picture) -> Maybe Timing -> Signal Graphics.Element.Element
display p1 p2 f mt =
  elaborateDisplay (Maybe.map (always "Zeit auf Null") mt) p1 p2 (\p t _ -> f p t) () (\_ _ _ -> identity) mt

displayWithState : (Int,Int) -> (Int,Int) -> ((Float,Float) -> Float -> a -> Picture) -> a -> (Event -> (Float,Float) -> Float -> a -> a) -> Maybe Timing -> Signal Graphics.Element.Element
displayWithState =
  elaborateDisplay (Just "auf Anfang")

elaborateDisplay mr (x1,y1) (x2,y2) f ini upd =
  let x2_ = max (x1 + 1) x2
      y2_ = max (y1 + 1) y2
      x1' = toFloat x1
      y1' = toFloat y1
      x2' = toFloat x2_
      y2' = toFloat y2_
      grid = makeGrid x1' y1' x2' y2'
      gridMbx = Signal.channel False  -- value here actually irrelevant
      gridCheck = Graphics.Input.checkbox (Signal.send gridMbx)
      restartMbx = Signal.channel ()
      restartButt = case mr of
                      Nothing -> []
                      Just msg -> [ Graphics.Element.spacer 10 10, Graphics.Input.button (Signal.send restartMbx ()) msg ]
      x = x2_ - x1
      y = y2_ - y1
      d = ((-x1' - x2') / 2, (-y1' - y2') / 2)
      f' g p t s =
         Graphics.Element.flow Graphics.Element.up
         [ Graphics.Element.flow Graphics.Element.left <| Text.asText p :: gridCheck g :: restartButt
         , Graphics.Element.color (Color.greyscale 0.05) <|
           Graphics.Element.container x y Graphics.Element.middle <|
           Graphics.Collage.collage x y
           ((if g then [ grid ] else []) ++ [ move d (f p t s) ]) ]
  in
   toScreen x1 y2_ f'
   [ Signal.map
       (\g _ t' state -> (t', { state | gridOn <- g, s <- upd NoEvent state.mousePos t' state.s }))
       (Signal.subscribe gridMbx)
   , Signal.map
       (\_ t _ state -> (0, { state | lastReset <- t, s <- ini }))
       (Signal.subscribe restartMbx)
   ]
   ini upd

type Event = Space | Left | Up | Right | Down | Click | NoEvent
           | A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z

toScreen x1 y2 f extra_sigs ini upd mt =
  let
    letters = Array.fromList [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z]
  in
   Signal.map (\(t, { gridOn, mousePos, s }) -> f gridOn mousePos t s) <|
   foldp'  -- Signal.Extra.foldp'
     (\(t, action) (_, state) -> action t ((t - state.lastReset) / 1000) state)
     (\(t, _) -> (0, { gridOn = False, mousePos = (0,0), lastReset = t, s = ini }))
   <|
   Time.timestamp <|
   Signal.mergeMany <|
   List.map (Signal.map (\event _ t' state -> (t', { state | s <- upd event state.mousePos t' state.s })))
     [ Signal.map (always NoEvent) <|
         case mt of
           Nothing             -> Signal.constant 0
           Just (Every f)      -> Time.every (if f < 0.017 then 17 else 1000 * f)
           Just (FPS f)        -> Time.fps (if f > 60 then 60 else f)
           Just AnimationFrame -> Time.fps 50  -- AnimationFrame.frame
     , Signal.map
         (\ks -> case ks of
                   [32] -> Space
                   [37] -> Left
                   [38] -> Up
                   [39] -> Right
                   [40] -> Down
                   [a]  -> Maybe.withDefault NoEvent (Array.get (a - 65) letters)
                   _ -> NoEvent)
         Keyboard.keysDown
     , Signal.map (always Click) Mouse.clicks
     ]
   ++
   Signal.map
       (\(x,y) _ t' state -> let pos = (toFloat (x1 + x), toFloat (y2 - y))
                             in (t', { state | mousePos <- pos, s <- upd NoEvent pos t' state.s }))
       Mouse.position
   ::
   extra_sigs

type alias Picture = Graphics.Collage.Form

circle : Float -> Picture
circle = circle' Graphics.Collage.defaultLine

circle' : LineStyle -> Float -> Picture
circle' s r =
  Graphics.Collage.outlined s <|
  Graphics.Collage.circle r

rectangle : (Float,Float) -> Picture
rectangle = rectangle' Graphics.Collage.defaultLine

rectangle' : LineStyle -> (Float,Float) -> Picture
rectangle' s (x,y) =
  Graphics.Collage.outlined s <|
  Graphics.Collage.rect x y

path : List (Float,Float) -> Picture
path = path' Graphics.Collage.defaultLine

path' : LineStyle -> List (Float,Float) -> Picture
path' s ps =
  Graphics.Collage.traced s <|
  Graphics.Collage.path ps

oval : (Float,Float) -> Picture
oval = oval' Graphics.Collage.defaultLine

oval' : LineStyle -> (Float,Float) -> Picture
oval' s (x,y) =
  Graphics.Collage.outlined s <|
  Graphics.Collage.oval x y

square : Float -> Picture
square = square' Graphics.Collage.defaultLine

square' : LineStyle -> Float -> Picture
square' s a =
  Graphics.Collage.outlined s <|
  Graphics.Collage.square a

type alias Color = Color.Color

ngon : Float -> Float -> Picture
ngon = ngon' black

ngon' : Color -> Float -> Float -> Picture
ngon' c n r =
  Graphics.Collage.rotate (pi/2) <|
  Graphics.Collage.filled c <|
  Graphics.Collage.ngon (floor n) r

polygon : List (Float,Float) -> Picture
polygon = polygon' Graphics.Collage.defaultLine

polygon' : LineStyle -> List (Float,Float) -> Picture
polygon' s ps =
  Graphics.Collage.outlined s <|
  Graphics.Collage.polygon ps

text : String -> Picture
text s =
  Graphics.Collage.toForm <|
  Text.leftAligned <|
  Text.fromString s

move : (Float,Float) -> Picture -> Picture
move = Graphics.Collage.move

group : List Picture -> Picture
group = Graphics.Collage.group

scale : Float -> Picture -> Picture
scale x f =
  Graphics.Collage.scale x <|
  group [ f ]

rotate : Float -> Picture -> Picture
rotate a f =
  Graphics.Collage.rotate a <|
  group [ f ]

alpha : Float -> Picture -> Picture
alpha = Graphics.Collage.alpha

type alias LineStyle = Graphics.Collage.LineStyle

solid : Color -> LineStyle
solid = Graphics.Collage.solid

dashed : Color -> LineStyle
dashed = Graphics.Collage.dashed

dotted : Color -> LineStyle
dotted = Graphics.Collage.dotted

red : Color
red = Color.red

orange : Color
orange = Color.orange

yellow : Color
yellow = Color.yellow

green : Color
green = Color.green

blue : Color
blue = Color.blue

purple : Color
purple = Color.purple

brown : Color
brown = Color.brown

white : Color
white = Color.white

black : Color
black = Color.black

image : (Float,Float) -> String -> Picture
image (x,y) s =
  Graphics.Collage.toForm <|
  Graphics.Element.image (round x) (round y) s

empty : Picture
empty = Graphics.Collage.toForm Graphics.Element.empty

icon : Float -> (Color -> Int -> Html.Html) -> Picture
icon = icon' black

icon' : Color -> Float -> (Color -> Int -> Html.Html) -> Picture
icon' c s i =
  let s' = round s
  in
   Graphics.Collage.toForm <|
   Html.toElement s' s' <|
   i c s'

---------------------------------
-- auxiliary, from Signal.Extra

(~>) : Signal a -> (a -> b) -> Signal b
(~>) =
  flip map

infixl 4 ~>

initSignal : Signal a -> Signal a
initSignal s =
  sampleOn (constant ()) s

zip : Signal a -> Signal b -> Signal (a,b)
zip =
  map2 (,)

foldp' : (a -> b -> b) -> (a -> b) -> Signal a -> Signal b
foldp' fun initFun input =
  let -- initial has no events, only the initial value is used
    initial = initSignal input ~> initFun
    -- both the initial value and the normal input are given to fun'
    rest = foldp fun' Nothing (zip input initial)
    -- when mb is Nothing, input had its first event to use ini
    -- otherwise use the b from Just
    fun' (inp, ini) mb =
      Maybe.withDefault ini mb
      |> fun inp |> Just
    
    fromJust (Just a) = a
  in
    fromJust <~ merge (Just <~ initial) rest