/
extract.lisp
56 lines (46 loc) · 1.98 KB
/
extract.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
;; Extract and decode the PNG pixel data from the calculator
;; screenshots.
;; Zoom size: 200%
(ql:quickload :pngload)
(defpackage "DECODE-PNG"
(:use "CL" "PNGLOAD")
(:export "PNG-TO-BYTES"
"SAVE-BYTES"))
(in-package "DECODE-PNG")
(defun subrect (bitmap x y width height subsample bit-transform)
(let* ((sh (truncate height subsample))
(sw (truncate width subsample))
(subrect (make-array (list sh sw) :element-type 'bit)))
(loop :for j :below sh
:do (loop :for i :below sw
:do (setf (aref subrect j i)
(funcall bit-transform
(aref bitmap
(+ y (* j subsample))
(+ x (* i subsample))
0)))))
subrect))
(defun decode-bytes (bitmap)
(loop
:with s := (make-array (/ (reduce (function *) (array-dimensions bitmap)) 8)
:element-type '(unsigned-byte 8))
:with r := -1
:for j :below (array-dimension bitmap 0)
:do (loop :for i :below (array-dimension bitmap 1) :by 8
:do (loop :for k :below 8
:for b := (aref bitmap j i)
:then (logior (ash b 1) (aref bitmap j (+ i k)))
:finally (setf (aref s (incf r)) b)))
:finally (return s)))
(defun png-to-bytes (pathname)
(let ((png (load-file pathname))
(offset 2)
(bit-size 4))
(bit-depth png)
(let* ((data (data png))
(h (array-dimension data 0))
(w (array-dimension data 1)))
(decode-bytes (subrect data offset offset (- w (* 2 offset)) (- h (* 2 offset)) bit-size (lambda (bit) (if (> bit 0) 0 1)))))))
(defun save-bytes (bytes pathname)
(with-open-file (out pathname :direction :output :if-does-not-exist :create :if-exists :supersede :element-type '(unsigned-byte 8))
(write-sequence bytes out)))