@verb $colours:tell_www_page this none this @program $colours:tell_www_page "Colours! - A colourful demonstration of Moo graphics."; "Copyright (C) October 2004 Neil Fraser"; "http://neil.fraser.name/"; ""; "This program is free software; you can redistribute it and/or"; "modify it under the terms of version 2 of the GNU General"; "Public License as published by the Free Software Foundation."; ""; "This program is distributed in the hope that it will be useful,"; "but WITHOUT ANY WARRANTY; without even the implied warranty of"; "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the"; "GNU General Public License for more details."; "http://www.gnu.org/"; ""; "Height and width of the image."; "All values work, but 2^n+1 squares are ideal (65x65, 129x129, 257x257, etc)."; rows = tonum($www:parse_GET("y") || 257); cols = tonum($www:parse_GET("x") || 257); "Limit the size to avoid denial of service attacks on my server."; rows = min(max(1, rows), 512 + 1); cols = min(max(1, cols), 512 + 1); "The grid of points that make up the image."; grid = this:make_grid(cols, rows); "The array of 256 equidistant colours."; palette = this:make_palette(256); "Create the binary BMP image."; bmp = this:render_bmp(grid, palette); "Send it to the web browser."; this:tell_bmp(bmp); . @verb $colours:make_palette this none this @program $colours:make_palette "Create an array of n equidistant colours spanning a range between"; "two randomly picked master colours."; {n} = args; "RGB colour declarations for the master colours"; c1r = c1g = c1b = 0.0; c2r = c2g = c2b = 0.0; while (((abs(c1r - c2r) + abs(c1g - c2g)) + abs(c1b - c2b)) < 256.0) c1r = tofloat(random(256)); c1g = tofloat(random(256)); c1b = tofloat(random(256)); c2r = tofloat(random(256)); c2g = tofloat(random(256)); c2b = tofloat(random(256)); "Keep looping until you get dissimilar colours."; endwhile "Precompute all colours."; colourtable = {}; nf = tofloat(n); for x in [1..n] x = tofloat(x); r = toint(((c1r * x) / nf) + (c2r * (1.0 - (x / nf)))); g = toint(((c1g * x) / nf) + (c2g * (1.0 - (x / nf)))); b = toint(((c1b * x) / nf) + (c2b * (1.0 - (x / nf)))); colourtable = {@colourtable, {r, g, b}}; $command_utils:suspend_if_needed(); endfor return colourtable; . @verb $colours:make_grid this none this @program $colours:make_grid "Create a 2D grid of 0-255 values using a recursive pattern."; {cols, rows} = args; "The grid of points that make up the image."; blank_row = $list_utils:make(cols, 0); grid = $list_utils:make(rows, blank_row); "Flip a coin to determine which diagonally opposite corners get the master colours."; if (random(2) == 1) grid[1][1] = 0; grid[rows][cols] = 255; grid[rows][1] = random(255); grid[1][cols] = random(255); else grid[1][cols] = 0; grid[rows][1] = 255; grid[1][1] = random(255); grid[rows][cols] = random(255); endif "Store the grid in a property so we don't have to keep passing it around."; propname = tostr("grid_", random()); add_property(this, propname, {}, {this.owner, "r"}); try this.(propname) = grid; grid = E_NONE; "Draw the top row and left column."; this:fillrow(1, 1, cols, propname); this:fillcol(1, 1, rows, propname); "Now we have the top edge, the left edge, and the bottom/right dot."; "We are all setup to fill the remaining area."; this:fillarea(1, rows, 1, cols, propname); grid = this.(propname); finally delete_property(this, propname); endtry return grid; . @verb $colours:fillrow this none this @program $colours:fillrow "Recursively fill one row."; "Used to bootstrap the recursive area fill."; "Also used to fudge our way out of ?x2 rectangles."; {row, endleft, endright, propname} = args; if ((endleft + 1) != endright) "Set the dot in the middle."; middleX = ((endright - endleft) / 2) + endleft; this.(propname)[row][middleX] = this:midpoint(this.(propname)[row][endleft], this.(propname)[row][endright]); "Go fill the two new sub-rows"; this:fillrow(row, endleft, middleX, propname); this:fillrow(row, middleX, endright, propname); $command_utils:suspend_if_needed(); endif . @verb $colours:fillcol this none this @program $colours:fillcol "Recursively fill one column."; "Used to bootstrap the recursive area fill."; "Also used to fudge our way out of ?x2 rectangles."; {col, endtop, endbottom, propname} = args; if ((endtop + 1) != endbottom) "Set the dot in the middle."; middleY = ((endbottom - endtop) / 2) + endtop; this.(propname)[middleY][col] = this:midpoint(this.(propname)[endtop][col], this.(propname)[endbottom][col]); "Go fill the two new sub-columns"; this:fillcol(col, endtop, middleY, propname); this:fillcol(col, middleY, endbottom, propname); $command_utils:suspend_if_needed(); endif . @verb $colours:fillarea this none this @program $colours:fillarea "Recursively fill the area."; {endtop, endbottom, endleft, endright, propname} = args; if (((endleft + 1) == endright) && ((endtop + 1) == endbottom)) "This is just a 2x2 square. Nothing to do."; elseif ((endleft + 1) == endright) "This is just a 2x? rectangle. Fill in some vertical space."; this:fillcol(endright, endtop, endbottom, propname); elseif ((endtop + 1) == endbottom) "This is just a ?x2 rectangle. Fill in some horizontal space."; this:fillrow(endbottom, endleft, endright, propname); else "Wide open space; something to sink our recursive teeth into..."; "Set the dot half way along the bottom row."; middleX = ((endright - endleft) / 2) + endleft; this.(propname)[endbottom][middleX] = this:midpoint(this.(propname)[endbottom][endleft], this.(propname)[endbottom][endright]); "Set the dot half way along the right column."; middleY = ((endbottom - endtop) / 2) + endtop; this.(propname)[middleY][endright] = this:midpoint(this.(propname)[endtop][endright], this.(propname)[endbottom][endright]); "Set the dot in the middle (midpoint of two midpoints)."; centre1 = this:midpoint(this.(propname)[endtop][middleX], this.(propname)[endbottom][middleX]); centre2 = this:midpoint(this.(propname)[middleY][endright], this.(propname)[middleY][endleft]); this.(propname)[middleY][middleX] = this:midpoint(centre1, centre2); "Go fill the four new quadrants."; this:fillarea(endtop, middleY, endleft, middleX, propname); this:fillarea(middleY, endbottom, endleft, middleX, propname); this:fillarea(endtop, middleY, middleX, endright, propname); this:fillarea(middleY, endbottom, middleX, endright, propname); $command_utils:suspend_if_needed(); endif . @verb $colours:midpoint this none this @program $colours:midpoint "Pick a random number between two end values (inclusive)."; {end1, end2} = args; if (end1 > end2) swap = end1; end1 = end2; end2 = swap; endif return (random(abs((end2 - end1) + 1)) + end1) - 1; . @verb $colours:render_bmp this none this @program $colours:render_bmp "Given a 2D grid of pixels, and a palette of RGB values, build a BMP."; "Switches automatically between 256 palette mode and 24-bit true-colour."; "Doesn't support 1-bit or 4-bit modes since Moo lacks efficient binary operators."; {grid, palette} = args; BITMAPFILEHEADER = ("BMxxxx" + encode_binary(0, 0, 0, 0)) + "yyyy"; biHeight = this:multibyteencode(length(grid), 4); biWidth = this:multibyteencode(length(grid[1]), 4); bfOffBits = this:multibyteencode(40, 4); if (length(palette) <= 256) bitcount = 8; else bitcount = 24; endif biBitCount = this:multibyteencode(bitcount, 2); BITMAPINFOHEADER = ((((bfOffBits + biWidth) + biHeight) + encode_binary(1, 0)) + biBitCount) + encode_binary(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); RGBQUAD = ""; if (bitcount != 24) for rgb in (palette) {r, g, b} = rgb; RGBQUAD = RGBQUAD + encode_binary(b-1, g-1, r-1, 0); $command_utils:suspend_if_needed(); endfor endif if (bitcount == 8) linelen = length(grid[1]); elseif (bitcount == 24) linelen = length(grid[1]) * 3; else raise("Unknown bitcount: can't happen"); endif if ((linelen % 4) == 1) padding = encode_binary(0, 0, 0); elseif ((linelen % 4) == 2) padding = encode_binary(0, 0); elseif ((linelen % 4) == 3) padding = encode_binary(0); else padding = ""; endif DATA = ""; for y in [0..length(grid) - 1] line = grid[length(grid) - y]; if (bitcount == 8) DATA = (DATA + encode_binary(@line)) + padding; elseif (bitcount == 24) for x in [1..length(line)] DATA = DATA + encode_binary(@palette[line[x] + 1]); endfor endif $command_utils:suspend_if_needed(); endfor BMP = ((BITMAPFILEHEADER + BITMAPINFOHEADER) + RGBQUAD) + DATA; "Specify the offset from the beginning of the file to the bitmap data."; mark = index(BMP, "yyyy"); BMP[mark..mark + 3] = this:multibyteencode(this:binary_string_length((BITMAPFILEHEADER + BITMAPINFOHEADER) + RGBQUAD), 4); "Insert the size of the BMP in bytes."; BMP[3..6] = this:multibyteencode(this:binary_string_length(BMP), 4); return BMP; . @verb $colours:tell_bmp this none this @program $colours:tell_bmp "Assuming the player is a web browser, print a BMP content-type header,"; "followed by the provided BMP data."; if (!player:isa($webber)) raise(E_INVIND, "Only webbers can see BMP images."); elseif (player.header_issued) raise(E_INVARG, "Must call :tell_bmp before header has been sent"); elseif (player == $webber) raise(E_PERM, "$webber is a generic."); endif player:notify("HTTP/1.0 200 OK"); player:notify($www:server_name()); player:notify("Content-type: image/bmp"); player:notify(tostr("Content-length: ", this:binary_string_length(args[1]))); player:notify(""); player.header_issued = 1; set_connection_option(player, "binary", 1); player:notify(args[1]); set_connection_option(player, "binary", 0); . @verb $colours:multibyteencode this none this @program $colours:multibyteencode "Return a binary string of the specified byte length that encodes the specified number"; "BIG-ENDIAN!"; {number, bytes} = args; (number > 0) || raise(E_INVARG, "Negative numbers not allowed."); oldbase = 1; string = ""; for x in [1..bytes] if (number == 0) byte = 0; else base = oldbase * 256; byte = number % base; number = number - byte; byte = byte / oldbase; oldbase = base; endif string = string + encode_binary(byte); endfor (number == 0) || raise(E_QUOTA, "Overflow, number too big for string length"); return string; . @verb $colours:binary_string_length this none this @program $colours:binary_string_length "Returns the 'true' length of binary string, counting ~07s as 1 character."; return (3 * length(args[1])) - (2 * length(strsub(args[1], "~", "~~"))); . "***finished***