-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathrepack.el
195 lines (171 loc) · 10.6 KB
/
repack.el
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
;;
;; NuLA JetPack
;; Emacs Lisp repacking functions
;; This is a library for emacs which allows easy reading/writing of binary data etc, see https://github.com/rejeep/f.el
(require 'f)
;; This is a modern list library, see https://github.com/magnars/dash.el
(require 'dash)
(defconst pixelValues '(#b00000000 #b00000001 #b00000100 #b00000101 #b00010000 #b00010001 #b00010100 #b00010101
#b01000000 #b01000001 #b01000100 #b01000101 #b01010000 #b01010001 #b01010100 #b01010101))
(defconst pixelLeft '#b10101010)
(defconst pixelRight '#b01010101)
(defun to-binary-string (i)
"convert an integer into it's binary representation in string format"
(let ((res ""))
(while (not (= i 0))
(setq res (concat (if (= 1 (logand i 1)) "1" "0") res))
(setq i (lsh i -1)))
(if (string= res "")
(setq res "0"))
res))
(defun split-number(arg)
"split a 4 bit number to its 2 values"
(concat (number-to-string (lsh arg -2)) "," (number-to-string (logand arg 3))))
(defun create-basic-nula-palette(filename)
"create a buffer containing codes to set up the NuLA palette from basic"
(interactive "fPalette file:")
(switch-to-buffer (get-buffer-create "*palette*"))
(erase-buffer)
(let* ((file-bytes (string-to-list (f-read-bytes filename))))
(message "length %d" (length file-bytes))
(cl-loop for i from 0 to (1- (length file-bytes)) by 2 do
(insert (format "?&FE23=&%02X : ?&FE23=&%02X\n" (nth i file-bytes) (nth (1+ i) file-bytes))))))
(defun show-alien-colours ()
(interactive)
(switch-to-buffer (get-buffer-create "*aliens*"))
(erase-buffer)
(cl-loop for i from 0 to 15 collect
(insert (replace-regexp-in-string " " "0" (format "%4s" (to-binary-string i))) " (" (split-number i) ") -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-1))) (cdr (decode-pixel (nth i alien-pixdata-1)))) " -> (new) -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-1-new))) (cdr (decode-pixel (nth i alien-pixdata-1-new)))) "\n"))
(insert "\n")
(cl-loop for i from 0 to 15 collect
(insert (replace-regexp-in-string " " "0" (format "%4s" (to-binary-string i))) " (" (split-number i) ") -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-2))) (cdr (decode-pixel (nth i alien-pixdata-2)))) " -> (new) -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-2-new))) (cdr (decode-pixel (nth i alien-pixdata-2-new)))) "\n"))
(insert "\n")
(cl-loop for i from 0 to 15 collect
(insert (replace-regexp-in-string " " "0" (format "%4s" (to-binary-string i))) " (" (split-number i) ") -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-3))) (cdr (decode-pixel (nth i alien-pixdata-3)))) " -> (new) -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-3-new))) (cdr (decode-pixel (nth i alien-pixdata-3-new)))) "\n"))
(insert "\n")
(cl-loop for i from 0 to 15 collect
(insert (replace-regexp-in-string " " "0" (format "%4s" (to-binary-string i))) " (" (split-number i) ") -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-4))) (cdr (decode-pixel (nth i alien-pixdata-4)))) " -> (new) -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-4-new))) (cdr (decode-pixel (nth i alien-pixdata-4-new)))) "\n"))
(insert "\n")
(cl-loop for i from 0 to 15 collect
(insert (replace-regexp-in-string " " "0" (format "%4s" (to-binary-string i))) " (" (split-number i) ") -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-5))) (cdr (decode-pixel (nth i alien-pixdata-5)))) " -> (new) -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-5-new))) (cdr (decode-pixel (nth i alien-pixdata-5-new)))) "\n"))
(insert "\n")
(cl-loop for i from 0 to 15 collect
(insert (replace-regexp-in-string " " "0" (format "%4s" (to-binary-string i))) " (" (split-number i) ") -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-6))) (cdr (decode-pixel (nth i alien-pixdata-6)))) " -> (new) -> "
(format "(%02d . %02d)" (car (decode-pixel (nth i alien-pixdata-6-new))) (cdr (decode-pixel (nth i alien-pixdata-6-new)))) "\n"))
(insert "\n"))
; (set-colour "c:/dev/jetpac-nula/bin/game.pal" 0 70 159 139)
(defun set-colour (filename colour-index red green blue)
"Convert an RGB (0..255) colour to NuLA format and write at `colour-index' in `filename'"
(let* ((file-bytes (string-to-list (f-read-bytes filename)))
(file-offset (* colour-index 2))
(new-red (round (* (/ red 255.0) 16.0)))
(new-green (round (* (/ green 255.0) 16.0)))
(new-blue (round (* (/ blue 255.0) 16.0)))
(byte-one (logior (lsh colour-index 4) new-red))
(byte-two (logior (lsh new-green 4) new-blue)))
(setq file-bytes (-replace-at file-offset byte-one file-bytes))
(setq file-bytes (-replace-at (1+ file-offset) byte-two file-bytes))
(f-write-bytes (apply 'unibyte-string file-bytes) (concat filename ".new"))))
; The alien graphics are stored as 2bpp, so extract their bits
(defun grab (srcPixel pixNum)
(cond ((equal pixNum 'one)
(let ((bitOne (logand srcPixel #b00000001))
(bitTwo (logand srcPixel #b00010000)))
(logior (lsh bitOne 0) (lsh bitTwo -3))))
((equal pixNum 'two)
(let ((bitOne (logand srcPixel #b00000010))
(bitTwo (logand srcPixel #b00100000)))
(logior (lsh bitOne -1) (lsh bitTwo -4))))
((equal pixNum 'three)
(let ((bitOne (logand srcPixel #b00000100))
(bitTwo (logand srcPixel #b01000000)))
(logior (lsh bitOne -2) (lsh bitTwo -5))))
((equal pixNum 'four)
(let ((bitOne (logand srcPixel #b00001000))
(bitTwo (logand srcPixel #b10000000)))
(logior (lsh bitOne -3) (lsh bitTwo -6))))
(t
0)))
(defun decode-pixel (arg)
"Given a number, returns the corresponding pixels for a Mode 2 byte"
(interactive "nByte: ")
(let* ((l (logand arg pixelLeft))
(r (logand arg pixelRight))
(pl (logior (logand (lsh l -1) #b1) (logand (lsh l -2) #b10) (logand (lsh l -3) #b100) (logand (lsh l -4) #b1000)))
(pr (logior (logand r #b1) (logand (lsh r -1) #b10) (logand (lsh r -2) #b100) (logand (lsh r -3) #b1000))))
(cons pl pr)))
(defun encode-pixel (left right)
"Given two pixel colours, returns the corresponding Mode 2 byte"
(logior (lsh (nth left pixelValues) 1) (nth right pixelValues)))
(defun create-alien-colour-lookup(colours)
"Create a new 16 byte colour table"
(cl-loop for i from 0 to 15 collect
(let* ((l (lsh i -2))
(r (logand i 3))
(final (encode-pixel (nth l colours) (nth r colours))))
final)))
(defun reorder (src)
(logior (grab src 'four) (lsh (grab src 'three) 2) (lsh (grab src 'two) 4) (lsh (grab src 'one) 6)))
(defun reverse-graphic (src dst)
"Read in the source graphic `src', reverse the bytes, then write out as `dst'"
(let* ((bytes (string-to-list (f-read-bytes src)))
(new-bytes (reverse bytes)))
(f-write-bytes (apply 'unibyte-string new-bytes) dst)))
(defun fill-graphic (src dst byte)
"Read in the source graphic, but write out `dst' as each byte replaced by `byte'"
(let* ((bytes (string-to-list (f-read-bytes src)))
(new-bytes (make-list (length bytes) byte)))
(f-write-bytes (apply 'unibyte-string new-bytes) dst)))
(defun fill-graphic-with-colours (src dst colour1 colour2)
"Read in the source graphic, but write out `dst' with each byte made up from `colour1' and `colour2'"
(let ((byte (logior (lsh (nth colour1 pixelValues) 1) (nth colour2 pixelValues))))
(fill-graphic src dst byte)))
(defun fill-alien-with-colours (src dst col1 col2 col3 col4)
"Read in the source alien graphic, but write out debug values"
(let ((byte (logior (lsh col1 6) (lsh col2 4) (lsh col3 2) (lsh col4 0))))
(fill-graphic src dst byte)))
(defun remap-alien-colours (src dst)
"Read in the source alien graphic, and remap the pixels"
(let* ((bytes (string-to-list (f-read-bytes src)))
(new-bytes nil)
(act-bytes nil))
(cl-loop for i in bytes do
(push (reorder i) new-bytes))
(setq new-bytes (reverse new-bytes))
(cl-loop for i downfrom (- 64 4) to 0 by 4 do
(setq act-bytes (nconc act-bytes (cl-subseq new-bytes i (+ i 4)))))
(f-write-bytes (apply 'unibyte-string act-bytes) dst)))
(defun create-new-alien-colour-tables(file)
"Create new alien colour tables"
(f-write-bytes (apply 'unibyte-string (append alien-pixdata-1-new
alien-pixdata-2-new
alien-pixdata-3-new
alien-pixdata-4-new
alien-pixdata-5-new
alien-pixdata-6-new))
file))
; Alien pixel data stored at 0xB20 in BBC memory, at 0x420 in "jet-pac" file
(defconst alien-pixdata-1 '(#x00 #x40 #x11 #x41 #x80 #xC0 #x91 #xC1 #x22 #x62 #x33 #x63 #x82 #xC2 #x93 #xc3))
(defconst alien-pixdata-2 '(#x00 #x15 #x40 #x05 #x3a #x3f #x6a #x2f #x80 #x95 #xc0 #x85 #x0a #x1f #x4a #x0f)) ; is 4th entry wrong? -> 3a should be 2a?
(defconst alien-pixdata-3 '(#x00 #x44 #x05 #x41 #x88 #xcc #x8d #xc9 #x0a #x4e #x0f #x4b #x82 #xc6 #x87 #xc3))
(defconst alien-pixdata-4 '(#x00 #x11 #x41 #x45 #x22 #x33 #x63 #x67 #x82 #x93 #xc3 #xc7 #x8a #x9b #xcb #xcf))
(defconst alien-pixdata-5 '(#x00 #x04 #x41 #x15 #x08 #x0c #x49 #x1d #x82 #x86 #xc3 #x97 #x2a #x2e #x6b #x3f))
(defconst alien-pixdata-6 '(#x00 #x15 #x45 #x41 #x2a #x3f #x6f #x6b #x8a #x9f #xcf #xcb #x82 #x97 #xc7 #xc3))
; New alien pixel data to overwrite the existing one so Chris can have colour 1 constant
(defconst alien-pixdata-1-new (create-alien-colour-lookup '(0 6 8 9)))
(defconst alien-pixdata-2-new (create-alien-colour-lookup '(0 6 10 11)))
(defconst alien-pixdata-3-new (create-alien-colour-lookup '(0 6 8 10)))
(defconst alien-pixdata-4-new (create-alien-colour-lookup '(0 6 9 10)))
(defconst alien-pixdata-5-new (create-alien-colour-lookup '(0 6 8 11)))
(defconst alien-pixdata-6-new (create-alien-colour-lookup '(0 6 9 11)))