gistfile1.txt

                                                                     
                                                                     
                                                                     
                                             
#lang racket

#|
P1  Portable bitmap   ASCII
P2  Portable graymap  ASCII
P3  Portable pixmap   ASCII
P4  Portable bitmap   Binary
P5  Portable graymap  Binary
P6  Portable pixmap   Binary
|#


(define cartella-immagini "C:/Users/bernardip/Desktop/Memorie/TEMP/001/")

(define immagini
  '(("IMG_2006" 1/2048)
    ("IMG_2007" 1/512)
    ("IMG_2008" 1/128)
    ("IMG_2009" 1/32)
    ("IMG_2010" 1/8)
    ("IMG_2011" 1/2)))

(define (prova2 info)
  (define aperti
    (map (位 (x)
           (match x
             ((list nome tempo)
              (define nome-in (string-append cartella-immagini nome ".ppm"))
              (list (open-input-file nome-in #:mode 'binary) tempo))))
         info))
  (define xdim #f)
  (define ydim #f)
  (define qcolori #f)
  (for-each (位 (x)
              (define dadove (first x))
              (define linea1 (read-line dadove))
              (unless (string=? linea1 "P6")
                (error 'errore-1))
              (set! xdim (read dadove))
              (set! ydim (read dadove))
              (set! qcolori (read dadove))
              (read-line dadove))
            aperti)
  (define nome-out (string-append cartella-immagini "xxx.ppm"))
  (define addove (open-output-file nome-out))
  (displayln "P3" addove)
  (display xdim addove)
  (display " " addove)
  (display ydim addove)
  (newline addove)
  (display 65535 addove)
  (newline addove)
  (define massimo 0)
  (for ((y (in-range ydim)))
    (for ((x (in-range xdim)))
      (define rgb (media (map (位 (dd)
                                (leggi-rgb (first dd)))
                              aperti)
                         aperti))
      (define r (round (vector-ref rgb 0)))
      (define g (round (vector-ref rgb 1)))
      (define b (round (vector-ref rgb 2)))
      (define m (max r g b))
      (when (> m massimo)
        (set! massimo m))
      (display r addove)
      (display " " addove)
      (display g addove)
      (display " " addove)
      (display b addove)
      (display " " addove))
    (newline addove))
  (for-each (位 (x)
              (close-input-port (first x)))
            aperti)
  (close-output-port addove)
  massimo)

(define (media lrgb aperti)
  (define nr 0)
  (define ng 0)
  (define nb 0)
  (define r 0)
  (define g 0)
  (define b 0)
  (define inf (* 20 256))
  (define sup (* 200 256))
  (for-each (位 (rgb aperto)
              (define tempo (second aperto))
              (match rgb
                ((vector rr gg bb)
                 (when (<= inf rr sup)
                   (set! nr (add1 nr))
                   (set! r (+ r (/ rr tempo))))
                 (when (<= inf gg sup)
                   (set! ng (add1 ng))
                   (set! g (+ g (/ gg tempo))))
                 (when (<= inf bb sup)
                   (set! nb (add1 nb))
                   (set! b (+ b (/ bb tempo)))))))
              lrgb
              aperti)
            (vector (f/ r nr)
                    (f/ g ng)
                    (f/ b nb)))
  
  (define (f/ nume deno)
    (if (zero? deno)
      0
      (/ nume deno)))
  
  (define (leggi-rgb dadove)
    (define rgb (for/vector ((i (in-range 3)))
                  (let* ((b1 (read-byte dadove))
                         (b2 (read-byte dadove)))
                    (+ (* b1 256) b2))))
    (define r (vector-ref rgb 0))
    (define g (vector-ref rgb 1))
    (define b (vector-ref rgb 2))
    (vector r g b))
  
  (define (prova)
    (for-each (位 (dp)
                (define nome (first dp))
                (define nome-in (string-append cartella-immagini nome ".ppm"))
                (define nome-out (string-append cartella-immagini "xxx-" nome ".ppm"))
                (displayln (list "leggo:" nome-in))
                (define imm (read-ppm nome-in (second dp)))
                (displayln (list "scrivo:" nome-out))
                (scrivi-ppm nome-out imm))
              immagini))
  
  (struct immagine (xdim ydim data))
  
  (define (read-ppm filename
                    (esposizione 1)
                    (soglia-min 1/10)
                    (soglia-max 9/10)
                    )
    (define fattore (/ esposizione))
    (call-with-input-file filename
      (位 (in)
        (let ((sig (read-line in)))
          (unless (string=? sig "P6")
            (error 'read-ppm))
          (let* ((xdim (read in))
                 (ydim (read in))
                 (colori (read in))
                 (ignore (read-line in))
                 (data (for/vector ((y (in-range ydim)))
                         (for/vector ((x (in-range xdim)))
                           (define rgb (for/vector ((i (in-range 3)))
                                         (let* ((b1 (read-byte in))
                                                (b2 (read-byte in)))
                                           (* fattore (+ (* b1 256) b2)))))
                           (define r (vector-ref rgb 0))
                           (define g (vector-ref rgb 1))
                           (define b (vector-ref rgb 2))
                           #;(/ (+ (* 54 256 r) (* 183 256 g) (* 19 256 b))
                                (* 256f0 256f0))
                           (vector r g b)
                           ))))
            (immagine xdim ydim data))))))
  
  (define output-prova
    (string-append cartella-immagini "output-prova-2011.pgm"))
  
  (define (scrivi-pgm filename imm)
    (call-with-output-file filename
      (位 (out)
        (match imm
          ((immagine xdim ydim data)
           
           (define massimo 0)
           (for ((y (in-range ydim)))
             (let ((riga (vector-ref data y)))
               (for ((x (in-range xdim)))
                 (define v (inexact->exact (round (vector-ref riga x))))
                 (when (> v massimo)
                   (set! massimo v)))))
           
           (displayln "P2" out)
           (display xdim out)
           (display " " out)
           (display ydim out)
           (newline out)
           (displayln massimo out)
           (for ((y (in-range ydim)))
             (let ((riga (vector-ref data y)))
               (for ((x (in-range xdim)))
                 (display (inexact->exact (round (vector-ref riga x))) out)
                 (display " " out)))
             (newline out)))))))
  
  
  (define (scrivi-ppm filename imm)
    (call-with-output-file filename
      (位 (out)
        (match imm
          ((immagine xdim ydim data)
           
           (define massimo 0)
           (for ((y (in-range ydim)))
             (let ((riga (vector-ref data y)))
               (for ((x (in-range xdim)))
                 (define pix (vector-ref riga x))
                 (for ((i (in-range 3)))
                   (define v (vector-ref pix i))
                   (when (> v massimo)
                     (set! massimo v))))))
           
           (define amp
             (string-length (number->string massimo)))
           
           (displayln "P3" out)
           (display xdim out)
           (display " " out)
           (display ydim out)
           (newline out)
           (displayln massimo out)
           (for ((y (in-range ydim)))
             (let ((riga (vector-ref data y)))
               (for ((x (in-range xdim)))
                 (define pix (vector-ref riga x))
                 (for ((i (in-range 3)))
                   (define v (number->string (vector-ref pix i)))
                   (spazi (- amp (string-length v)) out)
                   (display v out)
                   ;(display (vector-ref pix i) out)
                   (display " " out))
                 (display "   " out))
               (newline out))))))))
  
  (define (spazi quanti dove)
    (for ((i (in-range quanti)))
      (display #\Space dove)))