SCHEME SAMPLE CODE

| Home Page | Balloons and Present | Pentagram | Concentric Circles | Main WebScheme


Ballon with Present
SCHEME CODE FOR BALLOONS AND PRESENT
PRACTICE FOR BASIC DRAWING COMMANDS
Balloon with Present

****** WARNING ******
DO NOT COPY THE BALLOON CODE. DO NOT USE FIND AND REPLACE TO MAKE IT APPEAR DIFFERENT.
I WILL KNOW YOU ARE CHEATING YOURSELF OUT OF AN EDUCATION!

;;Create a canvas size 640 x 480
(start 640 480)

;;Defines a constant for background of black with green grass on bottom
(define BACKGROUND
  (and
   (draw-solid-rect (make-posn 0 0) 640 480 BLACK)
   (draw-solid-rect (make-posn 0 450) 640 30 GREEN)))

;;Defines a constant for 3 ballons with strings
(define BALLOONS
  (and
   (draw-circle (make-posn 150 200) 40 RED)
   (draw-circle (make-posn 150 200) 39 RED)
   (draw-circle (make-posn 150 200) 38 RED)
   (draw-solid-line (make-posn 150 240) (make-posn 150 350) WHITE)
   (draw-solid-disk (make-posn 320 150) 50 YELLOW)
   (draw-solid-line (make-posn 320 200) (make-posn 320 300) WHITE)
   (draw-solid-disk (make-posn 450 250) 40 BLUE)
   (draw-solid-line (make-posn 450 290) (make-posn 450 380) WHITE)))

;;Defines a constant for present with a ribbon
(define PRESENT
  (and
   (draw-solid-rect (make-posn 220 400) 200 60 RED)
   (draw-solid-line (make-posn 317 400) (make-posn 317 459) BLUE)
   (draw-solid-line (make-posn 318 400) (make-posn 318 459) BLUE)
   (draw-solid-line (make-posn 322 400) (make-posn 322 459) BLUE)
   (draw-solid-line (make-posn 323 400) (make-posn 323 459) BLUE)
   (draw-solid-line (make-posn 220 427) (make-posn 420 427) BLUE)
   (draw-solid-line (make-posn 220 428) (make-posn 420 428) BLUE)
   (draw-solid-line (make-posn 220 431) (make-posn 420 431) BLUE)
   (draw-solid-line (make-posn 220 432) (make-posn 420 432) BLUE)))

;;Defines a constant for the bow on the present
(define BOW
  (and(draw-circle (make-posn 317 380) 20 BLUE)
  (draw-circle (make-posn 310 388) 20 BLUE)
  (draw-circle (make-posn 330 388) 20 BLUE)
  (draw-circle (make-posn 320 378) 20 BLUE)))

BACK TO TOP


5-pointed stars
SCHEME CODE FOR PENTAGRAM
Draws a Star of any Size at any Position
5-pointed stars

;;------------- TRIGONOMETRIC CONSTANTS USED IN STAR -------------
;;Canvas size smaller for testing.
(start 400 400)

;;radians: number -> number
;;convert degrees to radians for use in trig functions
(define (radians degrees)
  (/ (* degrees 22/7) 180))

(define 18d (radians 18))
(define 72d (radians 72))
(define 54d (radians 54))
(define 36d (radians 36))

;;------------- The FIVE POINTS ----------------------------
;;All Points: posn number -> Boolean

;;Draw the top point in a 5 pointed star
(define (topPoint center side)
  (make-posn
   (posn-x center)
   (round (- (posn-y center)
             (* side (sin 72d))
             (* (* side (sin 18d))(tan 54d))))))

;;Draw the right point in a 5 pointed star
(define (right center side)
  (make-posn
   (round(+(posn-x center)
           (* side(sin 18d))side))
   (round(-(posn-y center)(*(* side(sin 18d))(tan 54d))))))

;;Draw the left point in a 5 pointed star
(define(left center side)
  (make-posn
   (round(-(posn-x center)
           (* side (sin 18d))side))
   (round(-(posn-y center)(*(* side (sin 18d))(tan 54d))))))

;;Draw the bottom left point in a 5 point star
(define(leftBottom center side)
  (make-posn
   (round(-(posn-x center)
           (* side (sin 54d))))
   (round(+(posn-y center)
           (/ (* side (sin 18d))
              (cos 54d))
           (* side (sin 36d))))))

;;Draw the right bottom right point in a 5 points star
(define(rightBottom center side)
  (make-posn
   (round(+(posn-x center)
           (* side(sin 54d))))
   (round(+(posn-y center)(/(* side (sin 18d))(cos 54d))(* side (sin 36d))))))

;;-------------------- FIVE LINES ----------------------------
;;AllLines: posn number -> boolean

;;Draw the left line of a 5 pointed star
(define (leftLine center side)
  (draw-solid-line(topPoint center side)(leftBottom center side)BLACK))

;;Draw the horizontal line of a 5 pointed star
(define(hortLine center side)
  (draw-solid-line(right center side)(left center side)BLACK))

;;Draw the right line of a 5 pointed star
(define(rightLine center side)
  (draw-solid-line(rightBottom center side)(topPoint center side)BLACK))

;;Draw the line from the horizontal line to the left bottompoint
(define(hortLeft center side)
  (draw-solid-line(leftBottom center side)(right center side)BLACK))

;;Draw the lline from the horizontal line to the right bottom
(define(hortRight center side)
  (draw-solid-line(left center side)(rightBottom center side)BLACK))

;;----------------------- CENTER CIRCLE ------------------------------
;;circleCenter: posn number -> Boolean
;;Draw the center circle to cover up the lines
(define (circleCenter center side)
  (draw-solid-disk
   (make-posn(posn-x center)(posn-y center))
   (round(/(* side(sin 18d))(sin 36d)))WHITE))

;;---------------------- THE MAIN STAR PROGRAM --------------------------
;;star:posn number -> boolean
;;draw five point star
(define(star center side)
  (and(leftLine center side)
      (hortLeft center side)
      (hortLine center side)
      (hortRight center side)
      (rightLine center side)
      (circleCenter center side)))

;;-------------------- RECURSIVE STAR  --------------------------------
;;starBullseye: posn number number -> Boolean
;;draw a series of stars reduced by a specified value
(define(starBullseye center side decrement)
  (cond
    [(< side 1) true]
    [else (and(star center side)
              (starBullseye center (- side decrement) decrement))]))

;;------------------- SOLID COLORED STAR ------------------------------
;;colorStar: posn number color -> Boolean
(define (colorStarLine center side color)
  (and
   (draw-solid-line(topPoint center side)(leftBottom center side)color)
   (draw-solid-line(right center side)(left center side)color)
   (draw-solid-line(rightBottom center side)(topPoint center side)color)
   (draw-solid-line(leftBottom center side)(right center side)color)
   (draw-solid-line(left center side)(rightBottom center side)color)))

(define (colorStar center side color)
  (cond
    [(< side 1) true]
    [else (and (colorStarLine center side color)
               (colorStar center (- side 1) color))]))

;;----------------- EXAMPLES - FUNCTION CALLS ------------------------
;;Call after basic drawing is complete - if call on a white background, nothing shows
;;Changing color of starts to show on white background.
;;(start 800 600)
;;(draw-solid-rect (make-posn 0 0) 800 600 BLACK)
(colorStar(make-posn 50 60) 10 WHITE)
(colorStar(make-posn 400 85) 5 BLUE)
(colorStar(make-posn 80 90) 8 YELLOW)
(colorStar(make-posn 450 105) 1 GREEN)
(colorStar(make-posn 100 50) 7 WHITE)

BACK TO TOP


Concentric Circles
SCHEME CODE FOR BACKGROUND OF WEB PAGE
CONCENTRIC CIRCLES
Concentric Circles

;;Creates a canvas size 800 x 600
(start 800 600)

;;(define CONSTANT value)
(define MID-X 400)
(define MID-Y 300)

;;backgroundColor: color -> Boolean (rectangle)
;;Draws a rectangle 800 x 600 to create the background color under the concentric circles
(define (backgroundColor color)
  (draw-solid-rect (make-posn 0 0) 800 600 color))
(backgroundColor WHITE)
  
;;centerCircle: number color -> Boolean
;;Draws a circle in the center of a canvas size 800 by 600 of variable size and color
(define (centerCircle radius color)
  (draw-circle (make-posn MID-X MID-Y) radius color))

;;centerCircles number number color -> Boolean
;;Draws concentric circles in center of a web canvas whose radius is incremented
(define (centerCircles radius increment color)
  (and (centerCircle radius color)
       (centerCircle (+ radius increment) color)
       (centerCircle (+ radius (* increment 2)) color)
       (centerCircle (+ radius (* increment 3)) color)))

;;concentricCircles: posn number number color -> Boolean
;;Draws concentric circles recursively
(define (concentricCircles position radius increment color)
  (cond
    [(< radius 5) true]
    [else (and (draw-circle position radius color)
               (concentricCircles position (- radius increment)increment color))]))

;;Defines a constant which create the web background for main webScheme page
(define WEB-BACKGROUND
  (and
   (concentricCircles (make-posn 320 240) 200 10 BLACK)
   (concentricCircles (make-posn 100 100) 100 15 RED)
   (concentricCircles (make-posn 400 400) 500 50 GREEN)
   (concentricCircles (make-posn 400 200) 300 25 YELLOW)
   (concentricCircles (make-posn 300 200) 1000 5 BLUE)))
BACK TO TOP