Palette Data Searcher

palette-search.lisp

(ql:quickload 'famiclom)

(in-package :famiclom)

(defparameter *candidates* nil)

(defun init ()
  (load-rom "/Users/brit/quicklisp/local-projects/famiclom/roms/smb.nes"))

(defun get-prg ()
  (romreader:rom-prg (mapper-rom (nes-mapper *nes*))))

(defun rom-size ()
  (getf (romreader:rom-metadata (mapper-rom (nes-mapper *nes*))) :prg-size))

(declaim (inline palettep))
(defun palettep (x)
  (<= 0 x #x3f))

(defun print-candidate (bytes)
  (format t "Candidate palette: ~{~2,'0X ~}~%" (coerce bytes 'list)))

(defun encode (list)
  "A run-length encoder stolen from Pascal Bourguignon (informatigo)."
  (when list
    (loop
       :with count = 0
       :with last-item = nil
       :with result = '()
       :for item :in list
       :do (cond
             ((zerop count)
              (setf count 1
                    last-item item))
             ((eql item last-item) (incf count))
             (t                    (push (list count last-item) result)
                                   (setf count 1
                                         last-item item)))
       :finally (when (plusp count)
                  (push (list count last-item) result))
       (return (nreverse result)))))

(defun searcher (prg length)
  (loop for i = 0 then (+ i 32)
     for bytes = (subseq prg i (+ i 32))
     when (and (every #'palettep bytes)
               (every (lambda (x) (< (first x) 4))
                      (encode (coerce bytes 'list))))
     collect (list i bytes) into candidates
     until (>= i (- length 32))
     finally (return candidates)))

;; (position-if-not #'palettep (get-prg) :start 3263)
;; (position-if-not #'palettep (get-prg) :end 3264 :from-end t)

;; 1. Find candidates
;; 2. Search backwards and forward to find the bounds.
;;    i.e. Things too big to be palette data.
;; 3. Present each candidate to a user and ask them to
;;    select a block of 32 colors as the "palette".