[tt]
' SCREEN 12 GET/PUT buffer format:
'
' Offset | Size/Type | Description
'--------+-----------+---------------------------------------------
' 0 | WORD | The number of pixels horizontally X
' 2 | WORD | The number of pixels vertically Y
' 4 | Y * ROW | Image data
'
' ROW format:
'
' Each row is X pixels wide. The data is stored in a packed planar format,
' which means that each successive bit of the colour goes into the same
' bit of a different plane. Each row of each plane is padded out to the
' next byte boundary. The number of padding bits is P = 7 - (X MOD 8). The
' total number of bits in each row of each plane is thus R = X + P.
' Mathematically, this is guaranteed to be an exact multiple of 8, and thus
' a non-fractional number of bytes.
'
' Bit Offset | Size | Description
'------------+---------+-----------------------------
' 0 * R + 0 | X * BIT | Pixel data for plane 0
'(0 * R + X | P * BIT | Padding (ignored) )
' 1 * R + 0 | X * BIT | Pixel data for plane 1
'(1 * R + X | P * BIT | Padding (ignored) )
' 2 * R + 0 | X * BIT | Pixel data for plane 1
'(2 * R + X | P * BIT | Padding (ignored) )
' 3 * R + 0 | X * BIT | Pixel data for plane 1
'(3 * R + X | P * BIT | Padding (ignored) )
'
' Thus, the number of bytes needed to store 1 row of a GET/PUT buffer in
' SCREEN 12 is the number of bytes needed to store the bits in one row of
' one plane times the number of planes, which is 4:
'
' rowPlaneBytes% = (imgWidth% + 7) \ 8
' rowBytes% = rowPlaneBytes% * 4
'
' ...all times the number of rows in the image:
'
' imgBytes% = imgHeight% * rowBytes%
'
' ...plus 4 bytes for the GET/PUT header:
'
' bufSize% = 4 + imgBytes%
'
' All of the functions other than the non-Bounds Mem functions do bounds
' checking on the input and throw an 'ERROR 5' if the array bounds are
' violated.
DECLARE SUB makeBuf (buf%(), source%(), x%, y%, w%, h%)
DECLARE SUB makeBufOfs (buf%(), ofs%, source%(), x%, y%, w%, h%)
DECLARE SUB makeMemBufBounds (segm%, offs%, bytes%, source%(), x%, y%, w%, h%)
DECLARE SUB makeMemBuf (segm%, offs%, source%(), x%, y%, w%, h%)
DECLARE SUB setBufPixel (buf%(), x%, y%, c%)
DECLARE SUB setBufOfsPixel (buf%(), ofs%, x%, y%, c%)
DECLARE SUB setMemBufBoundsPixel (segm%, offs%, bytes%, x%, y%, c%)
DECLARE SUB setMemBufPixel (segm%, BYVAL offs%, x%, y%, c%)
DECLARE SUB setBufSize (buf%(), w%, h%)
DECLARE SUB setBufOfsSize (buf%(), ofs%, w%, h%)
DECLARE SUB setMemBufBoundsSize (segm%, offs%, bytes%, w%, h%)
DECLARE SUB setMemBufSize (segm%, offs%, w%, h%)
DECLARE FUNCTION n& (x%)
DIM SHARED maskOff%(7), maskOn%(7)
pow2% = 1
FOR i% = 7 TO 0 STEP -1
maskOff%(i%) = NOT pow2%
maskOn%(i%) = pow2%
pow2% = pow2% + pow2%
NEXT i%
DIM buf%(5203), sourceImage%(99, 99)
'First, set up the source image
SCREEN 13
PRINT "Hello,"
PRINT " world!"
COLOR 12: PRINT "S";
COLOR 14: PRINT "o";
COLOR 10: PRINT "m";
COLOR 11: PRINT "e"
COLOR 9: PRINT "c";
COLOR 13: PRINT "o";
COLOR 12: PRINT "l";
COLOR 14: PRINT "o";
COLOR 10: PRINT "u";
COLOR 11: PRINT "r";
COLOR 9: PRINT "s"
LINE (20, 60)-(70, 30), 6
LINE -(50, 90), 6
LINE -(20, 60), 6
PAINT (30, 60), 12, 6
LINE (-1, -1)-(100, 100), 15, B
LOCATE 15, 1
PRINT "^^ The image in the box will be captured"
PRINT "This is SCREEN 13 (320x200x256), but"
PRINT "since it uses only colours 0 through 15,"
PRINT "the image data itself can be displayed"
PRINT "in SCREEN 12. Of course, the GET/PUT"
PRINT "buffers will be incompatible."
PRINT
PRINT "Press any key to continue"
SLEEP
'Then copy it into memory as a simple 2D array
FOR x% = 0 TO 99
FOR y% = 0 TO 99
sourceImage%(x%, y%) = POINT(x%, y%)
NEXT y%
NEXT x%
SCREEN 12
'Now convert the array into a GET/PUT buffer...
makeBuf buf%(), sourceImage%(), 0, 0, 100, 100
'...and draw it to the screen
LINE (0, 0)-(101, 101), 15, B '(with an outline)
PUT (1, 1), buf%, PSET
LOCATE 8, 1
PRINT "This buffer was copied"
PRINT "from a simple 2D array"
PRINT "captured from the"
PRINT "SCREEN 13 graphic"
PRINT
PRINT "Press any key to draw"
PRINT "a circle onto the"
PRINT "buffer"
SLEEP
'Now draw a circle with colours alternating to verify that
'the different bit planes were successfully accessed...
c% = 1
FOR angle# = 0 TO 6.283185 STEP .01
x% = 50 + 48 * COS(angle#)
y% = 50 - 48 * SIN(angle#)
setBufPixel buf%(), x%, y%, c%
counter% = counter% + 1
IF counter% = 50 THEN
counter% = 0
c% = (c% MOD 15) + 1
END IF
NEXT angle#
'..and then show the new buffer in a different location for comparison.
LINE (200, 0)-(301, 101), 15, B
PUT (201, 1), buf%, PSET
LOCATE 8, 25: PRINT "Same buffer; the pixels"
LOCATE 9, 25: PRINT "were overwritten in-place"
LOCATE 10, 25: ' for readability
LOCATE 11, 25: PRINT "Press any key to exit"
SLEEP
SCREEN 0: WIDTH 80, 25
' Takes a 2D array source%(x%, y%) where each entry corresponds to one pixel
' and writes it into the specified buffer in GET/PUT-compatible format.
SUB makeBuf (buf%(), source%(), x%, y%, w%, h%)
makeBufOfs buf%(), 0, source%(), x%, y%, w%, h%
END SUB
' Takes a 2D array source%(x%, y%) where each entry corresponds to one pixel
' and writes it into the specified buffer at the specified offset in
' GET/PUT-compatible format.
SUB makeBufOfs (buf%(), ofs%, source%(), x%, y%, w%, h%)
bytes% = UBOUND(buf%) - ofs% + 1
makeMemBufBounds VARSEG(buf%(ofs%)), VARPTR(buf%(ofs%)), bytes%, source%(), x%, y%, w%, h%
END SUB
' Takes a 2D array source%(x%, y%) where each entry corresponds to one pixel
' and writes the specified region of it into the buffer at the specified
' memory address in GET/PUT-compatible format.
SUB makeMemBuf (segm%, BYVAL offs%, source%(), x%, y%, w%, h%)
DEF SEG = segm%
POKE offs% + 0, w% AND 255
POKE offs% + 1, n&(w%) \ 256
POKE offs% + 2, h% AND 255
POKE offs% + 3, n&(h%) \ 256
offs% = offs% + 4
rowPlaneBytes% = (w% + 7) \ 8
rowBytes% = rowPlaneBytes% * 4
rowStart% = offs% + y% * rowBytes%
FOR yy% = 0 TO h% - 1
planeOffset% = rowStart%
FOR xx% = 0 TO w% - 1 STEP 8
plane0Byte% = 0
plane1Byte% = 0
plane2Byte% = 0
plane3Byte% = 0
FOR k% = 0 TO 7
IF xx% + k% >= w% THEN EXIT FOR
c% = source%(x% + xx% + k%, y% + yy%)
IF c% AND 1 THEN plane0Byte% = plane0Byte% OR maskOn%(k%)
IF c% AND 2 THEN plane1Byte% = plane1Byte% OR maskOn%(k%)
IF c% AND 4 THEN plane2Byte% = plane2Byte% OR maskOn%(k%)
IF c% AND 8 THEN plane3Byte% = plane3Byte% OR maskOn%(k%)
NEXT k%
POKE planeOffset% + 0 * rowPlaneBytes%, plane0Byte%
POKE planeOffset% + 1 * rowPlaneBytes%, plane1Byte%
POKE planeOffset% + 2 * rowPlaneBytes%, plane2Byte%
POKE planeOffset% + 3 * rowPlaneBytes%, plane3Byte%
planeOffset% = planeOffset% + 1
NEXT xx%
rowStart% = rowStart% + rowBytes%
NEXT yy%
END SUB
' Takes a 2D array source%(x%, y%) where each entry corresponds to one pixel
' and writes the specified region of it into the buffer at the specified
' memory address in GET/PUT-compatible format, checking the buffer size
' first.
SUB makeMemBufBounds (segm%, offs%, bytes%, source%(), x%, y%, w%, h%)
headerBytes% = 4
rowPlaneBytes% = (w% + 7) \ 8
rowBytes% = rowPlaneBytes% * 4
imageBytes% = h% * rowBytes%
totalBytes% = headerBytes% + imageBytes%
IF bytes% < totalBytes% THEN ERROR 5
lastX% = x% + w% - 1
lastY% = y% + h% - 1
lastPossibleX% = UBOUND(source%, 1)
lastPossibleY% = UBOUND(source%, 2)
IF (x% < LBOUND(source%, 1)) OR (y% < LBOUND(source%, 2)) THEN ERROR 5
IF (lastX% > lastPossibleX%) OR (lastY% > lastPossibleY%) THEN ERROR 5
makeMemBuf segm%, offs%, source%(), x%, y%, w%, h%
END SUB
FUNCTION n& (x%)
IF x% < 0 THEN n& = x% + 65536 ELSE n& = x%
END FUNCTION
' Sets the specified pixel in the buffer at the specified offset to the
' specified colour.
SUB setBufOfsPixel (buf%(), ofs%, x%, y%, c%)
bytes% = UBOUND(buf%) - ofs% + 1
setMemBufBoundsPixel VARSEG(buf%(ofs%)), VARPTR(buf%(ofs%)), bytes%, x%, y%, c%
END SUB
' Initializes the specified buffer at the specified offset to the specified
' size. The contents of the associated memory are not erased.
SUB setBufOfsSize (buf%(), ofs%, w%, h%)
bytes% = UBOUND(buf%) - ofs% + 1
setMemBufBoundsSize VARSEG(buf%(ofs%)), VARPTR(buf%(ofs%)), bytes%, w%, h%
END SUB
' Sets the specified pixel in the specified buffer to the specified colour.
SUB setBufPixel (buf%(), x%, y%, c%)
setBufOfsPixel buf%(), 0, x%, y%, c%
END SUB
' Initializes the specified buffer to the specified size. The contents of the
' associated memory are not erased.
SUB setBufSize (buf%(), w%, h%)
setBufOfsSize buf%(), 0, w%, h%
END SUB
' Sets the specified pixel in the buffer at the specified memory address to
' the specified colour, ensuring that the pixel lies within the buffer's
' bounds first.
SUB setMemBufBoundsPixel (segm%, offs%, bytes%, x%, y%, c%)
DEF SEG = segm%
imgWidth% = PEEK(offs%) + PEEK(offs% + 1) * 256
imgHeight% = PEEK(offs% + 2) + PEEK(offs% + 3) * 256
IF (x% < 0) OR (x% >= imgWidth%) THEN ERROR 5
IF (y% < 0) OR (y% >= imgHeight%) THEN ERROR 5
setMemBufPixel segm%, offs%, x%, y%, c%
END SUB
' Initializes the buffer at the specified memory location to the
' specified size, checking that the specified location can hold a
' buffer of that size first.
SUB setMemBufBoundsSize (segm%, offs%, bytes%, w%, h%)
rowPlaneBytes% = (w% + 7) \ 8
rowBytes% = rowPlaneBytes% * 4
imgBytes% = 4 + h% * rowBytes%
IF bytes% < imgBytes% THEN ERROR 5
setMemBufSize segm%, offs%, w%, h%
END SUB
' Sets the specified pixel of the buffer at the specified memory
' location to the specified colour.
SUB setMemBufPixel (segm%, BYVAL offs%, x%, y%, c%)
DEF SEG = segm%
imgWidth% = PEEK(offs%) + PEEK(offs% + 1) * 256
offs% = offs% + 2
imgHeight% = PEEK(offs%) + PEEK(offs% + 1) * 256
offs% = offs% + 2
rowPlaneBytes% = (imgWidth% + 7) \ 8
rowBytes% = rowPlaneBytes% * 4
rowOffs% = offs% + y% * rowBytes%
planeByteOffs% = x% \ 8
planeBitOffs% = x% AND 7
thisPlaneByteOffs% = rowOffs% + planeByteOffs%
IF (c% AND 1) THEN
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%)) OR maskOn%(planeBitOffs%)
ELSE
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%))
END IF
thisPlaneByteOffs% = thisPlaneByteOffs% + rowPlaneBytes%
IF (c% AND 2) THEN
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%)) OR maskOn%(planeBitOffs%)
ELSE
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%))
END IF
thisPlaneByteOffs% = thisPlaneByteOffs% + rowPlaneBytes%
IF (c% AND 4) THEN
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%)) OR maskOn%(planeBitOffs%)
ELSE
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%))
END IF
thisPlaneByteOffs% = thisPlaneByteOffs% + rowPlaneBytes%
IF (c% AND 8) THEN
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%)) OR maskOn%(planeBitOffs%)
ELSE
POKE thisPlaneByteOffs%, (PEEK(thisPlaneByteOffs%) AND maskOff%(planeBitOffs%))
END IF
END SUB
' Initializes the buffer at the specified memory location to the
' specified size.
SUB setMemBufSize (segm%, offs%, w%, h%)
DEF SEG = segm%
POKE offs% + 0, w% AND 255
POKE offs% + 1, n&(w%) \ 256
POKE offs% + 2, h% AND 255
POKE offs% + 3, n&(h%) \ 256
END SUB
[/tt]