write to file

Discussion of Scheme and Racket

write to file

Postby MadMuppet006 » Tue Aug 01, 2017 4:23 am

I am trying to write a mandelbrot set procedure to a ppm file. I can write the file ok and open it using gimp but the picture is not correct .. I am not sure what is wrong though my first impression is that I am writing the bytes the wrong way around ..

edit: no its not that I have tried 3 different approaches one to a binary ppm file one to an ascii ppm file and another ascii to console and they all give the same pic which is not correct .. I have edited the code it was pretty horrible so hopefully this makes more sense

any help appreciated ..

Code: Select all
;; aim to draw mandelbrot set using guile 2.2.2 on a raspberry pi 3 and using
;; http://netpbm.sourceforge.net/doc/ppm.html as source alternatively draw to repl

(use-modules (ice-9 binary-ports))
(use-modules (ice-9 format))

(define x 80)
(define y 50)
(define top-left-x (- 2.2))
(define top-left-y 1.0)
(define size-x 3.2)
(define size-y 2.0)
(define step-x (/ size-x x))
(define step-y (- (/ size-y y)))
(define escape 2.0)
(define maximum 128)
(define file-1 "foo.ppm") ;; using P6 format so binary file with ascii header
(define file-2 "bar.ppm") ;; using P3 format so asci file bigger file for same size pic

(define (sq n)(* n n))

(define create-one-line ;; (create-one-line top-left-x step-x top-left-x 1 80)
  (lambda (value step start c end)
    (if (>= c end)
   (cons value '())
   (cons value (create-one-line (+ value step) step start (+ c 1) end)))))

(define create-one-line-x (create-one-line top-left-x step-x top-left-x 1 x))

(define (make-complex a b)
  (make-rectangular a b))

(define (inside? n)
  (< (magnitude n) escape))

(define check?
  (lambda (n)
    (letrec
   ((hf (lambda (c n)
          (if (and (< c maximum)(inside? n))
         (hf (+ c 1)(+ (sq n) n))
         c))))
      (hf 0 n))))

(define create-one-line-x-and-y ;; (create-one-line-x-and-y y-value create-one-line-x)
  (lambda (y-value lst)
    (if (null? (cdr lst))
   (cons (make-complex (car lst) y-value)'())
   (cons (make-complex (car lst) y-value)
         (create-one-line-x-and-y y-value (cdr lst))))))

(define lst
  (lambda (c y-value step end)
    (if (>= c end)
   (create-one-line-x-and-y y-value create-one-line-x)
   (append (create-one-line-x-and-y y-value create-one-line-x)
      (lst (+ c 1)(+ y-value step) step end)))))

(define baz ;; use this procedure to produce pic in console
  (lambda (n)
    (if (= (check? n) maximum)
   'N
   'O)))

(define foo ;; (foo (open-output-file file-1)) ;; can do this better but works for now
  (lambda (port)
    (begin
      (display "P6"    port)(newline port)
      (display  x      port)(newline port)
      (display  y      port)(newline port)
      (display maximum port)(newline port)
      (letrec
     ((hf (lambda (ls)
       (if (null? (cdr ls))
           (begin
             (put-u8 port (check? (car ls)))
             (put-u8 port (check? (car ls)))
             (put-u8 port (check? (car ls)))
             (close-port port))
           (begin
             (put-u8 port (check? (car ls)))
             (put-u8 port (check? (car ls)))
             (put-u8 port (check? (car ls)))
             (hf (cdr ls)))))))
   (hf (lst 1 1.0 step-y y))))))

(define bar ;; should be (bar-2 (open-output-file file-2))
  (lambda (port)
    (begin
      (display "P3"    port)(newline port)
      (display x       port)(newline port)
      (display y       port)(newline port)
      (display maximum port)(newline port)
      (letrec
     ((hf (lambda (ls)
       (if (null? (cdr ls))
           (begin
             (display (check? (car ls)) port)(format port "~_") ;; make this better
             (display (check? (car ls)) port)(format port "~_")
             (display (check? (car ls)) port)(format port "~_")
             (close-port port))
           (begin
             (display (check? (car ls)) port)(format port "~_")
             (display (check? (car ls)) port)(format port "~_")
             (display (check? (car ls)) port)(format port "~_")
             (newline port)
             (hf (cdr ls)))))))
   (hf (lst 1 1.0 step-y y))))))

((lambda () ;; write to console will produce pic straight away if this file loaded into repl
  (letrec
      ((hf (lambda (lst c)
        (cond
         ((zero? (modulo c x))
          (cond
      ((null? (cdr lst))(display (baz (car lst))))
      (else ((lambda ()
          (newline)
          (display (baz (car lst))
              (hf (cdr lst)(+ c 1))))))))
         ((null? (cdr lst))(display (baz (car lst))))
         (else
          ((lambda ()
        (display (baz (car lst)))
        (hf (cdr lst)(+ c 1)))))))))
    (hf (lst 1 1.0 step-y y) 1))))
MadMuppet006
 
Posts: 11
Joined: Wed Nov 02, 2011 11:56 pm

Return to Scheme

Who is online

Users browsing this forum: No registered users and 1 guest