;;; makebmp.scm --- make bitmap from textual description
;;;
;;; This file is gift-ware.  This file is given to you freely
;;; as a gift.  You may use, modify, redistribute, and generally hack
;;; it about in any way you like, and you do not have to give anyone
;;; anything in return.
;;;
;;; I do not accept any responsibility for any effects, adverse or
;;; otherwise, that this code may have on just about anything that
;;; you can think of.  Use it at your own risk.
;;;
;;; Copyright (C) 1999  Michael Bukin

(define (make-bitmap-from-text filename colors pixels)
  (let ((bitmap #f)
	(size #f)
	(w 0)
	(h 0))
    (al:install_allegro al:system_none)
    (al:set_palette (al:default_palette))

    ;; Create bitmap size with correct size.
    (set! size (do ((h 0 (1+ h))
		    (w 0))
		   ((>= h (vector-length pixels)) (cons w h))
		 (if (> (string-length (vector-ref pixels h)) w)
		     (set! w (string-length (vector-ref pixels h))))))
    (set! w (car size))
    (set! h (cdr size))
    (set! bitmap (al:create_bitmap w h))
    (al:clear bitmap)

    ;; Fill bitmap with data.
    (do ((y 0 (1+ y))
	 (line #f)
	 (size 0))
	((>= y h) #f)
      (set! line (vector-ref pixels y))
      (set! size (string-length line))
      (do ((x 0 (1+ x))
	   (color #f))
	  ((>= x size) #f)
	(set! color (assoc (string-ref line x) colors))
	(if color
	    (al:putpixel bitmap x y (cadr color)))))

    (al:save_bitmap filename bitmap (al:default_palette))
    (al:destroy_bitmap bitmap)

    (al:allegro_exit)))

(make-bitmap-from-text "ghost.pcx"
		       '((#\  0) (#\a 4))
		       '#("      aaaaaaa       "
			  "     aaaaaaaaa      "
			  "    aaaaaaaaaaa     "
			  "   aaaaaaaaaaaaa    "
			  "  aaa   aaa   aaa   "
			  " aaaa   aaa   aaaa  "
			  "aaaaa   aaa   aaaaa "
			  "aaaaa   aaa   aaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaaaaaaaaaaaaaaaaaa "
			  "aaa aaaaa aaaaa aaa "
			  "aa   aaa   aaa   aa "
			  "a     a     a     a "
			  "                    "))

(make-bitmap-from-text "wall.pcx"
		       '((#\  0) (#\a 7) (#\b 15) (#\c 15) (#\d 8) (#\e 8))
		       '#("                    "
			  " accccccccccccccca  "
			  " bacccccccccccccad  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " bbaaaaaaaaaaaaadd  "
			  " baeeeeeeeeeeeeead  "
			  " aeeeeeeeeeeeeeeea  "
			  "                    "
			  "                    "))

(make-bitmap-from-text "eater.pcx"
		       '((#\  0) (#\a 14))
		       '#("       aaaaa        "
			  "    aaaaaaaaaaa     "
			  "   aaaaaaaaaaaaaa   "
			  "  aaaaaaaaaaaaaa    "
			  " aaaaaaaaaaaaaa     "
			  " aaaaaaaaaaaaa      "
			  " aaaaaaaaaaaa       "
			  "aaaaaaaaaaaa        "
			  "aaaaaaaaaaa         "
			  "aaaaaaaaaa          "
			  "aaaaaaaaaaa         "
			  "aaaaaaaaaaaa        "
			  " aaaaaaaaaaaa       "
			  " aaaaaaaaaaaaa      "
			  " aaaaaaaaaaaaaa     "
			  "  aaaaaaaaaaaaaa    "
			  "   aaaaaaaaaaaaaa   "
			  "    aaaaaaaaaaa     "
			  "       aaaaa        "
			  "                    "))

(make-bitmap-from-text "bonus.pcx"
		       '((#\  0) (#\a 4))
		       '#("                    "
			  "         a          "
			  "        aaa         "
			  "        aaa         "
			  "    aa  aaa  aa     "
			  "    aaa aaa aaa     "
			  "     aaaaaaaaa      "
			  "      aaaaaaa       "
			  "  aaaaaaaaaaaaaaa   "
			  " aaaaaaaaaaaaaaaaa  "
			  "  aaaaaaaaaaaaaaa   "
			  "      aaaaaaa       "
			  "     aaaaaaaaa      "
			  "    aaa aaa aaa     "
			  "    aa  aaa  aa     "
			  "        aaa         "
			  "        aaa         "
			  "         a          "
			  "                    "
			  "                    "))

(make-bitmap-from-text "coin.pcx"
		       '((#\  0) (#\a 14) (#\b 4))
		       '#("                    "
			  "                    "
			  "                    "
			  "                    "
			  "                    "
			  "                    "
			  "        aaa         "
			  "       aaaaa        "
			  "      aaaaaaa       "
			  "      aaaaaaab      "
			  "      aaaaaaab      "
			  "       aaaaabb      "
			  "        aaabb       "
			  "         bbb        "
			  "                    "
			  "                    "
			  "                    "
			  "                    "
			  "                    "
			  "                    "))

(make-bitmap-from-text "prize.pcx"
		       '((#\  0) (#\a 7) (#\b 15) (#\c 8))
		       '#("                    "
			  "        b           "
			  "       b            "
			  "      b             "
			  "      b  b          "
			  "      b   b         "
			  "       b  b         "
			  "          b         "
			  "         b          "
			  "                    "
			  "        aaa         "
			  "      acaaaaa       "
			  "    aaaacaaacaa     "
			  "  aacaaaaacaaaaaa   "
			  " aaaacaaacaacaaaaa  "
			  "  aaaaacaaaaaacaa   "
			  "     aaacaaaaa      "
			  "                    "
			  "                    "
			  "                    "))

;;; makebmp.scm ends here
