;;; File: ;;; grid.scm ;;; Author: ;;; Samuel A. Rebelsky ;;; Version: ;;; 0.2 of 25 October 2006 ;;; Summary: ;;; A collection of procedures to support grid-based drawing ;;; (a.k.a. "exploring color spaces"). ;;; Contents: ;;; Higher-Order Grid Art: ;;; (color-grid width height deltax deltay redproc greenproc blueproc) ;;; Build an image by drawing with the current pen at each position ;;; in a grid, using redproc, greenproc, and blueproc to determine ;;; the color in which to draw. ;;; (grid-art width height deltax deltay proc) ;;; Build an image by applying proc at each position in the grid. ;;; Color Functions: ;;; (func1 x y) ;;; (func2 x y) ;;; (func3 x y) ;;; Generate a number in [0..255] using x and/or y. ;;; Positional Procedures: ;;; (line-at img x y) ;;; Draw a line starting a (x,y). ;;; (positional-brush img x y) ;;; Choose a brush based on the position. ;;; (positional-color img x y) ;;; Choose a color based on the position. ;;; (splash img x y) ;;; Draw in a color based on the position. ;;; (splish img x y) ;;; Draw in a brush based on the position. ;;; History: ;;; At end. ; +-----------------------+------------------------------------------- ; | Higher-Order Grid Art | ; +-----------------------+ ;;; Procedure: ;;; color-grid ;;; Parameters: ;;; width, a positive integer [unverified] ;;; height, a positive integer [unverified] ;;; deltax, a positive integer [unverified] ;;; deltay, a positive integer [unverified] ;;; redproc, a function from positions to integers in the range [0..255] ;;; greenproc, a function from positions to integers in the range [0..255] ;;; blueproc, a function from positions to integers in the range [0..255] ;;; Purpose: ;;; Build an image by drawing with the current pen at each position ;;; in a grid, using redproc, greenproc, and blueproc to determine ;;; the color in which to draw. ;;; Produces: ;;; img, an image. (define color-grid (lambda (width height deltax deltay redproc greenproc blueproc) (let ((img (create-image width height))) (let ((x 0) (y 0)) (while (< y height) (set! x 0) (while (< x width) (set-fgcolor (list (modulo (redproc x y) 256) (modulo (greenproc x y) 256) (modulo (blueproc x y) 256))) (blot img x y) (set! x (+ x deltax))) (set! y (+ y deltay)))) (show-image img)))) (script-fu-register "color-grid" "/Xtns/Script-Fu/Glimmer/Color Grid" "Draws grid-based art" "Samuel A. Rebelsky" "Copyright (c) 2006 Samuel A. Rebelsky. All Rights Reserved" "Tuesday, 24 October 2006" "RGB" SF-VALUE "Width" "100" SF-VALUE "Height" "100" SF-VALUE "Horizontal Spacing" "9" SF-VALUE "Vertical Spacing" "7" SF-VALUE "Red Component" "func1" SF-VALUE "Green Component" "func2" SF-VALUE "Blue Component" "func3") ;;; Procedure: ;;; grid-art ;;; Parameters: ;;; width, a positive integer [unverified] ;;; height, a positive integer [unverified] ;;; deltax, a positive integer [unverified] ;;; deltay, a positive integer [unverified] ;;; proc, a procedure from (img,x,y) to colors [unverified] ;;; Purpose: ;;; Builds an image by applying proc at each position in the grid. ;;; Produces: ;;; grid, an image. (define grid-art (lambda (width height deltax deltay proc) (let ((img (create-image width height))) (let ((x 0) (y 0)) (while (< y height) (set! x 0) (while (< x width) (proc img x y) (set! x (+ x deltax))) (set! y (+ y deltay)))) (show-image img)))) (script-fu-register "grid-art" "/Xtns/Script-Fu/Glimmer/Grid Art" "Draws grid-based art" "Samuel A. Rebelsky" "Copyright (c) 2006 Samuel A. Rebelsky. All Rights Reserved" "Tuesday, 24 October 2006" "RGB" SF-VALUE "Width" "100" SF-VALUE "Height" "100" SF-VALUE "Horizontal Spacing" "9" SF-VALUE "Vertical Spacing" "7" SF-VALUE "Procedure" "") ; +-----------------+------------------------------------------------- ; | Color Functions | ; +-----------------+ (define func1 (lambda (x y) (modulo (* 5 x) 256))) (define func2 (lambda (x y) (trunc (* 255 (abs (sin y)))))) (define func3 (lambda (x y) (modulo (+ x y) 256))) ; +-----------------------+------------------------------------------- ; | Positional Procedures | ; +-----------------------+ ; Most of the following procedures were written for an alternative version ; of grid-based drawing, and are included here simply because I think that ; they may prove useful again. ;;; Procedure: ;;; line-at ;;; Parameters: ;;; image, an image ;;; x, an integer ;;; y, an integer ;;; Purpose: ;;; Draws a short line at the specified position. ;;; Produces: ;;; (nothing) (define line-at (lambda (image x y) (line image x y (+ x 2) (+ y 2)))) ;;; Procedure: ;;; positional-color ;;; Parameters: ;;; image, an image ;;; x, an integer ;;; y, an integer ;;; Purpose: ;;; Sets the current foreground color using the x and y positions. ;;; Produces: ;;; (nothing) (define positional-color (lambda (image x y) (set-fgcolor ((list (func1 x y) (func2 x y) (func3 x y)))))) (define positional-brush (let ((brushes (list "Circle (01)" "Circle (03)" "Circle (05)" "Circle (07)" "Circle (09)" "Circle (11)" "Circle Fuzzy (03)" "Circle Fuzzy (05)" "Circle Fuzzy (07)" "Circle Fuzzy (09)" "Circle Fuzzy (11)"))) (lambda (image x y) (set-brush (list-ref brushes (modulo (+ (trunc * 10 (sin x)) (trunc * 9 (cos y)))) (length brushes)))))) ;;; Procedure: ;;; splash ;;; Parameters: ;;; image, an image ;;; x, an integer ;;; y, an integer ;;; Purpose: ;;; Draws a short line at the specified position, using a color ;;; that depends on the position. ;;; Produces: ;;; (nothing) ;;; Postconditions: ;;; The foreground color may have changed. ;;; The image now contains an additional splash of color at or near ;;; (x,y). (define splash (lambda (image x y) (positional-color image x y) (line-at image x y))) ;;; Procedure: ;;; splish ;;; Parameters: ;;; image, an image ;;; x, an integer ;;; y, an integer ;;; Purpose: ;;; Draws a short line at the specified position, using a brush ;;; that depends on the position. ;;; Produces: ;;; (nothing) ;;; Postconditions: ;;; The brush may have changed. ;;; The image now contains an additional splash of color at or near ;;; (x,y). (define splish (lambda (image x y) (positional-brush image x y) (line-at image x y))) ; +---------+-------------------------------------------------------- ; | History | ; +---------+ ; Tuesday, 24 October 2006 (v 0.1) [Samuel A. Rebelsky] ; * Created while writing the reading. No documentation. ; Wednesday, 25 October 2006 (v 0.2) [Samuel A. Rebelsky] ; * Added documentation. ; * Other minor code cleanup.