<commit_before>{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}

{-
  Copyright 2019 The CodeWorld Authors. All rights reserved.

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}

module CodeWorld.Parameter
  {-# WARNING "This is an experimental API.  It can change at any time." #-}
  ( Parameter,
    parametricDrawingOf,
    parameterOf,
    paramConversion,
    constant,
    toggle,
    slider,
    random,
    timer,
    currentHour,
    currentMinute,
    currentSecond,
  )
where

import CodeWorld
import CodeWorld.Driver (runInspect)
import Data.Maybe (catMaybes)
import Data.Text (Text, pack)
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.LocalTime
import Numeric (showFFloatAlt)
import System.IO.Unsafe (unsafePerformIO)
import System.Random (newStdGen, randomR)

-- | A drawing that depends on parameters.  A parameter is a
parametricDrawingOf :: [Parameter] -> ([Double] -> Picture) -> IO ()
parametricDrawingOf initialParams mainPic =
  runInspect
    (layout (-7) 9.5 initialParams, True, 5)
    (const id)
    change
    picture
    rawPicture
  where
    layout _ _ [] = []
    layout x y (p : ps)
      | y > (-9.5) + h + 0.7 =
        framedParam x (y - 1.2) p : layout x (y - h - 1.2) ps
      | otherwise = layout (x + 6) 9.5 (p : ps)
      where
        h
          | Parameter _ _ _ Nothing <- p = 0
          | otherwise = 1
    change (KeyPress " ") (params, vis, _) = (params, not vis, 2)
    change event (params, vis, t) =
      (map (changeParam event) params, vis, changeTime event t)
    picture (params, False, t) =
      showHideBanner t
        & mainPic (map getParam params)
    picture (params, True, t) =
      showHideBanner t
        & pictures (catMaybes (map showParam params))
        & mainPic (map getParam params)
    rawPicture (params, _, _) = mainPic (map getParam params)
    changeParam event (Parameter _ handle _ _) = handle event
    showParam (Parameter _ _ _ pic) = pic
    getParam (Parameter _ _ val _) = val
    changeTime (TimePassing dt) t = max 0 (t - dt)
    changeTime _ t = t
    showHideBanner 0 = blank
    showHideBanner t =
      dilated 0.7 $
        colored (RGBA 0 0 0 t) (rectangle 10 2.5)
          & colored
            (RGBA 0 0 0 t)
            (translated 0 0.5 $ lettering "Press 'Space' to")
          & colored
            (RGBA 0 0 0 t)
            (translated 0 (-0.5) $ lettering "show/hide parameters.")
          & colored (RGBA 0.75 0.75 0.75 (min 0.8 t)) (solidRectangle 10 2.5)

data Parameter where
  Parameter ::
    Text ->
    (Event -> Parameter) ->
    Double ->
    Maybe Picture ->
    Parameter

parameterOf ::
  Text ->
  state ->
  (Event -> state -> state) ->
  (state -> Double) ->
  (state -> Maybe Picture) ->
  Parameter
parameterOf name initial change value picture =
  Parameter
    name
    (\e -> parameterOf name (change e initial) change value picture)
    (value initial)
    (picture initial)

paramConversion :: (Double -> Double) -> Parameter -> Parameter
paramConversion c (Parameter name handle val pic) =
  Parameter name (paramConversion c . handle) (c val) pic

framedParam :: Double -> Double -> Parameter -> Parameter
framedParam ix iy iparam =
  parameterOf
    (paramName iparam)
    (iparam, (ix, iy), True, Nothing)
    frameHandle
    frameValue
    framePicture
  where
    frameHandle (PointerPress (px, py)) (param, (x, y), open, anchor)
      | onOpenButton = (param, (x, y), not open, anchor)
      | onTitleBar = (param, (x, y), open, Just (px, py))
      where
        onTitleBar = abs (px - x) < 2.5 && abs (py - y - 0.85) < 0.35
        onOpenButton = abs (px - x - 2.15) < 0.2 && abs (py - y - 0.85) < 0.2
    frameHandle (PointerRelease _) (param, loc, open, Just _) =
      (param, loc, open, Nothing)
    frameHandle (PointerMovement (px, py)) (param, (x, y), open, Just (ax, ay)) =
      (param, (x + px - ax, y + py - ay), open, Just (px, py))
    frameHandle event (Parameter _ handle _ _, (x, y), True, anchor) =
      (handle (untranslate x y event), (x, y), True, anchor)
    frameHandle (TimePassing dt) (Parameter _ handle _ _, loc, open, anchor) =
      (handle (TimePassing dt), loc, open, anchor)
    frameHandle _ other = other
    frameValue (Parameter _ _ v _, _, _, _) = v
    framePicture (Parameter n _ v picture, (x, y), open, _) =
      Just
        $ translated x y
        $ translated 0 0.85 (titleBar n v open picture)
          & clientArea open picture<commit_msg>Cleanup: swap field order for Parameter type<commit_after>{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RankNTypes #-}

{-
  Copyright 2019 The CodeWorld Authors. All rights reserved.

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}

module CodeWorld.Parameter
  {-# WARNING "This is an experimental API.  It can change at any time." #-}
  ( Parameter,
    parametricDrawingOf,
    parameterOf,
    paramConversion,
    constant,
    toggle,
    slider,
    random,
    timer,
    currentHour,
    currentMinute,
    currentSecond,
  )
where

import CodeWorld
import CodeWorld.Driver (runInspect)
import Data.Maybe (catMaybes)
import Data.Text (Text, pack)
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.LocalTime
import Numeric (showFFloatAlt)
import System.IO.Unsafe (unsafePerformIO)
import System.Random (newStdGen, randomR)

data Parameter where
  Parameter ::
    Text ->
    Double ->
    Maybe Picture ->
    (Event -> Parameter) ->
    Parameter

-- | A drawing that depends on parameters.  A parameter is a
parametricDrawingOf :: [Parameter] -> ([Double] -> Picture) -> IO ()
parametricDrawingOf initialParams mainPic =
  runInspect
    (layout (-7) 9.5 initialParams, True, 5)
    (const id)
    change
    picture
    rawPicture
  where
    layout _ _ [] = []
    layout x y (p : ps)
      | y > (-9.5) + h + 0.7 =
        framedParam x (y - 1.2) p : layout x (y - h - 1.2) ps
      | otherwise = layout (x + 6) 9.5 (p : ps)
      where
        h
          | Parameter _ _ Nothing _ <- p = 0
          | otherwise = 1
    change (KeyPress " ") (params, vis, _) = (params, not vis, 2)
    change event (params, vis, t) =
      (map (changeParam event) params, vis, changeTime event t)
    picture (params, False, t) =
      showHideBanner t
        & mainPic (map getParam params)
    picture (params, True, t) =
      showHideBanner t
        & pictures (catMaybes (map showParam params))
        & mainPic (map getParam params)
    rawPicture (params, _, _) = mainPic (map getParam params)
    changeParam event (Parameter _ _ _ handle) = handle event
    showParam (Parameter _ _ pic _) = pic
    getParam (Parameter _ val _ _) = val
    changeTime (TimePassing dt) t = max 0 (t - dt)
    changeTime _ t = t
    showHideBanner 0 = blank
    showHideBanner t =
      dilated 0.7 $
        colored (RGBA 0 0 0 t) (rectangle 10 2.5)
          & colored
            (RGBA 0 0 0 t)
            (translated 0 0.5 $ lettering "Press 'Space' to")
          & colored
            (RGBA 0 0 0 t)
            (translated 0 (-0.5) $ lettering "show/hide parameters.")
          & colored (RGBA 0.75 0.75 0.75 (min 0.8 t)) (solidRectangle 10 2.5)

parameterOf ::
  Text ->
  state ->
  (Event -> state -> state) ->
  (state -> Double) ->
  (state -> Maybe Picture) ->
  Parameter
parameterOf name initial change value picture =
  Parameter
    name
    (value initial)
    (picture initial)
    (\e -> parameterOf name (change e initial) change value picture)

paramConversion :: (Double -> Double) -> Parameter -> Parameter
paramConversion c (Parameter name val pic handle) =
  Parameter name (c val) pic (paramConversion c . handle)

framedParam :: Double -> Double -> Parameter -> Parameter
framedParam ix iy iparam =
  parameterOf
    (paramName iparam)
    (iparam, (ix, iy), True, Nothing)
    frameHandle
    frameValue
    framePicture
  where
    frameHandle (PointerPress (px, py)) (param, (x, y), open, anchor)
      | onOpenButton = (param, (x, y), not open, anchor)
      | onTitleBar = (param, (x, y), open, Just (px, py))
      where
        onTitleBar = abs (px - x) < 2.5 && abs (py - y - 0.85) < 0.35
        onOpenButton = abs (px - x - 2.15) < 0.2 && abs (py - y - 0.85) < 0.2
    frameHandle (PointerRelease _) (param, loc, open, Just _) =
      (param, loc, open, Nothing)
    frameHandle (PointerMovement (px, py)) (param, (x, y), open, Just (ax, ay)) =
      (param, (x + px - ax, y + py - ay), open, Just (px, py))
    frameHandle event (Parameter _ _ _ handle, (x, y), True, anchor) =
      (handle (untranslate x y event), (x, y), True, anchor)
    frameHandle (TimePassing dt) (Parameter _ _ _ handle, loc, open, anchor) =
      (handle (TimePassing dt), loc, open, anchor)
    frameHandle _ other = other
    frameValue (Parameter _ v _ _, _, _, _) = v
    framePicture (Parameter n v picture _, (x, y), open, _) =
      Just
        $ translated x y
        $ translated 0 0.85 (titleBar n v open picture)
          & clientArea open picture
{'fraction_non_alphanumeric': 0.11038768866528559, 'fraction_numerical': 0.01696754463845319, 'mean_word_length': 2.59121501948282, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 53, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, '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': '398712', 'n_tokens_mistral': 3292, 'n_tokens_neox': 3141, 'n_words': 1155}