[racket] world/universe update model (functional update redux), using the I/O monad for state

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Mon Dec 12 22:55:13 EST 2011

Is the below really much less natural to write? I really enjoyed playing the qwerty row from left to right, or perhaps I was pressing the number keys at the same time :-)

#lang racket

(require (except-in (planet clements/rsound)
                    overlay
                    scale)
         2htdp/universe
         2htdp/image)

(define octave 48)
(define volume .4)
(define duration 22050)

(define (main)
  (big-bang `(,octave ,volume ,duration)
            (to-draw my-draw)
            (on-key  my-key)))

(define (my-draw num)
  (place-image/align (text (format "~s" num) 11 'red) 10 50 'left 'top (empty-scene 100 100)))

(define (my-key w key)
  (match (cons key w)
    [`("0" ,oct ,vol ,dur) `( 0 ,vol ,dur)]
    [`("1" ,oct ,vol ,dur) `(12 ,vol ,dur)]
    [`("2" ,oct ,vol ,dur) `(24 ,vol ,dur)]
    [`("3" ,oct ,vol ,dur) `(36 ,vol ,dur)]
    [`("4" ,oct ,vol ,dur) `(48 ,vol ,dur)]
    [`("5" ,oct ,vol ,dur) `(60 ,vol ,dur)]
    [`("6" ,oct ,vol ,dur) `(72 ,vol ,dur)]
    [`("7" ,oct ,vol ,dur) `(84 ,vol ,dur)]
    [`("8" ,oct ,vol ,dur) `(96 ,vol ,dur)]
    [`((or "=" "+") ,oct ,vol ,dur) `(,oct ,(if (< vol 1) (+ vol .1) vol) ,dur)]
    [`((or "-" "_") ,oct ,vol ,dur) `(,oct ,(if (> vol 0) (- vol .1) vol) ,dur)]
    [`("z" ,oct ,vol ,dur) `(,oct ,vol ,(if (> dur 11025) (- dur 11025) dur))]
    [`("x" ,oct ,vol ,dur) `(,oct ,vol ,(if (< dur 88200) (+ dur 11025) dur))]
    [`("q" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 12 oct)) vol dur)) w]
    [`("w" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 13 oct)) vol dur)) w]
    [`("e" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 14 oct)) vol dur)) w]
    [`("r" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 15 oct)) vol dur)) w]
    [`("t" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 16 oct)) vol dur)) w]
    [`("y" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 17 oct)) vol dur)) w]
    [`("u" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 18 oct)) vol dur)) w]
    [`("i" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 19 oct)) vol dur)) w]
    [`("o" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 20 oct)) vol dur)) w]
    [`("p" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 21 oct)) vol dur)) w]
    [`("[" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 22 oct)) vol dur)) w]
    [`("]" ,oct ,vol ,dur) (play (make-tone (midi-note-num->pitch (+ 23 oct)) vol dur)) w]
    [`("a" ,oct ,vol ,dur) (play c-hi-hat-1) w]
    [`("s" ,oct ,vol ,dur) (play c-hi-hat-2) w]
    [`("d" ,oct ,vol ,dur) (play o-hi-hat) w]
    [`("f" ,oct ,vol ,dur) (play snare) w]
    [`("g" ,oct ,vol ,dur) (play bassdrum) w]
    [`("h" ,oct ,vol ,dur) (play bassdrum) w]
    [`("j" ,oct ,vol ,dur) (play bassdrum-synth) w]         
    [`("k" ,oct ,vol ,dur) (play clap-1) w]
    [`("l" ,oct ,vol ,dur) (play clap-2) w]
    [`(";" ,oct ,vol ,dur) (play crash-cymbal) w]
    [else w]
    [else (displayln `(no match ,w))]))
     
(main)


Posted on the users mailing list.