screenshotbot-cli/android.lisp at master · moderninterpreters/screenshotbot-cli · GitHub

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
(in-package :screenshotbot-sdk)

(define-flag *metadata*
  :selector "metadata"
  :default-value nil
  :type (or null string)
  :help "A metadata.xml file (Android only)")

(defun child-by-name (item name)
  (loop for child across (dom:child-nodes item)
        if (string= name (dom:node-name child))
          return child))

(Defun node-value (item)
  (dom:node-value (elt (dom:child-nodes item) 0)))

(defun node-integer-value (item)
  (declare (optimize (speed 0) (debug 3)))
  (parse-integer (node-value item)))

(defclass image-bundle () ())

(defclass directory-image-bundle (image-bundle)
  ((directory :initarg :directory)))

(defclass zip-image-bundle (image-bundle)
  ((zip :initarg :zip)
   (zipfile)))

(defmethod initialize-instance :after ((inst zip-image-bundle) &key zip &allow-other-keys)
  (with-slots (zipfile) inst
    (setf zipfile (zip:open-zipfile zip))
    (let ((zipfile zipfile))
      (trivial-garbage:finalize inst
                                (lambda ()
                                  (zip:close-zipfile zipfile))))))


(defmethod read-image ((bundle directory-image-bundle) name)
  (with-slots (directory) bundle
   (imago:read-image
    (path:catfile directory
                  (format nil "~a.png" name)))))

(defmethod read-image ((bundle zip-image-bundle) name)
  (with-slots (zipfile) bundle
    (uiop:with-temporary-file (:pathname p :stream s :direction :output :type "png"
                               :element-type 'flexi-streams:octet)
     (let ((entry (zip:get-zipfile-entry (format nil "~a.png" name) zipfile)))
       (zip:zipfile-entry-contents entry s)
       (finish-output s)
       (with-slots (directory) bundle
         (imago:read-image p))))))

(defun merge-tiles (tiles)
  (destructuring-bind (w h)
      (array-dimensions tiles)
    (let ((full-width (loop for i from 0 below w
                             summing (imago:image-width (aref tiles i 0)
)))
          (full-height (loop for i from 0 below h
                            summing (imago:image-height (aref tiles 0 i))))
          (single-tile-width (imago:image-width (aref tiles 0 0)))
          (single-tile-height (imago:image-height (aref tiles 0 0))))

      (let ((dest (make-instance 'imago:rgb-image
                                 :width full-width
                                 :height full-height)))
        (let ((x 0))
          (dotimes (ww w)
            (let ((y 0))
              (dotimes (hh h)
                (log:trace "Writing tile: (~d,~d) to (~d, ~d) "
                          ww hh
                          x y)
                (let ((src (aref tiles ww hh)))
                  (imago:copy dest src
                              :height (imago:image-height src)
                              :width (imago:image-width src)
                              :dest-y y
                              :dest-x x))
                (incf y single-tile-height)))
            (incf x single-tile-width)))
        dest))))

(defmethod read-screenshot-tiles (screenshot (bundle image-bundle))
  (declare (optimize (speed 0) (debug 3)))
  (let* ((name (node-value (child-by-name screenshot "name")))
         (tile-height (node-integer-value (child-by-name screenshot "tile_height")))
         (tile-width (node-integer-value (child-by-name screenshot "tile_width"))))
    (let ((arr (make-array (list tile-width tile-height))))
      (dotimes (w tile-width)
        (dotimes (h tile-height)
          (let ((name (cond
                        ((and (eql 0 h) (eql 0 w))
                         name)
                        (t
                         (format nil "~a_~d_~d" name w h)))))
            (setf (aref arr w h) (read-image bundle name)))))
      (cons name (merge-tiles arr)))))

(defun read-android-metadata (metadata-file image-bundle)
  (let ((xml (cxml:parse-file metadata-file (cxml-dom:make-dom-builder))))
    (loop for screenshot across (dom:child-nodes (dom:document-element xml))
          collect (read-screenshot-tiles screenshot image-bundle))))

(defun make-image-bundle (output)
  (cond
    ((path:-d output)
     (make-instance 'directory-image-bundle :directory output))
    ((path:-e output)
     (make-instance 'zip-image-bundle :zip output))
    (t
     (error "Does not exist: ~a" output))))

(defun make-regular-dir (metadata-file output &key image-bundle)
  (let ((image-bundle (or image-bundle
                          (make-instance 'directory-image-bundle
                                         :directory (path:dirname metadata-file)))))
   (let ((files (read-android-metadata metadata-file image-bundle)))
     (loop for (name . im) in files do
       (imago:write-png im (make-pathname :defaults output
                                          :name name
                                          :type "png"))))))

#+nil
(make-regular-dir (path:catfile (asdf:system-source-directory :screenshotbot.sdk)
                                "example/metadata.xml")
                  #P "/tmp/foog/")


(defun android-run-p ()
  *metadata*)

(defun prepare-android-directory (fn)
  (log:info "Pre-processing image in bundle")
  (tmpdir:with-tmpdir (dir)
    (make-regular-dir *metadata*
                      dir
                      :image-bundle (make-image-bundle *directory*))
    (funcall fn dir)))