; NeoPixel Assembler Program v1 - 29th May 2025
; see http://www.ulisp.com/show?58QB

(defun pulse (ns)
  (let ((n (round ns *delay*)))
    (list
     ($mov 'r5 n)
     ($sub 'r5 1)
     ($bne (- *pc* 2)))))

(defcode neopixel (pin lst)
  ($push '(lr r5 r4))
  ($ldr 'r4 port)
  ($mov 'r3 1)
  ($lsl 'r3 'r0)
  repeat
  ($cmp 'r1 0)
  ($beq finished)
  ($ldr 'r0 '(r1 0))
  ($ldr 'r0 '(r0 4))
  ($mov 'r2 1)
  ($lsl 'r2 23)
  nextbit
  ($tst 'r0 'r2)
  ($bne one)
  zero
  ($cpsid 3)
  ($str 'r3 '(r4 *outset*))
  (pulse 350)            
  ($str 'r3 '(r4 *outclr*))
  (pulse 800)
  ($cpsie 3)
  ($b next)
  one
  ($str 'r3 '(r4 *outset*))
  (pulse 700)
  ($str 'r3 '(r4 *outclr*))
  (pulse 600)
  next
  ($lsr 'r2 1)
  ($bne nextbit)
  ($ldr 'r1 '(r1 4))
  ($b repeat)
  finished
  ($pop '(r4 r5 pc))
  port
  ($word *port-address*))