Skip to content

Instantly share code, notes, and snippets.

@relrod
Last active August 29, 2015 13:57
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save relrod/9868354 to your computer and use it in GitHub Desktop.
Save relrod/9868354 to your computer and use it in GitHub Desktop.
Sort-of working 8-bit ASCII RTTY
Copyright (c) 2014, Ricky Elrod
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Ricky Elrod nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-- Initial RTTY.cabal generated by cabal init. For further documentation,
-- see http://haskell.org/cabal/users-guide/
name: RTTY
version: 0.1.0.0
-- synopsis:
-- description:
license: BSD3
license-file: LICENSE
author: Ricky Elrod
maintainer: ricky@elrod.me
-- copyright:
category: Data
build-type: Simple
-- extra-source-files:
cabal-version: >=1.10
executable RTTY
main-is: RTTY.hs
-- other-modules:
other-extensions: OverloadedStrings
build-depends: base >=4.5 && <4.7, text >=0.11 && <0.12, WAVE, text-format
-- hs-source-dirs:
default-language: Haskell2010
{-# LANGUAGE OverloadedStrings #-}
module Data.RTTY where
import Control.Monad (join)
import Data.WAVE
import Data.Int (Int32)
import Data.Char
import Data.Text.Format (left)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Text.Lazy (unpack)
import Numeric (showIntAtBase)
samplesPS = 16000
bitrate = 32
header = WAVEHeader 1 samplesPS bitrate Nothing
sound :: Double -- | Frequency
-> Int -- | Samples per second
-> Double -- | Lenght of sound in seconds
-> Int32 -- | Volume, (maxBound :: Int32) for highest, 0 for lowest
-> [Int32]
sound freq samples len volume = take (round $ len * (fromIntegral samples)) $
map (round . (* fromIntegral volume)) $
map sin [0.0, (freq * 2 * pi / (fromIntegral samples))..]
seconds = 0.0220022
zero_tone = 700
one_tone = 870
waveData = WAVE header $ rttyData "HelloWorldHelloWorldHelloWorld"
makeWavFile :: WAVE -> IO ()
makeWavFile = putWAVEFile "temp.wav"
main = makeWavFile waveData
asciiToBinary :: Char -> String
asciiToBinary c = "0" ++ reverse (unpack (toLazyText s)) ++ "11"
where
s = left 8 '0' (showIntAtBase 2 intToDigit (Data.Char.ord c) [])
stringToBinary :: String -> String
stringToBinary = join . map asciiToBinary
rttyData :: String -> [[Int32]]
rttyData s = map (:[]) (concat (map tone (stringToBinary s)))
where
tone '0' = sound zero_tone samplesPS seconds (maxBound `div` 2)
tone '1' = sound one_tone samplesPS seconds (maxBound `div` 2)
tone _ = error "nope!"
import Distribution.Simple
main = defaultMain
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment