X-Git-Url: http://uxul.de/gitweb/?a=blobdiff_plain;f=bmp.lisp;h=3597045e2dfced9005f6df234a6d27eeb91ed4a2;hb=fe47814b2cd1ec57db67e494ff48faae46ffe21c;hp=0b05d552ced739463ebb33e81c88d81492b8897e;hpb=074a5863f985bd9a078f41af96310fd55828df3f;p=uxul-world.git

diff --git a/bmp.lisp b/bmp.lisp
index 0b05d55..3597045 100755
--- a/bmp.lisp
+++ b/bmp.lisp
@@ -1,6 +1,6 @@
 ;;; -*- lisp -*-
 
-;;; Copyright 2010 Christoph Senjak
+;;; Copyright 2010-2011 Christoph Senjak
 
 (in-package :uxul-world)
 
@@ -115,6 +115,17 @@ all."
 		    :displaced-index-offset o)
 	(subseq sequence o (+ o l)))))
 
+(defun blit-image (x y src-width src-height src-blob
+		   dst-width dst-height dst-blob)
+  (declare (ignore dst-height))
+  (do ((cx 0 (1+ cx))) ((= cx src-width))
+    (do ((cy 0 (1+ cy))) ((= cy src-height))
+      (let ((src-pos (* 4 (+ cx (* cy src-width))))
+	    (dst-pos (* 4 (+ (+ x cx) (* (+ y cy) dst-width)))))
+	(do ((i 0 (1+ i))) ((= i 4))
+	  (setf (elt dst-blob (+ i dst-pos))
+		(elt src-blob (+ i src-pos))))))))
+
 (defun resize-pixeldata
     (argb-pixeldata old-width old-height new-width new-height
      &optional (new-pixeldata (make-array (list (* 4 new-width new-height))