[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))))))