Images

Colors

In order to represent images, we'll need to handle colors. We keep a 0-255 value for the red, green, and blue component of the current color.

implement colors +≡

variable red
variable green
variable blue

We'll often use it to setup colors specified as a triple. Often this triple will be floating point in the 0-1 range.

implement colors +≡

: rgb ( r g b -- ) blue ! green ! red ! ;
: f>primary ( f -- n ) 255e f* f>s 0 max 255 min ;
: rgbf ( rf gf bf -- ) f>primary f>primary f>primary rgb ;

We can then define some important common colors.

implement colors +≡

: black ( -- ) 0 0 0 rgb ;
: white ( -- ) 255 255 255 rgb ;

And some common color sets.

implement colors +≡

: gray ( n -- ) dup dup rgb ;

Images

We will need to implement images. For now, a single global image will suffice. We'll store it in 4 byte per pixel form (with the alpha component unused for now). These fields will be needed.

implement images +≡

variable image-width
variable image-height
variable image-data

In manipulating images we'll want to be able to reference the total size of the image data.

implement images +≡

: image-data-size ( -- n )
    image-width @ image-height @ * 4 * ;

We will (re-)allocate image data on setup.

implement images +≡

: image-pick-size ( w h -- )
    image-height ! image-width ! ;
: image-free-old
    image-data @ dup if free 0= assert else drop then ;
: image-allocate
    image-data-size allocate 0= assert image-data ! ;
: image-clear
    image-data @ image-data-size 0 fill ;
: image-setup ( w h -- )
    image-pick-size image-free-old image-allocate image-clear ;

The most basic operation will be to plot to a given (x, y) coordinate with the current color.

implement images +≡

implement colors
: image-xy ( x y -- a )
    image-width @ * + 4 *
    image-data @ + ;
: plot ( x y -- )
    image-xy
    red @ over c!
    green @ over 1+ c!
    blue @ over 2 + c!
    0 swap 3 + c! ;

Writing BMPs.

We will want to output the current image to a windows BMP file. We will assume we're only writing one BMP at time and keep a global to its file handle.

writing bmp files +≡

variable bmp-file

Opening and closing the file based on an atom name will be useful.

writing bmp files +≡

: bmp-begin ( A -- )
    atom-string@ w/o bin create-file 0= assert bmp-file ! ;
: bmp-end ( -- )
    bmp-file @ close-file 0= assert ;

We will halt on failures to write, so we should centralize that.

writing bmp files +≡

: bmp-write ( $ -- )
    bmp-file @ write-file 0= assert ;

Additionally writing out little endian bytes, words, and double words will be needed.

writing bmp files +≡

: bmp-byte ( b -- ) here c! here 1 bmp-write ;
: bmp-word ( w -- ) dup 255 and bmp-byte 8 rshift 255 and bmp-byte ;
: bmp-dword ( d -- ) dup 65535 and bmp-word 16 rshift 65535 and bmp-word ;

BMP files have two headers, the main BMP header and a DIB (device independent header. We'll need to talk about the size of them.

writing bmp files +≡

3 2 * 2 4 * + constant bmp-header-size
10 4 * constant dib-header-size

We can then implement writing the bmp file. Starting with the BMP header.

writing bmp files +≡

: bmp-save ( A -- )
  bmp-begin
  \ BMP header
  s" BM" bmp-write
  bmp-header-size
  dib-header-size +
  image-data-size + bmp-dword \ size of bmp file in bytes
  0 bmp-word \ unused
  0 bmp-word \ unused
  bmp-header-size
  dib-header-size + bmp-dword \ offset to start of bitmap image data

Then the DIB header.

writing bmp files +≡

  \ DIB header
  dib-header-size bmp-dword \ size of header in bytes
  image-width @ bmp-dword \ width
  image-height @ bmp-dword \ height
  1 bmp-word \ color planes
  32 bmp-word \ bits per pixel
  0 bmp-dword \ BI_RGB (uncompressed)
  image-data-size bmp-dword \ pixel data size
  0 bmp-dword \ horizontal pixels per meter
  0 bmp-dword \ vertical pixels per meter
  0 bmp-dword \ colors in color palette
  0 bmp-dword \ important colors in palette

Then the image data and done.

writing bmp files +≡

  \ Image data
  image-data @ image-data-size bmp-write
  bmp-end
;