
;; milkytracker fx descriptions: http://milkytracker.org/docs/MilkyTracker.html#effects
;; openMpt fx description: http://wiki.openmpt.org/Manual:_Effect_Reference
;; The mod format document: http://www.aes.id.au/modformat.html
;;
;; http://demozoo.org/music/?page=2
;; https://files.scene.org




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define-struct event
  :patternnum
  :channel
  :linenum
  :type
  :value
  :value2 0
  :instrumentnum 0
  :tick 0
  :added-afterwards #f) ;; used during processing

(delafina (m-e-0 :type type
                 :pattern 0
                 :channel 0
                 :instrumentnum 0
                 :line 0
                 :value 0
                 :value2 0
                 :tick 0
                 )
  (make-event pattern
              channel              
              line
              type
              value
              value2
              instrumentnum
              tick))

(define (m-e type . rest)
  (if (not (memq type '(:note :velocity :break :loop :stop :pitch-slide :slide-to-note :continue-slide-to-note :fine-pitch-slide :vibrato :tremolo :sample-offset :velocity-slide :fine-velocity-slide :pattern-delay :tpd :bpm :retrigger-note :delay-note :arpeggio)))
      (throw (<-> "Unknwon event type " type)))
  (apply m-e-0
         (append (list :type type)
                 rest)))
#||
(print-event (m-e :break
                  :line 8))
||#

(define (event-to-string event)  
  (<-> "[p: " (event :patternnum)
       ", c: " (event :channel)
       ", line: " (if (integer? (event :linenum))
                      (event :linenum)
                      (* 1.0 (event :linenum)))
       ", type: " (event :type)
       (if (> (event :tick) 0)
           (<-> ", tick: " (event :tick))
           "")
       ", value: " (event :value)
       (if (> (event :value2) 0)
           (<-> ", value2: " (event :value2))
           "")
       (if (> (event :instrumentnum) 0)
           (<-> ", instrument: " (event :instrumentnum))
          "")
       "]"))


(define (print-event event)
  (c-display (event-to-string event)))

(define (print-events events)
  (newline)
  (for-each print-event events))
                  
                                                 
(define *default-tpd* 6)
(define *default-bpm* 125)

;; Note: add-event doesn't sort channels
(define (add-event events new-event)
  (if (null? events)
      (list new-event)
      (begin
        (define event (car events))
        (if (and (<= (new-event :patternnum)
                     (event :patternnum))
                 (<= (new-event :linenum)
                     (event :linenum)))
            (cons new-event
                  events)
            (cons event
                  (add-event (cdr events) new-event))))))

(define *num-radium-ticks* 65534)
(define *smallest-radium-tick* (/ 1 *num-radium-ticks*))
(define (-line linenum)
  (- linenum *smallest-radium-tick*))


(define (place-line place)
  (floor place))
(define (place-counter place)
  (numerator (- place (place-line place))))
(define (place-dividor place)
  (denominator (- place (place-line place))))

(define (place-list place)
  (let* ((line (place-line place))
         (rest (- place line)))
    (list line
          (numerator rest)
          (denominator rest))))
          
(define (event->place-list event tpds)
  (let ((linenum (event :linenum)))
    (list linenum
          (event :tick)
          (tpds linenum))))

(define (place-list-equal? place-list1 place-list2)
  (= (+ (car place-list1)
        (/ (cadr place-list1)
           (caddr place-list1)))
     (+ (car place-list2)
        (/ (cadr place-list2)
           (caddr place-list2)))))

     
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; convert between events and patterns ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (events-to-patterns-0 events pattern)
  (if (null? events)
      (list (reverse pattern))
      (let ((event (car events))
            (patternnum ((car pattern) :patternnum)))
        (if (= (event :patternnum) patternnum)
            (events-to-patterns-0 (cdr events) (cons event pattern))
            (cons (reverse pattern)
                  (events-to-patterns-0 (cdr events) (list event)))))))
                
(define (events-to-patterns events)
  (if (null? events)
      '()
      (events-to-patterns-0 (cdr events)
                            (list (car events)))))


(***assert*** (events-to-patterns (list (m-e :note :line 29 :pattern 0)
                                        (m-e :break :line 30 :pattern 0)                                        
                                        (m-e :break :line 31 :pattern 1)))
              (list (list (m-e :note :line 29 :pattern 0)
                          (m-e :break :line 30 :pattern 0))
                    (list (m-e :break :line 31 :pattern 1))))
              

(define (patterns-to-events patterns)
  (apply append patterns))


(let ((events (list (m-e :note :line 29 :pattern 0)
                    (m-e :note :line 30 :pattern 0)
                    (m-e :break :line 30 :pattern 0)
                    (m-e :break :line 31 :pattern 1)
                    (m-e :break :line 31 :pattern 3))))
  (***assert*** (patterns-to-events (events-to-patterns events))
                events))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; convert between pattern and channels ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; can be optimized
(define (pattern-events-to-channels pattern-events break-event num-channels)
  (map (lambda (channelnum)
         (append (keep (lambda (event)
                         (and (= (event :channel) channelnum)
                              (not (eq? (event :type) :break))))
                       pattern-events)
                 (list (copy-event break-event  ;; add the break event to every channel.
                                   :channel channelnum))))
       (iota num-channels)))

;; Can be optimized a lot. Likely that this function is not needed though.
(define (channels-to-pattern channels)
  (c-display "warning, events are not sorted by channel when converting channels->pattern")
  (let loop ((result '())
             (events (apply append channels)))
    (if (null? events)
        result
        (loop (add-event result (car events)) ;; Not quite correct. add-event doesn't insert into channel-correctly.
              (cdr events)))))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; copy pattern                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (copy-pattern events from-patternnum to-patternnum)
  (define from-pattern (keep (lambda (event)
                               (and (= (event :patternnum) from-patternnum)
                                    (not (event :added-afterwards))))
                             events))
  (map (lambda (event)
         (copy-event event :patternnum to-patternnum))
       from-pattern))

(***assert*** (copy-pattern (list (m-e :break :line 30 :pattern 1)
                                  (m-e :break :line 32 :pattern 2))
                            1 3)
              (list (m-e :break :line 30 :pattern 3)))

                                  

(define (list-replace-element das-list pos new-value)
  (if (= 0 pos)
      (cons new-value
            (cdr das-list))
      (cons (car das-list)
            (list-replace-element (cdr das-list)
                                  (1- pos)
                                  new-value))))

(define (replace-patterns-in-playlist playlist from1 from2 to)
  (cond ((null? playlist)
         playlist)
        ((null? (cdr playlist))
         playlist)
        ((and (= (car playlist) from1)
              (= (cadr playlist) from2))
         (cons to
               (replace-patterns-in-playlist (cddr playlist) from1 from2 to)))
        (else
         (cons (car playlist)
               (replace-patterns-in-playlist (cdr playlist) from1 from2 to)))))

(define (find-num-patterns events)
  (1+ ((last events) :patternnum)))
        
(define (add-new-pattern playlist playlistnum events prev-tpd prev-bpm)
  (define from-patternnum (list-ref playlist playlistnum))
  (define to-patternnum (find-num-patterns events))
  (define new-pattern (copy-pattern events from-patternnum to-patternnum))
  (define new-events (add-line0-tpd-and-bpm-to-pattern (append events new-pattern)
                                                       to-patternnum
                                                       prev-tpd prev-bpm))
  (c-display "add-new-pattern" playlistnum to-patternnum)
  (define new-playlist (list-replace-element playlist playlistnum to-patternnum))
  (list new-playlist
        new-events))

(define (get-num-lines-in-pattern events)
  ;;(print-events events)
  (define event (car events))
  (if (eq? (event :type) :break)
      (event :linenum)
      (get-num-lines-in-pattern (cdr events))))

(***assert*** (get-num-lines-in-pattern (list (m-e :note)
                                              (m-e :break :line 64)))
              64)

(define (remove-break-events-and-everything-after events)
  (let ((event (car events)))
    (if (eq? (event :type) :break)
        '()
        (cons event
              (remove-break-events-and-everything-after (cdr events))))))

(define (append-patterns events from-patternnum1 from-patternnum2)
  (define to-patternnum (find-num-patterns events))
  (define new-pattern1 (copy-pattern events from-patternnum1 to-patternnum))
  (define new-pattern2 (copy-pattern events from-patternnum2 to-patternnum))
  ;;(c-display "bef" from-patternnum1 from-patternnum2)
  ;;(print-events events)
  (define num-lines-in-pattern1 (get-num-lines-in-pattern new-pattern1))
  ;;(c-display "num" num-lines-in-pattern1)
  (append (remove-break-events-and-everything-after new-pattern1)
          (map (lambda (event)
                 (copy-event event :linenum (+ num-lines-in-pattern1 (event :linenum))))
               new-pattern2)))

(***assert*** (append-patterns (list (m-e :note :pattern 0)
                                     (m-e :break :line 64)
                                     (m-e :note :pattern 1)
                                     (m-e :break :line 64 :pattern 1))
                               0 1)
              (list (m-e :note :line 0 :pattern 2)
                    (m-e :note :line 64 :pattern 2)
                    (m-e :break :line 128 :pattern 2)))
              
(define (add-new-merged-pattern playlist events from-patternnum1 from-patternnum2)
  (define to-patternnum (find-num-patterns events))
  (define new-pattern (append-patterns events from-patternnum1 from-patternnum2))
  (define new-playlist (replace-patterns-in-playlist playlist from-patternnum1 from-patternnum2 to-patternnum))
  
  (list new-playlist
        (append events
                new-pattern)))
  

(define (find-line0-tpd-event events patternnum)
  (if (null? events)
      #f
      (let ((event (car events)))
        (cond ((> (event :patternnum) patternnum)
               #f)
              ((< (event :patternnum) patternnum)
               (find-line0-tpd-event (cdr events) patternnum))
              ((> (event :linenum) 0)
               #f)
              ((eq? (event :type) :tpd)
               event)
              (else
               (find-line0-tpd-event (cdr events) patternnum))))))


#||
(find-line0-tpd-event (list (make-event :patternnum 1
                                        :channel 2343
                                        :linenum 0
                                        :type :tpd
                                        :value 50))
                      1)
||#

(define (find-line0-bpm-event events patternnum)
  (if (null? events)
      #f
      (let ((event (car events)))
        (cond ((> (event :patternnum) patternnum)
               #f)
              ((< (event :patternnum) patternnum)
               (find-line0-bpm-event (cdr events) patternnum))
              ((> (event :linenum) 0)
               #f)
              ((eq? (event :type) :bpm)
               event)
              (else
               (find-line0-bpm-event (cdr events) patternnum))))))

(define (add-line0-tpd-and-bpm-to-pattern events patternnum tpd bpm)
  (define first-tpd-event (find-line0-tpd-event events patternnum))
  (define first-bpm-event (find-line0-bpm-event events patternnum))

  ;;(assert (or first-tpd-event first-bpm-event))
  
  (define events2 (if (and first-tpd-event
                           (not (first-tpd-event :added-afterwards)))
                      events
                      (add-event events (make-event :patternnum patternnum
                                                    :linenum 0
                                                    :channel 0
                                                    :type :tpd
                                                    :value tpd
                                                    :added-afterwards #t
                                                    ))))
  
  
  (define events3 (if (and first-bpm-event
                           (not (first-bpm-event :added-afterwards)))
                      events2
                      (add-event events2 (make-event :patternnum patternnum
                                                     :linenum 0
                                                     :channel 0
                                                     :type :bpm
                                                     :value bpm
                                                     :added-afterwards #t
                                                     ))))
  events3)

#||
(print-events (add-line0-tpd-and-bpm-to-pattern (list) 6 2 3))
||#
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; create-new-patterns-based-on-tempo              ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (last-tpd-value events patternnum result)
  (if (null? events)
      result
      (let ((event (car events)))
        (cond ((< (event :patternnum) patternnum)
               (last-tpd-value (cdr events) patternnum result))
              ((> (event :patternnum) patternnum)
               result)              
              ((eq? (event :type) :tpd)
               (last-tpd-value (cdr events) patternnum (event :value)))
              (else
               (last-tpd-value (cdr events) patternnum result))))))

#||
(last-tpd-value events 2 #f)
||#

(define (last-bpm-value events patternnum result)
  (if (null? events)
      result
      (let ((event (car events)))
        (cond ((< (event :patternnum) patternnum)
               (last-bpm-value (cdr events) patternnum result))
              ((> (event :patternnum) patternnum)
               result)              
              ((eq? (event :type) :bpm)
               (last-bpm-value (cdr events) patternnum (event :value)))
              (else
               (last-bpm-value (cdr events) patternnum result))))))
  
(define (create-new-patterns-based-on-tempo-0 playlist events playlistnum prev-tpd prev-bpm)
  (if (= (length playlist) playlistnum)
      (list playlist events)
      (let* ((patternnum (list-ref playlist playlistnum))
             (first-tpd-event (find-line0-tpd-event events patternnum))
             (first-bpm-event (find-line0-bpm-event events patternnum))
             (must-create-new-pattern? (begin
                                         (c-display "patternnum" patternnum first-tpd-event first-bpm-event prev-tpd prev-bpm)
                                         (or (and first-tpd-event
                                                  (first-tpd-event :added-afterwards)
                                                  (not (= prev-tpd (first-tpd-event :value))))
                                             (and first-bpm-event
                                                  (first-bpm-event :added-afterwards)
                                                  (not (= prev-bpm (first-bpm-event :value)))))))
             (new-playlist-and-events (if must-create-new-pattern?
                                          (add-new-pattern playlist playlistnum events prev-tpd prev-bpm)
                                          (list playlist
                                                (add-line0-tpd-and-bpm-to-pattern events patternnum prev-tpd prev-bpm))))
             (new-playlist (car new-playlist-and-events))
             (new-events (cadr new-playlist-and-events)))
        (create-new-patterns-based-on-tempo-0 new-playlist
                                              new-events
                                              (1+ playlistnum)
                                              (last-tpd-value new-events patternnum prev-tpd)
                                              (last-bpm-value new-events patternnum prev-bpm)))))

(define (get-redundant-tpd-events events last-tpd-event)
  (if (null? events)
      '()
      (let ((event (car events)))
        (if (and last-tpd-event
                 (eq? (event :type)
                      :tpd)
                 (= (event :patternnum)
                    (last-tpd-event :patternnum))
                 (= (event :linenum)
                    (last-tpd-event :linenum)))
            (cons last-tpd-event
                  (get-redundant-tpd-events (cdr events) event))
            (get-redundant-tpd-events (cdr events)
                                      (if (eq? (event :type) :tpd)
                                          event
                                          last-tpd-event))))))

(define (remove-redundant-tpd-events events)
  (let loop ((redundants (get-redundant-tpd-events events #f))
             (events events))
    (if (null? redundants)
        events
        (loop (cdr redundants)
              (delete-from events (car redundants))))))
    
(define (get-redundant-bpm-events events last-bpm-event)
  (if (null? events)
      '()
      (let ((event (car events)))
        (if (and last-bpm-event
                 (eq? (event :type)
                      :bpm)
                 (= (event :patternnum)
                    (last-bpm-event :patternnum))
                 (= (event :linenum)
                    (last-bpm-event :linenum)))
            (cons last-bpm-event
                  (get-redundant-bpm-events (cdr events) event))
            (get-redundant-bpm-events (cdr events)
                                      (if (eq? (event :type) :bpm)
                                          event
                                          last-bpm-event))))))

(define (remove-redundant-bpm-events events)
  (let loop ((redundants (get-redundant-bpm-events events #f))
             (events events))
    (if (null? redundants)
        events
        (loop (cdr redundants)
              (delete-from events (car redundants))))))
    
(define (remove-redundant-tempos events)
  (remove-redundant-tpd-events
   (remove-redundant-bpm-events
    events)))
      
(define (create-new-patterns-based-on-tempo playlist events)
  (define new-events (remove-redundant-tempos events))
  (create-new-patterns-based-on-tempo-0 playlist new-events 0 *default-tpd* *default-bpm*))
      

#||
(define events (list (make-event :type :tpd
                                 :patternnum 2
                                 :channel 0
                                 :linenum 5
                                 :added-afterwards #f
                                 :value 20)
                     (make-event :type :note
                                 :patternnum 1
                                 :channel 2
                                 :linenum 8
                                 :value 5)
                     (make-event :type :tpd
                                 :patternnum 2
                                 :channel 1
                                 :linenum 5
                                 :added-afterwards #f
                                 :value 24)
                     (make-event :type :bpm
                                 :patternnum 2
                                 :channel 1
                                 :linenum 6
                                 :added-afterwards #f
                                 :value 240)
                     ))

(define hepp (car (remove-redundant-tpd-events events)))
(test (hepp :channel) 1)

(remove-redundant-tempos events)

(define hepp (create-new-patterns-based-on-tempo '(0 1 2 1)
                                                 events))

(print-events (cadr hepp))

(length (cadr hepp))

||#




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; create-new-patterns-based-on-other-stuff        ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (has-track-hanging-note?-0 track-events result)
  (if (null? track-events)
      result
      (let ((event (car track-events)))
        (cond ((eq? (event :type) :stop)
               (has-track-hanging-note?-0 (cdr track-events) #f))
              ((eq? (event :type) :note)
               (has-track-hanging-note?-0 (cdr track-events) #t))
              (else
               (has-track-hanging-note?-0 (cdr track-events) result))))))
  
;;(define (has-track-hanging-note?-0 track-events result)
;;  #f)

(define (has-track-hanging-note? track-events)
  (has-track-hanging-note?-0 track-events #f))
      

(define (is-hanging-note-stopped-at-beginning? track-events)
  (if (null? track-events)
      #f
      (let ((event (car track-events)))
        (cond ((> (event :linenum) 0)
               #f)
              ((eq? (event :type) :stop)
               #t)
              ((eq? (event :type) :note)
               #t)
              (else
               (is-hanging-note-stopped-at-beginning? (cdr track-events)))))))
      

;; hva med skifte av instrument uten ny note? De bør kanskje oversettes til nye noter i et eget step som blir kalt før denne.
;;
(define (track-starts-with-continuing-data? track previous-events) ;; note: 'previous-events' is just a local variable for the function. It should always be '() when called from the outside.
  (define (no-events-in-previous-events type)
    (let loop ((events previous-events))
      (cond ((null? events)
             #t)
            ((eq? ((car events) :type) type)
             #f)
            (else
             (loop (cdr events))))))
  (define (clean-note-in-previous-events? linenum-of-slide-to-note)
    (let loop ((events previous-events))
      (if (null? events)
          #f
          (let ((event (car events)))
            (cond ((eq? (event :type) :note)
                   (if (= (event :linenum) linenum-of-slide-to-note)
                       (loop (cdr events))
                       #t))
                  ((eq? (event :type) :slide-to-note)             
                   (if (null? (cdr events))
                       #f
                       (let ((event2 (cadr events)))
                         (if (and (eq? (event2 :type) :note)
                                  (= (event :linenum) (event2 :linenum)))
                             (loop (cddr events)) ;; skip notes that are actually just arguments to :slide-to-note
                             (loop (cdr events))))))
                  (else
                   (loop (cdr events))))))))
  (if (null? track)
      #f
      (let ((event (car track)))
        (or (and (eq? (event :type) :note)
                 (= 0 (event :instrumentnum))
                 (no-events-in-previous-events :note))
            (and (eq? (event :type) :slide-to-note)
                 (not (clean-note-in-previous-events? (event :linenum)))) ;; slide-to-note requires a base note to start sliding from, not just slide to.
            (and (eq? (event :type) :slide-to-note)
                 (= 0 (event :value) 0)
                 (no-events-in-previous-events :slide-to-note))
            (and (eq? (event :type) :continue-slide-to-note) ;; TODO: Fix this.
                 (no-events-in-previous-events :slide-to-note)) ;; this is correct
            (and (eq? (event :type) :vibrato)
                 (or (= 0 (event :value) 0)
                     (= 0 (event :value2) 0))
                 (no-events-in-previous-events :vibrato))
            (and (eq? (event :type) :continue-vibrato)
                 (no-events-in-previous-events :vibrato)) ;; this is correct
            (and (eq? (event :type) :tremolo)
                 (or (= 0 (event :value) 0)
                     (= 0 (event :value2) 0))
                 (no-events-in-previous-events :tremolo))
            (track-starts-with-continuing-data? (cdr track)
                                                (cons event previous-events))))))


(***assert*** (track-starts-with-continuing-data? (list (m-e :note  :line 0 :value 2 :instrumentnum 0)
                                                        (m-e :break :line 64))
                                                  '())
              #t)

(***assert*** (track-starts-with-continuing-data? (list (m-e :note  :line 0 :value 2 :instrumentnum 2)
                                                        (m-e :note  :line 1 :value 2 :instrumentnum 0)
                                                        (m-e :break :line 64))
                                                  '())
              #f)

(***assert*** (track-starts-with-continuing-data? (list (m-e :vibrato :line 0 :value 0))
                                                  '())
              #t)

(***assert*** (track-starts-with-continuing-data? (list (m-e :vibrato :line 0 :value 2 :value2 3)
                                                        (m-e :vibrato :line 1 :value 0))
                                                  '())
              #f)

(***assert*** (track-starts-with-continuing-data? (list (m-e :tremolo :line 0 :value 0))
                                                  '())
              #t)

(***assert*** (track-starts-with-continuing-data? (list (m-e :tremolo :line 0 :value 2 :value2 3)
                                                        (m-e :tremolo :line 1 :value 0))
                                                  '())
              #f)

;; slide-to-note tests, testing with already playing note
;;
(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 0 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 1 :value 0))
                                                  '())
              #t)

(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 0 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 1 :value 5)
                                                        (m-e :slide-to-note :line 2 :value 0))
                                                  '())
              #f)

(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 0 :value 2 :instrumentnum 2)
                                                        (m-e :continue-slide-to-note :line 1 :value 0))
                                                  '())
              #t)

(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 0 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 1 :value 2)
                                                        (m-e :continue-slide-to-note :line 2 :value 0))
                                                  '())
              #f)


;; slide-to-note tests, testing without already playing note
;;
(***assert*** (track-starts-with-continuing-data? (list (m-e :slide-to-note :line 1 :value 5))
                                                  '())
              #t)

;; the data in this test doesn't make much sense, but it doesn't help to merge patterns, I think, so it should return #f
(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 0 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 1 :value 5))
                                                  '())
              #f)

(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 0 :value 2 :instrumentnum 2)
                                                        (m-e :note          :line 1 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 1 :value 5)
                                                        )
                                                  '())
              #f)

(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 1 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 1 :value 5)
                                                        )
                                                  '())
              #t)

(***assert*** (track-starts-with-continuing-data? (list (m-e :note          :line 1 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 1 :value 5)
                                                        (m-e :note          :line 2 :value 2 :instrumentnum 2)
                                                        (m-e :slide-to-note :line 2 :value 5)
                                                        )
                                                  '())
              #t)



#||                 
(define (get-track events patternnum channel)
  (keep (lambda (event)
          (and (= (event :patternnum) patternnum)
               (= (event :channel) channel)))
        events))
||#

;; optimized version:
(define (get-track events patternnum channel)
  (if (null? events)
      '()
      (let* ((event (car events))
             (event-patternnum (event :patternnum)))
        (cond ((< event-patternnum patternnum)
               (get-track (cdr events) patternnum channel))
              ((= event-patternnum patternnum)
               (if (= (event :channel) channel)
                   (cons event
                         (get-track (cdr events) patternnum channel))
                   (get-track (cdr events) patternnum channel)))
              (else
               '())))))

(define (must-create-new-pattern? playlist events playlistpos1 playlistpos2 channel)
  (let* ((patternnum2 (list-ref playlist playlistpos2))
         (track2 (get-track events patternnum2 channel)))
    (or (track-starts-with-continuing-data? track2 '())
        (and (not (is-hanging-note-stopped-at-beginning? track2))
             (let* ((patternnum1 (list-ref playlist playlistpos1))
                    (track1 (get-track events patternnum1 channel)))
               (has-track-hanging-note? track1))))))

(define (merge-patterns-1 playlist events channel playlistpos) ;; iterate over playlistpos
  (if (= (1- (length playlist)) playlistpos)
      (list playlist events)
      (let ((playlistpos1 playlistpos)
            (playlistpos2 (1+ playlistpos)))
        (if (must-create-new-pattern? playlist events playlistpos1 playlistpos2 channel)
            (let* ((patternnum1 (list-ref playlist playlistpos1))
                   (patternnum2 (list-ref playlist playlistpos2))
                   (displaying-result (c-display "  Merging patterns" patternnum1 "and" patternnum2 "into patternnum" (find-num-patterns events)))
                   (new-playlist-and-events (add-new-merged-pattern playlist
                                                                    events
                                                                    patternnum1 patternnum2))
                   (new-playlist (car new-playlist-and-events))
                   (new-events (cadr new-playlist-and-events)))
              (merge-patterns-1 new-playlist
                                new-events
                                channel
                                playlistpos))
            (merge-patterns-1 playlist
                              events
                              channel
                              (1+ playlistpos))))))


(define (merge-patterns-0 playlist events channel) ;; iterate over channel
  (if (= channel -1)
      (list playlist
            events)
      (let* ((new-playlist-and-events (merge-patterns-1 playlist events channel 0))
             (new-playlist (car new-playlist-and-events))
             (new-events   (cadr new-playlist-and-events)))
        (merge-patterns-0 new-playlist new-events (1- channel)))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; replace-c00-with-stops ;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (remove-c00-at-same-line patternnum channel linenum c00s)
  (keep (lambda (c00)
          (or (not (= patternnum (c00 :patternnum)))
              (not (= channel (c00 :channel)))
              (not (= linenum (c00 :linenum)))))
        c00s))

(define (find-c00s-at c00s patternnum channel)
  (if (null? c00s)
      '()
      (let ((c00 (car c00s)))
        (if (and (= patternnum (c00 :patternnum))
                 (= channel (c00 :channel)))
            (cons c00 
                  (find-c00s-at (cdr c00s) patternnum channel))
            (find-c00s-at (cdr c00s) patternnum channel)))))

(define (find-all-c00-stops events current-c00s)
  ;;(c-display "events" events)
  (if (null? events)
      current-c00s ;; We also convert all hanging c00s into stops.
      (let* ((event (car events))
             (patternnum (event :patternnum))
             (channel (event :channel))
             (linenum (event :linenum)))
        (cond ((eq? :note (event :type))
               (let ((c00s (find-c00s-at current-c00s patternnum channel)))
                 (remove-c00-at-same-line patternnum channel linenum
                                          (append c00s
                                                  (find-all-c00-stops (cdr events) (delete-list-from current-c00s c00s))))))
              
              ((eq? :velocity (event :type))
               (if (= 0 (event :value))
                   (find-all-c00-stops (cdr events) (cons event current-c00s))
                   (let ((c00s (find-c00s-at current-c00s patternnum channel))) ;; these are the only c00s we don't want to convert into stops.
                     (find-all-c00-stops (cdr events) (delete-list-from current-c00s c00s)))))
              
              (else
               (find-all-c00-stops (cdr events) current-c00s))))))

(define (convert-c00-event-to-stop events c00-event)
  (cond ((eq? (car events) c00-event)
         (cons (copy-event (car events)
                           :type :stop)
               (cdr events)))
        (else
         (cons (car events)
               (convert-c00-event-to-stop (cdr events) c00-event)))))

(define (replace-c00-with-stops-1 events c00s)
  (if (null? c00s)
      events
      (replace-c00-with-stops-1 (convert-c00-event-to-stop events (car c00s))
                                (cdr c00s))))

(define (replace-c00-with-stops events)
  (replace-c00-with-stops-1 events
                            (find-all-c00-stops events '())))


;;TODO: Add tests to make sure c00s which are actually just parameters for slide-to-note are not made into :stops.
;; plus fix replace-c00-with-stops and move prepare-slide-to-note after merge-patterns.


;; We don't add :stop if it's on the same line as a note
(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :line 3   :value 0)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :velocity :line 3  :value 0)))


(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :line 10  :value 0)
                     (m-e :note     :line 11  :value 1)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :stop     :line 10  :value 0)
                    (m-e :note     :line 11  :value 1)))

(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :line 10  :value 3)
                     (m-e :note     :line 11  :value 1)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :velocity :line 10  :value 3)
                    (m-e :note     :line 11  :value 1)))


(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :line 10  :value 3)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :velocity :line 10  :value 3)))

(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :line 10  :value 0)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :stop     :line 10)))

(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :channel 2 :line 10  :value 0)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :stop     :channel 2 :line 10)))

(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :line 10  :value 0)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :stop     :line 10)))

;; We don't add :stop if a new velocity turns on the volume again later
(***assert*** (replace-c00-with-stops
               (list (m-e :note     :line 3   :value 2)
                     (m-e :velocity :line 10  :value 0)
                     (m-e :velocity :line 11  :value 5)))
              (list (m-e :note     :line 3   :value 2)
                    (m-e :velocity :line 10  :value 0)
                    (m-e :velocity :line 11  :value 5)))




#||
(define events (list
                (make-event :type :note
                            :patternnum 1
                            :channel 0
                            :linenum 3
                            :value 2)
                (make-event :type :note
                            :patternnum 1
                            :channel 1
                            :linenum 8
                            :value 5)
                (make-event :type :velocity
                            :patternnum 1
                            :channel 1
                            :linenum 10
                            :value 0)
                (make-event :type :note
                            :patternnum 1
                            :channel 1
                            :linenum 11
                            :value 1)
                ))

(print-events (replace-c00-with-stops events))
||#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Note cut effect (ECx) effect            ;;;
;;;;  works by transforming into c00 effects ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#||

Done during input reading instead.

(define (remove-note-cut-effects-0 events)
  (if (null? events)
      '()
      (let ((event (car events)))
        (if (eq? (event :type) :cut-note)
            (cons (copy-event
                   (copy-event
                    (copy-event
                     event
                     :value 0)
                    :tick (event :value))
                   :type :velocity)
                  (remove-note-cut-effects-0 (cdr events)))
            (cons event
                  (remove-note-cut-effects-0 (cdr events)))))))
        
;; This can probably be done during input. It's just creating a c00 effect with a custom tick value.
(define (remove-note-cut-effects events)
  (remove-note-cut-effects-0 events))

(***assert*** (remove-note-cut-effects (list (m-e :cut-note :value 5)))
              (list (m-e :velocity :tick 5)))
||#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Merge patterns (main function)          ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (merge-patterns playlist events num-channels)
  (define new-events (replace-c00-with-stops
                      events))
  (merge-patterns-0 playlist new-events (1- num-channels)))

#||
(let* ((stuff (process-events '(0 0)
                              #(#("for game music:" "/home/kjetil/.radium/mod_samples/GrooveLoop.wav" 11282 0 64 0 0 24))
                             (list (m-e :note        :line 1   :value 5  :instrumentnum 1 :pattern 0 :channel 2)
                                   ;(m-e :velocity    :line 2   :value 32  :pattern 0)
                                   ;;(m-e :loop        :line 3   :value 0)
                                   ;;(m-e :loop        :line 4   :value 10)
                                   (m-e :velocity    :line 5   :value 9 :channel 2)
                                   (m-e :break       :line 5   :channel 2 :pattern 0 :value 10 :instrumentnum -1)
                                   (m-e :loop        :line 6   :value 1   :pattern 0 :instrumentnum -1)
                                   (m-e :note        :line 10  :value 6 :instrumentnum 1)
                                   (m-e :break       :line 64  :channel 2 :pattern 0 :instrumentnum -1)
                                   )))
       (playlist (car stuff))
       (patterns (caddr stuff))
       (pattern (car patterns)))
  (c-display "pattern" pattern)
  (c-display "playlist: " playlist)
  (c-display "num-patterns: " (length patterns))
  (print-events (car (pattern 0))))

(print-events (cadr (merge-patterns '(0 1)
                                    (list (m-e :note  :pattern 0 :line 5 :value 1 :instrumentnum 2)
                                          (m-e :break :pattern 0 :line 62 :channel 2)
                                          (m-e :note  :pattern 1 :line 2 :value 2 :instrumentnum 2)
                                          (m-e :break :pattern 1 :line 64))
                                    4)))
||#                                       

;; test continuing note
(let* ((events (list (m-e :note  :pattern 0 :line 5 :value 1 :instrumentnum 2)
                     (m-e :break :pattern 0 :line 64)
                     (m-e :note  :pattern 1 :line 2 :value 2 :instrumentnum 2)
                     (m-e :break :pattern 1 :line 64)))
       (hepp (merge-patterns '(0 1) events 3)))

  (***assert*** (car hepp) '(2))
  (***assert*** (cadr hepp)
                (append events
                        (list (m-e :note  :pattern 2 :line 5  :value 1 :instrumentnum 2)
                              (m-e :note  :pattern 2 :line 66 :value 2 :instrumentnum 2)
                              (m-e :break :pattern 2 :line 128)))))


(let* ((events (list (m-e :break :pattern 0 :line 64)
                     (m-e :note  :pattern 1 :line 2 :value 2 :instrumentnum 2)
                     (m-e :break :pattern 1 :line 64)))
       (hepp (merge-patterns '(0 1) events 3)))

  ;;(print-events (cadr hepp))

  (***assert*** (car hepp) '(0 1))
  (***assert*** (cadr hepp) events))
                

;; test continuing instrument num
(let* ((events (list (m-e :note  :pattern 0 :line 5 :value 1 :instrumentnum 2)
                     (m-e :break :pattern 0 :line 64)
                     (m-e :note  :pattern 1 :line 0 :value 2 :instrumentnum 0)
                     (m-e :break :pattern 1 :line 64)))
       (hepp (merge-patterns '(0 1) events 3)))

  (begin
    (c-display "playlist: " (car hepp))
    (print-events (cadr hepp)))
  
  (***assert*** (car hepp) '(2))
  (***assert*** (cadr hepp)
                (append events
                        (list (m-e :note  :pattern 2 :line 5  :value 1 :instrumentnum 2)
                              (m-e :note  :pattern 2 :line 64 :value 2 :instrumentnum 0)
                              (m-e :break :pattern 2 :line 128)))))

                

(define (add-break-events-1 events must-add patternnum default-num-lines)
  (define (create-break-event)
    (make-event :type :break
                :patternnum patternnum
                :channel 0
                :instrumentnum -1
                :linenum default-num-lines
                :value 0))
  (if (null? events)
      (if must-add
          (list (create-break-event))
          '())
      (let ((event (car events)))
        (assert (>= (event :patternnum) patternnum))
        (cond ((> (event :patternnum)
                  patternnum)
               (if must-add
                   (cons (create-break-event)
                         (add-break-events-1 events ;; It is correct. Not (cdr events) here
                                             #t
                                             (1+ patternnum)
                                             default-num-lines))
                   (add-break-events-1 events ;; It is correct. Not (cdr events) here
                                       #t
                                       (1+ patternnum)
                                       default-num-lines)))
              ((and (eq? :break (event :type))
                    (= (event :linenum) default-num-lines))
               (cons event
                     (add-break-events-1 (cdr events)
                                         #f
                                         patternnum
                                         default-num-lines)))
              (else
               (cons event 
                     (add-break-events-1 (cdr events)
                                         must-add
                                         patternnum
                                         default-num-lines)))))))
               
            
(define (add-break-events events default-num-lines playlist)
  (define last-patternnum-in-events (if (null? events) 0 ((last events) :patternnum)))
  (define last-patternnum-in-playlist (apply max playlist))
  (define appended-break-events (let loop ((patternnum (1+ last-patternnum-in-events)))
                                  (if (> patternnum last-patternnum-in-playlist)
                                      '()
                                      (cons (m-e :break :pattern patternnum :line default-num-lines :instrumentnum -1)
                                            (loop (1+ patternnum))))))
  (append (add-break-events-1 events #f -1 default-num-lines)
          appended-break-events))

(***assert*** (add-break-events (list (m-e :break :pattern 0 :line 8 :instrumentnum -1)
                                      (m-e :note :pattern 1 :line 16)
                                      (m-e :note :pattern 5 :line 16))
                                64
                                '(1 4 8 4))
              (list (m-e :break :pattern 0 :line 8 :instrumentnum -1)
                    (m-e :break :pattern 0 :line 64 :instrumentnum -1)

                    (m-e :note  :pattern 1 :line 16)
                    (m-e :break :pattern 1 :line 64 :instrumentnum -1)

                    (m-e :break :pattern 2 :line 64 :instrumentnum -1)
                    (m-e :break :pattern 3 :line 64 :instrumentnum -1)
                    (m-e :break :pattern 4 :line 64 :instrumentnum -1)

                    (m-e :note  :pattern 5 :line 16)
                    (m-e :break :pattern 5 :line 64 :instrumentnum -1)

                    (m-e :break :pattern 6 :line 64 :instrumentnum -1)
                    (m-e :break :pattern 7 :line 64 :instrumentnum -1)
                    (m-e :break :pattern 8 :line 64 :instrumentnum -1)
                    ))
#||
(print-events (add-break-events (list (m-e :break :pattern 0 :line 8)
                                      (m-e :note :pattern 1 :line 16)
                                      (m-e :note :pattern 5 :line 16))
                                64
                                '(1 4 8 4)))
||#

(let* ((playlist '(0 1 2))
       (hepp (merge-patterns playlist
                             (add-break-events (list (m-e :note :pattern 1 :channel 2 :line 8 :value 5))
                                               64
                                               playlist)
                             3)))
  ;;(c-display "playlist " (car hepp))
  
  ;;(print-events (cadr hepp))

  (***assert*** (car hepp) '(4))

  (***assert*** (cadr hepp)
                (list (m-e :break :pattern 0 :line 64 :instrumentnum -1)
                      
                      (m-e :note  :pattern 1 :line 8 :channel 2 :value 5)
                      (m-e :break :pattern 1 :line 64 :instrumentnum -1)
                      
                      (m-e :break :pattern 2 :line 64 :instrumentnum -1)
                      
                      (m-e :note  :pattern 3 :line (+ 64 8) :channel 2 :value 5)
                      (m-e :break :pattern 3 :line 128 :instrumentnum -1)
                      
                      (m-e :note  :pattern 4 :line (+ 64 8) :channel 2 :value 5)
                      (m-e :break :pattern 4 :line 192 :instrumentnum -1))))



(define (remove-events-after-breaks-0 events remove-patternnum)
  (if (null? events)
      '()
      (let ((event (car events)))
        (cond ((= (event :patternnum) remove-patternnum)
               (remove-events-after-breaks-0 (cdr events) remove-patternnum))
              ((eq? (event :type) :break)
               (cons event
                     (remove-events-after-breaks-0 events (event :patternnum))))
              (else
               (cons event
                     (remove-events-after-breaks-0 (cdr events) remove-patternnum)))))))

;; simplify-break-events and fix-break-events must be called first.
;; It does not remove events placed on the same line as a break if it is placed before the break in the events list. 'fix-break-events' takes care of that.
(define (remove-events-after-breaks events)
  (remove-events-after-breaks-0 events -1))


(***assert*** (remove-events-after-breaks (list (m-e :break :line 8)
                                                (m-e :note :line 8)
                                                (m-e :break :line 16)
                                                (m-e :note :line 16)))
              (list (m-e :break :line 8)))



#||
(define events (list
                (make-event :type :note
                            :patternnum 1
                            :channel 2
                            :linenum 8
                            :value 5)
                ))

(print-events (add-break-events events 64))

(define hepp (create-new-patterns-based-on-continuing-notes '(0 1 2 1)
                                                            (add-break-events events 64 '(0 1 2 1))
                                                            3))

(print-events (cadr hepp))

(length (cadr hepp))

||#


;; This function is called right after reading in the events. It makes sure the events are sorted properly since they are placed one line earlier than they start working in the MOD format.
;; <strike>It also makes sure that a break-lin starts with the break event.</strike> Not needed, break events are always inserted in the previous line.
(define (fix-break-events events)
  (let loop ((events events)
             (break-event #f))
    ;;(c-display "events: " (map event-to-string events))
    ;;(c-display "break-event: " (and break-event (event-to-string break-event)))
    (if (null? events)
        (if break-event
            (list break-event)
            '())
        (let ((event (car events)))
          (cond ((and break-event
                      (or (not (= (event :patternnum)
                                  (break-event :patternnum)))
                          (>= (event :linenum)
                              (break-event :linenum))))
                 (cons break-event
                       (loop events
                             #f)))
                
                ((and break-event
                      (eq? :break (event :type))) ;; Double break on the same line and pattern. Throw away the first break. (think it's the last one that counts)
                 (loop (cdr events) 
                       event))
                
                ((eq? :break (event :type))
                 (loop (cdr events)
                       event))

                (else
                 (cons event
                       (loop (cdr events)
                             break-event))))))))


(***assert*** (fix-break-events (list (m-e :break :line 8)
                                      (m-e :note :line 7)
                                      (m-e :note :line 7)))
              (list (m-e :note :line 7)
                    (m-e :note :line 7)
                    (m-e :break :line 8)))

#||
(print-events (fix-break-events (list (m-e :break :line 8)
                                      (m-e :note :line 8)
                                      (m-e :note :line 8))))
||#

(***assert*** (fix-break-events (list (m-e :break :line 8)
                                      (m-e :note :line 8)
                                      (m-e :note :line 8)))
              (list (m-e :break :line 8)
                    (m-e :note :line 8)
                    (m-e :note :line 8)))

#||
The behavior for these three tests are not needed since break events are always inserted on the previous line.
(***assert*** (fix-break-events (list (m-e :note :line 8)
                                      (m-e :break :line 8)))
              (list (m-e :break :line 8)
                    (m-e :note :line 8))))

(***assert*** (fix-break-events (list (m-e :note :line 8)
                                      (m-e :break :line 8)
                                      (m-e :note :line 8)))
              (list (m-e :break :line 8)
                    (m-e :note :line 8)
                    (m-e :note :line 8)))

(***assert*** (fix-break-events (list (m-e :note :line 8)
                                      (m-e :note :line 8)
                                      (m-e :break :line 8)))
              (list (m-e :break :line 8)
                    (m-e :note :line 8)
                    (m-e :note :line 8)))
||#

(***assert*** (fix-break-events (list (m-e :break :line 8)
                                      (m-e :note :line 0 :pattern 1)))
              (list (m-e :break :line 8)
                    (m-e :note :line 0 :pattern 1)))

(***assert*** (fix-break-events (list (m-e :break :line 8)
                                      (m-e :break :line 9)
                                      (m-e :note :line 8)))
              (list (m-e :break :line 8)
                    (m-e :note :line 8)
                    (m-e :break :line 9)))

#||
(set! (*s7* 'history-size) 8)
||#



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (find-loop-events-0 events loopstart)
  (if (null? events)
      '()
      (let ((event (car events)))
        (if (eq? (event :type) :loop)
            (if (= (event :value) 0)
                (find-loop-events-0 (cdr events) event)
                (let ((value2 (if (= (event :patternnum)
                                     (loopstart :patternnum))
                                  (loopstart :linenum)
                                  0)))
                  (cons (copy-event event :value2 value2)
                        (find-loop-events-0 (cdr events) loopstart))))
            (find-loop-events-0 (cdr events) loopstart)))))

(define (find-loop-events events)
  (find-loop-events-0 events (m-e :loop :pattern -1)))

(define (expand-loop-split before during events patternnum startline endline)
  (define (next-before event)
    (expand-loop-split (cons event before) during (cdr events) patternnum startline endline))
  (define (next-during event)
    (expand-loop-split before (cons event during) (cdr events) patternnum startline endline))
  (define (got-it)
    (list (reverse before)
          (reverse during)
          events))
  (if (null? events)
      (got-it)
      (let ((event (car events)))
        (cond ((< (event :patternnum) patternnum)
               (next-before event))
              ((> (event :patternnum) patternnum)
               (got-it))
              ((< (event :linenum) startline)
               (next-before event))
              ((>= (event :linenum) endline)
               (got-it))
              (else
               (next-during event))))))
              

(define (expand-loop-looped-events-0 events startline endline num)
  (if (= num 0)
      events
      (map (lambda (event)
             (copy-event event :linenum (+ (event :linenum)
                                           (* num (- endline startline)))))
           events)))

(define (expand-loop-looped-events events startline endline num num-repeats)
  (if (= num num-repeats)
      '()
      (append (expand-loop-looped-events-0 events startline endline num)
              (expand-loop-looped-events events startline endline (1+ num) num-repeats))))

(define (expand-loop-after-events events patternnum startline endline num-repeats)
  (if (null? events)
      '()
      (let ((event (car events)))
        (if (= (event :patternnum) patternnum)
            (cons (copy-event event :linenum (+ (event :linenum)
                                                (* num-repeats (- endline startline))))
                  (expand-loop-after-events (cdr events) patternnum startline endline num-repeats))
            events))))
              
;; Must check whether the endline is played. Now it is not played.
(define (expand-loop events patternnum startline endline num-repeats)
  (define splitted (expand-loop-split '() '() events patternnum startline endline))

  (define before-events (car splitted))
  (define loop-events (cadr splitted))
  (define after-events (caddr splitted))

  (append before-events
          (expand-loop-looped-events loop-events startline endline 0 num-repeats)
          (expand-loop-after-events  after-events patternnum startline endline num-repeats)))


(define (expand-loops events)
  ;(define org-events events)
  ;(define (print events)
  ;  (print-events (keep (lambda (event)
  ;                        (and (= 0 (event :patternnum))
  ;                             (or (= 0 (event :channel))
  ;                                 (= 2 (event :channel)))))
  ;                      events)))
  (let loop ((loops (find-loop-events events))
             (events events))
    (if (null? loops)
        (begin
          ;(c-display "          BEFORE")
          ;(print org-events)
          ;(c-display "          AFTER")
          ;(print (remove (lambda (event)
          ;                 (eq? (event :type) :loop))
          ;               events))
          ;(assert #f)
          events
          )
        (let* ((loop-event (car loops))
               (startline (loop-event :value2))
               (endline (loop-event :linenum))
               (num-repeats (1+ (loop-event :value))))
          (loop (cdr loops)
                (expand-loop events
                             (loop-event :patternnum)
                             startline        
                             endline
                             num-repeats))))))

#||
(print-events (expand-loops (list (m-e :note :line 3)
                                  (m-e :loop :line 61 :value 2)
                                  (m-e :break :channel 2 :line 64))))

(***assert*** (expand-loops (list (m-e :note :line 3)
                                  (m-e :loop :line 5 :value 0)
                                  (m-e :note :line 8 :value 1)
                                  (m-e :loop :line 10 :value 3)
                                  (m-e :note :line 12 :value 2)
                                  (m-e :note :pattern 1 :line 9 :value 3)
                                  (m-e :loop :pattern 1 :line 10 :value 1)))
              (list (m-e :note :line 3)
                    (m-e :note :line 8 :value 1)
                    (m-e :note :line 13 :value 1)
                    (m-e :note :line 18 :value 1)
                    (m-e :note :line 23 :value 1)
                    (m-e :note :line 32 :value 2)
                    (m-e :note :pattern 1 :line 9 :value 3)
                    (m-e :note :pattern 1 :line 19 :value 3)))
              

(print-events (expand-loops (list (m-e :note :line 3)
                                  (m-e :loop :line 5 :value 0)
                                  (m-e :note :line 8 :value 1)
                                  (m-e :loop :line 10 :value 3)
                                  (m-e :note :line 12 :value 2)
                                  ;;(m-e :loop :pattern 1 :line 0 :value 0) ;; default loop start, unnecessary event
                                  (m-e :note :pattern 1 :line 9 :value 3)
                                  (m-e :loop :pattern 1 :line 10 :value 1))))

||#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (find-first-break-in-pattern events patternnum)
  (if (null? events)
      #f
      (let ((event (car events)))
        (cond ((< (event :patternnum) patternnum)
               (find-first-break-in-pattern (cdr events) patternnum))
              ((> (event :patternnum) patternnum)
               #f)
              ((eq? (event :type) :break)
               event)
              (else
               (find-first-break-in-pattern (cdr events) patternnum))))))

(***assert*** (find-first-break-in-pattern (list (m-e :note)) 0)
              #f)

(define (simplify-break-event playlist playlistpos events break-event)
  (define from-patternnum (list-ref playlist playlistpos))
  (define to-patternnum (find-num-patterns events))
  (define new-pattern (copy-pattern events from-patternnum to-patternnum))
  (define new-playlist (list-replace-element playlist playlistpos to-patternnum))
  (define value (break-event :value))
  (define new-events (append events
                             (map (lambda (event)
                                    (copy-event event :linenum (- (event :linenum) value)))
                                  (remove (lambda (event)
                                            (< (event :linenum) value))
                                          new-pattern))))
  (list new-playlist
        new-events))

(define (simplify-break-events-0 playlist playlistpos events)
  ;;(c-display "playlist" playlist playlistpos)
  (if (>= playlistpos (1- (length playlist))) ;; We stop if it's the last played pattern
      (list playlist events)
      (let* ((patternnum (list-ref playlist playlistpos))
             (first-break-in-pattern (find-first-break-in-pattern events patternnum)))
        (print-event first-break-in-pattern)
        (if (and first-break-in-pattern
                 (> (first-break-in-pattern :value) 0))
            (let* ((playlist-and-events (simplify-break-event playlist (1+ playlistpos) events first-break-in-pattern))
                   (new-playlist (car playlist-and-events))
                   (new-events (cadr playlist-and-events)))
              ;;(print-events new-events)
              (simplify-break-events-0 new-playlist (1+ playlistpos) new-events))
            (simplify-break-events-0 playlist (1+ playlistpos) events)))))


;; Creates new patterns and changes events and playlist so that the 'value' value
;; of break events can be ignored (i.e we always jump to line 0 in the next pattern).
;;
(define (simplify-break-events playlist events)
  (simplify-break-events-0 playlist 0 events))

(let* ((playlist '(0 1 2))
       (hepp (simplify-break-events playlist
                                    (add-break-events (list (m-e :note)
                                                            (m-e :break :pattern 0 :line 5 :value 4 :instrumentnum -1)
                                                            (m-e :note  :pattern 1 :line 3)
                                                            (m-e :note  :pattern 1 :line 6)
                                                            )
                                                      64
                                                      playlist))))
  ;;(c-display (car hepp))
  ;;(print-events (cadr hepp))
  
  (***assert*** (car hepp) '(0 3 2))
  (***assert*** (cadr hepp)
                (list (m-e :note  :pattern 0 :line 0)
                      (m-e :break :pattern 0 :line 5  :value 4 :instrumentnum -1)
                      (m-e :break :pattern 0 :line 64 :instrumentnum -1)

                      (m-e :note  :pattern 1 :line 3)
                      (m-e :note  :pattern 1 :line 6)
                      (m-e :break :pattern 1 :line 64 :instrumentnum -1)

                      (m-e :break :pattern 2 :line 64 :instrumentnum -1)

                      (m-e :note  :pattern 3 :line 2)
                      (m-e :break :pattern 3 :line 60 :instrumentnum -1))))



(define (legalize-pattern-lengths-0 playlist playlistpos events)
  (if (>= playlistpos (1- (length playlist))) ;; We stop if it's the last played pattern
      (list playlist events)
      (let* ((patternnum1 (list-ref playlist playlistpos))
             (first-break-in-pattern1 (find-first-break-in-pattern events patternnum1)) ;; actually, there should be only one break now
             (patternlength1 (first-break-in-pattern1 :linenum))
             (patternnum2 (list-ref playlist (1+ playlistpos)))
             (first-break-in-pattern2 (find-first-break-in-pattern events patternnum2))
             (patternlength2 (first-break-in-pattern2 :linenum)))
        (if (or (= 1 patternlength1)
                (= 1 patternlength2))
            (let* ((new-playlist-and-events (add-new-merged-pattern playlist events patternnum1 patternnum2))
                   (new-playlist (car new-playlist-and-events))
                   (new-events (cadr new-playlist-and-events)))
              ;;(print-events new-events)
              (list new-playlist new-events)
              (legalize-pattern-lengths-0 new-playlist playlistpos new-events))
            (legalize-pattern-lengths-0 playlist (1+ playlistpos) events)))))


(define (find-one-lined-patterns events)
  (if (null? events)
      '()
      (let ((event (car events)))
        (if (and (eq? (event :type) :break)
                 (= (event :linenum) 1))
            (cons (event :patternnum)
                  (find-one-lined-patterns (cdr events)))
            (find-one-lined-patterns (cdr events))))))

(define (erase-patterns events patterns)
  (if (or (null? events)
          (null? patterns))
      events
      (let ((event (car events))
            (patternnum (car patterns)))
        (cond ((< (event :patternnum) patternnum)
               (cons event
                     (erase-patterns (cdr events) patterns)))
              ((> (event :patternnum) patternnum)
               (erase-patterns events (cdr patterns)))
              ((eq? (event :type) :break)
               (cons (copy-event event :linenum 64)
                     (erase-patterns (cdr events) patterns)))
              (else
               (erase-patterns (cdr events) patterns))))))
              
(define (erase-one-lined-patterns events)
  (erase-patterns events
                  (find-one-lined-patterns events)))
      
;; Radium blocks must have at least two lines. Ensure that.
;; Only makes sense to call this function after calling remove-events-after-breaks.
(define (legalize-pattern-lengths playlist events)
  (let* ((new-playlist-and-events (legalize-pattern-lengths-0 playlist 0 events))
         (new-playlist (car new-playlist-and-events))
         (new-events (cadr new-playlist-and-events)))
    (list new-playlist
          (erase-one-lined-patterns new-events))))



(let* ((playlist '(0 1 2))
       (hepp (legalize-pattern-lengths playlist
                                       (list (m-e :note  :pattern 0 :line 0 :value 10)
                                             (m-e :break :pattern 0 :line 1)
                                             (m-e :note  :pattern 1 :line 0 :value 11)
                                             (m-e :break :pattern 1 :line 1)
                                             (m-e :note  :pattern 2 :line 0 :value 12)
                                             (m-e :break :pattern 2 :line 2)))))

  ;;(c-display (car hepp))
  ;;(print-events (cadr hepp))

  (***assert*** (car hepp) '(3 2))
  (***assert*** (cadr hepp)
                (list (m-e :break :pattern 0 :line 64)
                      (m-e :break :pattern 1 :line 64)
                      (m-e :note  :pattern 2 :line 0 :value 12)
                      (m-e :break :pattern 2 :line 2)
                      (m-e :note  :pattern 3 :line 0 :value 10)
                      (m-e :note  :pattern 3 :line 1 :value 11)
                      (m-e :break :pattern 3 :line 2)))
  )




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; pattern delay effect (EEx effect)    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (apply-pattern-delay pattern-events pattern-delay-event)
  (if (null? pattern-events)
      '()
      (let ((event (car pattern-events))
            (linenum (pattern-delay-event :linenum)))
        (cond ((structs-equal? event pattern-delay-event)
               (apply-pattern-delay (cdr pattern-events) pattern-delay-event))  ;; remove the pattern-delay-event event itself from pattern-events
              
              ((<= (event :linenum) linenum)
               (cons event
                     (apply-pattern-delay (cdr pattern-events) pattern-delay-event)))
              
              (else
               (cons (copy-event event :linenum (+ (pattern-delay-event :value)
                                                   (event :linenum)))
                     (apply-pattern-delay (cdr pattern-events) pattern-delay-event)))))))

;; TODO: Make process events instead of pattern.
(define (remove-pattern-delay-effects pattern-events)
  (let ((pattern-delay-event (find-first pattern-events (lambda (event)
                                                   (eq? (event :type) :pattern-delay)))))
    (if (not pattern-delay-event)
        pattern-events
        (remove-pattern-delay-effects (apply-pattern-delay pattern-events
                                                           pattern-delay-event)))))



(***assert*** (remove-pattern-delay-effects (list (m-e :note          :line 3 :value 1)
                                                  (m-e :pattern-delay :line 3 :value 0)
                                                  (m-e :note          :line 3 :value 2)
                                                  (m-e :note          :line 4 :value 4)))
              (list (m-e :note          :line 3 :value 1)
                    (m-e :note          :line 3 :value 2)
                    (m-e :note          :line 4 :value 4)))

(let ((hepp (remove-pattern-delay-effects (list (m-e :note          :line 3 :value 1)                                                
                                                (m-e :pattern-delay :line 3 :value 3)
                                                (m-e :note          :line 3 :value 2)
                                                
                                                (m-e :pattern-delay :line 4 :value 1)
                                                (m-e :note          :line 4 :value 4)
                                                
                                                (m-e :note          :line 5 :value 5)))))
  (print-events hepp)
  (***assert*** hepp
                (list (m-e :note          :line 3 :value 1)
                      (m-e :note          :line 3 :value 2)
                      (m-e :note          :line (+ 4 3) :value 4)
                      (m-e :note          :line (+ 5 3 1) :value 5))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; tpd registry                         ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (create-tpds-0 pattern-events last-line last-tpd)
  ;;(c-display "pat:" (length pattern))
  (let ((event (car pattern-events)))
    ;;(c-display "event" event);;(event-to-string event))
    (cond

     ((> (event :linenum) last-line)
      (cons last-tpd
            (create-tpds-0 pattern-events
                           (1+ last-line)
                           last-tpd)))
     
     ((eq? (event :type) :break)
      (list last-tpd)) ;; Needed for the :break events
     
     ((eq? (event :type) :tpd)
      (create-tpds-0 (cdr pattern-events)
                     last-line
                     (event :value)))
     
     (else
      (create-tpds-0 (cdr pattern-events)
                     last-line
                     last-tpd)))))

;; simplify-break-events must be called on the pattern before calling
(define (create-tpds pattern-events)
  (list->vector (create-tpds-0 pattern-events 0 *default-tpd*)))

(let ((hepp (create-tpds (list (m-e :tpd :line 1 :value 2)
                               (m-e :tpd :line 1 :value 3)
                               (m-e :tpd :line 1 :value 4)
                               (m-e :note :line 2)
                               (m-e :tpd :line 3 :value 8)
                               (m-e :tpd :line 3 :value 9)
                               (m-e :break :line 5)))))
  ;;(c-display "hepp: " hepp)
  ;;(c-display "aslist: " (vector->list hepp))
  (***assert*** hepp
                (vector *default-tpd* ; line 0
                        4             ; line 1
                        4             ; line 2
                        9             ; line 3
                        9             ; line 4
                        9)))           ; line 5

(define (get-tpd tpds linenum)
  (vector-ref tpds linenum))


(define (get-num-lines-from-tpds tpds)
  (1- (vector-length tpds)))

(***assert*** (get-num-lines-from-tpds (create-tpds (list (m-e :tpd :line 1 :value 2)
                                                          (m-e :tpd :line 1 :value 3)
                                                          (m-e :tpd :line 1 :value 4)
                                                          (m-e :note :line 2)
                                                          (m-e :tpd :line 3 :value 9)                               
                                                          (m-e :break :line 5))))
              5)
                             

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; note retrigger effect (E9x) effect  ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#||
  tpd = 6
  retrigger = 1
  -> 0/6 1/6 2/6 3/6 4/6 5/6

  tpd = 3
  retrigger = 1
  -> 0/3 1/3 2/3

  tpd = 6
  retrigger = 2
  -> 0/6 2/6 4/6
||#

;; TODO: What happens if we retrigger after volume or pitch has changed?
(define (get-retrigger-notes note retrigger-event tpds)
  (define interval (retrigger-event :value))

  (if (= interval 0)
      '()
      (begin
        
        (define linenum (retrigger-event :linenum))
  
        (define tpd (get-tpd tpds linenum))

        (c-display "note: " note ", linenum: " linenum)
        (define firsttick (if (= (note :linenum)
                                 linenum)
                              interval ;; don't retrigger at tick 0 if the note started playing on the same line
                              0))
        
        (let loop ((tick firsttick))
          (if (>= tick tpd)
              '()
              (cons (copy-event note
                                :linenum linenum
                                :tick tick)                    
                    (loop (+ tick interval))))))))
               

(define (remove-note-retrigger-effects-0 channel tpds curr-note)
  (if (null? channel)
      '()
      (let ((event (car channel)))
        (cond ((eq? (event :type) :retrigger-note)
               (if curr-note
                   (append (get-retrigger-notes curr-note
                                                event
                                                tpds)
                           (remove-note-retrigger-effects-0 (cdr channel)
                                                            tpds
                                                            curr-note))
                   (remove-note-retrigger-effects-0 (cdr channel)
                                                    tpds
                                                    curr-note)))
              ((eq? (event :type) :stop)
               (cons event 
                     (remove-note-retrigger-effects-0 (cdr channel)
                                                      tpds
                                                      #f)))
              ((eq? (event :type) :note)
               (cons event
                     (remove-note-retrigger-effects-0 (cdr channel)
                                                      tpds
                                                      event)))
              (else
               (cons event
                     (remove-note-retrigger-effects-0 (cdr channel)
                                                      tpds
                                                      curr-note)))))))
        
(define (remove-note-retrigger-effects channel tpds)
  (remove-note-retrigger-effects-0 channel tpds #f))

(let ((hepp (remove-note-retrigger-effects (list (m-e :note :line 3)
                                                 (m-e :retrigger-note :line 4 :value 2)
                                                 (m-e :note :line 5)
                                                 (m-e :retrigger-note :line 5 :value 2)
                                                 (m-e :stop :line 6)
                                                 (m-e :retrigger-note :line 6 :value 2))
                                           (create-tpds (list (m-e :tpd :line 4 :value 4)
                                                              (m-e :break :line 10))))))
  (print-events hepp)
  
  (***assert*** hepp
                (list (m-e :note :line 3)
                      (m-e :note :line 4)
                      (m-e :note :line 4 :tick 2)
                      (m-e :note :line 5)
                      (m-e :note :line 5 :tick 2)
                      (m-e :stop :line 6)))
  )
                


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; note delay effect (EDx) effect      ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (remove-note-delay-effects events)
  (if (null? events)
      '()
      (let ((event1 (car events)))
        (cond ((eq? (event1 :type) :delay-note)
               (remove-note-delay-effects (cdr events))) ;; remove stray delay-note events
              ((not (eq? (event1 :type) :note))
               (cons event1
                     (remove-note-delay-effects (cdr events))))
              ((null? (cdr events))
               (list event1))
              (else
               (let ((event2 (cadr events)))              
                 (if (and (eq? (event2 :type) :delay-note)
                          (= (event1 :channel) (event2 :channel))
                          (= (event1 :linenum) (event2 :linenum))
                          (= (event1 :patternnum) (event2 :patternnum)))
                     (cons (copy-event event1 :tick (event2 :value))
                           (remove-note-delay-effects (cddr events)))
                     (cons event1
                           (remove-note-delay-effects (cdr events))))))))))

(let ((hepp (remove-note-delay-effects (list (m-e :note :line 2)
                                             (m-e :delay-note :line 2 :value 5)
                                             (m-e :delay-note :line 3 :value 6)))))
  (print-events hepp)
  (***assert*** hepp (list (m-e :note :line 2 :tick 5))))






;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Clone instruments                                                      ;;;
;;;;  Necessary if tremolo, vibrato, panning or sample offset is changed simultaneously on the same instrument  ;;;
;;        actually, don't know if panning follows the channel. Probably not, but should check out.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define-struct cloned-instrument
  :old-instrumentnum
  :new-instrumentnum
  )

(define (cloned-instrument-to-string event)
  (<-> "[old-instrument: " (event :old-instrumentnum)
       ", new-instrument: " (event :new-instrumentnum)
       "]"))

(define *clashing-effect-types* (list :vibrato   ;; vibrato-with-volume-slide effects have been converted to two separate events earlier
                                      :tremolo   ;; tremolo-with-volume-slide effects have been converted to two separate events earlier
                                      :sample-offset
                                      :finetune))

(define (is-mayclashing-effect? event)
  (memq (event :type) *clashing-effect-types*))
;  (let ((type (event :type)))
;    (or (eq? type :vibrato)
;        (eq? type :tremolo)
;        (eq? type :sample-offset)))


(define (is-mayclashing-effect-clashing? event playing-mayclashing-effects)
  (memq (event :type) (map (lambda (effect)
                             (event :type))
                           playing-mayclashing-effects)))

(define (is-effect-clashing? playing-mayclashing-effects event) ;; note that 'event' must be a mayclashing effect event
  (let ((instrumentnum (event :instrumentnum))
        (type          (event :type)))
    (find-first playing-mayclashing-effects
                (lambda (playing-mayclashing-effect)
                  (and (= (playing-mayclashing-effect :instrumentnum) instrumentnum)
                       (eq? (playing-mayclashing-effect :type) type))))))

(define (instrument-used-in-pattern? events instrumentnum patternnum)
  (if (null? events)
      #f
      (let ((event (car events)))
        (cond ((not (= patternnum (event :patternnum)))
               #f)
              ((= instrumentnum (event :instrumentnum))
               #t)
              (else
               (instrument-used-in-pattern? (cdr events) instrumentnum patternnum))))))

(define (find-already-cloned-instrument cloned-instruments instrumentnum patternnum result)
  (find-first cloned-instruments
              (lambda (cloned-instrument)
                (and (= instrumentnum (cloned-instrument :old-instrumentnum))
                     (not (instrument-used-in-pattern? result
                                                       (cloned-instrument :new-instrumentnum)
                                                       patternnum))))))

(define (find-new-instrumentnum cloned-instruments)
  (if (null? cloned-instruments)
      (length *instrumentlist*) ;;; This is clearly a hack. Could just send a "num-instruments" variable around, but this is probably managable.
      (let ((cloned-instrument (car cloned-instruments))) ;; the first cloned instrument is also the one with the highest instrument number
        (1+ (cloned-instrument :new-instrumentnum)))))

(define (clone-instrument-if-necessary cloned-instruments event result)
  (let ((already-cloned-instrument (find-already-cloned-instrument cloned-instruments (event :instrumentnum) (event :patternnum) result)))
    (if already-cloned-instrument
        (list (already-cloned-instrument :new-instrumentnum)
              cloned-instruments)
        (let ((new-instrumentnum (find-new-instrumentnum cloned-instruments)))
          (list new-instrumentnum
                (cons (make-cloned-instrument (event :instrumentnum)
                                              new-instrumentnum)
                      cloned-instruments))))))

(define (replace-clashed-events events patternnum channel old-instrumentnum new-instrumentnum)
  (if (null? events)
      '()
      (let ((event (car events)))
        (cond ((not (= (event :patternnum) patternnum))
               events)
              ((and (= (event :channel) channel)
                    (= (event :instrumentnum) old-instrumentnum))
               (cons (copy-event event :instrumentnum new-instrumentnum)
                     (replace-clashed-events (cdr events)
                                             patternnum
                                             channel
                                             old-instrumentnum
                                             new-instrumentnum)))
              (else
               (cons event
                     (replace-clashed-events (cdr events)
                                             patternnum
                                             channel
                                             old-instrumentnum
                                             new-instrumentnum)))))))

;; both 'events' and 'result' are list of events. 'events' is forward in time, 'result' is backwards in time.
(define (replace-instrument-numbers-for-clashing-effect cloned-instruments event events result)
  (let ((old-instrumentnum (event :instrumentnum))
        (channel (event :channel))
        (patternnum (event :patternnum)))
    (let* ((stuff (clone-instrument-if-necessary cloned-instruments event result))
           (new-instrumentnum (car stuff))
           (new-cloned-instruments (cadr stuff)))
      (list new-cloned-instruments
            (replace-clashed-events events patternnum channel old-instrumentnum new-instrumentnum)
            (replace-clashed-events result patternnum channel old-instrumentnum new-instrumentnum)))))


;; Must remove unaffiliated effect events before calling this function, plus add instrument number to all effect events.
;;
(define (get-cloned-instruments-0 events
                                  result
                                  cloned-instruments
                                  playing-mayclashing-effects
                                  last-linenum
                                  last-patternnum)
  (if (null? events)
      (list cloned-instruments (reverse result))
      (let* ((event (car events))
             (linenum (event :linenum))
             (patternnum (event :patternnum)))
        ;;(c-display "_event: " (event-to-string event) ", last/now: " last-linenum (event :linenum))
        (if (and (not (null? playing-mayclashing-effects)) ;; the 'not null' test on this line is just a small optimization. The test can be removed.
                 (or (not (= linenum last-linenum))
                     (not (= patternnum last-patternnum))))
            (get-cloned-instruments-0 events
                                      result
                                      cloned-instruments
                                      '()
                                      linenum
                                      patternnum)
            (let ((is-mayclashing-effect (is-mayclashing-effect? event)))
              (if (and is-mayclashing-effect
                       (is-effect-clashing? playing-mayclashing-effects event))
                  (let* ((stuff (replace-instrument-numbers-for-clashing-effect cloned-instruments
                                                                                event
                                                                                events
                                                                                result))
                         (new-cloned-instruments (car stuff))
                         (new-events (cadr stuff))
                         (new-result (caddr stuff)))
                    (get-cloned-instruments-0 new-events
                                              new-result
                                              new-cloned-instruments
                                              playing-mayclashing-effects
                                              linenum
                                              patternnum))
                  (get-cloned-instruments-0 (cdr events)
                                            (cons event result)
                                            cloned-instruments
                                            (if is-mayclashing-effect
                                                (cons event playing-mayclashing-effects)
                                                playing-mayclashing-effects)
                                            linenum
                                            patternnum)))))))
  

;; Returns (list a b) where a = list of 'new-instrument' structs, b = transformed events
;; (Note that the instruments are not created here. The function only returns a list of 'cloned-instrument' structs.)
;;
(define (get-cloned-instruments events)
  (get-cloned-instruments-0 events '() '() '() -1 -1))


;; 1. Tests to make sure instruments are not cloned unless needed.
;;
;;
(let ((hepp (get-cloned-instruments (list))))
  (***assert*** hepp '(() 
                       ())))

(let* ((events (list (m-e :note :line 5 :instrumentnum 9)))
       (hepp (get-cloned-instruments events)))
  ;;(c-display "hepp: " hepp)
  (***assert*** hepp (list '()
                           events)))


(let* ((events (list (m-e :note :line 5)))
       (hepp (get-cloned-instruments events)))
  ;;(c-display "hepp: " hepp)
  (***assert*** hepp (list '()
                           events)))

(let* ((events (list (m-e :note :line 5)
                     (m-e :vibrato :line 9)))
       (hepp (get-cloned-instruments events)))
  ;;(c-display "hepp: " hepp)
  (***assert*** hepp (list '()
                           events)))

;; different instrument number
(let* ((events (list (m-e :note :line 5)
                     (m-e :vibrato :line 9 :instrumentnum 0)
                     (m-e :vibrato :line 9 :instrumentnum 1)))
       (hepp (get-cloned-instruments events)))
  (***assert*** hepp (list '()
                           events)))

;; different line numbers
(let* ((events (list (m-e :note :line 5)
                     (m-e :vibrato :line 9)
                     (m-e :vibrato :line 10)))
       (hepp (get-cloned-instruments events)))
  (***assert*** hepp (list '()
                           events)))

;; different patterns
(let* ((events (list (m-e :vibrato :channel 0 :line 9 :pattern 1)
                     (m-e :vibrato :channel 1 :line 9 :pattern 2)))
       (hepp (get-cloned-instruments events)))
  (***assert*** hepp (list '()
                           events)))


;; different effect types
(let* ((events (list (m-e :vibrato :channel 0 :line 9 :pattern 1)
                     (m-e :sample-offset :channel 1 :line 9 :pattern 2)))
       (hepp (get-cloned-instruments events)))
  ;;(print-events events)
  ;;(print-events (cadr hepp))
  (***assert*** hepp (list '()
                           events)))


;; 2. Other tests
;;
;;

;; For testing only. The real *instrumentlist* variable is define further down in this file.
(define *instrumentlist* (make-vector 100 #f))

;; 2.1 basic tests for vibrato, tremolo and sample-offset
(let* ((events (list (m-e :vibrato :channel 0 :line 9 :pattern 1 :value2 1)
                     (m-e :vibrato :channel 1 :line 9 :pattern 1 :value2 2)))
       (hepp (get-cloned-instruments events)))
  (***assert*** (cadr hepp)
                (list (car events)
                      (copy-event (cadr events) :instrumentnum 100)))

  (***assert*** (car hepp)
                (list (make-cloned-instrument :old-instrumentnum 0
                                              :new-instrumentnum 100)))
  )

(let* ((events (list (m-e :tremolo :channel 0 :line 9 :pattern 1 :value2 1)
                     (m-e :tremolo :channel 1 :line 9 :pattern 1 :value2 2)))
       (hepp (get-cloned-instruments events)))
  (***assert*** (cadr hepp)
                (list (car events)
                      (copy-event (cadr events) :instrumentnum 100)))

  (***assert*** (car hepp)
                (list (make-cloned-instrument :old-instrumentnum 0
                                              :new-instrumentnum 100)))
  )

(let* ((events (list (m-e :sample-offset :channel 0 :line 9 :pattern 1 :value2 1)
                     (m-e :sample-offset :channel 1 :line 9 :pattern 1 :value2 2)))
       (hepp (get-cloned-instruments events)))
  (***assert*** (cadr hepp)
                (list (car events)
                      (copy-event (cadr events) :instrumentnum 100)))

  (***assert*** (car hepp)
                (list (make-cloned-instrument :old-instrumentnum 0
                                              :new-instrumentnum 100)))
  )

;; 2.2 Check that other events in the pattern change instrument number too, not the just the clashing effects
(let* ((events (list (m-e :note    :channel 1 :line 3  :pattern 1 :value2 1)
                     (m-e :note    :channel 2 :line 4  :pattern 1 :value2 1)
                     (m-e :note    :channel 2 :line 5  :pattern 1 :value2 1 :instrumentnum 5) ;;check that unrelated instrument numbers are not changed
                     
                     (m-e :vibrato :channel 1 :line 9  :pattern 1 :value2 2)                     
                     (m-e :vibrato :channel 2 :line 9  :pattern 1 :value2 2)

                     (m-e :note    :channel 1 :line 12 :pattern 1 :value2 1)
                     (m-e :note    :channel 2 :line 16 :pattern 1 :value2 1)
                     (m-e :note    :channel 2 :line 17 :pattern 1 :value2 1 :instrumentnum 5) ;;check that unrelated instrument numbers are not changed
                     ))
       (hepp (get-cloned-instruments events)))
  ;;(print-events (cadr hepp))
  ;;(c-display (car hepp))
  (***assert*** (cadr hepp)
                 (map (lambda (event)
                        (if (and (= 2 (event :channel))
                                 (= 0 (event :instrumentnum)))
                            (copy-event event :instrumentnum 100)
                            event))
                      (cadr hepp)))

  (***assert*** (car hepp)
                (list (make-cloned-instrument :old-instrumentnum 0
                                              :new-instrumentnum 100)))
  )

;; 2.3 test three simultaneously channels
(let* ((events (list (m-e :vibrato :channel 0 :line 9 :pattern 1 :value2 1)
                     (m-e :vibrato :channel 1 :line 9 :pattern 1 :value2 2)
                     (m-e :vibrato :channel 2 :line 9 :pattern 1 :value2 2)))
       (hepp (get-cloned-instruments events)))
  (print-events (cadr hepp))
  (c-display (car hepp))
  (***assert*** (cadr hepp)
                (list (car events)
                      (copy-event (cadr events)  :instrumentnum 100)
                      (copy-event (caddr events) :instrumentnum 101)))

  (***assert*** (car hepp)
                 (list (make-cloned-instrument :old-instrumentnum 0
                                               :new-instrumentnum 101)
                       (make-cloned-instrument :old-instrumentnum 0
                                               :new-instrumentnum 100)))
  
  )

;; 2.4 reuse cloned instrument in other patterns
(let* ((events (list (m-e :vibrato :channel 0 :line 9 :pattern 1 :value2 1)
                     (m-e :vibrato :channel 1 :line 9 :pattern 1 :value2 2)
                     (m-e :vibrato :channel 0 :line 10 :pattern 2 :value2 3)
                     (m-e :vibrato :channel 1 :line 10 :pattern 2 :value2 4)
                     ))
       (hepp (get-cloned-instruments events)))
  (***assert*** (cadr hepp)
                 (map (lambda (event)
                        (if (= (event :channel) 1)
                            (copy-event event :instrumentnum 100)
                            event))
                      (cadr hepp)))

  (***assert*** (car hepp)
                (list  (make-cloned-instrument :old-instrumentnum 0
                                               :new-instrumentnum 100)))
  
  )




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  assign instrument number to events ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (assign-instrument-numbers-0 events instrument-numbers last-patternnum) ;; Careful! 'instrument-numbers' is mutable.
  (define (next)
    (assign-instrument-numbers-0 (cdr events)
                                 instrument-numbers
                                 last-patternnum))
  (if (null? events)
      '()
      (let ((event (car events)))
        (if (not (= (event :patternnum) last-patternnum))
            (assign-instrument-numbers-0 events
                                         (make-hash-table 39 =)
                                         (event :patternnum))
            (let ((channel (event :channel))
                  (instrumentnum (event :instrumentnum)))
              (assert (>= instrumentnum -1))
              (cond ((= instrumentnum -1) ;; tempos and such
                     (cons event (next)))
                    ((= instrumentnum 0)                           
                     (let ((stored-instrumentnum (instrument-numbers channel)))
                       (if stored-instrumentnum
                           (cons (copy-event event :instrumentnum stored-instrumentnum)
                                 (next))
                           (next)))) ;; throw away events without instrument number assigned (what are we supposed to do with them?)
                    (else
                     (hash-table-set! instrument-numbers channel instrumentnum)
                     (cons event
                           (next)))))))))
               
;; Beware that all control events must have instrumentnum = -1 here. If not, they will be removed.
(define (assign-instrument-numbers events)
  (assign-instrument-numbers-0 events (make-hash-table 39 =) -1))


(let ((events (list (m-e :vibrato :channel 0 :line 9 :pattern 1))))
  (***assert*** (assign-instrument-numbers events)
                '()))
  
(let ((events (list (m-e :note :channel 0 :line 9 :pattern 1 :instrumentnum 1))))
  (***assert*** (assign-instrument-numbers events)
                events))
  
(let ((events (list (m-e :note :channel 0 :line 9 :pattern 1 :instrumentnum 1)
                    (m-e :vibrato :channel 0 :line 9 :pattern 1 :instrumentnum 0))))
  (***assert*** (assign-instrument-numbers events)
                (list (car events)
                      (copy-event (cadr events) :instrumentnum 1))))
  
 
(let ((events (list (m-e :note    :channel 0 :line 9 :pattern 1 :instrumentnum 1)
                    (m-e :vibrato :channel 1 :line 9 :pattern 1 :instrumentnum 0))))
  (***assert*** (assign-instrument-numbers events)
                (list (car events))))
 
(let ((events (list (m-e :note    :channel 0 :line 9 :pattern 1 :instrumentnum 1)
                    (m-e :vibrato :channel 0 :line 9 :pattern 2 :instrumentnum 0))))
  (***assert*** (assign-instrument-numbers events)
                (list (car events))))
  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;    Add :stop events to all notes    ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; We don't add :stop events for notes that stops at :break though.
;; We only add :stop events for notes that are stopped because of a subsequent note on the same channel.

(define (add-stop-events-0 channel last-note)
  (if (null? channel)
      '()
      (let* ((event (car channel))
             (type (event :type)))
        (cond ((or (eq? type :note))
               ;;(eq? type :break)) ;; Note that we put the :stop event at "line 64" here. That is not legal in Radium, so we need to handle this situation specifically when sending notes over. (no, simpler to interpret :break events as stops instead of checking if the :stop event is placed on the same line as the :break event.)
               (if last-note
                   (append (list (copy-event last-note
                                             :linenum (event :linenum)
                                             :tick (event :tick)
                                             :type :stop)
                                 event)
                           (add-stop-events-0 (cdr channel)
                                              event))
                                              ;;;(and (eq? type :note) event)))
                   (cons event
                         (add-stop-events-0 (cdr channel)
                                            event))))
                                            ;;;(and (eq? type :note) event)))))
              ((eq? type :stop)
               (cons event
                     (add-stop-events-0 (cdr channel) #f)))
              (else
               (cons event
                     (add-stop-events-0 (cdr channel) last-note)))))))
             
      
(define (add-stop-events channel)
  (add-stop-events-0 channel #f))


(***assert*** (add-stop-events (list (m-e :note :line 4 :instrumentnum 4)
                                     (m-e :note :line 6 :tick 3 :instrumentnum 5)
                                     (m-e :break :line 8)))
              (list (m-e :note :line 4 :instrumentnum 4)
                    (m-e :stop :line 6 :tick 3 :instrumentnum 4)
                    (m-e :note :line 6 :tick 3 :instrumentnum 5)
                    (m-e :break :line 8)))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;       remove effect memory          ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; For these three lines:
;; 452
;; 787
;; 400 <- what happens here? Is it actually 452, 787, or nothing? Reading the soundtracker source, it looks like 452 is the correct one.

(define (remove-effect-memory-0 channel memory)
  (define (next)
    (remove-effect-memory-0 (cdr channel) memory))
  (if (null? channel)
      '()
      (let* ((event (car channel))
             (type (event :type)))
        (cond ((memq type '(:pitch-slide :velocity-slide :fine-pitch-slide :fine-velocity-slide))
               (if (= (event :value) 0)
                   (let ((stored-value (memory type)))
                     (if stored-value
                         (cons (copy-event event :value stored-value)
                               (next))
                         (next))) ;; throw it away
                   (begin
                     (hash-table-set! memory type (event :value))
                     (cons event
                           (next)))))
              ((memq type '(:vibrato :tremolo))
               (define value1 (event :value))
               (define value2 (event :value2))
               (if (or (= value1 0)
                       (= value2 0))
                   (let ((stored-value (memory type)))
                     (if stored-value
                         (begin
                           (if (= 0 value1)
                               (set! value1 (car stored-value)))
                           (if (= 0 value2)
                               (set! value2 (cadr stored-value)))))))
               (hash-table-set! memory type (list value1 value2))
               (cons (copy-event event
                                 :value value1
                                 :value2 value2)
                     (next)))
              (else
               (cons event
                     (next)))))))
                                   
 ;; No worry: 1xx shares effect memory with 2xx. (http://wiki.openmpt.org/Manual:_Effect_Reference#Effect_Column_2)
(define (remove-effect-memory channel)
  (remove-effect-memory-0 channel (make-hash-table 39 eq?)))

(let ((events (list (m-e :pitch-slide :value -5))))
  (***assert*** (remove-effect-memory events)
                events))

(let ((events (list (m-e :pitch-slide :value 0))))
  (***assert*** (remove-effect-memory events)
                '()))

(let ((events (list (m-e :pitch-slide :value -5 :line 0)
                    (m-e :pitch-slide :value 0 :line 1))))
  (***assert*** (remove-effect-memory events)
                (list (car events)
                      (copy-event (cadr events) :value -5))))

(let ((events (list (m-e :vibrato  :value 0 :value2 0 :line 0)
                    (m-e :vibrato  :value 0 :value2 0 :line 1))))
  (***assert*** (remove-effect-memory events)
                events))

(let ((events (list (m-e :vibrato  :value 0 :value2 2 :line 0)
                    (m-e :vibrato  :value 0 :value2 0 :line 1))))
  (***assert*** (remove-effect-memory events)
                (list (car events)
                      (copy-event (cadr events) :value2 2))))

(let ((events (list (m-e :vibrato  :value 2 :value2 0 :line 0)
                    (m-e :vibrato  :value 0 :value2 0 :line 1))))
  (***assert*** (remove-effect-memory events)
                (list (car events)
                      (copy-event (cadr events) :value 2))))

(let ((events (list (m-e :vibrato  :value 2 :value2 3 :line 0)
                    (m-e :vibrato  :value 0 :value2 0 :line 1)
                    (m-e :vibrato  :value 3 :value2 0 :line 2))))
  (***assert*** (remove-effect-memory events)
                (list (car events)
                      (copy-event (cadr events)
                                  :value 2
                                  :value2 3)
                      (copy-event (caddr events) :value2 3))))

(let ((events (list (m-e :tremolo  :value 2 :value2 3 :line 0)
                    (m-e :vibrato  :value 0 :value2 0 :line 1)
                    (m-e :tremolo  :value 3 :value2 0 :line 2))))
  (***assert*** (remove-effect-memory events)
                (list (car events)
                      (cadr events)
                      (copy-event (caddr events) :value2 3))))


#||
(define th (make-hash-table 39 eq?))
(th :asdf)
||#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;       remove slide-to-note          ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Replaces slide-to-note effects with slide.
;; Sets value2 of the effect to the destination note.
;; No. It can't be done. If there are regular slide-down or slide-up events inbetween, the direction can change.
;;
;;           current-note   current-result-note
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; c2 ---       c2                --
;; c3 310       c2                c3
;;    315       c2                c3
;; c4 300       c2                c4
;; c5 319       c2                c5
;;              c2                c5
;; stp          --                --
;;    320       --                --
#||
(define (remove-slide-to-note-0 channel result current-note current-result-note)
  (if (null? channel)
      (reverse result)
      (let ((event (car channel)))
        (cond ((and (eq? (event :type) :note)
                    (not (null? (cdr events)))
                    (eq? :slide-to-note ((cadr events) :type))) ;; and same line
               (remove-slide-to-note-0 (cdr channel) event))
              ((eq? :slide-to-note (event :type))
               (if current-result-note
                   
             
            (let ((
                   ...)))
            ))))))
||#



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  helper functions for velocity and pitch gliding 2. ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#||
(define (fix-gliding glidings)
  ...)

(fix-gliding '((0 1 1 5)               
               (5 1 6 8)))
-> '((0 1)
     (1 5)
     (,(-line 5) 5)
     (5 1)
     (6 8))

(fix-gliding '((0 1 1 1)
               (1 5 2 5)))
-> '((0 1)
     (,(-line 1) 1)
     (1 5)
     (2 5))
||#


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;  helper functions for velocity and pitch gliding ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;; the name "pitches" is used everywhere, but it doesn't have to be pitches.


(define (validate-glidings pitches)
  (define org-pitches pitches)
  (let loop ((pitches pitches))
    (when (not (null? (cdr pitches)))
          (let ((p1 (car pitches))
                (p2 (cadr pitches)))
            (when (< (car p2) (car p1))
                  (for-each c-display pitches)
                  (c-display "p1: " p1 (* 1.0 (car p1)) ", p2: " p2 (* 1.0 (car p2)))
                  (assert #f))
            (loop (cdr pitches))))))

;; Converts '(0 10 1 11) -> '((0 10) (1 11)), etc.
(define (fix-gliding-0 pitches is-first)
  (if (or (null? pitches)
          (null? (cdr pitches)))
      (begin
        (assert (or (null? pitches) (= (length (car pitches)) 2)))
        pitches)
      (let* ((pitch1 (car pitches))
             (pitch2 (cadr pitches))
             (line1 (car pitch1))
             (value1 (cadr pitch1))
             (is-gliding1 (> (length pitch1) 2))
             (is-gliding2 (> (length pitch2) 2))
             (glide-line  (and is-gliding1 (caddr pitch1)))
             (glide-value (and is-gliding1 (cadddr pitch1)))
             (line2 (car pitch2))
             (value2 (cadr pitch2)))
        (cond (is-gliding1
               (append (list (list line1 value1)
                             (list glide-line glide-value))
                       (fix-gliding-0 (cdr pitches) #f)))
              ((and is-first
                    (= line2 line1))
               (fix-gliding-0 (cdr pitches) #f))
              (else
               (append (list (list line1 value1)
                             (list (-line line2) value1))
                       (fix-gliding-0 (cdr pitches) #f)))))))

(define (trim-gliding pitches)
  (c-display "trim-gliding" pitches)
  ;;(validate-glidings pitches)
  (if (or (null? pitches)
          (null? (cdr pitches)))
      pitches
      (let* ((pitch1 (car pitches))
             (pitch2 (cadr pitches))
             (line1 (car pitch1))
             (value1 (cadr pitch1))
             (line2 (car pitch2))
             (value2 (cadr pitch2)))
        (cond ((and (= line1 line2)
                    (= value1 value2))
               (trim-gliding (cdr pitches)))

              ((= line1 line2)
               (trim-gliding (cons (list (-line line1) value1)
                                   (cdr pitches))))
              
              ((and (not (null? (cddr pitches))) ;; if three values in a row are equal, remove the middle element.
                    (let* ((pitch3 (caddr pitches))
                           (value3 (cadr pitch3)))
                      (= value1 value2 value3)))
               (trim-gliding (cons pitch1
                                   (cddr pitches))))
              
              (else
               (cons pitch1
                     (trim-gliding (cdr pitches))))))))

(define (trim-unneeded-equal-glidings pitches)
  (let ((all-equal (let loop ((pitches pitches)
                              (value (cadr (car pitches))))
                     (if (null? pitches)
                         #t
                         (let ((pitch (car pitches)))
                           (if (= (cadr pitch) value)
                               (loop (cdr pitches)
                                     value)
                               #f))))))
    (if all-equal
        (list (car pitches) (last pitches))
        pitches)))

;; Fixes that events can not be placed on the line after the last line.
(define (fix-gliding-after-break pitches num-lines)
  ;;(c-display "PITHCHES" pitches)
  (validate-glidings pitches)
  (if (or (null? pitches)
          (null? (cdr pitches)))
      (throw "glidings must always contain at least 2 elements (start and stop)")
      (let* ((reversed (reverse pitches))
             (last-pitch (car reversed))
             (last-line (car last-pitch))
             (last-value (cadr last-pitch)))
        (assert (not (> last-line num-lines)))
        (if (not (= last-line num-lines))
            pitches ;; all well
            (let* ((last2-pitch (cadr reversed))
                   (last2-line (car last2-pitch))
                   (last2-value (cadr last2-pitch)))
              (assert (> last-line last2-line))
              (let* ((new-last-line (-line last-line))
                     (new-last2-line (if (= new-last-line last2-line)
                                         (-line last2-line)
                                         last2-line)))
                (c-display new-last-line new-last2-line)
                (assert (> new-last-line new-last2-line))
                (reverse
                 (cons (list new-last-line last-value)
                       (cons (list new-last2-line last2-value)
                             (cddr reversed))))))))))
        

(***assert*** (fix-gliding-after-break `((0 10)
                                         (5 11))
                                       7)
              '((0 10)
                (5 11)))

(***assert*** (fix-gliding-after-break `((0 10)
                                         (7 11))
                                       7)
              `((0 10)
                (,(-line 7) 11)))

(***assert*** (fix-gliding-after-break (trim-gliding `((0 10)
                                                       (7 10)
                                                       (7 0)))
                                       7)
              `((0 10)
                (,(-line (-line 7)) 10)
                (,(-line 7) 0)))


;; input: The result from calling get-pitches, get-velocities, get-vibratos, etc.
;; output: A list format very similar to the one used in Radium (everyting glides in radium, so instead discontinous graphs are simulated by adding extremely short glides)
(define (fix-gliding pitches num-lines)
  (fix-gliding-after-break (trim-unneeded-equal-glidings
                            (trim-gliding
                             (fix-gliding-0 pitches #t)))
                           num-lines))
                           

(***assert*** (fix-gliding '((5 2)) 10)
              '((5 2)
                (5 2)))

(***assert*** (fix-gliding '((5 2)
                             (5 2))
                           10)
              '((5 2)
                (5 2)))

(***assert*** (fix-gliding '((5 2)
                             (6 2))
                           10)
              '((5 2)
                (6 2)))

(***assert*** (fix-gliding '((5 2)
                             (6 2)
                             (7 2))
                           10)
              '((5 2)
                (7 2)))

(***assert*** (fix-gliding '((5 2)
                             (5 3))
                           10)
              '((5 3)
                (5 3)))

(***assert*** (fix-gliding '((5 2)
                             (5 2 6 3)
                             (6 3))
                           10)
              '((5 2)
                (6 3)))

(***assert*** (fix-gliding '((5 2)
                             (6 3))
                           10)
              `((5 2)
                (,(-line 6) 2)
                (6 3)))

(***assert*** (fix-gliding '((5 2 6 3)
                             (6 3))
                           10)
              '((5 2)
                (6 3)))

(***assert*** (fix-gliding '((5 2 6 4)
                             (6 5))
                           10)
              `((5 2)
                (,(-line 6) 4)
                (6 5)))

(***assert*** (fix-gliding `((5 2 ,(+ 5 1/2) 4)
                             (,(+ 5 1/2) 4)
                             (6 4))
                           10)
              `((5 2)
                (,(+ 5 1/2) 4)
                (6 4)))

(***assert*** (fix-gliding `((5 2 ,(+ 5 1/2) 4)
                             (,(+ 5 1/2) 4)
                             (6 5))
                           10)
              `((5 2)
                (,(+ 5 1/2) 4)                
                (,(-line 6) 4)
                (6 5)))

(***assert*** (fix-gliding '((5 2)
                             (6 4)
                             (6 4)
                             (7 5)
                             (7 5)
                             (8 6))
                           10)
              `((5 2)
                (,(-line 6) 2)
                (6 4)
                (,(-line 7) 4)
                (7 5)
                (,(-line 8) 5)
                (8 6)))

;; arpeggio
(***assert*** (fix-gliding '((0/3 20)
                             (0/3 20)
                             (1/3 21)
                             (2/3 22)
                             (3/3 23))
                           10)
              `((0/3 20)
                (,(-line 1/3) 20)
                
                (1/3 21)
                (,(-line 2/3) 21)

                (2/3 22)
                (,(-line 3/3) 22)

                (3/3 23)))


(define (tickify y num-ticks-in-line)
  y) ;; nah, don't bother. 'y' is the correct value, the tickified value only exists in protracker.

;; Keep correct graph direction even if x2 goes outside legal value
(define (clamp-glide y1 x1
                     y2 x2
                     min-x2 max-x2
                     num-ticks-in-line)
  (c-display "clamp-glide" y1 x1 y2 x2 min-x2 max-x2 num-ticks-in-line)
  (cond ((= x1 x2)
         (list y1 x1 y2 x2))
        ((> x2 x1)
         (c-display "glide a" y1 x1 y2 x2 (<= x2 max-x2))
         (if (<= x2 max-x2)
             (list y1 x1 y2 x2)
             (let ((new-y2 (scale max-x2
                                  x1 x2
                                  y1 y2)))
               (list y1 x1
                     (tickify new-y2 num-ticks-in-line) max-x2))))
        (else
         (c-display "glide b" y1 x1 y2 x2)
         (if (>= x2 min-x2)
             (list y1 x1 y2 x2)
             (let ((new-y2 (scale min-x2
                                  x1 x2
                                  y1 y2)))
               (list y1 x1
                     (tickify new-y2 num-ticks-in-line) min-x2))))))
         
(clamp-glide 45 29
             45.16666666666666 28
             113 856
             6)

(***assert*** (clamp-glide 5 0
                           6 2
                           0 2
                           4)
              '(5 0 6 2))
                  
(***assert*** (clamp-glide 5 0
                           6 4
                           0 1
                           4)
              `(5 0 ,(+ 5 1/4) 1))
                  
(***assert*** (clamp-glide 5 4
                           6 0
                           1 4
                           4)
              `(5 4 ,(+ 5 3/4) 1))
                  


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;   create pitch changes for a note   ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define *note-to-period-table* (vector
  1712 1616 1524 1440 1356 1280 1208 1140 1076 1016  960  906  ;; c0 ->
  856  808  762  720  678  640  604  570  538  508  480  453   ;; c1 ->
  428  404  381  360  339  320  302  285  269  254  240  226   ;; c2 ->
  214  202  190  180  170  160  151  143  135  127  120  113   ;; c3 ->
  107  101   95   90   85   80   75   71   67   63   60   56   ;; c4 ->

  53  50  47  45  42  40  37  35  33  31  30  28               ;; c5 ->
  27  25  24  22  21  20  19  18  17  16  15  14               ;; c6 ->
  ))

(define *max-period* (*note-to-period-table* 0))

(define *max-slide-period* 856)
(define *min-slide-period* 113)

(define (get-period-to-note-table period period1 period2 note1)
  ;;(c-display period period1 period2 note1)
  (cond ((< period 0)
         '())
        ((< period period2)
         (get-period-to-note-table period
                                   period2
                                   (if (>= (+ 2 note1)
                                           (vector-length *note-to-period-table*))
                                       0
                                       (*note-to-period-table* (+ 2 note1)))
                                   (1+ note1)))
        (else
         (cons (scale period
                      period1 period2
                      note1 (1+ note1))
               (get-period-to-note-table (1- period)
                                         period1
                                         period2
                                         note1)))))

;; Note that period values between 14 and 0 are not correct (the values are scaled between 83 and 84 instead of 83 and +inf),
;; but it shouldn't matter since these periods are not allowed/used in modules.
(define *period-to-note-table* (list->vector
                                (reverse
                                 (get-period-to-note-table *max-period*
                                                           (*note-to-period-table* 0)
                                                           (*note-to-period-table* 1)
                                                           0))))


(define (note->period note)
  (*note-to-period-table* note))

(define (period->note period)
  (*period-to-note-table* (round period)))


(***assert*** (period->note 1712)
              0)
(***assert*** (period->note 1616)
              1)
(***assert*** (period->note (/ (+ 1712 1616) 2))
              1/2)
(***assert*** (period->note 14)
              83)
(***assert*** (period->note 0)
              84)
(***assert*** #t
              (apply and (map (lambda (note)
                                (= note
                                   (period->note (note->period note))))
                              (iota 84))))


(define *test-tpds* (list->vector (iota 64))) ;; contains (vector 0 1 2 3 ... 84)
                                  
(define (create-arpeggio-pitches linenum curr-period val1 val2 tpds)
  (let* ((note1 (period->note curr-period))
         (note2 (+ note1 val1))
         (note3 (+ note1 val2))
         (notes (vector note1 note2 note3))
         (num-ticks (get-tpd tpds linenum)))
    (let loop ((tick 0))
      (if (= tick num-ticks)
          (list (list (1+ linenum) note1 #f))
          (cons (list (+ linenum (/ tick num-ticks)) (notes (modulo tick 3)) #f)
                (loop (1+ tick)))))))

(***assert*** (create-arpeggio-pitches 1 20 4 8 (vector 5 6))
              (let* ((note1 (period->note 20))
                     (note2 (+ note1 4))
                     (note3 (+ note1 8)))
                (list (list (+ 1 0/6) note1 #f)
                      (list (+ 1 1/6) note2 #f)
                      (list (+ 1 2/6) note3 #f)
                      (list (+ 1 3/6) note1 #f)
                      (list (+ 1 4/6) note2 #f)
                      (list (+ 1 5/6) note3 #f)
                      (list (+ 1 6/6) note1 #f))))


(define (clamp-period period)
  (between *min-slide-period* period *max-slide-period*))

(define (period-glide-to-note-glide period-glide)
  ;;(c-display "period-glide: " period-glide)
  (list (list (car period-glide)
              (period->note (cadr period-glide))
              #t)
        (list (caddr period-glide)
              (period->note (cadddr period-glide))
              #f)))

(define (get-pitches-0 note curr-period events tpds)
  (let* ((event (car events))
         (linenum (event :linenum))
         (place (+ linenum (/ (event :tick) (tpds linenum))))
         (type (event :type)))
    (cond ((or (eq? type :stop)
               (eq? type :note))
           (list (list place
                       (period->note curr-period)
                       #f)))

          ((eq? type :break)
           (assert (= place linenum))
           (list (list place
                       (period->note curr-period)
                       #f)))

          ((eq? type :pitch-slide)
           ;; The mod v4. document clearly says that final period is period-value*(tpd-1), and not period-value*tpd.
           ;; The source of soundtracker and openMTP indicates that it might be correct too although it sounds like the sound might sound a bit strange sometimes.
           (let* ((num-ticks-in-line (get-tpd tpds linenum))
                  (new-period        (- curr-period (* (event :value) (1- num-ticks-in-line))))
                  (glide             (clamp-glide place       curr-period
                                                  (1+ linenum) new-period
                                                  *min-slide-period* *max-slide-period*
                                                  num-ticks-in-line)))
             (append (period-glide-to-note-glide glide)
                     (get-pitches-0 note (last glide) (cdr events) tpds))))
          
          ((eq? type :fine-pitch-slide)
           (let ((new-period (clamp-period (- curr-period (event :value)))))
             (cons  (list place
                          (period->note new-period)
                          #f)
                    (get-pitches-0 note new-period (cdr events) tpds))))
          
          ((eq? type :arpeggio)
           (assert (= place linenum))
           (append (create-arpeggio-pitches linenum
                                            curr-period
                                            (event :value)
                                            (event :value2)
                                            tpds)
                   (get-pitches-0 note curr-period (cdr events) tpds)))


          ((and (eq? type :slide-to-note)
                (not (= (event :value2)
                        curr-period)))
           (assert (= place linenum))
           (let* ((num-ticks-in-line (tpds linenum))
                  (value (event :value))
                  (goal-period (event :value2))
                  (up? (> goal-period curr-period))
                  (period-next-line (if up?
                                        (+ curr-period (* (1- num-ticks-in-line) value)) ;; think (1- num-ticks-in-line) is how protracker does it...
                                        (- curr-period (* (1- num-ticks-in-line) value)))) ;; think (1- num-ticks-in-line) is how protracker does it...
                  (span-whole-line (if up?
                                       (>= goal-period period-next-line)
                                       (<= goal-period period-next-line))))

             ;;(c-display "hepp" curr-period period-next-line goal-period num-ticks-in-line)
             ;;(c-display "span-whole: " span-whole-line)
             (if span-whole-line
                 (let ((glide (clamp-glide place         curr-period
                                           (1+ linenum) period-next-line
                                           *min-slide-period* *max-slide-period*
                                           num-ticks-in-line)))
                   (append (period-glide-to-note-glide glide)
                           (get-pitches-0 note
                                          (last glide)
                                          (cdr events)
                                          tpds)))
                 (let ((glide (clamp-glide linenum
                                           curr-period
                                           (+ linenum
                                              (/ (min num-ticks-in-line
                                                      (ceiling (abs (scale goal-period
                                                                           curr-period period-next-line ;; probably not entirely correct due to the num-ticks-in-line-1 weirdness.
                                                                           0 num-ticks-in-line))))
                                                 num-ticks-in-line))
                                           goal-period
                                           *min-slide-period* *max-slide-period*
                                           num-ticks-in-line)))
                   ;;(c-display "glide: " glide)
                   ;;(c-display "period-glide: " (period-glide-to-note-glide glide))
                   (append (period-glide-to-note-glide glide)
                           (get-pitches-0 note
                                          (last glide)
                                          (cdr events)
                                          tpds))))))
                  
          (else
           (get-pitches-0 note
                          curr-period
                          (cdr events)
                          tpds)))))

(define (validate-gliding2 glidings)
  (define org-glidings glidings)
  (let loop ((glidings glidings))
    (cond ((not (null? (cdr glidings)))
           (let ((p1 (car glidings))
                 (p2 (cadr glidings)))
             (if (not (> (car p2) (car p1)))
                 (begin
                   (for-each c-display org-glidings)
                   (c-display "p1: " p1 (* 1.0 (car p1)) ", p2: " p2 (* 1.0 (car p2)))
                   ;;(assert #f)
                   #f
                   )
                 (loop (cdr glidings)))))
          (else
           #t))))


(define (fix-gliding2 glidings)
  (let loop ((glidings glidings)
             (is-first #t))
    (if (or (null? glidings)
            (null? (cdr glidings)))
        glidings
        (let* ((a (car glidings))
               (b (cadr glidings))
               (time-a (car a))
               (time-b (car b)))
          (if (= time-a time-b)
              (let ((value-a (cadr a))
                    (value-b (cadr b)))
                (cond ((null? (cddr glidings))
                       (list a))
                      ((= value-a value-b)
                       (loop (cdr glidings) is-first))
                      (is-first
                       (loop (cdr glidings) is-first))
                      (else
                       (cons (list (-line time-a) value-a #f) ;; must include both glides
                             (loop (cdr glidings) #f)))))
              (cons a
                    (loop (cdr glidings) #f)))))))



;; Before calling:
;; * note-arguments for ':slide-to-note' must be moved into :value2.
;;
(define (get-pitches note channel-events tpds) ;; 'events' is here all the rest of the events in the channel right after the note.
  (let* ((linenum (note :linenum))
         (place1 (+ (note :linenum) (/ (note :tick) (tpds linenum))))
         (value1 (note :value)))
    (fix-gliding (cons (list place1 value1)
                       (get-pitches-0 note
                                      (note->period (note :value))
                                      channel-events
                                      tpds))
                 (get-num-lines-from-tpds tpds))))

(define (get-pitches note channel-events tpds) ;; 'events' is here all the rest of the events in the channel right after the note.
  (let* ((linenum (note :linenum))
         (place1 (+ (note :linenum) (/ (note :tick) (tpds linenum))))
         (value1 (note :value)))
    (cons (list place1 value1)
          (get-pitches-0 note
                         (note->period (note :value))
                         channel-events
                         tpds))))

(define (get-pitches note channel-events tpds)
  (let* ((linenum (note :linenum))
         (place1 (+ (note :linenum) (/ (note :tick) (tpds linenum))))
         (value1 (note :value)))
    (fix-gliding2
     (cons (list place1 value1 #f)
           (get-pitches-0 note
                          (note->period (note :value))
                          channel-events
                          tpds)))))

(***assert*** (get-pitches (m-e :note :line 44 :value 29)
                           (list
                            (m-e :slide-to-note :line 45 :value 48 :value2 339)
                            (m-e :break :line 64))
                           (make-vector 100 6))
              '((44 29 #f)
                (45 29 #t)
                (271/6 28 #f) ;; Note: Haven't calculated and checked manually that 271/6 is correct. Might be wrong.
                (64 28 #f)))



;; Testing 'slide'
;;
(***assert*** (get-pitches (m-e :note :line 5)
                           (list
                            (m-e :stop :line 9))
                           *test-tpds*)
              '((5 0 #f)
                (9 0 #f)))

(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :pitch-slide :line 5 :value 7)
                            (m-e :stop :line 6))
                           *test-tpds*)
              (let ((period1 (- (note->period 20)
                                (* 4 7))))
                `((5 20 #t)
                  (6 ,(period->note period1) #f))))

(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :pitch-slide :line 5 :value 7)
                            (m-e :stop :line 9))
                           *test-tpds*)
              (let ((period1 (- (note->period 20)
                                (* 4 7))))
                `((5 20 #t)
                  (6 ,(period->note period1) #f)
                  (9 ,(period->note period1) #f))))

(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :pitch-slide :line 6 :value 7)
                            (m-e :stop :line 9))
                           *test-tpds*)
              (let ((period1 (- (note->period 20)
                                (* 5 7))))
                `((5 20 #f)
                  (6 20 #t)
                  (7 ,(period->note period1) #f)
                  (9 ,(period->note period1) #f))))

(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :pitch-slide :line 6 :value 7)
                            (m-e :break :line 9))
                           *test-tpds*)
              (let ((period1 (- (note->period 20)
                                (* 5 7))))
              `((5 20 #f)
                (6 20 #t)
                (7 ,(period->note period1) #f)
                (9 ,(period->note period1) #f)))) ;; TODO: Fix outside-block line positions when sending over to radium instead.

(***assert*** (get-pitches (m-e :note :line 5 :value 20)
                           (list 
                            (m-e :pitch-slide :line 6 :value 7)
                            (m-e :pitch-slide :line 7 :value 8)
                            (m-e :stop :line 9))
                           *test-tpds*)
              (let* ((period7 (- (note->period 20)
                                 (* 5 7)))
                     (period8  (- period7
                                  (* 6 8))))
                `((5 20 #f)
                  (6 20 #t)
                  (7 ,(period->note period7) #t)
                  (8 ,(period->note period8) #f)
                  (9 ,(period->note period8) #f))))

#||
(get-pitches (m-e :note :line 5 :value 20)
             (list 
              (m-e :pitch-slide :line 6 :value 7)
              (m-e :pitch-slide :line 7 :value 8)
              (m-e :stop :line 9))
             *test-tpds*)
(* 1.0 593/28)
(* 1.0 619/27)
((5 20) (6 20 7 593/28) (7 593/28 8 619/27) (9 619/27))
||#


;; testing trying to slide outside min and max period
;;
;; min period
(let* ((note1 46)
       (period1 (note->period note1))
       (note2 (period->note *min-slide-period*)))
  (***assert*** (get-pitches (m-e :note :value note1 :line 0)
                             (list 
                              (m-e :pitch-slide :line 0 :value 7)
                              (m-e :stop :line 1))
                             (vector 4 4 4))
                `((0   ,note1 #t)
                  (1/3 ,note2 #f)
                  (1   ,note2 #f))))
;;
;; max period
(let* ((note1 13)
       (period1 (note->period note1))
       (note2 (period->note *max-slide-period*)))
  ;;(c-display "period1" period1)
  (***assert*** (get-pitches (m-e :note :value note1 :line 0)
                             (list 
                              (m-e :pitch-slide :line 0 :value -48)
                              (m-e :stop :line 1))
                             (vector 4 4 4))
                `((0   ,note1 #t)
                  (1/3 ,note2 #f)
                  (1   ,note2 #f))))


;; Testing 'fine-slide'
;;
(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :fine-pitch-slide :line 5 :value 7)
                            (m-e :stop :line 6))
                           *test-tpds*)
              (let ((period1 (- (note->period 20)
                                7)))
                `((5 ,(period->note period1) #f)
                  (6 ,(period->note period1) #f))))

(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :fine-pitch-slide :line 6 :value 7)
                            (m-e :stop :line 8))
                           *test-tpds*)
              (let ((period1 (- (note->period 20)
                                7)))
                `((5 20 #f)
                  (6 ,(period->note period1) #f)
                  (8 ,(period->note period1) #f))))

(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :fine-pitch-slide :line 5 :value 7)
                            (m-e :fine-pitch-slide :line 7 :value 8)
                            (m-e :stop :line 8))
                           *test-tpds*)
              (let* ((period1 (- (note->period 20)
                                 7))
                     (period2 (- period1 8)))
                `((5 ,(period->note period1) #f)
                  (7 ,(period->note period2) #f)
                  (8 ,(period->note period2) #f))))

(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list 
                            (m-e :pitch-slide :line 5 :value 7)
                            (m-e :fine-pitch-slide :line 6 :value 8)
                            (m-e :stop :line 8))
                           *test-tpds*)
              (let* ((period1 (note->period 20))
                     (period2 (- (note->period 20)
                                 (* 4 7)))
                     (period3 (- period2 8)))
                (list (list 5          (period->note period1)  #t)
                      (list (-line 6)  (period->note period2)  #f)
                      (list 6          (period->note period3)  #f)
                      (list 8          (period->note period3)  #f))))


;; Testing 'arpeggio'
;;
(***assert*** (get-pitches (m-e :note :value 20 :line 5)
                           (list
                            (m-e :pitch-slide :line 5 :value 7)
                            (m-e :arpeggio :line 6 :value 3 :value2 8)
                            (m-e :stop :line 7))
                           *test-tpds*)
              (let* ((period1 (- (note->period 20)
                                 (* 7 4)))
                     (note1 (period->note period1))
                     (note2 (+ note1 3))
                     (note3 (+ note1 8)))
                
                ;;(c-display "hepp" note1 note2 note3)
                (list (list 5 20 #t)

                      (list (+ 6 0/6) note1 #f)

                      (list (+ 6 1/6) note2 #f)

                      (list (+ 6 2/6) note3 #f)

                      (list (+ 6 3/6) note1 #f)

                      (list (+ 6 4/6) note2 #f)

                      (list (+ 6 5/6) note3 #f)

                      (list (+ 6 6/6) note1 #f))))
              

;; Testing 'slide-to-note
;;
;; simple down 
(let* ((note1 20)
       (note2 18)
       (period1 (note->period note1))  ;; = 604
       (period2 (note->period note2))) ;; = 538,  604-538 = 66
  ;;(c-display "p12" period1 period2)
  (***assert*** (get-pitches (m-e :note :line 1 :value note1)
                             (list
                              (m-e :slide-to-note :line 1 :value 6 :value2 period2)
                              (m-e :stop :line 2))
                             (vector 12 12 12 12))
                (list (list 1 note1 #t)
                      (list 2 note2 #f))))

;; simple up
(let* ((note1 18)
       (note2 20)
       (period1 (note->period note1))
       (period2 (note->period note2)))
  (***assert*** (get-pitches (m-e :note :line 1 :value note1)
                             (list
                              (m-e :slide-to-note :line 1 :value 6 :value2 period2)
                              (m-e :stop :line 2))
                             (vector 12 12 12 12))
                (list (list 1 note1 #t)
                      (list 2 note2 #f))))

;; down
(let* ((note1 20)
       (note2 18)
       (period1 (note->period note1))  ;; = 604
       (period2 (note->period note2))) ;; = 538,  604-538 = 66
  ;;(c-display "p12" period1 period2)
  (***assert*** (get-pitches (m-e :note :line 1 :value note1)
                             (list
                              (m-e :slide-to-note :line 2 :value 3 :value2 period2)
                              (m-e :slide-to-note :line 3 :value 3 :value2 period2)
                              (m-e :stop :line 4))
                             (vector 12 12 12 12 12 12))
                (list (list 1 note1 #f)
                      (list 2 note1 #t)
                      (list 3 (period->note (+ period1 (* 3 11))) #t)
                      (list 4 note2 #f))))
;; up
(let* ((note1 18)
       (note2 20)
       (period1 (note->period note1))
       (period2 (note->period note2)))
  (***assert*** (get-pitches (m-e :note :line 1 :value note1)
                             (list
                              (m-e :slide-to-note :line 2 :value 3 :value2 period2)
                              (m-e :slide-to-note :line 3 :value 3 :value2 period2)
                              (m-e :stop :line 4))
                             (vector 12 12 12 12 12 12))
                (list (list 1 note1 #f)
                      (list 2 note1 #t)
                      (list 3 (period->note (- period1 (* 3 11))) #t)
                      (list 4 note2 #f))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;      prepare-slide-to-note events   ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Remove notes that are not actually notes, but instead parameters for slide-to-note.
;; Also update :value2 of :slide-to-note.
(define (prepare-slide-to-note-0 events channelnum patternnum curr-period-goal curr-value)
  (define (has-next-event?)
    (not (null? (cdr events))))
  (define (get-next-event)
    (cadr events))
  
  (if (null? events)
      '()
      (let* ((event (car events))
             (type (event :type)))
        
        (cond ((not (= patternnum (event :patternnum)))
               (prepare-slide-to-note-0 events channelnum (event :patternnum) #f #f))

              ((not (= channelnum (event :channel)))
               (cons event
                     (prepare-slide-to-note-0 (cdr events) channelnum patternnum curr-period-goal curr-value)))
               
              ((and (eq? type :note)
                    (has-next-event?)
                    (eq? ((get-next-event) :type) :slide-to-note)
                    (= (event :linenum)
                       ((get-next-event) :linenum))
                    (= (event :channel)
                       ((get-next-event) :channel))
                    (= (event :patternnum)
                       ((get-next-event) :patternnum)))
               (prepare-slide-to-note-0 (cdr events)     ;; remove note that's really just a parameter value for slide-to-note
                                        channelnum
                                        patternnum
                                        (note->period (event :value))
                                        curr-value))
              
              ((eq? type :slide-to-note)
               (let ((value (if (> (event :value) 0)
                                (event :value)
                                curr-value)))
                 (if (or (not curr-period-goal)
                         (not value))
                     (prepare-slide-to-note-0 (cdr events) channelnum patternnum curr-period-goal value) ;; no value or goal value, throw it away, but update curr-value value. FIX: But this is run before 'merge-patterns', so we may throw away good events here. Ouch, catch 22. I guess it's not very common to use memorized slide-to-note parameters stored in previously played tracks though. Could run 'merge-patterns' twice though since 'remove-c00' is just an optimalization for 'merge-patterns'. No, that's no point. The reason for running c00 first is only to reduce the number of merged patterns. Seems like the correct solution is to add an exception to remove-c00 for c00-notes that are actually just parameters for slide-to-note.
                     (cons (copy-event event
                                       :value value
                                       :value2 curr-period-goal)
                           (prepare-slide-to-note-0 (cdr events)
                                                    channelnum
                                                    patternnum
                                                    curr-period-goal
                                                    value)))))

              (else
               (cons event
                     (prepare-slide-to-note-0 (cdr events) channelnum patternnum curr-period-goal curr-value)))))))

                                              
(define (prepare-slide-to-note events num-channels)
  (let loop ((channelnum 0)
             (events events))
    (if (= channelnum num-channels)
        events
        (loop (1+ channelnum)
              (prepare-slide-to-note-0 events channelnum 0 #f #f)))))

(***assert*** (prepare-slide-to-note '() 4)
              '())

(***assert*** (prepare-slide-to-note (list (m-e :note))
                                     4)
              (list (m-e :note)))

(***assert*** (prepare-slide-to-note (list (m-e :slide-to-note))
                                     4)
              '())

(***assert*** (prepare-slide-to-note (list (m-e :note           :value 5 :line 0)
                                           (m-e :slide-to-note :value 30 :line 1))
                                     4)
              (list (m-e :note           :value 5 :line 0)))

(***assert*** (prepare-slide-to-note (list (m-e :note           :value 5 :line 0)
                                           (m-e :note           :value 6 :line 1)
                                           (m-e :slide-to-note :value 0 :line 1))
                                     4)
              (list (m-e :note           :value 5  :line 0)))


(***assert*** (prepare-slide-to-note (list (m-e :note           :value 5 :line 0)
                                           (m-e :note           :value 6 :line 1)
                                           (m-e :slide-to-note :value 30 :line 1))
                                     4)
              (list (m-e :note           :value 5  :line 0)
                    (m-e :slide-to-note  :value 30 :line 1 :value2 (note->period 6))))

(***assert*** (prepare-slide-to-note (list (m-e :note           :value 5 :line 0)
                                           (m-e :note           :value 6 :line 1)
                                           (m-e :slide-to-note :value 30 :line 1)
                                           (m-e :slide-to-note :value 0 :line 2))
                                     4)
              (list (m-e :note           :value 5  :line 0)
                    (m-e :slide-to-note  :value 30 :line 1 :value2 (note->period 6))
                    (m-e :slide-to-note  :value 30 :line 2 :value2 (note->period 6))))


(let ((hepp (prepare-slide-to-note (list (m-e :note           :value 5 :line 0 :instrumentnum 1)
                                         (m-e :velocity       :value 0 :line 0)
                                         (m-e :note           :value 10 :line 1 :instrumentnum 1)
                                         (m-e :slide-to-note  :value 30 :line 1)
                                         (m-e :velocity       :value 0  :line 5))
                                   4)))
  (print-events hepp)
  (***assert*** hepp
                (list (m-e :note           :value 5 :line 0 :instrumentnum 1)
                      (m-e :velocity       :value 0 :line 0)
                      (m-e :slide-to-note  :value 30 :line 1 :value2 (note->period 10))
                      (m-e :velocity       :value 0  :line 5))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;          get-velocities           ;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (velocity-glide-to-velocity-glide glide)
  (list (list (car glide)
              (cadr glide)
              #t)
        (list (caddr glide)
              (cadddr glide)
              #f)))

(define (get-velocities-0 note curr-velocity events tpds)
  (let* ((event (car events))
         (linenum (event :linenum))
         (place (+ linenum (/ (event :tick) (tpds linenum))))
         (type (event :type)))
    (cond ((or (eq? type :stop)
               (eq? type :note))
           (list (list place
                       curr-velocity
                       #f)))
          
          ((eq? type :break)
           (assert (= place linenum))
           (list (list linenum
                       curr-velocity
                       #f)))

          ((eq? type :velocity)
           (cons (list place
                       (event :value)
                       #f)
                 (get-velocities-0 note (event :value) (cdr events) tpds)))

          ((eq? type :velocity-slide)
           (assert (= place linenum))
           (let* ((num-ticks-in-line (get-tpd tpds linenum))
                  (new-velocity (+ curr-velocity (* (event :value) (1- num-ticks-in-line)))) ;; TODO: Handle sliding above 1
                  (glide (clamp-glide linenum      curr-velocity
                                      (1+ linenum) new-velocity
                                      0 64
                                      num-ticks-in-line)))
             (append (velocity-glide-to-velocity-glide glide)
                     (get-velocities-0 note (last glide) (cdr events) tpds))))

          ((eq? type :fine-velocity-slide)
           (assert (= place linenum))
           (let ((new-velocity (between 0 (+ curr-velocity (event :value)) 64)))
             ;;(c-display "curr: " curr-velocity)
             ;;(c-display "new: " new-velocity (event :value))
             (cons  (list linenum
                          new-velocity
                          #f)
                    (get-velocities-0 note new-velocity (cdr events) tpds))))
          
          (else
           (get-velocities-0 note
                          curr-velocity
                          (cdr events)
                          tpds)))))

(define (get-velocities-old note instrument-velocity channel-events tpds)
  (let* ((linenum (note :linenum))
         (place1 (+ linenum (/ (note :tick) (tpds linenum)))))
    (fix-gliding (cons (list place1 instrument-velocity)
                       (get-velocities-0 note
                                         instrument-velocity
                                         channel-events
                                         tpds))
                 (get-num-lines-from-tpds tpds))))

(define (get-velocities note instrument-velocity channel-events tpds)
  (let* ((linenum (note :linenum))
         (place1 (+ linenum (/ (note :tick) (tpds linenum)))))
    (fix-gliding2
     (cons (list place1 instrument-velocity #f)
           (get-velocities-0 note
                             instrument-velocity
                             channel-events
                             tpds)))))


;; test :fine-velocity-slide
;;
(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              32
                              (list 
                               (m-e :fine-velocity-slide :line 5 :value 64)
                               (m-e :stop :line 6))
                              *test-tpds*)
              '((5 64 #f)
                (6 64 #f)))

(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              64
                              (list 
                               (m-e :fine-velocity-slide :line 5 :value 5)
                               (m-e :stop :line 6))
                              *test-tpds*)
              '((5 64 #f)
                (6 64 #f)))

(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              1
                              (list 
                               (m-e :fine-velocity-slide :line 5 :value -5)
                               (m-e :stop :line 6))
                              *test-tpds*)
              '((5 0 #f)
                (6 0 #f)))


;; test :velocity
;;
(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              32
                              (list 
                               (m-e :velocity :line 5 :value 5)
                               (m-e :stop :line 6))
                              *test-tpds*)
              '((5 5 #f)
                (6 5 #f)))

(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              32
                              (list 
                               (m-e :velocity :line 6 :value 5)
                               (m-e :stop :line 7))
                              *test-tpds*)
              `((5 32 #f)
                (6 5 #f)
                (7 5 #f)))

;; test :velocity-slide
;;
(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              32
                              (list 
                               (m-e :velocity-slide :line 5 :value 5)
                               (m-e :stop :line 6))
                              (vector 5 5 5 5 5 5 5 5 5))
              '((5 32 #t)
                (6 52 #f)))
                
(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              32
                              (list 
                               (m-e :velocity-slide :line 6 :value -5)
                               (m-e :stop :line 8))
                              (vector 5 5 5 5 5 5 5 5 5 5))
              '((5 32 #f)
                (6 32 #t)
                (7 12 #f)
                (8 12 #f)))
                
(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              2
                              (list 
                               (m-e :velocity-slide :line 5 :value -8)
                               (m-e :stop :line 6))
                              (vector 2 2 2 2 2 2 2 2))
              `((5 2 #t)
                (,(+ 5 1/4) 0 #f)
                (6 0 #f)))
                

(***assert*** (get-velocities (m-e :note :value 20 :line 5)
                              62
                              (list 
                               (m-e :velocity-slide :line 5 :value 8)
                               (m-e :stop :line 6))
                              (vector 2 2 2 2 2 2 2 2))
              `((5 62 #t)
                (,(+ 5 1/4) 64 #f)
                (6 64 #f)))
                



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;         split-channels            ;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; Make sure each channel only contains events belonging to one instrument
;; Returns a list of channels
(define (split-channel channel)
  (group-by (lambda (event)
              (event :instrumentnum))
            =
            channel))


(let* ((channel (list (m-e :note :instrumentnum 5 :line 3)
                      (m-e :note :instrumentnum 5 :line 4)
                      (m-e :note :instrumentnum 2 :line 5)
                      (m-e :note :instrumentnum 9 :line 7)
                      (m-e :note :instrumentnum 2 :line 8)))
       (channels (split-channel channel)))
  ;;(for-each print-events channels))
  (***assert*** channels (list (list (channel 0)
                                     (channel 1))
                               (list (channel 2)
                                     (channel 4))
                               (list (channel 3)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;     * add :line value to :tick,   ;;;;;;
;;;;     * validate tick values        ;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#||
(define (add-line-to-tick-value channel tpds)
  (let loop ((events channel))
    (if (null? events)
        '()
        (let* ((event (car events))
               (tick (event :tick))
               (line (event :line))
               (tpd (tpds line)))
          (if (>= tick tpd)
              (loop (cdr events)) ;; throw the event away (this might not be correct behavior for note cut, and possible other effects, since there has been a non-existing stop event during processing)
              (cons (copy-event event :tick (+ (/ tick (tpds line))
                                               line))
                    (loop cdr events)))))))

(***assert*** (add-line-to-tick-value (list (m-e :note :line 0 :tick 0)
                                            (m-e :note :line 1 :tick 2)
                                            (m-e :velocity :line 1 :tick 0)
                                            (m-e :note :line 2 :tick 1))
                                      (vector 2 2))
              (list (m-e :note :line 0 :tick 0)
                    (m-e :velocity :line 1 :tick 1)
                    (m-e :note :line 2 :tick (+ 2 1/2)))
              ||#


              
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;         Get tempo events            ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (get-tempo-events pattern-events)
  (keep (lambda (event)
          (let ((type (event :type)))
            (or (eq? :tpd type)
                (eq? :bpm type))))
        pattern-events))

              


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;            Pattern                  ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (make-pattern channels tempos tpds)
  (assert (list? channels))
  (assert (list? tempos))
  (assert (vector? tpds))
  (vector channels tempos tpds))


(define (pattern-get-channels pattern)
  (pattern 0))

(define (pattern-get-tempos pattern)
  (pattern 1))

(define (pattern-get-tpds pattern)
  (pattern 2))

(define (pattern-get-num-lines pattern)
  (get-num-lines-from-tpds (pattern-get-tpds pattern)))

(define (pattern-get-num-channels pattern)
  (length (pattern-get-channels pattern)))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;         interface                   ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define *events* '())

(define (start-adding-protracker-events!)
  (set! *events* '()))



(define *playlist* '())

(define (set-protracker-playlist! daslist)
  (set! *playlist* daslist))



;; Each element in the *instrumentlist* vector is another vector with the following six elements:
;; 0. Sample name
;; 1. Sample filename
;; 2. Num samples
;; 3. Finetune (between -8 and 7, spanning between -0.25 and 0.25 notes)
;; 4. Sample default volume (0-64). Needed for default velocity of notes
;; 5. Sample loop start. Ignored, if loop length = 0
;; 6. Sample loop length. Ignored if 0.
;; 7. Radium instrument number (filled in when calling send-instruments-to-radium).
;;
(define *instrumentlist* (vector))

(define (set-protracker-instrumentlist! daslist)
  (set! *instrumentlist* daslist))

(define (instrument-sample-name instr)
  (instr 0))
(define (instrument-sample-filename instr)
  (instr 1))
(define (instrument-num-samples instr)
  (instr 2))
(define (instrument-finetune instr)
  (instr 3))
(define (instrument-volume instr)
  ;;(c-display "instr: " (to-displayable-string instr))
  (instr 4))
(define (instrument-loop-start instr)
  (instr 5))
(define (instrument-loop-length instr)
  (instr 6))
(define (instrument-radium-instrument-num instr)
  (instr 7))
(define (set-instrument-radium-instrument-num! instr num)
  (vector-set! instr 7 num))

;; add events to *events*
(define (add-protracker-trackline patternnum channelnum linenum period instrumentnum effectnum effectvalue)
  
  (define (value1)
    (ash effectvalue -4))
  
  (define (value2)
    (logand effectvalue #xf))

  (define (push-volume-slide-event!)
    (let ((volumechange (- (value1) (value2))))
      (if (not (= 0 volumechange))
          (push! *events* (m-e :velocity-slide
                               :line linenum
                               :pattern patternnum
                               :channel channelnum
                               :value volumechange)))))

  (delafina (push-break-event! :value 0)
    (push! *events* (m-e :break
                         :line (1+ linenum)
                         :pattern patternnum
                         :channel channelnum
                         :instrumentnum -1
                         :value value)))
  
  (if (> period 0)
      (push! *events* (m-e :note
                           :instrumentnum instrumentnum
                           :line linenum
                           :pattern patternnum
                           :channel channelnum
                           :value (period->note period))))
  (cond ((and (= effectnum 0)
              (> effectvalue 0))
         (push! *events* (m-e :arpeggio
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value (value1)
                              :value2 (value2))))
        
        ((and (or (= effectnum 1)
                  (= effectnum 2))
              (> effectvalue 0)) ;; no portamento effect memory in protracker
         (push! *events* (m-e :pitch-slide
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value (if (= effectnum 1)
                                         effectvalue
                                         (- effectvalue)))))

        ((= effectnum 3)
         (push! *events* (m-e :slide-to-note
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value effectvalue)))

        ((= effectnum 4)
         (push! *events* (m-e :vibrato
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value (value1)
                              :value2 (value2))))

        ((= effectnum 5)
         (push! *events* (m-e :slide-to-note
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value 0))
         (push-volume-slide-event!))
        
        ((= effectnum 6)
         (push! *events* (m-e :vibrato
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value 0))
         (push-volume-slide-event!))
        
        ((= effectnum 7)
         (push! *events* (m-e :tremolo
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value (value1)
                              :value2 (value2))))

        ((= effectnum 8)
         (assert #f)) ;; panning not implemented yet (not supported in protracker anyway)

        ((= effectnum 9)
         (push! *events* (m-e :tremolo
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value (value1)
                              :value2 (value2))))

        ((= effectnum 10)
         (push-volume-slide-event!))

        ((= effectnum 11)
         (c-display "import_mod.scm/error: Bxx Jump to order is not supported (MOD) " effectvalue)
         (push-break-event!))

        ((= effectnum 12)
         (push! *events* (m-e :velocity
                              :line linenum
                              :pattern patternnum
                              :channel channelnum
                              :value effectvalue)))
         
        ((= effectnum 13)
         (push-break-event! :value (+ (* (value1) 10) (value2))))

        ((= effectnum 15)
         (let ((value (if (= effectvalue 0)
                          1
                          effectvalue)))
           (push! *events* (m-e (if (< effectvalue 32)
                                    :tpd
                                    :bpm)
                                :line linenum
                                :pattern patternnum
                                :channel channelnum
                                :instrumentnum -1
                                :value value))))
        
        ((= effectnum 14)
         (let ((effectnum (value1))
               (effectvalue (value2)))
           (cond ((= effectnum 0)
                  (c-display "import_mod.scm/error: E0x Set filter On/Off is not supported (MOD)" effectvalue))
                 
                 ((or (= effectnum 1)
                      (= effectnum 2))
                  (push! *events* (m-e :fine-pitch-slide
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :value (if (= effectnum 1)
                                                  (- effectvalue)
                                                  effectvalue))))
                 
                 ((= effectnum 3)
                  (c-display "import_mod.scm/error: E3x Glissando control is not supported (MOD)" effectvalue ", p:" patternnum ", c:" channelnum ", line:" linenum))

                 ((= effectnum 4)
                  (c-display "import_mod.scm/error: E4x Vibrato control is not supported (MOD)" effectvalue))

                 ((= effectnum 5)
                  (push! *events* (m-e :fine-tune
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :value (if (< effectvalue 8)
                                                  (scale effectvalue 0  8  0 1)                                                  
                                                  (scale effectvalue 8 16 -1 0)))))


                 ((= effectnum 6)
                  (push! *events* (m-e :loop
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :instrumentnum -1
                                       :value effectvalue)))
                  
                 ((= effectnum 7)
                  (c-display "import_mod.scm/error: E5x Tremolo control is not supported (MOD)" effectvalue))

                 ((= effectnum 8)
                  (c-display "import_mod.scm/error: E8x Set panning position or karplus strong is not supported (MOD)" effectvalue))

                 ((= effectnum 9)
                  (push! *events* (m-e :retrigger-note
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :value effectvalue)))

                 ((and (or (= effectnum 10)
                           (= effectnum 11))
                       (> effectvalue 0))
                  (push! *events* (m-e :fine-velocity-slide
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :value (if (= effectnum 10)
                                                  effectvalue
                                                  (- effectvalue)))))

                 ((= effectnum 12) ;; note-cut
                  (push! *events* (m-e :velocity
                                       :tick effectvalue
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :value 0)))

                 ((and (= effectnum 13)
                       (> effectvalue 0))
                  (push! *events* (m-e :delay-note
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :value effectvalue)))

                 ((and (= effectnum 14)
                       (> effectvalue 0))
                  (push! *events* (m-e :pattern-delay
                                       :line linenum
                                       :pattern patternnum
                                       :channel channelnum
                                       :instrumentnum -1
                                       :value effectvalue)))

                 ((= (effectnum 15))
                  (c-display "import_mod.scm/error: Efx Invert loop is not supported (MOD)" effectvalue)))))))

;; Returns an event that will stop the note. (i.e. not necessarily a :stop event)
(define (get-next-stop-event events)
  (find-first (append events (list (m-e :break :line 64))) ;; TODO: Add, etc.
              (lambda (event)
                (memq (event :type) '(:note :stop :break)))))

(get-next-stop-event (list (m-e :note :line 5)
                           (m-e :break :line 6)))

(define *pitch-transpose* 24)

(define (send-note-event-to-radium note channelnum events instrument tpds num-lines)

  (define (legal-pos pos)
    (min (-line num-lines)
         pos))
  
  ;;(c-display "instruments: " instruments)
  (let* ((pitches (get-pitches note events tpds))
         (velocities (get-velocities note (instrument-volume instrument) events tpds))
         
         (first-pitch (car pitches))
         (first-pitch-pos (car first-pitch))
         (first-pitch-value (cadr first-pitch))
         
         (last-pitch (last pitches))
         (last-pitch-pos (legal-pos (car last-pitch)))
         (last-pitch-value (cadr last-pitch))
         
         (first-velocity (car velocities))
         (first-velocity-pos (car first-velocity))
         (first-velocity-value (cadr first-velocity))
         
         (last-velocity (last velocities))
         (last-velocity-pos (legal-pos (car last-velocity)))
         (last-velocity-value (cadr last-velocity))
         
         (start-place (place-list first-velocity-pos))
         (stop-place (place-list last-velocity-pos)))
    
    ;;(c-display "velocities" (event-to-string note) start-place stop-place velocities)
    (when (null? (cdr velocities))
          (print-events events))
    
    (assert (= last-pitch-pos last-velocity-pos))
    (assert (= first-pitch-pos first-velocity-pos))

    (assert (not (null? (cdr velocities)))) ;; could fail if not all events after :break have been removed
    (assert (not (null? (cdr pitches))))
    
    ;;(c-display "note start: " (event->place-list note tpds))
    ;;(c-display "vel start:  " (place-list first-velocity-pos))
    (assert (place-list-equal? (event->place-list note tpds) (place-list first-velocity-pos)))

    ;;(c-display "pitches" (event-to-string note) start-place stop-place pitches)

    (when (and (= (note :patternnum) 4)
               (= (note :channel) 3)
               (= (note :linenum) 44))
          (c-display "gakk")
          (print-events events))

    
    (when (or (not (validate-gliding2 pitches))
              (not (validate-gliding2 velocities)))
      (c-display "FAILED")
      (c-display note)
      (print-events events)
      (assert #f))      
    
    (let ((radium-notenum (ra:add-note2 (+ *pitch-transpose* first-pitch-value)
                                        (* first-velocity-value (/ 65536 64))

                                        (car start-place) (cadr start-place) (caddr start-place)
                                        
                                        (car stop-place) (cadr stop-place) (caddr stop-place)
                                        
                                        -1 -1 channelnum)))
      (when (not (= -1 radium-notenum))

        ;; set end velocity value
        (ra:set-velocity 1
                         (/ last-velocity-value 64)
                         -1 ;; i.e. don't change time position
                         radium-notenum
                         channelnum)
        
        ;; add velocity nodes
        (for-each (lambda (velocity)
                    (c-display velocities)
                    (when (>= (car velocity) last-velocity-pos)
                          (c-display "note" (event-to-string note))
                          (c-display "channelnum" channelnum)
                          (c-display "instrument" instrument)
                          (c-display "pitches" pitches)
                          (c-display "velocities" velocities)
                          (c-display "num-lines" num-lines)
                          (print-events events)
                          (assert #f))
                    (let ((place (place-list (car velocity))))
                      (ra:create-velocity3 (/ (cadr velocity) 64) ;; value
                                           (car place) (cadr place) (caddr place)
                                           radium-notenum
                                           channelnum)))
                  (butlast (cdr velocities)))

        ;; set velocity logtypes
        (for-each (lambda (velocity velocitynum)
                    (ra:set-velocity-logtype-holding (not (caddr velocity)) velocitynum  radium-notenum channelnum))
                  (butlast velocities)
                  (iota (1- (length velocities))))

        ;; whether to add pitches or not
        (when (or (not (= first-pitch-value last-pitch-value))
                  (> (length pitches) 2))
              
          (ra:set-note-end-pitch (+ *pitch-transpose* last-pitch-value)
                                 radium-notenum
                                 channelnum)
           
          (for-each (lambda (pitch)  ;; TODO: Fix.
                      (assert (< (car pitch) last-pitch-pos))
                      (let ((place (place-list (car pitch))))
                        (ra:create-pitch3 (+ *pitch-transpose* (cadr pitch))  ;; value
                                          (car place) (cadr place) (caddr place)
                                          ;; ra:create-pitch doesn't need a 'radium-notenum' argument. It's not really needed either unless you have polyphonic tracks, which is not the case for MOD.
                                          channelnum)))
                    (butlast (cdr pitches)))

          ;; set pitch logtypes
          (for-each (lambda (pitch pianonotenum)
                      (ra:set-pianonote-logtype-holding (not (caddr pitch)) pianonotenum  radium-notenum channelnum))
                    (butlast pitches)
                    (iota (1- (length pitches))))
          
          )))))
      

(define (get-vibrato-depths vibrato-events tpds)
  (fix-gliding (let loop ((events vibrato-events)
                          (last-value #f)
                          (last-line #f))
                 ;;(c-display "events:" events)
                 (let* ((event (car events))
                        (linenum (event :linenum))
                        (place (+ linenum (/ (event :tick) (tpds linenum))))
                        (type (event :type)))
                   (cond ((and last-line
                               (not (= (1+ last-line)
                                       place)))
                          (cons (list (1+ last-line)
                                      0)
                                (loop events
                                      #f
                                      #f)))
                         ((eq? type :break)
                          '())
                         ((eq? type :vibrato)
                          (let ((value (event :value)))
                            (append (list (list place
                                                value)
                                          (list (1+ linenum)
                                                value))
                                    (loop (cdr events)
                                          value
                                          linenum))))
                         (else
                          (loop (cdr events) #f #f)))))
               (get-num-lines-from-tpds tpds)))


(for-each c-display
 (get-vibrato-depths (list (m-e :vibrato :line 5 :value 10 :value2 20)
                           (m-e :vibrato :line 6 :value 10 :value2 21)
                           (m-e :vibrato :line 8 :value 11 :value2 22)
                           (m-e :break :line 9))
                     (make-vector 10 6)))



#||
(***assert*** (get-vibrato-depths (list (m-e :vibrato :line 5 :value 10 :value2 20)
                                        (m-e :vibrato :line 6 :value 10 :value2 21)
                                        (m-e :vibrato :line 8 :value 11 :value2 22)
                                        (m-e :break :line 9))
                                  (make-vector 10 6))
              (list `((5 10)
                      (,(-line 7) 10)
                      
                      (7 0)
                      (,(-line 8) 0)
                      
                      (8 11)
                      (,(-line (-line 9)) 11)
                      
                      (,(-line 9) 0))))
||#


(define (get-radium-vibrato-speed-events events last-line)
  (if (null? events)
      '()
      '()))

#||
(***assert*** (get-radium-vibrato-speed-events (list (m-e :vibrato :tick 5 :value 10 :value2 20)
                                                     (m-e :vibrato :tick 6 :value 10 :value2 21)
                                                     (m-e :vibrato :tick 8 :value 11 :value2 22)))
              (list `((5 20)
                      (,(-line 6) 20)
                      
                      (6 21)
                      (,(-line 7) 21)
                      
                      (7 0)
                      (,(-line 8) 0)
                      
                      (8 12)
                      (,(-line 9) 12)
                      (9 0))))
||#

(define (get-radium-vibrato-events vibrato-events)
  (list (get-radium-vibrato-depth vibrato-events -1)
        (get-radium-vibrato-speed vibrato-events -1)))



(define (send-vibrato-events-to-radium channel)
  (let ((vibrato-events (keep (lambda (event)
                                (or (eq? (event :type) :vibrato)
                                    (eq? (event :type) :break)))
                              channel)))
    ...))

(define (get-radium-tempos tempo-events)
  (let loop ((events tempo-events)
             (result '())
             (last-bpm 125)
             (last-tpd 6)
             (last-linenum -1))
    ;;(c-display "events::: " events)
    (if (null? events)
        (reverse result)
        (let* ((event (car events))
               (type (begin (c-display "event: " event) (event :type)))
               (linenum (event :linenum))
               (disp1 "aaa")
               (same-line? (= linenum last-linenum))
               (disp2 "bbb")
               (bpm (if (eq? type :bpm)
                        (event :value)
                        last-bpm))
               (disp3 "ccc")
               (tpd (if (eq? type :tpd)
                        (event :value)
                        last-tpd))
               (disp4 "ddd")
               (radium-bpm (round (/ (* 6 bpm)
                                     tpd)))
               (disp1 "eee")
               (lpb (if (> radium-bpm 999)
                        8
                        4)))
          (c-display "got here" linenum bpm tpd )
          (loop (cdr events)
                (cons (list linenum lpb radium-bpm) (if same-line? (cdr result) result))
                bpm
                tpd
                linenum)))))
                      
(***assert*** (get-radium-tempos (list (m-e :tpd :line 0 :value 1)
                                       (m-e :bpm :line 0 :value 400)
                                       (m-e :tpd :line 2 :value 9)
                                       (m-e :bpm :line 3 :value 80)))
              `((0 8 ,(round (/ (* 6 400) 1)))
                (2 4 ,(round (/ (* 6 400) 9)))
                (3 4 ,(round (/ (* 6 80) 9)))))

(define (send-tempos-to-radium tempo-events)
  (let loop ((tempos (get-radium-tempos tempo-events))
             (last-lpb 4)
             (last-bpm 125))
    (c-display "looping" last-lpb last-bpm tempos)
    (c-display "hmm1" (null? tempos))
    (c-display "hmm2" (not (null? tempos)))
    (if (not (null? tempos))
        (let* ((tempo (car tempos))
               (l1 (c-display "p1"))
               (line (car tempo))
               (l2 (c-display "p2"))
               (lpb (cadr tempo))
               (l1 (c-display "p3"))
               (bpm (caddr tempo)))
          (c-display "l1")
          (when (not (= lpb last-lpb))
                (c-display line ": LPB" lpb)
                (ra:add-lpb lpb line 0 1))
          (c-display "l2")
          (when (not (= bpm last-bpm))
                (c-display line ": BPM" bpm)
                (ra:add-bpm (if (= lpb 8)
                                (round (/ bpm 2))
                                bpm)
                            line 0 1))
          (c-display "l3")
          (loop (cdr tempos) lpb bpm)))))

#||
(send-tempos-to-radium (list (list (m-e :tpd :line 0 :value 6)
                                   (m-e :bpm :line 0 :value 125))
                             (list (m-e :tpd :line 1 :value 1))
                             (list (m-e :bpm :line 1 :value 400))
                             (list (m-e :tpd :line 2 :value 9)
                                   (m-e :bpm :line 3 :value 80))))
||#


(define (send-pattern-to-radium-old pattern tempo-events instruments tpds)
  (ra:set-num-lines ((find-first (car pattern)
                                (lambda (event)
                                  (eq? (event :type) :break)))
                     :linenum))
  
  (if (= 0 (length pattern))
      (ra:set-num-tracks 1)
      (ra:set-num-tracks (length pattern)))

  (ra:minimize-block-tracks)
  
  (send-tempos-to-radium tempo-events)
  (c-display "FINISHED sending tempos to radium")
  
  (for-each (lambda (channel tracknum)
              (let ((first-instrument-event (find-first channel
                                                        (lambda (event)
                                                          (not (= -1 (event :instrumentnum)))))))
                (if first-instrument-event
                    (let* ((instrument-num (first-instrument-event :instrumentnum))
                           (instrument (instruments (1- instrument-num)))
                           (radium-instrument-num (instrument-radium-instrument-num instrument)))
                      (if radium-instrument-num
                          (ra:set-instrument-for-track radium-instrument-num tracknum))
                
                      (let loop ((events channel))
                        (if (not (null? events))
                            (let* ((event (car events))
                                   (type (event :type)))
                              (cond ((eq? type :note)
                                     (send-note-event-to-radium event tracknum (cdr events) instrument tpds))
                                    (else
                                     #t))
                      (loop (cdr events)))))))))

            pattern
            (iota (length pattern))))

(define (send-pattern-to-radium pattern instruments)
  (define num-lines (pattern-get-num-lines pattern))
  
  (ra:set-num-lines num-lines)
  
  (if (= 0 (pattern-get-num-channels pattern))
      (ra:set-num-tracks 1)
      (ra:set-num-tracks (pattern-get-num-channels pattern)))

  (ra:minimize-block-tracks)
  
  (send-tempos-to-radium (pattern-get-tempos pattern))
  
  (for-each (lambda (channel tracknum)
              (let ((first-instrument-event (find-first channel
                                                        (lambda (event)
                                                          (not (= -1 (event :instrumentnum)))))))
                (if first-instrument-event
                    (let* ((instrument-num (first-instrument-event :instrumentnum))
                           (instrument (instruments (1- instrument-num)))
                           (radium-instrument-num (instrument-radium-instrument-num instrument)))
                      (if radium-instrument-num
                          (ra:set-instrument-for-track radium-instrument-num tracknum))

                      (ra:set-track-pan (get-pan-value (first-instrument-event :channel)) tracknum)
                      (ra:set-track-pan-on-off #t tracknum)
                      
                      (let loop ((events channel))
                        (if (not (null? events))
                            (let* ((event (car events))
                                   (type (event :type)))
                              (cond ((eq? type :note)
                                     (send-note-event-to-radium event tracknum (cdr events) instrument (pattern-get-tpds pattern) num-lines))
                                    (else
                                     #t))
                      (loop (cdr events)))))))))

            (pattern-get-channels pattern)
            (iota (pattern-get-num-channels pattern))))

(define (clear-radium-editor)
  (while (> (ra:get-num-blocks) 1)
         (ra:delete-block))
  (ra:append-block)
  (ra:select-prev-block)
  (ra:delete-block))

(define (send-playlist-to-radium playlist)
  (ra:set-playlist-length (length playlist))
  (let loop ((pos 0)
             (playlist playlist))
    (when (not (null? playlist))
          (ra:set-playlist-block pos (car playlist))
          (loop (1+ pos)
                (cdr playlist)))))

(define (send-events-to-radium playlist instruments patterns)
  (clear-radium-editor)
  
  (ra:set-lpb 4)
  (ra:set-bpm 125) ;; Default mod value

  (for-each (lambda (pattern)
              (send-pattern-to-radium pattern instruments)
              (ra:append-block)
              )
;            (list (patterns 37))
;            (list (tpdss 37))
            patterns) ;; TODO: Uncomment
;            (list (car patterns))
;            (list (car tpdss)))
    ;        )
  
  (send-playlist-to-radium playlist) ;; TODO: Uncomment

  (ra:reset-undo)
  )


(define (send-instruments-to-radium instruments)
  (for-each (lambda (instrument)
              (when (> (instrument-num-samples instrument) 0)
                    (define radium-instrument-num (ra:create-audio-instrument "Sample Player" "Sample Player" (instrument-sample-name instrument)))
                    
                    (set-instrument-radium-instrument-num! instrument radium-instrument-num)
                    
                    (ra:set-instrument-sample radium-instrument-num (instrument-sample-filename instrument))
                    
                    (let ((loop-length (instrument-loop-length instrument)))
                      (if (> loop-length 0)
                          (ra:set-instrument-loop-data radium-instrument-num
                                                       (instrument-loop-start instrument)
                                                       loop-length)))
                    (let ((finetune (instrument-finetune instrument)))
                      (if (not (= 0 finetune))
                          ;; Radium finetune effect goes between 0 and 1, where 0 = -100 cents, and 1 = +100 cents.
                          (ra:set-instrument-effect radium-instrument-num "Finetune" (scale finetune -8 7 0.25 0.75))))
                    
                    ;; We don't hear clicks when modules are played in protracker, for some reason.
                    ;; But in Radium the clicks are quite noticable.
                    (ra:set-instrument-effect radium-instrument-num "Attack" 2)
                    (ra:set-instrument-effect radium-instrument-num "Release" 2)
                    ))
            
            (vector->list instruments)))
              
#||
  Merging patterns 3 and 4 into patternnum 68 
  Merging patterns 68 and 18 into patternnum 69 
  Merging patterns 69 and 19 into patternnum 70 
  Merging patterns 70 and 20 into patternnum 71 
  Merging patterns 71 and 21 into patternnum 72 
  Merging patterns 72 and 22 into patternnum 73 
  Merging patterns 73 and 23 into patternnum 74 
  Merging patterns 74 and 24 into patternnum 75 
  Merging patterns 75 and 25 into patternnum 76 
  Merging patterns 63 and 32 into patternnum 77 
  Merging patterns 33 and 34 into patternnum 78 
  Merging patterns 78 and 35 into patternnum 79 
  Merging patterns 38 and 39 into patternnum 80 
  Merging patterns 80 and 40 into patternnum 81 
  Merging patterns 41 and 42 into patternnum 82 
  Merging patterns 82 and 43 into patternnum 83 
  Merging patterns 46 and 47 into patternnum 84 
  Merging patterns 84 and 48 into patternnum 85 
  Merging patterns 85 and 49 into patternnum 86 
  Merging patterns 86 and 50 into patternnum 87 
  Merging patterns 87 and 51 into patternnum 88 
  Merging patterns 88 and 52 into patternnum 89 
  Merging patterns 89 and 53 into patternnum 90 
  Merging patterns 90 and 54 into patternnum 91 
  Merging patterns 91 and 55 into patternnum 92 
  Merging patterns 92 and 56 into patternnum 93 
  Merging patterns 93 and 57 into patternnum 94 
  Merging patterns 94 and 58 into patternnum 95 
  Merging patterns 95 and 59 into patternnum 96 
  Merging patterns 96 and 60 into patternnum 97 
  Merging patterns 97 and 61 into patternnum 98 
  Merging patterns 98 and 62 into patternnum 99 
  Merging patterns 10 and 11 into patternnum 100 
  Merging patterns 100 and 64 into patternnum 101 
  Merging patterns 101 and 28 into patternnum 102 
  Merging patterns 102 and 29 into patternnum 103 
  Merging patterns 103 and 65 into patternnum 104 
  Merging patterns 104 and 11 into patternnum 105 
  Merging patterns 105 and 66 into patternnum 106 
  Merging patterns 106 and 28 into patternnum 107 
  Merging patterns 107 and 29 into patternnum 108 
  Merging patterns 108 and 67 into patternnum 109 
  Merging patterns 109 and 12 into patternnum 110 
  Merging patterns 0 and 1 into patternnum 111 
  Merging patterns 111 and 2 into patternnum 112 
  Merging patterns 77 and 79 into patternnum 113 
  Merging patterns 113 and 36 into patternnum 114 
  Merging patterns 114 and 37 into patternnum 115 
  Merging patterns 115 and 81 into patternnum 116 
  Merging patterns 116 and 83 into patternnum 117 
  Merging patterns 117 and 44 into patternnum 118 
  Merging patterns 118 and 45 into patternnum 119 
  Merging patterns 119 and 99 into patternnum 120 
  Merging patterns 14 and 13 into patternnum 121 
  Merging patterns 121 and 15 into patternnum 122 
  Merging patterns 122 and 17 into patternnum 123 
  Merging patterns 123 and 26 into patternnum 124 
||#
  
(define (process-events playlist instruments events)

  (define *num-channels* 4)
  
  (define step 0)

  (define (print-progress-message message)
    (c-display (<-> step ". PREPARING MOD. " message)))
    
  (define (set-playlist-and-events! message new-playlist-and-events)
    (print-progress-message (<-> message " finished."))
    (set! step (1+ step))
    (set! playlist (car new-playlist-and-events))
    (set! events (cadr new-playlist-and-events)))
  
  (define (set-events! message new-events)
    (set-playlist-and-events! message (list playlist new-events)))
  
  (define (add-instruments-and-events! message new-instruments-and-events)    
    (define cloned-instruments (map (lambda (cloned-instrument)
                                      (let ((instrument (instruments (cloned-instrument :old-instrumentnum))))
                                        (vector-copy instrument)))
                                    (car new-instruments-and-events)))
    (set! instruments (append instruments cloned-instruments))
    (set-events! message (cadr new-instruments-and-events)))
  
  
  (set-events! "Fix break events"
               (fix-break-events events))
               
  (set-events! "Adding break events to all patterns"
               (add-break-events events 64 playlist))

  (set-playlist-and-events! "Simplify break events"
                            (simplify-break-events playlist events))

  (set-events! "Expand loops"
               (expand-loops events))

  (set-events! "Prepare slide-to-note"
               (prepare-slide-to-note events *num-channels*))

  (c-display "playlist-before" playlist)
  (set-playlist-and-events! "Merge patterns"
                            (merge-patterns playlist events *num-channels*))
  (c-display "playlist-after" playlist)
  ;;(assert #f)
  
  (set-playlist-and-events! "Create new patterns based on tempo"
                            (create-new-patterns-based-on-tempo playlist events))

  (set-events! "Remove events after breaks"
               (remove-events-after-breaks events))

  (set-playlist-and-events! "Legalize pattern lengths"
                            (legalize-pattern-lengths playlist events))
  
  (set-events! "Remove note delay effects"
               (remove-note-delay-effects events))

  ;;(c-display "num-events1: " (length events) (events 5) (events 6) (events 7))
  ;;(print-events events)
  
  ;; same here.
  (set-events! "Assign instrument numbers"
               (assign-instrument-numbers events))

  ;;(c-display "num-events2: " (length events) (events 5) (events 6) (events 7))

  ;; works on events:
  (add-instruments-and-events! "Clone instruments"
                               (get-cloned-instruments events))

  (print-progress-message (<-> "Sending instruments to Radium"))
  (send-instruments-to-radium instruments)

  (define patterns
    (map (lambda (pattern-events)

           ;;(c-display "Remove pattern delay effects")
           (set! pattern-events (remove-pattern-delay-effects pattern-events))

           (define  break-event (find-first pattern-events
                                            (lambda (event)
                                              (eq? (event :type) :break))))
           ;;(print-events pattern-events)
           (c-display "break-event: " break-event)
           (print-progress-message (<-> "Processing pattern " (break-event :patternnum)))
           
           (define tpds (create-tpds pattern-events))

           (define tempos (get-tempo-events pattern-events))
           
           (define channels (pattern-events-to-channels pattern-events break-event *num-channels*))
           
           (set! channels (map add-stop-events channels))
           
           (set! channels (apply append (map split-channel channels)))

           ;; Remove all channels not containing musical data. (i.e empty channels or channels only containing events with instrumentnum = -1
           (set! channels (keep (lambda (channel)
                                  (true-for-at-least-one? (lambda (event)
                                                            (not (= (event :instrumentnum) -1)))
                                                          channel))
                                channels))

           ;; add break event to every channel.
           (set! channels (map (lambda (channel)
                                 (append channel
                                         (list break-event)))
                               channels))

           (set! channels (map (lambda (channel)
                  
                                  ;; works on channels:
                                  ;;(c-display "Remove note retrigger effects")
                                  (set! channel (remove-note-retrigger-effects channel tpds))
                                  
                                  ;; works on channels:
                                  ;;(c-display "Remove effect memory")
                                  (set! channel (remove-effect-memory channel))
                                  
                                  ;; The functions which sends data to Radium expects :tick to contain both both the value of :line and :tick
                                  ;;(set! channel (add-line-to-tick-value channel tpds))
                                  
                                  channel)
                               channels))

           (make-pattern channels
                         tempos
                         tpds))
         
         (events-to-patterns events)))

  (list playlist
        instruments
        patterns)
  
  )

#||
(send-protracker-events-to-radium '(0) '())
||#

(ra:eval-python "print 51")
(ra:eval-scheme "(c-display 50)")

(define (get-pan-value channelnum)
  (if (= 1 (modulo (floor (/ (1- channelnum)
                             2))
                   2))
      -0.25
      0.25))


(begin
  (ra:reset-undo)
  ;;(ra:load-song "mod_song_template.rad")
  (ra:new-song)
  
  (ra:eval-python "import import_mod2")
  (ra:eval-python "import_mod2=reload(import_mod2)")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/GODZILLA.MOD\")")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/ksvalast/Downloads/GODZILLA.MOD\")")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/ksvalast/Downloads/4mats-madness.mod\")")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/4mats-madness.mod\")")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/ksvalast/Downloads/black_queen.mod\")")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/beyond_music.mod\")")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/radium/bin/4-Mats_Madness.mod\")")
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/spacedeb.mod\")") ;; error
  (ra:eval-python "import_mod2.import_mod(\"/tmp/spacedeb.mod\")") ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/professionaltracker.mod\")") ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/radium/bin/Phantasmagoria.mod\")") ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/MOD.phantasmagoria\")") ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/hoffman_and_daytripper_-_professional_tracker.mod\")") ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/black_queen.mod\")")  ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/protracker-code/bin/blackqueen.mod\")")  ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/hoisaga1.mod\")") ;; error
  ;;(ra:eval-python "import_mod2.import_mod(\"/home/kjetil/Downloads/enigma.mod\")") ;;erro
  
  (let* ((stuff (process-events *playlist*
                                *instrumentlist*
                                (reverse *events*)))
         (playlist (car stuff))
         (instruments (cadr stuff))
         (patterns (caddr stuff))
         (num 0))
    (for-each (lambda (pattern)
                (c-display "pattern" num ":" (length (pattern-get-num-channels pattern)) (length (apply append (pattern-get-channels pattern))))
                (set! num (1+ num)))
                ;(for-each (lambda (channel)
                ;            (c-display "  channel: " + (length channel)))
                ;          pattern)
              patterns)
    (send-events-to-radium playlist instruments patterns)
    (c-display "playlist before: " *playlist*)
    (c-display "playlist after: " playlist)
    #t))

'(for-each (lambda (n)
             (print-events *events*))
           (iota 100))


#||
FIX:
(let* ((stuff (process-events '(0)
                              #(#("for game music:" "/home/ksvalast/.radium/mod_samples/for32game32music58.wav" 11282 0 64 0 0 24))
                             (list (m-e :note           :value 5 :line 0 :instrumentnum 1)
                                   (m-e :velocity       :value 0 :line 0)
                                   (m-e :note           :value 10 :line 1 :instrumentnum 1)
                                   (m-e :slide-to-note  :value 30 :line 1)
                                   (m-e :velocity       :value 0  :line 5))))
       (patterns (caddr stuff))
       (pattern (car patterns)))
  (print-events (car (pattern 0))))
||#



#||

* add-break-events events default-num-lines playlist)

* simplify-break-events playlist events
  * add-break-events

* remove-events-after-breaks events
  * simplify-break-events

* expand-loops events
  * remove-events-after-breaks

;; * remove-note-cut-effects

* replace-c00-with-stops
  * remove-note-cut-effects
  * prepare-slide-to-note (some c00-notes are actually just effect parameters for prepare-slide-to-note, and must be converted to effect parameter first)

* merge-patterns
  * expand-loops
  calls:
    * replace-c00-with-stops
    * remove-note-cut-effects


* create-new-patterns-based-on-tempo playlist events ;; TODO: determine whether merge-patterns or create-new-patterns-based-on-tempo must be run first, or if it matters.
  * expand-loops 

* remove-pattern-delay-effects pattern
  * simplify-break-events

* legalize-pattern-lengths playlist events)
  - last

* remove-note-retrigger-effects channel tpds
   - needs notes with velocity and portamento information in order to retrigger correct volume and pitch (i think, should check this)

* remove-note-delay-effects events
  - Probably anywhere.

* get-cloned-instruments events
  * assign-instrument-numbers

* add-stop-events

* assign-instrument-numbers
  - Note that non-instrument events such as tempo change must have instrument number -1 assigned before calling to avoid the events to be thrown away.
    This must be done when the events are read in.

* remove-effect-memory
  * remove-glide-to-note <- This one either translates 3xx effects into 1xx or 2xx effects, or removes those effects if there are no forthcoming notes

;;* remove-glide-to-note
  * assign-instrument-numbers (no, probably not)
  * replace-c00-with-stops
  * merge-patterns (needs to merge patterns if the slide-to-note effect is not connected to a playing note in the current pattern)
  - This one probably needs to be run very early, since it uses a "note on" event as parameter for an effect. In other words, these notes are not real notes,
    and should be removed. I haven't thought through this, but these "ghost notes" may screw up other things. At least it doesn't hurt to remove them
    as soon as possible.

    From the documentation:

    " Any note in this channel's division is not played,
      but changes the "remembered" note - it can be thought of as a
      parameter to this effect. "

* prepare-slide-to-note

* get-pitches
  * prepare-slide-to-note
  * add-stop-events

* get-velocities
  * add-stop-events
 
Er noter med instrument-nummer=0 handtert? (ja, det går automatisk når kanalene blir assignet til tracks)
Men tracks som starter med instrument-nummer=0 er ikke handtert.


* TODO:
  * Channel panning
  * Instrument number change on a channel is not registered if it's done without note.
  ;;  * Many effects doesn't have memory in protracker mode. This can be handled when reading in the data. (i.e. don't create event if value is 0)
  * Note events with note value 0, and instrument event > 0.
    * May need to merge patterns because of this too.
    * Have to check first in protracker what actually happens though.
    * Same thing happens with the retrigger effect. The retrigger effect does in effect create note events with value=0. So this needs to be handled after creating retrigger notes.
  * Max/min period for pitch slide up and down
  * Continuing pitch slides.
  * [14][3]: Set glissando on/off ;; a lot of work, and probably for nothing. I doubt this effect is used very much. (GODZILLA actually uses this effect, but it seems more like a typo (i.e. e93 instead of e39)
  * [14][15]: Invert loop (strange effect, it's not event documentet in milkytracker. It's not playing the loop backwards, but inverts the sample, which I don't know why it's so important that there's a special realtime (!) effect for it in protracker)
  * Perhaps it's better to instrument-pan rather than track-pan. Just add support for pan-effect, and
    add events to the start of every channel. It's quite ugly now, plus much work to adjust.
  * Bxx Jump to order
  * Retrigger note after volume or pitch has changed. (also read above, for handling note events with value 0)

||#

#||
(for-each (lambda (i)
            (print-events *events*)
            (gc)
            (print-events *events*)
            (gc)
            )
          (iota 100))
(load "import_mod.scm")
(gc)
||#

      
