[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Beginners problem with programing




Im beginner in scheme and I couldn t affect with one homework.

I may modify plot function to draw not only graph (like line), but also
fill area between graph and axis.

This is a program and file which is loading is in attatchment. 


;; PROGRAM !!!

(load "canvas.scm")                                              

(define pi (* 4 (atan 1)))                                       

(define (draw-axes x y)                                          
  (graphics-line 0 (- y) 0 y GRAY)
  (graphics-line 0 0 x 0 GRAY))

(define (plot-function x a b dx)
  (graphics-line-to x (* (sin (* a x)) (cos (* b x))) RED)

  (if (< x (* 2 pi))                                             
      (plot-function (+ x dx) a b dx)))                 

(define (draw-function width height x y a b dx )
  (graphics-init width height 0 (- y) x y)
  (draw-axes x y)
  (plot-function 0 a b dx)
  (graphics-click)
  (graphics-done))

(draw-function 640 160 (* 2 pi) 1 1 1 0.005 )

;; END !!!
  
Now Im desperate from scheme, because I m not be able to solve this
problem.


Thanx for help!!!

TuLeN
;;;;;
;;;;;  PP1, Simple Canvas Library
;;;;;  Written by Vilem Vychodil, <vilem.vychodil@upol.cz>
;;;;;

;; graficka knihovna
(require-library "graphics.ss" "graphics")

;; nedefinovana funkce
(define undefined-f (lambda arg (error "Use init-graphics first.")))

;; definice symbolu pro funkce
(define graphics-move-to undefined-f)
(define graphics-line-to undefined-f)
(define graphics-line undefined-f)
(define graphics-polyline undefined-f)
(define graphics-done undefined-f)
(define graphics-clear undefined-f)
(define graphics-click undefined-f)

;; definice barev
(define BLACK (make-rgb 0 0 0))
(define BLUE (make-rgb 0 0 0.5))
(define GREEN (make-rgb 0 0.5 0))
(define CYAN (make-rgb 0 0.5 0.5))
(define RED (make-rgb 0.5 0 0))
(define MAGENTA (make-rgb 0.5 0 0.5))
(define YELLOW (make-rgb 0.5 0.5 0))
(define GRAY (make-rgb 0.5 0.5 0.5))

;; inicialisace grafickeho rozhrani
(define (graphics-init width height minx miny maxx maxy)
  (let* ((viewport #f)
	 ; okraj
	 (border 16)
	 ; implicitni barva
	 (default-color (make-rgb 0 0 0))
	 ; vrat barvu pokud je specifikovana, nebo implicitni
	 (get-color (lambda (color)
		      (if (null? color)
			  default-color
			  (car color))))
	 ; okenkova transformace
	 (model->viewport (lambda (x w min max)
			    (+ (* w (/ (- x min) (- max min))) border)))
	 ; prvni posice
	 (last-pos (make-posn 
		    (model->viewport 0 width minx maxx)
		    (model->viewport 0 height maxy miny)))
	 ; universalni kreslici funkce
	 (draw (lambda (x y line? color)
		 (let ((real-last-pos last-pos))
		   (begin
		     (set! last-pos
			   (make-posn (model->viewport x width minx maxx)
				      (model->viewport y height maxy miny)))
		     (if line? ((draw-line viewport)
				real-last-pos last-pos (get-color color))))))))
    (begin
      (open-graphics)
	 
      ; inicialisace okna
      (set! viewport 
	    (open-viewport "DrScheme Canvas"
			   (+ width (* 2 border)) (+ height (* 2 border))))
       
      ; vycisti okno
      (set! graphics-clear
	    (lambda ()
	      ((clear-viewport viewport))))
	
      ; cekej na kliknuti
      (set! graphics-click 
	    (lambda () (get-mouse-click viewport)))

      ; ukonci grafiku
      (set! graphics-done
	    (lambda () 
	      (begin 
		(close-viewport viewport)
		(close-graphics)
		(set! graphics-move-to undefined-f)
		(set! graphics-line-to undefined-f)
		(set! graphics-line undefined-f)
		(set! graphics-polyline undefined-f)
		(set! graphics-done undefined-f)
		(set! graphics-clear undefined-f))))

      ; nakresli caru od -- do
      (set! graphics-line (lambda (x1 y1 x2 y2 . color)
			    (begin
			      (draw x1 y1 #f color)
			      (draw x2 y2 #t color))))

      ; nakresli lomenou caru, argumenty jsou teckove pary souradnic
      (set! graphics-polyline 
	    (lambda args
	      (let* ((len (length args))
		     (last (if (and (> len 0)
				    (not (pair? 
					  (list-ref args (- len 1)))))
			       (list (list-ref args (- len 1)))
			       ())))
		(if (and (not (null? args))
			 (or (not (null? last))
			     (not (null? (cdr args)))))
		    (begin
		      (draw (caar args) (cdar args) #f last)
		      (for-each (lambda (pos)
				  (draw (car pos) 
					(cdr pos) #t last))
				(cdr args)))))))
       
      ; move-to, line-to -- klasika, zelvicka
      (set! graphics-move-to (lambda (x y . color) (draw x y #f color)))
      (set! graphics-line-to (lambda (x y . color) (draw x y #t color))))))