;;; -*- syntax: Sal; font-size: 16; theme: "Emacs"; -*-

; The rotation pattern rotates (swaps) elements according to a 'rotate  rule':

variable *pat* = make-rotation({a b c d}, rotate: {0 1 1})

next(*pat*, #t)

; the rotate rule is a list of up to 4 elements:

;
;    {[start 0] [step 1] [width 1] end}
;
; 'start' is the starting index in the data to begin swapping
; 'step' is the stepping increment between swaps
; 'width' is the distance between the elements to swap
; 'end' is the position (inclusive) in the data to stop swapping
; and defaults to the last element in the data

; loop for i from START to END
;  swap(data[i], data[i+WIDTH])
;  set i += STEP
; end

; the rotate rule is mapped iteratively over all the elements in
; the pattern to produce the next rotation 

; The default rule is {0 1 1} which causes
; elements in the pattern to rotate leftward, as shown here:
;              x           x           x
;A B C D  =>  B A C D   B C A D   B C D A
;B C D A  =>  C B D A   C D B A   C D A B
;C D A B  =>  D C A B   D A C B   D A B C
;D A B C  =>  A D B C   A B D C   A B C D
;A B C D  =>  ...

variable *pat* = make-rotation({a b c d}, rotate: {0 1 1})

next(*pat*, #t)

;rotation of pairs

variable *pat* = make-rotation({a b c d e f}, rotate: {0 2 1 })

next(*pat*, #t)

; the same but stops at the fouth element

variable *pat* = make-rotation({a b c d e f}, rotate: {0 2 1 3})

next(*pat*, #t)

; rotation of alterantes 
variable *pat* = make-rotation({a b c d e f}, rotate: {0 1 2})

next(*pat*, #t)

;  the rotate rule can be a pattern of rotations

variable *pat* = make-rotation({a b c d e f}, rotate: make-cycle({{0 1 1}{0 2 1}} ))

next(*pat*, #t)


variable *pat* = make-rotation({a b c d e f}, rotate: make-cycle({{0 1 1}{0 1 2}} ))

next(*pat*, #t)

;; example Rotate a descending whole-tone figure with fixed notes

function stepper(start)
  function stepper-aux()
      with this-value = start
      set start += -2
      this-value
    end
  stepper-aux
end

variable *pat* = make-cycle( list( stepper(72), 61, 62))

next(*pat*)




concat( make-cycle({84 82 80 78 76 74 72}, for: 1), {b3 f4 g5 ef6})

variable *pat* = make-rotation( concat( make-cycle({84 82 80 78 76 74 72}, for: 1), {b3 f4 g5 ef6}),
                               rotate: make-cycle({{0 1 1} {0 1 2}}))

next(*pat*, #t)                                     

process play-pat(reps, pat, rate)
  with k,d,a
  repeat reps 
  for x = next(pat)
  if (symbol?(x))
    set k = key(x), a = .35, d = (rate * 2.5)
  else
    set k = x, a = .7, d = (rate * 4)
  end
  mp:midi(key: k, amp: a, dur: d)
  wait rate
end

begin with rot = make-rotation( concat( make-cycle({84 82 80 78 76 74 72}, for: 1), {b3 f4 g5 ef6}),
                           rotate: make-cycle({{0 1 1} {0 1 2}}))
  sprout( play-pat(69, rot, .25) )
end


;
; Examples of "change ringing".  Change ringing is an algorithmic procedure
; for ringing church bells, invented by those clever British, who also gave
; these algorithms great names like Plain Bob Minimus, Grandsire Doubles etc. 
; The algorithms all involve rotating diferent pairs of bells in the peal, 
; but "...the composer's job is to be sure that he has selected as far as
; possible the most musical sequences from the many thousands available."
; You can implement change ringing by passsing the appropriate changes to the
; rotation pattern. These rotation changes affect just the first two
; change value numbers, ie. the start index and the stepping increment of
; the rotation.  Change ringing rotates (almost always) by pairs, so the
; step increment between rotations is generally 2.  The start index is
; (almost always) the mod 2 cycle. The basic changes for even bell hunting
; is therefore a cycle of two changes: (items (0 2) (1 2)).  This pattern
; is called the Plain Hunt. Plain Hunting causes a set of n elements to
; repeat after 2n changes, or n times through our cycle. Here is Plain Hunt
;  Minumus (4 elements A B C D); X marks the rotations.

;
; Plain Hunt Minimus
;	A B C D
;	 X   X
;	B A D C
;	   X
;	B D A C
;	 X   X
;	D B C A
;	   X
;	D C B A
;	 X   X
;	C D A B
;	   X
;	C A D B
;	 X   X
;	A C B D
;	   X
;	A B C D
;


;
; Plain Hunt changes: start=cycle(0,1) and step=2.
; For n elements, this process brings a pattern back to its original
; form after 2*n changes, which we look at as n repetitions of
; cycle(0,1)
;

function plain-hunt ()
  make-cycle({{0 2} {1 2}})
end

variable *pat* = make-rotation({a b c d}, rotate: plain-hunt())

next(*pat*, #t)

; utility function to return pattern results.

function peals (p)
  with a = next(p, #t),
       r = list(a),
       i = 1
  loop for l = next(p, #t)
    until equal?(l, a)
    set r &= l, i += 1
  end
  values(r, i)
end

peals( make-rotation({a b c d}, rotate: plain-hunt()) )


;
; Plain Bob builds on the Plain Hunt and is n-1 repetions of cycle(0,1)
; followed by a "dodge" on the nth: cycle(0,2), which causes the rotation
; to start at the 2nd index instead of the first, this stops the return 
; of the pattern, which finally repeats after 2n*(n-1) changes.
;

function dodge (start &optkey step = 2)
  ;; returns a "dodged" cycle, ie instead of 0,1 its 0,x
  make-cycle(list( {0 2}, list(start,step)))
end

function plain-bob (n)
  make-cycle( list( make-cycle( plain-hunt(), for: (n - 1)),
                    dodge(2)))
end

peals(make-rotation( {a b c d}, rotate: plain-bob(4)))

;
; Call Bob builds on Plain Bob. It's n-2 repitions of Plain Bob
; followed by a plain bob whose dodge is different: cycle(1,3). The
; total number of changes become 3*(2n*(n-1)). So for 6 bells 
; (Call Bob Minumus), the pattern repeats after 3*60 or 180 changes.
;


function call-bob (n)
  make-cycle( list( make-cycle( plain-bob(n), for: (n - 2)) , 
                    make-cycle( list(make-cycle(plain-hunt(), for: (n - 1)),
                                     dodge(1, 3)))))
end

peals( make-rotation({a b c d e f}, rotate: call-bob(6)))

;
; Call Single builds on Call Bob, but the very last dodge of 1,3 is
; replaced by a rotation of just the last two elements, which causes
; the process to double (360 changes for 6 bells). 
;

function call-single (n)
  make-cycle(list(
                  make-cycle(call-bob(n), for: 2),
                  make-cycle(list(make-cycle(plain-bob(n), for: ( n - 2)) ,
                                  ;; the third call-bob is the single
                                  make-cycle(list(make-cycle(plain-hunt(), for: (n - 1)) ,
                                                  dodge( (n - 2))))))))
end

peals(make-rotation({a b c d e f}, rotate: call-single( 6)))

multiple-value-bind(a b) values(1,23)

;
; Grandsire rotates an odd number of Bells
;

function grandsire (n)
  make-cycle(list( {0 3},
                   make-cycle(make-cycle({{1 2} {0 2}}), for: (n - 1)),
                   {1 2}))
end

peals(make-rotation({a b c d}, rotate: plain-hunt()))

peals(make-rotation({a b c d e}, rotate: grandsire(5)))

process chrds (n, p, r, d, k, a, z)
  with j 
  repeat n
  set j = k
  loop for i in next(p, #t)
    if (not( equal?( i, 0)))
      mp:midi(dur: d, amp: a, key: j)
    set j += i
    end
  end
  set k += z
  wait r
end

sprout(chrds(60, make-rotation({0 3 4 7 8 11}, rotate: plain-bob( 6)) ,
             .5, .5, 48, .3, 0))


sprout(list(chrds(60, make-rotation({0 3 4 7 8 11}, rotate: plain-bob(6)), .7, 2, 80, .3, -1),
            chrds(60, make-rotation({0 3 4 7 8 11}, rotate: plain-bob(6)),
                  .7, 2, 20, .3, 1))
       )

process dograndshire (r, n, tr, am)
  with pat = make-rotation(key({cs4 ds fs gs as g a d}),
                           rotate: grandsire(5))
  repeat n
  for k = next(pat)
  mp:midi(key: (k + tr),
          amp: am,
          dur: (r * 1.5))
  wait r
end

sprout(list(dograndshire(.15, 100,  12, .4),
            dograndshire(.3,  50,  -12, .5),
            dograndshire(.48, 32,  -36, .7)
            ))