write to file

Discussion of Scheme and Racket
Post Reply
MadMuppet006
Posts: 11
Joined: Wed Nov 02, 2011 11:56 pm

write to file

Post by 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))))

Post Reply