-
Notifications
You must be signed in to change notification settings - Fork 0
/
hardwareSprites.r
299 lines (286 loc) · 12.3 KB
/
hardwareSprites.r
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
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
## Desired Y position + vertical-offset of the display window = 25 + 44 = 69
## Desired X position + horizontal-offset of display window ~= 94 + 64 = 158
.validity.HWSprite <- function(object)
{
if (length(object@VStart) != 1) stop("VStart should have a length of 1")
if (length(object@HStart) != 1) stop("HStart should have a length of 1")
if (length(object@VStop) != 1) stop("VStop should have a length of 1")
if (length(object@control.bits) != 8) stop("control.bits should have a length of 8")
if (length(object@end.of.data) != 4) stop("end.of.data should have a length of 4")
if (length(object@colours) != 3) stop("colours should have a length of 3")
if (object@VStop < object@VStart) stop("VStop should be equal to or greater than VStart.")
if (object@HStart < 0) stop("HStart can't be negative")
if (object@VStart < 0) stop("VStart can't be negative")
if (object@VStop < 0) stop("VStop can't be negative")
if (!all(.is.colour(object@colours))) stop("colours should represent colours")
if (!all(object@end.of.data == raw(4))) warning("Extended sprites are currently not supported")
if (length(object@bitmap) != (object@VStop - object@VStart)*4) stop("bitmap should have a length of (VStop-VStart)*4")
return(T)
}
#' The hardwareSprite class
#'
#' An S4 class object that represent graphical objects known as
#' hardware sprites on the Commodore Amiga.
#'
#' Amiga hardware supported sprites, which are graphical objects that
#' could be moved around the display and independently from each other.
#' Basic sprites were 16 pixels wide and any number of pixels high and
#' were composed of four colours, of which one is transparent.
#'
#' More complex sprites could be formed by linking separate sprites
#' together. That way, sprites could become wider, or be composed of
#' more colours. Such extended sprites are currently not supported
#' by this package.
#'
#' A well known example of hardware sprite on the Commodore Amiga is
#' the mouse pointer.
#'
#' This object simply holds the basic information belonging to
#' hardware sprite. Use [as.raster()] to convert it to
#' a raster which is a more useful graphical element in R.
#'
#' @slot VStart The vertical starting position of a sprite.
#' @slot HStart The horizontal starting position of a sprite.
#' @slot VStop The vertical stopping position of a sprite. The
#' height of a sprite should be given by `VStart` - `VStop`.
#' @slot control.bits 8 `logical` values used for extending
#' sprites. The values are stored in this objects but extending
#' sprites is not (yet) supported.
#' @slot bitmap Interleaved bitmap data containing information on
#' the pixel colour numbers of the sprite.
#' @slot colours A vector of the 3 colours used for the sprite.
#' @slot end.of.data Sprite data can be followed by another sprite. It is terminated
#' with two WORDS equalling zero (`raw(4)`). Repeated sprite data is currently not
#' supported.
#' @references <http://amigadev.elowar.com/read/ADCD_2.1/Hardware_Manual_guide/node00AE.html>
#' @name hardwareSprite-class
#' @rdname hardwareSprite-class
#' @aliases hardwareSprite
#' @examples
#' ## This generates a sprite of a single line (16x1 pixels) with an empty bitmap:
#' new("hardwareSprite")
#'
#' ## This generates a sprite of a single line (16x1 pixels) where
#' ## the bitmap contains some coloured pixels:
#' new("hardwareSprite", bitmap = as.raw(c(0x01,0x02,0x03,0x04)))
#'
#' ## This generates a sprite of 16x16 pixels:
#' new("hardwareSprite",
#' VStop = 16,
#' bitmap = as.raw(sample.int(255, 64, replace = TRUE)))
#' @exportClass hardwareSprite
#' @author Pepijn de Vries
setClass("hardwareSprite",
representation(VStart = "numeric",
HStart = "numeric",
VStop = "numeric",
control.bits = "logical",
bitmap = "raw",
end.of.data = "raw",
colours = "character"),
prototype(VStart = 0,
HStart = 0,
VStop = 1,
control.bits = rep(F, 8),
bitmap = raw(4),
end.of.data = raw(4),
colours = c("#000000", "#888888", "#FFFFFF")),
validity = .validity.HWSprite)
setGeneric("rawToHWSprite", function(x, col) standardGeneric("rawToHWSprite"))
#' Convert raw data into an Amiga hardware sprite
#'
#' Convert `raw` data structured conform a Commodore Amiga hardware
#' sprite (see references) into a [hardwareSprite()] object.
#'
#' Information to set up a hardware sprite is stored as `raw` data
#' on Commodore Amigas. This method can be used to convert this data
#' into a [hardwareSprite()] object. This object can in turn
#' be converted with [as.raster()] such that it can be plotted in R.
#'
#' @docType methods
#' @rdname rawToHWSprite
#' @name rawToHWSprite
#' @aliases rawToHWSprite,raw,missing-method
#' @param x `raw` data structured as an Amiga hardware sprite
#' (see references).
#' @param col A `vector` of colours (`character`) to be used
#' for the hardware sprite. Specify the three visible colours for the
#' sprite. When missing some default colours (grayscale) will be used.
#' The colours have to be provided separately as they are usually not stored
#' together with the hardware sprite data.
#' @returns Returns a [hardwareSprite()] object based on the provided raw data
#' @references <http://amigadev.elowar.com/read/ADCD_2.1/Hardware_Manual_guide/node00B9.html>
#' @examples
#' ## Let's generate a 16x16 sprite with a random bitmap:
#' dat <- as.raw(c(0x00, 0x00, 0x10, 0x00,
#' sample.int(255, 64, replace = TRUE),
#' 0x00, 0x00, 0x00, 0x00))
#' ## make it a hardware sprite object:
#' spr <- rawToHWSprite(dat)
#' ## and plot it:
#' plot(spr, interpolate = FALSE)
#'
#' ## with some imagination when can make
#' ## a more structured image:
#' dat <- as.raw(c(0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0xff, 0xf8,
#' 0x7f, 0x80, 0x80, 0x70, 0x7f, 0x00, 0xbe, 0xe0,
#' 0x7e, 0x00, 0x85, 0xc0, 0x7d, 0x80, 0x82, 0x40,
#' 0x6b, 0xc0, 0x95, 0xa0, 0x57, 0xe0, 0xa8, 0xd0,
#' 0x2f, 0xf0, 0xd1, 0x68, 0x4f, 0xf8, 0xb0, 0x34,
#' 0x07, 0xfc, 0xf8, 0x5a, 0x03, 0xfe, 0xe4, 0x0d,
#' 0x01, 0xfc, 0xc2, 0x12, 0x00, 0xf8, 0x81, 0x04,
#' 0x00, 0x70, 0x00, 0x88, 0x00, 0x20, 0x00, 0x50,
#' 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00))
#' spr <- rawToHWSprite(dat, c("#EE4444", "#000000", "#EEEECC"))
#' plot(spr, interpolate = FALSE)
#' @family raw.operations
#' @family HWSprite.operations
#' @author Pepijn de Vries
#' @export
setMethod("rawToHWSprite", c("raw", "missing"), function(x, col) {
result <- methods::new("hardwareSprite")
result@HStart <- .rawToAmigaInt(x[1], 8, F)
result@VStart <- .rawToAmigaInt(x[2], 8, F)
result@VStop <- .rawToAmigaInt(x[3], 8, F)
if (result@VStop == 0) result@VStop <- 16 ## This appears to be the case for the mouse pointer. Check if this is always the case
result@control.bits <- as.logical(.rawToBitmap(x[4], invert.longs = F))
vlen <- result@VStop - result@VStart
result@bitmap <- x[4 + 1:(vlen*4)]
offset <- vlen*4 + 4
eod <- x[offset + 1:4]
result@end.of.data <- eod
while (!all(eod == raw(4))) {
result@end.of.data <- c(result@end.of.data, eod)
offset <- offset + 4
eod <- x[offset + 1:4]
}
return(result)
})
#' @rdname rawToHWSprite
#' @aliases rawToHWSprite,raw,character-method
#' @export
setMethod("rawToHWSprite", c("raw", "character"), function(x, col) {
result <- rawToHWSprite(x)
result@colours <- col
return(result)
})
#' @rdname as.raster
#' @name as.raster
#' @aliases as.raster,hardwareSprite-method
#' @export
as.raster.hardwareSprite <- function(x, background = "#AAAAAA", ...) {
## Make sure that background is a valid color
background <- grDevices::adjustcolor(background)
cols <- c(background, x@colours)
return(bitmapToRaster(x@bitmap, 16, length(x@bitmap)*8/(2*16), 2, cols)) # assume 2 bitplanes
}
#' @rdname plot
#' @name plot
#' @export
plot.hardwareSprite <- function(x, y, ...) {
graphics::plot(as.raster(x), ...)
}
#' @rdname as.raw
#' @name as.raw
#' @aliases as.raw,hardwareSprite-method
#' @export
setMethod("as.raw", "hardwareSprite", function(x) {
result <- c(
.amigaIntToRaw(c(x@HStart, x@VStart, x@VStop), 8, F),
.bitmapToRaw(x@control.bits, invert.longs = F, invert.bytes = F),
x@bitmap,
x@end.of.data
)
return(result)
})
#' @export
print.hardwareSprite <- function(x, ...) {
cat(sprintf("A %i row high hardware sprite sprite", x@VStop - x@VStart))
}
setMethod("show", "hardwareSprite", function(object){
print(object)
})
#' Convert a raster object into an hardwareSprite object
#'
#' Convert a grDevices raster object into an Amiga hardwareSprite class object.
#'
#' A [grDevices()] raster image can be converted into a
#' [hardwareSprite()] class object with this function. For this purpose
#' the any true-colour image will be converted to an indexed palette with 4 colours.
#' The Amiga hardware sprite will reserve one of the colours as transparent. Thos function
#' will use fully transparent colours in the original image (i.e., the alpha level equals 0)
#' for this purpose. Or when the image has no fully transparent colours, it will use the
#' most frequently occuring colour (at least when the default `indexing` function
#' is used).
#'
#' @rdname rasterToHWSprite
#' @name rasterToHWSprite
#' @param x A [grDevices()] raster object ([grDevices::as.raster()])
#' that needs to be converted into a [hardwareSprite()] class object.
#' Note that a [hardwareSprite()] has a maximum width of 16 pixels.
#' When `x` is wider, it will be cropped.
#' @param indexing A function that accepts two arguments: `x` (a grDevices
#' `raster` object); `length.out`, a numeric value indicating the
#' desired size of the palette (i.e., the number of colours). It should return
#' a matrix with numeric palette indices (ranging from 1 up to the number of
#' colours in the palette). The result should have an attribute named `palette' that
#' contains the colours that correspond with the index numbers. The result should
#' also carry an attribute with the name `transparent', with a single numeric value
#' representing which colour in the palette should be treated as transparent (or
#' `NA` when no transparency is required). By default the
#' function [index.colours()] is used.
#' @returns Returns a [hardwareSprite()] class object based on `x`
#' @examples
#' \dontrun{
#' ## first create a raster object that can be used as input
#' ## (making sure that the background is transparent):
#' rst <- as.raster(simpleSysConfig()$PointerMatrix, "#AAAAAA00")
#'
#' ## now turn it into a hardware sprite:
#' spr <- rasterToHWSprite(rst)
#'
#' ## and plot it as a check:
#' plot(spr)
#' }
#' @family raster.operations
#' @family HWSprite.operations
#' @author Pepijn de Vries
#' @export
rasterToHWSprite <- function(x, indexing = index.colours) {
if (!inherits(x, "raster")) stop ("x should be of class raster")
if (!inherits(indexing, "function")) stop("'indexing' should be a function")
if (!all(c("x", "length.out") %in% names(formals(indexing)))) stop("Function 'indexing' should require arguments 'x' and 'length.out'.")
if (dim(x)[2] > 16) {
warning("Raster is more then 16 pixels wide. It will be cropped.")
x <- x[,1:16]
}
pal <- NULL
bm <- rasterToBitmap(x, 2, indexing = function(x, length.out) {
result <- indexing(x, length.out)
pal <<- attributes(result)[["palette"]]
trans <- attributes(result)[["transparent"]]
## make sure that the transparent colour is the first colour in the palette:
if (!is.na(trans) && trans != 1) {
result[result == 1] <- -1
result[result == trans] <- 1
result[result == -1] <- trans
pal[c(1, trans)] <<- pal[c(trans, 1)]
trans <- 1
}
attributes(result)[["palette"]] <- pal
attributes(result)[["transparent"]] <- trans
result
})
bm <- .bitmapToRaw(bm, T, F)
result <- new("hardwareSprite",
VStop = dim(x)[1],
bitmap = bm,
colours = pal[-1])
result
}
#' @export
dim.hardwareSprite <- function(x) {
result <- x@VStop - x@VStart
result[result == 0] <- 16
c(result, 16)
}