Sync

Task/Image-noise/Common-Lisp/image-noise.lisp

@@ -0,0 +1,40 @@
+;; (require :lispbuilder-sdl)
+
+(defun draw-noise (surface)
+  "draws noise on the surface. Returns the surface"
+  (let ((width (sdl:width surface))
+	(height (sdl:height surface))
+	(i-white (sdl:map-color sdl:*white* surface))
+	(i-black (sdl:map-color sdl:*black* surface)))
+    (sdl-base::with-pixel (s (sdl:fp surface))
+      (dotimes (h height)
+	(dotimes (w width)
+	  ;;(sdl:draw-pixel-* w h :surface s :color (if (zerop (random 2)) sdl:*white* sdl:*black*)))))
+	  (sdl-base::write-pixel s w h (if (zerop (random 2))
+					   i-white i-black ))))))
+  surface)
+
+(defun draw-fps (surface)
+  "draws fps text-info on surface. Returns surface"
+  (sdl:with-surface (s surface)
+    (sdl:draw-string-solid-* (format nil "FPS: ~,3f" (sdl:average-fps))
+			     20 20 :surface s :color sdl:*magenta*)))
+
+(defun main ()
+  "main function, creates initializes the library and creates de display window"
+  (setf *random-state* (make-random-state))
+  (sdl:with-init (SDL:SDL-INIT-VIDEO SDL:SDL-INIT-TIMER)
+    (let ((main-window (sdl:window 320 240
+				   :title-caption "noise_sdl.lisp"
+				   :bpp 8
+				   :flags (logior SDL:SDL-DOUBLEBUF SDL:SDL-HW-SURFACE)
+				   :fps (make-instance 'sdl:fps-unlocked))))
+      (sdl:initialise-default-font)
+      (sdl:with-events ()
+	(:idle ()
+	       (sdl:update-display (draw-fps (draw-noise main-window))))
+	(:video-expose-event ()
+			     (sdl:update-display))
+	(:quit-event () T)))))
+
+(main)

Task/Image-noise/Racket/image-noise.rkt

@@ -0,0 +1,26 @@
+#lang racket
+(require 2htdp/image 2htdp/universe)
+
+(define black (color   0   0   0 255))
+(define white (color 255 255 255 255))
+
+(define-struct world (last fps))
+
+(define (noise w h)
+  (color-list->bitmap
+   (for*/list ([x (in-range w)] [y (in-range h)])
+     (if (zero? (random 2)) black white))
+   w h))
+
+(define (draw w)
+  (underlay/xy
+   (noise 320 240) 0 0
+   (text (number->string (world-fps w)) 64 "Red")))
+
+(define (handle-tick w)
+  (define cm (current-inexact-milliseconds))
+  (make-world cm (exact-floor (/ 1000.0 (- cm (world-last w))))))
+
+(big-bang (make-world 1 0)
+          [on-draw draw]
+          [on-tick handle-tick (/ 1. 120)])