Scorange

OK, today, a bit of a departure.  I just completed my first programming project using Haskell.

I call it Scorange.  Why?

1. It’s a portmanteau of ’score’ and ‘range’.
2. It finally gives us something that rhymes with orange.

I’ve already demonstrated its use on my Csound blog.  Briefly, here’s what it does: it allows me to create Csound score files of arpeggios, and automates a number of repetitive tasks.  It also allows me to control the sound by generating an arbitrary number of parameters.  (I’ve more discussion on this in the original article.)

Anyway, for regular readers of my WordPress blog — who may or may not be into Haskell or Csound — here’s what it sounds like.  If you generated the score file using the program below, and processed the score file using Csound, you’d hear something like this:

Scorpio [mp3, 13.8 seconds, 218 K]

OK, now that you’ve heard it, most of you can leave.  Haskell folks who’ve stumbled on to this page — the code is posted below (beyond the ‘more’ tag).

I definitely bought in to modular programming with this one.  Thing is, it worked.  As advertised, as soon as I’d gotten the system to compile, the compiler had taken care of a lot of debugging — it ran without errors the first time I tried it.  Part of this was because I checked each module using ghc -Wall -c --make and made sure each file compiled without errors. When the time came to try my first example, it was almost impossible for it to fail (except for the usual typos, of course).

You need all six of the module files to get this to work.  And of course, at the end, I’ve included an example — it’s the one that was used to produce “scorpio01.csd” on my Csound blog.

Event.hs

{-
  Event.hs
  Bruce H. McCosar

  Compile with:
    ghc -Wall -c --make Event.hs
-}

module Event where

data Event = Event
  {
    seconds :: Float,   -- real time in seconds
    barline :: Float,   -- composition time in 'bars'
    counter :: Float    -- counter within each bar
  }

type TimeLine = [Event]

stackEvents :: [Float] -> [Float] -> [Float] -> TimeLine
stackEvents (s:ss) (b:bs) (c:cs) =
  Event {seconds=s,barline=b,counter=c} : stackEvents ss bs cs
stackEvents [] _ _ = []
stackEvents _ [] _ = []
stackEvents _ _ [] = []

Cellular.hs

{-
  Cellular.hs
  Bruce H. McCosar

  Compile with:
    ghc -Wall -c --make Cellular.hs
-}

module Cellular where

import Event

data CellField = CellFunction (Event -> Float)
  | CellConstant Float
  | CellPattern [Float]

data Cell = Cell
  {
    title :: String,            -- labels column in Csound score file
    fmstr :: String,            -- format string for printf
    field :: CellField          -- cell content generator
  }

Formatter.hs

{-
  Formatter.hs
  Bruce H. McCosar

  Compile with:
    ghc -Wall -c --make Formatter.hs
-}

module Formatter where

import Text.Printf
import List

import Event
import Cellular

putHeader :: [Cell] -> IO ()
putHeader (f:fs) = do
  printf (title f ++ " ")
  putHeader fs
putHeader [] = do putStr "\n"

generateFields :: TimeLine -> [Cell] -> [[Float]]
generateFields es (c:cs) =
  let
    results = case (field c) of
      CellFunction f -> map f es
      CellConstant k -> take (length es) (repeat k)
      CellPattern tp -> take (length es) (cycle tp)
  in
    results : generateFields es cs
generateFields _ [] = []

generateFormats :: [Cell] -> [String]
generateFormats (f:fs) =
  fmstr f : generateFormats fs
generateFormats [] = []

putField :: [String] -> [Float] -> IO ()
putField (fmt:fmts) (ent:ents) = do
  printf fmt ent
  putStr " "
  putField fmts ents
putField _ [] = do putStr "\n"
putField [] _ = do putStr "\n"

putLines :: [String] -> [[Float]] -> IO ()
putLines fmt (dat:dats) = do
  putStr "i "
  putField fmt dat
  putLines fmt dats
putLines _ [] = do putStr "\n"

putScore :: TimeLine -> [Cell] -> IO ()
putScore es fs =
  let
    fields = generateFields es fs
    fmtstrings = generateFormats fs
  in do
    putStr "; "
    putHeader fs
    putLines fmtstrings (transpose fields)

Rhythm.hs

{-
  Rhythm.hs
  Bruce H. McCosar

  Compile with:
    ghc -Wall -c --make Rhythm.hs
-}

module Rhythm where

data Rhythm = Rhythm
  {
    beats :: Int,       -- number of beats per bar
    subdv :: Int,       -- number of notes per beat
    tempo :: Float,     -- beats per minute
    nbars :: Int,       -- total repetitions (in bars)
    width :: Float      -- note width
  }

notelist :: Rhythm -> [Float]
notelist rhythm =
  let
    maxnotes = (nbars rhythm) * (beats rhythm) * (subdv rhythm)
  in
    [ fromIntegral (e - 1) | e <- [1..maxnotes] ] seconds_per_note :: Rhythm -> Float
seconds_per_note rhythm =
  let
    seconds_per_beat = 60 / (tempo rhythm)
  in
    seconds_per_beat / (fromIntegral (subdv rhythm))

listSeconds :: Rhythm -> [Float]
listSeconds rhythm =
  let
    n = notelist rhythm
    s = seconds_per_note rhythm
  in
    [s * i | i <- n] listBarline :: Rhythm -> [Float]
listBarline rhythm =
  let
    n = notelist rhythm
    b = (fromIntegral (beats rhythm)) * (fromIntegral (subdv rhythm))
  in
    [i / b | i <- n] listCounter :: Rhythm -> [Float]
listCounter rhythm =
  let
    b = (beats rhythm) * (subdv rhythm)
    c = [ fromIntegral (e - 1) | e <- [1..b] ]
    k = fromIntegral (subdv rhythm)
  in
    cycle [i / k | i <- c]

Temporal.hs

{-
  Temporal.hs
  Bruce H. McCosar

  Compile with:
    ghc -Wall -c --make Temporal.hs
-}

module Temporal where

import Event
import Rhythm

timeline :: Rhythm -> TimeLine
timeline rhythm =
  let
    ss = listSeconds rhythm
    bs = listBarline rhythm
    cs = listCounter rhythm
  in
    stackEvents ss bs cs

Scorange.hs

{-
  Scorange.hs
  Bruce H. McCosar

  Compile with:
    ghc -Wall -c --make Scorange.hs
-}

module Scorange where

import Event
import Cellular
import Formatter
import Rhythm
import Temporal

scorange :: Rhythm -> [Cell] -> Int -> IO ()
scorange rhythm ucells inst =
  let
    events = timeline rhythm
    p1 = Cell
      {
        title = "inst",
        fmstr = "%4.0f",
        field = CellConstant (fromIntegral inst)
      }
    p2 = Cell
      {
        title = "   time   ",
        fmstr = "%10.5f",
        field = CellFunction seconds
      }
    p3 = Cell
      {
        title = " width  ",
        fmstr = "%8.5f",
        field = CellConstant (width rhythm * seconds_per_note rhythm)
      }
    p4 = Cell
      {
        title = " dur    ",
        fmstr = "%8.5f",
        field = CellConstant (seconds_per_note rhythm)
      }
    cells = p1 : p2 : p3: p4 : ucells
  in
    putScore events cells

Example — genScorpio01.hs

On Linux, this finished program can be used to generate a score file using a shell redirect, for example ./genScorpio01 > scorpio01.sco

{-
  genScorpio01

  Compile with:
    ghc -Wall --make genScorpio01.hs -o genScorpio
-}

import Event
import Rhythm
import Cellular
import Scorange

r1 :: Rhythm
r1 = Rhythm
  {
    beats = 4,
    subdv = 4,
    tempo = 141,
    nbars = 8,
    width = 1.22
  }

notes1 :: Cell
notes1 = Cell
  {
    title = " pch ",
    fmstr = "%5.2f",
    field = CellPattern [6.07,6.07,7.02,7.07]
  }

emphs1 :: Cell
emphs1 = Cell
  {
    title = " emphs",
    fmstr = "%6.2f",
    field = CellPattern [-2,-9,-5,-12]
  }

panner1 :: Event -> Float
panner1 e =
  let
    t = 2*pi*(barline e)
  in
    (1 - sin t) / 2

pan1 :: Cell
pan1 = Cell
  {
    title = " pan ",
    fmstr = "%5.2f",
    field = CellFunction panner1
  }

brighten1 :: Event -> Float
brighten1 e =
  let
    t = counter e
  in
    5 - t

brite1 :: Cell
brite1 = Cell
  {
    title = "brite",
    fmstr = "%5.2f",
    field = CellFunction brighten1
  }

r2 :: Rhythm
r2 = Rhythm
  {
    beats = 4,
    subdv = 4,
    tempo = 141,
    nbars = 8,
    width = 1.11
  }

notes2 :: Cell
notes2 = Cell
  {
    title = " pch ",
    fmstr = "%5.2f",
    field = CellPattern [8.07,8.10,9.02]
  }

emphs2 :: Cell
emphs2 = Cell
  {
    title = " emphs",
    fmstr = "%6.2f",
    field = CellPattern [-3,-12,-6,-15]
  }

panner2 :: Event -> Float
panner2 e =
  let
    t = 3*pi*(barline e)
  in
    (1 + sin t) / 2

pan2 :: Cell
pan2 = Cell
  {
    title = " pan ",
    fmstr = "%5.2f",
    field = CellFunction panner2
  }

brighten2 :: Event -> Float
brighten2 e =
  let
    t = counter e
  in
    t + 5

brite2 :: Cell
brite2 = Cell
  {
    title = "brite",
    fmstr = "%5.2f",
    field = CellFunction brighten2
  }

r3 :: Rhythm
r3 = Rhythm
  {
    beats = 4,
    subdv = 1,
    tempo = 141,
    nbars = 8,
    width = 1.54
  }

notes3 :: Cell
notes3 = Cell
  {
    title = " pch ",
    fmstr = "%5.2f",
    field = CellPattern [5.07,6.02]
  }

emphs3 :: Cell
emphs3 = Cell
  {
    title = " emphs",
    fmstr = "%6.2f",
    field = CellPattern [-5,-8,-6,-10]
  }

panner3 :: Event -> Float
panner3 e =
  let
    t = 2*pi*(barline e)/2
  in
    0.4 + 0.1*(1 + sin t)

pan3 :: Cell
pan3 = Cell
  {
    title = " pan ",
    fmstr = "%5.2f",
    field = CellFunction panner3
  }

brighten3 :: Event -> Float
brighten3 e =
  let
    t = 2*pi*(barline e)/4
  in
    2 + sin t

brite3 :: Cell
brite3 = Cell
  {
    title = "brite",
    fmstr = "%5.2f",
    field = CellFunction brighten3
  }

main :: IO ()
main = do
  scorange r1 [notes1,emphs1,pan1,brite1] 1001
  scorange r2 [notes2,emphs2,pan2,brite2] 1002
  scorange r3 [notes3,emphs3,pan3,brite3] 1003