├── .gitignore ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── app └── Main.hs ├── mauve.cabal ├── package.yaml ├── src ├── BadApple.hs ├── Compose.hs └── Play.hs ├── stack.yaml ├── stack.yaml.lock └── test └── Spec.hs /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | *~ 3 | output.bin -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for mauve 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2020 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # λ Mavue 2 | 3 | ## Quick Start 4 | 5 | ![play](https://cdn.jsdelivr.net/gh/raptazure/cdn/projects/thplay.png) 6 | 7 | - Install `ffplay`. 8 | - Play *Bad Apple!!* 9 | ```shell 10 | stack run 11 | ``` 12 | 13 | - Suggestions are welcomed! 14 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Compose (outputFilePath, sampleRate) 4 | import Play (save) 5 | import System.Process (runCommand) 6 | import Text.Printf (printf) 7 | 8 | main :: IO () 9 | main = do 10 | save outputFilePath 11 | _ <- runCommand $ printf "ffplay -autoexit -showmode 1 -f f32le -ar %f %s" sampleRate outputFilePath 12 | return () -------------------------------------------------------------------------------- /mauve.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | 3 | -- This file has been generated from package.yaml by hpack version 0.33.0. 4 | -- 5 | -- see: https://github.com/sol/hpack 6 | -- 7 | -- hash: 7fe0de8d4f7a0da0ee88ee95f4e201175f9f4afd62af1769796575057bbeef46 8 | 9 | name: mauve 10 | version: 0.1.0.0 11 | description: Please see the README on GitHub at 12 | homepage: https://github.com/raptazure/mauve#readme 13 | bug-reports: https://github.com/raptazure/mauve/issues 14 | author: raptazure 15 | maintainer: hermit0x9@outlook.com 16 | copyright: 2021 raptazure 17 | license: BSD3 18 | license-file: LICENSE 19 | build-type: Simple 20 | extra-source-files: 21 | README.md 22 | ChangeLog.md 23 | 24 | source-repository head 25 | type: git 26 | location: https://github.com/raptazure/mauve 27 | 28 | library 29 | exposed-modules: 30 | BadApple 31 | Compose 32 | Play 33 | other-modules: 34 | Paths_mauve 35 | hs-source-dirs: 36 | src 37 | build-depends: 38 | base >=4.7 && <5 39 | , bytestring 40 | , process 41 | default-language: Haskell2010 42 | 43 | executable mauve-exe 44 | main-is: Main.hs 45 | other-modules: 46 | Paths_mauve 47 | hs-source-dirs: 48 | app 49 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 50 | build-depends: 51 | base >=4.7 && <5 52 | , bytestring 53 | , process 54 | , mauve 55 | default-language: Haskell2010 56 | 57 | test-suite mauve-test 58 | type: exitcode-stdio-1.0 59 | main-is: Spec.hs 60 | other-modules: 61 | Paths_mauve 62 | hs-source-dirs: 63 | test 64 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 65 | build-depends: 66 | base >=4.7 && <5 67 | , bytestring 68 | , mauve 69 | , process 70 | default-language: Haskell2010 71 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: mauve 2 | version: 0.1.0.0 3 | github: "raptazure/mauve" 4 | license: BSD3 5 | author: "raptazure" 6 | maintainer: "hermit0x9@outlook.com" 7 | copyright: "2021 raptazure" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - bytestring 25 | - process 26 | 27 | library: 28 | source-dirs: src 29 | exposed-modules: 30 | - BadApple 31 | - Compose 32 | - Play 33 | 34 | executables: 35 | mauve-exe: 36 | main: Main.hs 37 | source-dirs: app 38 | ghc-options: 39 | - -threaded 40 | - -rtsopts 41 | - -with-rtsopts=-N 42 | dependencies: 43 | - mauve 44 | 45 | tests: 46 | mauve-test: 47 | main: Spec.hs 48 | source-dirs: test 49 | ghc-options: 50 | - -threaded 51 | - -rtsopts 52 | - -with-rtsopts=-N 53 | dependencies: 54 | - mauve 55 | -------------------------------------------------------------------------------- /src/BadApple.hs: -------------------------------------------------------------------------------- 1 | module BadApple 2 | ( song, 3 | ) 4 | where 5 | 6 | import Compose (Pulse, note) 7 | 8 | song :: [Pulse] 9 | song = 10 | concat 11 | [ note 2 0.5, 12 | note 4 0.5, 13 | note 5 0.5, 14 | note 7 0.5, 15 | note 9 1, 16 | note 14 0.5, 17 | note 12 0.5, 18 | note 9 1, 19 | note 2 1, 20 | note 9 0.5, 21 | note 7 0.5, 22 | note 5 0.5, 23 | note 4 0.5, 24 | note 2 0.5, 25 | note 4 0.5, 26 | note 5 0.5, 27 | note 7 0.5, 28 | note 9 1, 29 | note 7 0.5, 30 | note 5 0.5, 31 | note 4 0.5, 32 | note 2 0.5, 33 | note 4 0.5, 34 | note 5 0.5, 35 | note 4 0.5, 36 | note 2 0.5, 37 | note 1 0.5, 38 | note 4 0.5, 39 | -- phase 2 40 | note 2 0.5, 41 | note 4 0.5, 42 | note 5 0.5, 43 | note 7 0.5, 44 | note 9 1, 45 | note 14 0.5, 46 | note 12 0.5, 47 | note 9 1, 48 | note 2 1, 49 | note 9 0.5, 50 | note 7 0.5, 51 | note 5 0.5, 52 | note 4 0.5, 53 | note 2 0.5, 54 | note 4 0.5, 55 | note 5 0.5, 56 | note 7 0.5, 57 | note 9 1, 58 | note 7 0.5, 59 | note 5 0.5, 60 | note 4 1, 61 | note 5 1, 62 | note 7 1, 63 | note 9 1, 64 | -- repeat 65 | note 2 0.5, 66 | note 4 0.5, 67 | note 5 0.5, 68 | note 7 0.5, 69 | note 9 1, 70 | note 14 0.5, 71 | note 12 0.5, 72 | note 9 1, 73 | note 2 1, 74 | note 9 0.5, 75 | note 7 0.5, 76 | note 5 0.5, 77 | note 4 0.5, 78 | note 2 0.5, 79 | note 4 0.5, 80 | note 5 0.5, 81 | note 7 0.5, 82 | note 9 1, 83 | note 7 0.5, 84 | note 5 0.5, 85 | note 4 0.5, 86 | note 2 0.5, 87 | note 4 0.5, 88 | note 5 0.5, 89 | note 4 0.5, 90 | note 2 0.5, 91 | note 1 0.5, 92 | note 4 0.5, 93 | -- phase 2 94 | note 2 0.5, 95 | note 4 0.5, 96 | note 5 0.5, 97 | note 7 0.5, 98 | note 9 1, 99 | note 14 0.5, 100 | note 12 0.5, 101 | note 9 1, 102 | note 2 1, 103 | note 9 0.5, 104 | note 7 0.5, 105 | note 5 0.5, 106 | note 4 0.5, 107 | note 2 0.5, 108 | note 4 0.5, 109 | note 5 0.5, 110 | note 7 0.5, 111 | note 9 1, 112 | note 7 0.5, 113 | note 5 0.5, 114 | note 4 1, 115 | note 5 1, 116 | note 7 1, 117 | note 9 1, 118 | -- 119 | note 12 0.5, 120 | note 14 0.5, 121 | note 9 0.5, 122 | note 7 0.5, 123 | note 9 1, 124 | note 7 0.5, 125 | note 9 0.5, 126 | note 12 0.5, 127 | note 14 0.5, 128 | note 9 0.5, 129 | note 7 0.5, 130 | note 9 1, 131 | -- 5654 312 1234 562 132 | note 7 0.5, 133 | note 9 0.5, 134 | note 7 0.5, 135 | note 5 0.5, 136 | note 4 0.5, 137 | note 0 0.5, 138 | note 2 1, 139 | note 0 0.5, 140 | note 2 0.5, 141 | note 4 0.5, 142 | note 5 0.5, 143 | note 7 0.5, 144 | note 9 0.5, 145 | note 2 1, 146 | -- 61.1.2. 656 561.2. 656 147 | note 9 0.5, 148 | note 12 0.5, 149 | note 12 0.5, 150 | note 14 0.5, 151 | note 9 0.5, 152 | note 7 0.5, 153 | note 9 1, 154 | note 7 0.5, 155 | note 9 0.5, 156 | note 12 0.5, 157 | note 14 0.5, 158 | note 9 0.5, 159 | note 7 0.5, 160 | note 9 1, 161 | -- 5654 312 1234 562 162 | note 7 0.5, 163 | note 9 0.5, 164 | note 7 0.5, 165 | note 5 0.5, 166 | note 4 0.5, 167 | note 0 0.5, 168 | note 2 1, 169 | note 0 0.5, 170 | note 2 0.5, 171 | note 4 0.5, 172 | note 5 0.5, 173 | note 7 0.5, 174 | note 9 0.5, 175 | note 2 1, 176 | -- 61.1.2. 656 561.2. 656 177 | note 9 0.5, 178 | note 12 0.5, 179 | note 12 0.5, 180 | note 14 0.5, 181 | note 9 0.5, 182 | note 7 0.5, 183 | note 9 1, 184 | note 7 0.5, 185 | note 9 0.5, 186 | note 12 0.5, 187 | note 14 0.5, 188 | note 9 0.5, 189 | note 7 0.5, 190 | note 9 1, 191 | -- 5654 312 1234 562 192 | note 7 0.5, 193 | note 9 0.5, 194 | note 7 0.5, 195 | note 5 0.5, 196 | note 4 0.5, 197 | note 0 0.5, 198 | note 2 1, 199 | note 0 0.5, 200 | note 2 0.5, 201 | note 4 0.5, 202 | note 5 0.5, 203 | note 7 0.5, 204 | note 9 0.5, 205 | note 2 1, 206 | -- 61.1.2. 656 561.2. 656 207 | note 9 0.5, 208 | note 12 0.5, 209 | note 12 0.5, 210 | note 14 0.5, 211 | note 9 0.5, 212 | note 7 0.5, 213 | note 9 1, 214 | note 7 0.5, 215 | note 9 0.5, 216 | note 12 0.5, 217 | note 14 0.5, 218 | note 9 0.5, 219 | note 7 0.5, 220 | note 9 1, 221 | -- 2.3.4.3. 2.1.6 5654 312 222 | note 14 0.5, 223 | note 16 0.5, 224 | note 17 0.5, 225 | note 16 0.5, 226 | note 14 0.5, 227 | note 12 0.5, 228 | note 9 1, 229 | note 7 0.5, 230 | note 9 0.5, 231 | note 7 0.5, 232 | note 5 0.5, 233 | note 4 0.5, 234 | note 0 0.5, 235 | note 2 1, 236 | -- 61.1.2. 656 561.2. 656 237 | note 9 0.5, 238 | note 12 0.5, 239 | note 12 0.5, 240 | note 14 0.5, 241 | note 9 0.5, 242 | note 7 0.5, 243 | note 9 1, 244 | note 7 0.5, 245 | note 9 0.5, 246 | note 12 0.5, 247 | note 14 0.5, 248 | note 9 0.5, 249 | note 7 0.5, 250 | note 9 1, 251 | -- 5654 312 1234 562 252 | note 7 0.5, 253 | note 9 0.5, 254 | note 7 0.5, 255 | note 5 0.5, 256 | note 4 0.5, 257 | note 0 0.5, 258 | note 2 1, 259 | note 0 0.5, 260 | note 2 0.5, 261 | note 4 0.5, 262 | note 5 0.5, 263 | note 7 0.5, 264 | note 9 0.5, 265 | note 2 1, 266 | -- 61.1.2. 656 561.2. 656 267 | note 9 0.5, 268 | note 12 0.5, 269 | note 12 0.5, 270 | note 14 0.5, 271 | note 9 0.5, 272 | note 7 0.5, 273 | note 9 1, 274 | note 7 0.5, 275 | note 9 0.5, 276 | note 12 0.5, 277 | note 14 0.5, 278 | note 9 0.5, 279 | note 7 0.5, 280 | note 9 1, 281 | -- 2.3.4.3. 2.1.6 5654 312 282 | note 14 0.5, 283 | note 16 0.5, 284 | note 17 0.5, 285 | note 16 0.5, 286 | note 14 0.5, 287 | note 12 0.5, 288 | note 9 1, 289 | note 7 0.5, 290 | note 9 0.5, 291 | note 7 0.5, 292 | note 5 0.5, 293 | note 4 0.5, 294 | note 0 0.5, 295 | note 2 1 296 | ] -------------------------------------------------------------------------------- /src/Compose.hs: -------------------------------------------------------------------------------- 1 | module Compose 2 | ( outputFilePath, 3 | Pulse, 4 | note, 5 | sampleRate, 6 | ) 7 | where 8 | 9 | type Pulse = Float 10 | 11 | type Seconds = Float 12 | 13 | type Samples = Float 14 | 15 | type Hz = Float 16 | 17 | type Semitones = Float 18 | 19 | type Beats = Float 20 | 21 | outputFilePath :: FilePath 22 | outputFilePath = "output.bin" 23 | 24 | volume :: Float 25 | volume = 0.2 26 | 27 | sampleRate :: Samples 28 | sampleRate = 48000.0 29 | 30 | pitchStandard :: Hz 31 | pitchStandard = 523.25 32 | 33 | bpm :: Beats 34 | bpm = 130.0 35 | 36 | beatDuration :: Seconds 37 | beatDuration = 60.0 / bpm 38 | 39 | -- https://pages.mtu.edu/~suits/NoteFreqCalcs.html 40 | f :: Semitones -> Hz 41 | f n = pitchStandard * (2 ** (1.0 / 12.0)) ** n 42 | 43 | note :: Semitones -> Beats -> [Pulse] 44 | note n beats = freq (f n) (beats * beatDuration) 45 | 46 | freq :: Hz -> Seconds -> [Pulse] 47 | freq hz duration = 48 | map (* volume) $ zipWith3 (\x y z -> x * y * z) release attack output 49 | where 50 | step = (hz * 2 * pi) / sampleRate 51 | 52 | attack :: [Pulse] 53 | attack = map (min 1.0) [0.0, 0.001 ..] 54 | 55 | release :: [Pulse] 56 | release = reverse $ take (length output) attack 57 | 58 | output :: [Pulse] 59 | output = map sin $ map (* step) [0.0 .. sampleRate * duration] 60 | -------------------------------------------------------------------------------- /src/Play.hs: -------------------------------------------------------------------------------- 1 | module Play 2 | ( save, 3 | ) 4 | where 5 | 6 | import BadApple (song) 7 | import qualified Data.ByteString.Builder as B 8 | import qualified Data.ByteString.Lazy as B 9 | import Data.Foldable (Foldable (fold)) 10 | 11 | save :: FilePath -> IO () 12 | save filePath = B.writeFile filePath $ B.toLazyByteString $ fold $ map B.floatLE song 13 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: 21 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/20.yaml 22 | 23 | # User packages to be built. 24 | # Various formats can be used as shown in the example below. 25 | # 26 | # packages: 27 | # - some-directory 28 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 29 | # subdirs: 30 | # - auto-update 31 | # - wai 32 | packages: 33 | - . 34 | # Dependency packages to be pulled from upstream that are not in the resolver. 35 | # These entries can reference officially published versions as well as 36 | # forks / in-progress versions pinned to a git hash. For example: 37 | # 38 | # extra-deps: 39 | # - acme-missiles-0.3 40 | # - git: https://github.com/commercialhaskell/stack.git 41 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 42 | # 43 | # extra-deps: [] 44 | 45 | # Override default flag values for local packages and extra-deps 46 | # flags: {} 47 | 48 | # Extra package databases containing global packages 49 | # extra-package-dbs: [] 50 | 51 | # Control whether we use the GHC we find on the path 52 | # system-ghc: true 53 | # 54 | # Require a specific version of stack, using version ranges 55 | # require-stack-version: -any # Default 56 | # require-stack-version: ">=2.5" 57 | # 58 | # Override the architecture used by stack, especially useful on Windows 59 | # arch: i386 60 | # arch: x86_64 61 | # 62 | # Extra directories used by stack for building 63 | # extra-include-dirs: [/path/to/dir] 64 | # extra-lib-dirs: [/path/to/dir] 65 | # 66 | # Allow a newer minor version of GHC than the snapshot specifies 67 | # compiler-check: newer-minor 68 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 532177 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/20.yaml 11 | sha256: 0e14ba5603f01e8496e8984fd84b545a012ca723f51a098c6c9d3694e404dc6d 12 | original: 13 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/20.yaml 14 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | --------------------------------------------------------------------------------