/hmsl/pieces/xforms.fth
https://github.com/philburk/hmsl · Forth · 297 lines · 264 code · 32 blank · 1 comment · 7 complexity · 321827b00c16fe05bde18af08f5d5dc2 MD5 · raw file
- \ This piece uses three tracks.
- \ Track one repeats a simple 5 note theme.
- \ This sounds good on a bass or tuned drum preset.
- \ The second track grabs the theme and slowly transforms it
- \ by adding or removing notes, transposing notes, etc.
- \ This sounds nice on a flute like preset.
- \ The third track periodically grabs a copy of the second
- \ track and plays it. Sometimes the playing is delayed.
- \ This third track is sometimes slowed down by 2.
- \ Try a violin or clarinet sound for this.
- \
- \ MOD: PLB 9/89 Converted to 3.3 system.
- \ MOD: PLB 10/4/89 Added call to SE.UPDATE.SHAPE
- \ MOD: PLB 3/26/90 Use new collection, }STUFF:
- \ MOD: PLB 4/9/91 Explicit names for clone.
- \ MOD: PLB 4/28/96 Use General MIDI presets
- \
- \ Composer Phil Burk
- \ Copyright 1987 Phil Burk
- include? { ju:locals
- ANEW TASK-XFORMS
- OB.SHAPE SH-THEME
- OB.SHAPE SH-DEVEL
- OB.SHAPE SH-DELAY
- OB.COLLECTION XF-PAR-COL
- OB.PRODUCTION PRODUCTION-5
- 13 constant PRESET_TRACK_1 \ bass or tuned drum
- 74 constant PRESET_TRACK_2 \ flute
- \ 41 constant PRESET_TRACK_3 \ violin
- \ 43 constant PRESET_TRACK_3 \ cello
- 25 constant PRESET_TRACK_3 \ guitar
- \ Play theme on drum or bass. ---------------------------------
- VARIABLE XF-MEASURE ( length of a measure )
- rtc.rate@ 3 * 5 / ticks/beat !
- ticks/beat @ 2/ constant DUR_BASIC
- : XF.BUILD.THEME ( -- theme in sh-theme )
- 20 3 new: sh-theme
- DUR_BASIC 14 100 add: sh-theme
- DUR_BASIC 2* 12 80 add: sh-theme
- DUR_BASIC 6 90 add: sh-theme
- DUR_BASIC 15 80 add: sh-theme
- DUR_BASIC 9 70 add: sh-theme
- ( ---- )
- DUR_BASIC 6 * xf-measure !
- ;
- : XF.INIT.THEME ( -- )
- xf.build.theme
- sh-theme ins-midi-1 build: player-1
- 1 put.channel: ins-midi-1
- PRESET_TRACK_1 put.preset: ins-midi-1
- \ Use the current key, the default is D minor.
- tr-current-key put.gamut: ins-midi-1
- 20 put.offset: ins-midi-1
- 800000 put.repeat: player-1
- sh-theme standard.dim.names
- " SH-THEME" put.name: sh-theme
- ;
- \ ------------------------------------------------------------
- \ Develop theme by adding, removing and changing notes. ------
- \ Played on Pan Flute.
- \ These Forth words support this motivic development.
- : COPY.SHAPE { shape1 shape2 -- , copy contents of shape }
- \ shapes must have same number of dimensions and be newed
- shape2 empty: []
- shape1 many: [] 0
- DO i shape1 get: []
- shape2 add: []
- LOOP
- ;
- 2 constant XF_SMALLEST_DUR
- : INSERT.NOTE { shape | elmnt dur -- , place new note in shape }
- \ Find notes to subdivide with sufficient duration.
- \ Give up after 20 tries to avoid hanging. piece.
- 20 0
- DO shape many: [] 1- choose -> elmnt
- elmnt 0 shape ed.at: [] ( get duration )
- dup -> dur xf_smallest_dur >
- IF leave THEN
- LOOP
- \
- \ Fit two notes in duration of existing note
- \ by splitting time alloted
- elmnt 1 shape stretch: [] ( copy element )
- dur 2/ dup elmnt 0 shape ed.to: [] ( 1/2 duration )
- dur swap - elmnt 1+ 0 shape ed.to: [] ( remainder )
- \
- \ The new note is placed between two existing notes
- \ with a random displacement from their average.
- \ This "Midpoint Subdivision" method is common in computer
- \ graphics where it is used to generate fractal landscapes.
- elmnt 1 shape ed.at: [] ( get note )
- elmnt 2+ 1 shape ed.at: [] ( get next note )
- + 2/ ( average and displace )
- 2 choose+/- +
- elmnt 1+ 1 shape ed.to: []
- ;
- \ These are START and REPEAT functions for a Player
- : XF.COPY.SHAPE ( player -- , make copy )
- drop sh-theme sh-devel copy.shape
- 27 put.offset: ins-midi-2
- \ Update SE display in case it is being shown.
- sh-devel se.update.shape
- ;
- : XF.MODIFY ( player -- , randomly execute a function )
- drop
- many: production-3 choose
- exec: production-3
- sh-devel se.update.shape
- ;
- \ This is a set of modifying functions that can work in a production.
- : XF.INSERT.NOTE ( - )
- sh-devel insert.note \ ." I"
- ;
- : XF.TRANSPOSE ( -- , random walk offset of MIDI instrument.)
- get.offset: ins-midi-2
- 9 choose 4 - + 20 40 clipto
- put.offset: ins-midi-2 \ ." T"
- ;
- : XF.REMOVE ( -- , remove note and lengthen previous note )
- \ This maintains original total length.
- many: sh-devel dup 2 >
- IF 1- choose ( -- elmnt )
- dup 1+ 0 ed.at: sh-devel ( -- elmnt dur2 )
- over 0 ed.at: sh-devel + ( -- elmnt new_dur )
- over 0 ed.to: sh-devel
- 1+ remove: sh-devel
- ELSE drop
- THEN \ ." R"
- ;
- : XF.CHANGE.NOTE ( -- , change one of the notes )
- many: sh-devel choose dup
- 1 ed.at: sh-devel ( get note )
- 11 choose 5 - + 1 25 clipto ( move up or down )
- swap 1 ed.to: sh-devel
- \ ." C"
- ;
- : STOP.ECHO ( morph -- , stop echoing player )
- drop finish: player-1
- finish: player-3
- ;
- : XF.INIT.DEVEL ( -- , setup objects to develop theme )
- 40 3 new: sh-devel
- sh-devel ins-midi-2 build: player-2
- tr-current-key put.gamut: ins-midi-2
- 2 put.channel: ins-midi-2
- PRESET_TRACK_2 put.preset: ins-midi-2
- sh-theme sh-devel copy.shape
- sh-devel standard.dim.names
- " SH-DEVEL" put.name: sh-devel
- \
- \ Add measure rest before playing shape.
- xf-measure @ put.start.delay: player-2
- \
- \ Production-3 holds functions that are randomly executed
- \ by the word XF.MODIFY.
- stuff{
- 'c xf.insert.note
- 'c xf.insert.note
- 'c xf.insert.note
- 'c xf.transpose
- 'c xf.remove
- 'c xf.change.note
- 'c xf.change.note
- }stuff: production-3
- \
- \ Execute XF.MODIFY every time PLAYER-2 repeats.
- 'c xf.copy.shape put.start.function: player-2
- 'c xf.modify put.repeat.function: player-2
- \ Put Player-2 in a Collection so we can restart it.
- stuff{ player-2 }stuff: coll-p-2
- 8 put.repeat: player-2 ( 1 development cycle )
- 100000 put.repeat: coll-p-2 ( develop 8 times )
- 'c stop.echo put.stop.function: coll-p-2
- ;
- \ ---------------------------------------------------------
- \ Third track which embellishes piece. --------------------
- \ This will play a delayed and sometimes slower copy of s2
- : XF.COPY.S2-S3 ( -- )
- sh-devel sh-delay copy.shape
- \ Set random delay to 0-3 measures to space out responses
- xf-measure @ 4 choose * put.repeat.delay: player-3
- sh-delay se.update.shape
- ;
- : XF.PROLONG.S3 ( -- , multiply all durations by 2 )
- many: sh-delay 0
- DO i 0 ed.at: sh-delay 2*
- i 0 ed.to: sh-delay
- LOOP
- sh-devel se.update.shape
- ;
- : XF.EXEC.FLUFF ( player -- , randomly copy or prolong )
- drop
- 2 choose
- IF 2 choose
- IF xf.copy.s2-s3
- ELSE xf.prolong.s3
- THEN
- THEN
- ;
- : XF.INIT.FLUFF ( -- )
- \ Setup player for sh-delay
- sh-delay ins-midi-3 build: player-3
- 3 put.channel: ins-midi-3
- PRESET_TRACK_3 put.preset: ins-midi-3
- tr-current-key put.gamut: ins-midi-3
- 'c xf.exec.fluff put.repeat.function: player-3
- 800000 put.repeat: player-3
- \
- \ Setup shape
- 40 3 new: sh-delay
- sh-theme sh-delay copy.shape
- sh-delay standard.dim.names
- " SH-DELAY" put.name: sh-delay
- ;
- \ ------------------------------------------------------
- : XF.INIT ( -- , tie everything together )
- xf.init.theme
- xf.init.devel
- xf.init.fluff
- \
- \ Top level collection.
- 0 player-1 \ Play Theme
- coll-p-2 \ Development
- player-3 \ echo
- 0stuff: xf-par-col
- 1 put.repeat: xf-par-col
- \
- \ Put shapes in holder for editing
- clear: shape-holder
- sh-theme add: shape-holder
- sh-devel add: shape-holder
- sh-delay add: shape-holder
- \
- \ use explicit names for clone
- " sh-theme" put.name: sh-theme
- sh-theme standard.dim.names
- " sh-devel" put.name: sh-devel
- sh-devel standard.dim.names
- " sh-delay" put.name: sh-delay
- sh-delay standard.dim.names
- \
- \ print.hierarchy: xf-par-col
- ;
- : XF.TERM ( -- )
- free: production-3
- default.hierarchy: xf-par-col
- free.hierarchy: xf-par-col
- sh-theme delete: shape-holder
- sh-devel delete: shape-holder
- sh-delay delete: shape-holder
- ;
- : XFORMS ( -- , play piece )
- cls
- xf.init
- cr ." Seed = " rand-seed ? cr
- xf-par-col hmsl.play
- xf.term
- ;
- : XF.RAND ( seed -- , provide seed for repeatable performance )
- depth 1 <
- abort" Supply seed for random function."
- rand-seed !
- xforms
- ;
- cr ." Enter: XFORMS or seed XF.RAND" cr