justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15105 additions and 13343 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Button/Draw.hs
+17 -13
View File
@@ -1,9 +1,10 @@
module Dodge.Button.Draw where
import Color
import Dodge.Data.Button
import Geometry
import Color
import ShapePicture
import Shape
import ShapePicture
drawButton :: ButtonDraw -> Button -> SPic
drawButton bd = case bd of
@@ -13,16 +14,19 @@ drawButton bd = case bd of
drawSwitch :: Color -> Color -> Button -> SPic
drawSwitch col1 col2 bt
| _btState bt == BtOff
= flick $ pi/4
| otherwise = flick (negate (pi/4))
| _btState bt == BtOff =
flick $ pi / 4
| otherwise = flick (negate (pi / 4))
where
flick a = ( mconcat
[ colorSH col1 . upperPrismPoly 20 $ reverse $ rectNSWE (-2) (-5) (-10) 10
, colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ reverse
$ rectNSWE 10 0 (-2) 2
]
, mempty)
flick a =
( mconcat
[ colorSH col1 . upperPrismPoly 20 $ reverse $ rectNSWE (-2) (-5) (-10) 10
, colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $
reverse $
rectNSWE 10 0 (-2) 2
]
, mempty
)
defaultDrawButton :: Color -> Button -> SPic
defaultDrawButton col bt =
@@ -31,6 +35,6 @@ defaultDrawButton col bt =
)
where
buttonGeometry
| _btState bt == BtOff = reverse $ rectNSWE 10 (-1) (-width) width
| otherwise = reverse $ rectNSWE 2 (-1) (-width) width
| _btState bt == BtOff = reverse $ rectNSWE 10 (-1) (- width) width
| otherwise = reverse $ rectNSWE 2 (-1) (- width) width
width = 8
src/Dodge/Button/Event.hs
+18 -14
View File
@@ -1,31 +1,35 @@
module Dodge.Button.Event where
import Dodge.Data
import Dodge.SoundLogic
import Dodge.WorldEffect
import Control.Lens
import Dodge.Data.World
import Dodge.SoundLogic
import Dodge.WorldEffect
doButtonEvent :: ButtonEvent -> Button -> World -> World
doButtonEvent be = case be of
ButtonDoNothing -> const id
ButtonPress newstate newevent thesound f -> \b -> doWdWd f
. set (cWorld . buttons . ix (_btID b) . btState) newstate
. set (cWorld . buttons . ix (_btID b) . btEvent) newevent
. soundStart (LeverSound 0) (_btPos b) thesound Nothing
ButtonPress newstate newevent thesound f -> \b ->
doWdWd f
. set (cWorld . buttons . ix (_btID b) . btState) newstate
. set (cWorld . buttons . ix (_btID b) . btEvent) newevent
. soundStart (LeverSound 0) (_btPos b) thesound Nothing
--ButtonSwitch onstate onevent onsound oneff offstate offevent offsound offeff -> undefined
ButtonSimpleSwith oneff offeff -> flipSwitch oneff offeff
ButtonAccessTerminal -> accessTerminal . _btTermMID
flipSwitch :: WdWd -> WdWd -> Button -> World -> World
flipSwitch oneff offeff bt
| _btState bt == BtOff = doWdWd oneff . dosound
. over (cWorld . buttons . ix (_btID bt)) turnon
| otherwise = doWdWd offeff . dosound
. over (cWorld . buttons . ix (_btID bt)) turnoff
flipSwitch oneff offeff bt
| _btState bt == BtOff =
doWdWd oneff . dosound
. over (cWorld . buttons . ix (_btID bt)) turnon
| otherwise =
doWdWd offeff . dosound
. over (cWorld . buttons . ix (_btID bt)) turnoff
where
turnon = (btState .~ BtOn ) . (btText .~ "SWITCH\\")
turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
turnon = (btState .~ BtOn) . (btText .~ "SWITCH\\")
turnoff = (btState .~ BtOff) . (btText .~ "SWITCH/")
dosound = soundFromGeneral (LeverSound 0) (const $ _btPos bt) click1S Nothing
-- switchEffect b = case _btState b of
-- BtOff -> effOn . (buttons . ix (_btID b) %~ turnOn )
-- BtOn -> effOff . (buttons . ix (_btID b) %~ turnOff)