home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / Linux / Divers / bomb.tar.gz / bomb.tar / bomb / bomb.scm < prev    next >
Text File  |  1998-01-14  |  4KB  |  126 lines
  1. ;
  2. ;    bomb - automatic interactive visual stimulation
  3. ;    Copyright (C) 1994  Scott Draves <spot@cs.cmu.edu>
  4. ;
  5. ;    This program is free software; you can redistribute it and/or modify
  6. ;    it under the terms of the GNU General Public License as published by
  7. ;    the Free Software Foundation; either version 2 of the License, or
  8. ;    (at your option) any later version.
  9. ;
  10. ;    This program is distributed in the hope that it will be useful,
  11. ;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. ;    GNU General Public License for more details.
  14. ;
  15. ;    You should have received a copy of the GNU General Public License
  16. ;    along with this program; if not, write to the Free Software
  17. ;    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  
  19. (define fill-hramp  0)
  20. (define fill-vramp  1)
  21. (define fill-grid   2)
  22. (define fill-noise  3)
  23. (define fill-vnoise 4)
  24. (define fill-sparse 5)
  25. (define nfills      6)
  26.  
  27. (define rule-rug            0)
  28. (define rule-rug2           1)
  29. (define rule-static         2)
  30. (define rule-rotorug        3)
  31. (define rule-acidlife1      4)
  32. (define rule-acidlife2      5)
  33. (define rule-rug-anneal     6)
  34. (define rule-rug-anneal2    7)
  35. (define rule-rug-rug        8)
  36. (define rule-rug-brain      9)
  37. (define rule-shade         10)
  38. (define rule-wave          11)
  39. (define rule-rug-image     12)
  40. (define rule-slip          13)
  41. (define rule-fuse          14)
  42. (define rule-rug-multi     15)
  43. (define rule-rd            16)
  44. (define rule-rd2           17)
  45. (define rule-quad          18)
  46. (define nrules             19)
  47.  
  48. (define cmap-mono   0)
  49. (define cmap-mono4  1)
  50. (define cmap-loop   2)
  51. (define cmap-path   3)
  52. (define cmap-heat   4)
  53. (define cmap-plain  5)
  54. (define cmap-split  6)
  55. (define cmap-noise  7)
  56. (define cmap-black  8)
  57. (define cmap-ramp   9)
  58.  
  59. (define fill bomb-fill)
  60. (define (frame . a)
  61.   (bomb-do-frame (if (null? a) 1 (car a))))
  62. (define pulse bomb-pulse)
  63. (define pulse-driver bomb-pulse-driver)
  64. (define random-flame-shape bomb-random-flame-cp)
  65. (define random-flame-dir bomb-random-flame-dir)
  66. (define srandom bomb-srandom)
  67. (define file-to-image bomb-file-to-image)
  68. (define drive-with-image bomb-drive-with-image)
  69.  
  70. (define (concat-symbols a b)
  71.   (string->symbol
  72.    (string-append (symbol->string a)
  73.           (symbol->string b))))
  74.  
  75. ; (x (x)) == id
  76. (defmacro define-var (name)
  77.   `(define (,name . a)
  78.      (if (null? a)
  79.      (,(concat-symbols 'bomb-get- name))
  80.      (,(concat-symbols 'bomb-set- name) (car a)))))
  81.  
  82. (define-var color)         ; palette index ~ 0-100
  83. (define-var color-type)    ; cmap-*
  84. (define-var rule)          ; rule-*
  85. (define-var speed)
  86. (define-var mask)
  87. (define-var remap)
  88. (define-var randomized-underflow)
  89. (define-var brain)
  90. (define-var brain-shift)
  91. (define-var drift)
  92. (define-var drift-speed)
  93. (define-var drift-time)
  94. (define-var pen-size)
  95. (define-var hot)           ; in rule-rug, nframes heating (allow underflow)
  96. (define-var cool)          ; in rule-rug, nframes cooling (clamp at zero)
  97. (define-var cycle-bkg)     ; bool, effects rule-rug
  98.  
  99. (define (bomb-flame-shape-gen get set)
  100.   (lambda a
  101.     (if (null? a)
  102.     (let* ((s (with-input-from-string 
  103.               (string-append "(" (get) ")")
  104.             read)))
  105.       s)
  106.     (let ((list-of-strings
  107.            (let loop ((l (car a)))
  108.          (if (null? l)
  109.              '(";")
  110.              (let ((a (car l)))
  111.                (cons (if (number? a)
  112.                  (number->string a)
  113.                  (symbol->string a))
  114.                  (cons " " (loop (cdr l)))))))))
  115.       (set (apply string-append list-of-strings))))))
  116.  
  117. (define flame-shape (bomb-flame-shape-gen bomb-get-flame-cp bomb-set-flame-cp))
  118. (define flame-dir (bomb-flame-shape-gen bomb-get-flame-dir bomb-set-flame-dir))
  119.  
  120. (define (show-image n)
  121.   (bomb-file-to-image n 0)
  122.   (bomb-drive-with-image 0))
  123.  
  124. (define (repeat n f)
  125.   (if (= 0 n) 'ok (begin (f) (repeat (- n 1) f))))
  126.