Bit Tetris, http://nabetani.sakura.ne.jp/hena/ord2/

2012-07-25-bit-tetris.lisp

;;;; Last modified: 2013-11-25 19:53:40 tkych


;;====================================================================
;; Bit Tetris
;;====================================================================
;; - [Bit Tetris 〜 横へな 2012.7.25](http://nabetani.sakura.ne.jp/hena/ord2/)


;;--------------------------------------------------------------------

(in-package :cl-user)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :split-sequence))
(defpackage :bit-tetris (:use :cl))
(in-package :bit-tetris)


;;--------------------------------------------------------------------
;; Main
;;--------------------------------------------------------------------

;; (setf *print-base* 2) ; for DEV
;; (parse-input "ff-2f-23-f3-77-7f-3b")
;; => (11111111 101111 100011 11110011 1110111 1111111 111011)
(defun parse-input (input)
  (mapcar (lambda (hex) (parse-integer hex :radix 16))
          (split-sequence:split-sequence #\- input)))

(defun remove-nth-bit (i bits)
  (logior (ash (mask-field (byte 8 (1+ i)) bits) -1)
          (mask-field (byte i 0) bits)))

;; (let ((bits #b01101011))
;;   (format t "~&76543210")
;;   (format t "~&~8,'0B" bits)
;;   (format t "~&--------")
;;   (loop :for i :from 7 :downto 0
;;         :do (format t "~&~8,'0B" (remove-nth-bit i bits))))

(defun remove-nth-line (i bits-list)
  (mapcar (lambda (bits) (remove-nth-bit i bits))
          bits-list))

(defun main (input)
  (let* ((bits-list (parse-input input))
         (lines-to-be-removed (apply #'logand bits-list)))
    (loop :for i :from 7 :downto 0
          :when (logbitp i lines-to-be-removed)
            :do (setf bits-list (remove-nth-line i bits-list)))
    (format nil "~(~{~2,'0X~^-~}~)" bits-list)))


;;--------------------------------------------------------------------
;; Tests
;;--------------------------------------------------------------------

(defun =>? (got want)
  (assert (string= got want)))

(progn
  (=>? (main "ff-2f-23-f3-77-7f-3b") "1f-03-00-1c-0d-0f-06")
  (=>? (main "01") "00")
  (=>? (main "00") "00")
  (=>? (main "7a-4e") "0c-02")
  (=>? (main "56-b6") "08-14")
  (=>? (main "12-12-12") "00-00-00")
  (=>? (main "de-ff-7b") "0a-0f-05")
  (=>? (main "95-be-d0") "05-1e-20")
  (=>? (main "7c-b0-bb") "1c-20-2b")
  (=>? (main "7a-b6-31-6a") "3a-56-11-2a")
  (=>? (main "32-0e-23-82") "18-06-11-40")
  (=>? (main "ff-7f-bf-df-ef") "0f-07-0b-0d-0e")
  (=>? (main "75-df-dc-6e-42") "35-5f-5c-2e-02")
  (=>? (main "62-51-ef-c7-f8") "22-11-6f-47-78")
  (=>? (main "0c-47-8e-dd-5d-17") "04-23-46-6d-2d-0b")
  (=>? (main "aa-58-5b-6d-9f-1f") "52-28-2b-35-4f-0f")
  (=>? (main "ff-55-d5-75-5d-57") "0f-00-08-04-02-01")
  (=>? (main "fe-fd-fb-f7-ef-df-bf") "7e-7d-7b-77-6f-5f-3f")
  (=>? (main "fd-fb-f7-ef-df-bf-7f") "7e-7d-7b-77-6f-5f-3f")
  (=>? (main "d9-15-b5-d7-1b-9f-de") "69-05-55-67-0b-4f-6e")
  (=>? (main "38-15-fd-50-10-96-ba") "18-05-7d-20-00-46-5a")
  (=>? (main "fe-fd-fb-f7-ef-df-bf-7f") "fe-fd-fb-f7-ef-df-bf-7f")
  )


;;====================================================================