anchor.diff:      (eor (imm #b10010000))            ; Invert pattern bank.
       (sta (mem +ppu-cr1+))
   
  -    ;; In theory, the music player will run here.
  -    (emit-delay (round (* 113.66 14)))
  +    ;; Run the music
  +    (jsr 'player-step)
  +
  +    ;; Leftover scanlines before wave effect starts
  +    (emit-delay (round (+ (* 113.66 9) 110)))
   
       ;; Wavy effect
       (flet ((kernel ()
  -             (poke #b11111110 +ppu-cr2+)
  +             ;; Assumes Y counts down each line..
  +             (poke #b00011110 +ppu-cr2+) ; To visually calibrate timing.
                (clc)
                (lda wt-get)               ; Get wave offset
                (adc scroll-x)             ; Add to BG scroll position
  +             (ldx (imm 0))
                (sta (mem +vram-scroll+))
  -             (lda (imm 0))
  -             (sta (mem +vram-scroll+))
  +             (stx (mem +vram-scroll+))
                (lda ntaddr)               ; Carry in. Effectively, scroll-x and
                (adc (imm 0))              ; ntaddr.0 form a 9-bit field.
                (sta (mem +ppu-cr1+))
  
positive.code: ;;;; banks mid-frame.  It also incorporates an NSF file to provide
  ;;;; some crude music.
  
  ;;;; I'm no demo coder. Expect no 6502 wizardry here.
  
  ;;;; It targets a basic NROM board (32KB program, 8KB character). I
  ;;;; haven't had a chance to test on real hardware yet.
  
  ;;;; Somewhat embarrassingly, this demo reveals a bug in my own NES
  ;;;; emulator which I've yet to fix, where the frame timing is
  ;;;; apparently off by one scanline. Oops.
  
  (defpackage :dollhouse-demo
    (:use :common-lisp :6502 :6502-modes :asm6502 :asm6502-utility :asm6502-nes))
  
negative.code: (in-package :dollhouse-demo)
  
  (defvar *path* #.*compile-file-pathname*)
  
  ;;;; --- Music language ---
  
  (defun register (address value) (list value address))
  (defun nop-write ()  (register #x0D 0)) ; Dummy write to unused register.
  
  (defun pad-list (list padding desired-length)
    (assert (<= (length list) desired-length))
    (append list (loop repeat (- desired-length (length list)) collect padding)))
  
  (defun pad-frame (frame)
    (pad-list frame (nop-write) 16))
  
  (defun segment (length list)
    (if (< (length list) length)
        (pad-list list nil length)
        (subseq list 0 length)))
  
  (defun translate-freq (seqlen lbits freq)
    (let ((fbits (round (/ +ntsc-clock-rate+ seqlen freq))))
     (values (ldb (byte 8 0) fbits)
             (logior (ldb (byte 3 8) fbits)
                     (ash lbits 3)))))
  
  (defun noteon (chan lbits freq)
    (multiple-value-bind (base seqlen)
        (ecase chan
          (0 (values 0 8))
          (1 (values 4 8))
          (2 (values 8 32)))
      (multiple-value-bind (v2 v3) (translate-freq seqlen lbits freq)
        (list
         (register (+ 2 base) v2)
         (register (+ 3 base) v3)))))
  
  (defun translate-length (length)
    "Find closest match to load the length counter."
    (first
     (first
      (sort
       (copy-list
        '((0 #x0A)  (1 #xFE)
          (2 #x14)  (3 #x02)
          (4 #x28)  (5 #x04)
          (6 #x50)  (7 #x06)
          (8 #xA0)  (9 #x08)
          (10 #x3C) (11 #x0A)
          (12 #x0E) (13 #x0C)
          (14 #x1A) (15 #x0E)
          (16 #x0C) (17 #x10)
          (18 #x18) (19 #x12)
          (20 #x30) (21 #x14)
          (22 #x60) (23 #x16)
          (24 #xC0) (25 #x18)
          (26 #x48) (27 #x1A)
          (28 #x10) (29 #x1C)
          (30 #x20) (31 #x1E)))
       #'<
       :key (lambda (p) (abs (- (second p) length)))))))
  
  (defun cfg (channel &key (duty 2) (vol 15) (env t) (loop nil))
    (list
     (list (register (* channel 4)
                     (logior (ash duty 6)
                             (if env 0 #x10)
                             (if loop #x20 0)
                             vol)))))
  
  (defun note (channel length freq &key (d length) cfg)
    (check-type channel (integer 0 1))
    (segment length
             (para
              (and cfg (apply 'cfg channel cfg))
              (list
               (noteon channel (translate-length d) freq)))))
  
  (defun silence-channel (channel)
    (ecase channel
      (0 (note 0 1 1 :d 0 :cfg '(:vol 0 :loop t :env nil)))
      (1 (note 1 1 1 :d 0 :cfg '(:vol 0 :loop t :env nil)))))
  
  (defun tri (length freq &key (d length))
    (check-type d (integer 0 31))
    (segment length
             (list
              (list* (register #x8 (* d 4))
                     (noteon 2 1 freq)))))
  
  (defun noise (length duration period &key short loop (env t) (vol 15))
    (check-type duration (integer 0 31))
    (check-type vol (integer 0 15))
    (check-type period (integer 0 15))
    (segment length
      (list
       (list
        (register #xC (logior (if loop #x20 0)
                              (if env 0 #x10)
                              vol))
        (register #xE (logior (if short #x80 0)
                              period))
        (register #xF (ash (translate-length duration) 3))))))
  
  (defun para (&rest args)
    (apply #'mapcar #'append (mapcar (lambda (x) (pad-list x nil (reduce #'max args :key #'length))) args)))
  
  (defun measure (&rest args)
    (segment 128 (apply 'para args)))
  
  ;;; These look familiar:
  (defun seq (&rest args)
    (apply #'concatenate 'list args))
  
  (defun repeat (n &rest args)
    (apply #'seq (mapcan #'copy-list (loop repeat n collect args))))
  
  (defun rst (length) (segment length nil))
  
  (defun et (&rest args)
    (* 276.0 (expt 2 (/ (apply '+ args) 12))))
  
  (defun kick (length)
    (noise length 8 15 :vol 1))
  
  (defun snare (length &optional (variation 0))
    (noise length 8 (+ 10 variation) :vol 1))
  
  (defun hat (length &optional (variation 0))
    (noise length 4 (+ variation 1) :vol 1))
  
  (defun thump (length &optional (pitch (et -24)))
    (segment
     length
     (seq (tri 1 (* pitch 1))
          (tri 1 (* pitch 4/3))
          (tri 1 (* pitch 2/3))
          (tri 1 (* pitch 1/2)))))
  
  (defun shaker (length volume)
    (assert (>= length 2))
    (segment
     length
     (seq
      (noise 1 1 1 :env nil :loop t :vol volume)
      (noise 1 1 1 :env nil :vol 0))))
  
  (defun eltmod (i seq) (elt seq (mod i (length seq))))
  (defun clamp (x min max) (max (min x max) min))
  
  (defun volramp (&optional (start 15) (rate -1/10))
    (lambda (time)
     (clamp (round (+ start (* time rate)))
            0
            15)))
  
  (defun shimmer (&optional (time-shift -4) (phase-offset 0))
    (lambda (time) (mod (+ phase-offset (ash time time-shift)) 4)))
  
  (defun arpeggio (channel length chord &key
                   (rate 3)
                   (d rate)
                   (env nil)
                   (loop t)
                   (mute nil)
                   (volume (volramp))
                   (duty (shimmer)))
    (segment length
             (para
              (loop for time below length by rate
                    for index upfrom 0
                    append (note channel rate (eltmod index chord)
                                 :d d
                                 :cfg (list :duty (funcall duty time)
                                            :vol (funcall volume time)
                                            :env env
                                            :loop loop)))
              (seq
               (rst (1- length))
               (and mute (silence-channel channel))))))
  
  (defun fat-arp (length chord &rest args)
    (para
     (apply #'arpeggio 0 length (apply #'chord (- (first chord) 0.06) (rest chord))
            :duty (shimmer -2) args)
     (apply #'arpeggio 1 length (apply #'chord (+ (first chord) 0.06) (rest chord))
            :duty (shimmer -2 2) args)))
  
  (defun funky-arp (&rest args)
    (fat-arp (* 8 (length args)) (list* 0.0 args)
             :d 15 :rate 8 :env t :loop nil :volume (constantly 1) :mute t))
  
  (defun chord (root &rest notes)
    (mapcar (lambda (note) (et root note)) notes))
  
  
  
  ;;;; *******************************************************************
  ;;;;  ( You are now about to witness the power of street knowledge. ;)
  
  (let* ((global (make-instance 'basic-context :address #x8000))
         (*context* global)
         (num-wavy-lines (* 3 26))        ; Must be multiple of 3 !
         (log2-wavy-period 5)
  
         ;; Music player:
         (mfr-addr #x40)
         (mfr-get (indi mfr-addr))
         (mptr #x42)
         (mptr-msb  (zp (1+ mptr)))
         (mptr-lsb  (zp mptr))
         (log2-song-length 4)             ; Base 2 log of song length.
         (write-patterns (make-hash-table :test 'equal))
         (music-sequence '())
  
         ;; Variables (graphics):
         (sprite-table #x0300)
         (table-x      #x0200)
         (table-y      #x0240)
  