From MHCGraphics
; Mead definitions for a model of a three-way intersection
; used for Exam 1, Spring 2008
;
; Jim Teresco
; Computer Science 110
; Mount Holyoke College
;
; $Id: SignScene.scm 542 2008-03-07 00:20:42Z terescoj $
;
(require (lib "Defs.ss" "Mead"))
; we'll put in our own lights later
(object scene Group)
; a constant for scale throughout
(define roadWidth 300)
(define laneWidth (/ roadWidth 2))
; some lighting
(object sun Light
(color white)
(intensity 1)
)
(object moon Light
(color white)
(intensity 0.2)
)
(object headlight Light
(color white)
(intensity 0.5)
)
(object headlights Group
(add headlight (translate (/ laneWidth 6) 25 (- (* 2 roadWidth))))
(add headlight (translate (* 5 (/ laneWidth 6))
25 (- (* 2 roadWidth))))
)
(object lighting Group
(add moon (translate 2000 2000 -2000))
(add headlights)
;(add bulb (translate 300 300 0))
)
; Build a stop sign
;
; Some materials for the stop sign
(object reflectiveRed Material
(color red)
(ambient 0.1)
(diffuse 0.6)
(roughness 0.1)
(specularity 0.8)
)
;
; First the octagonal face.
; It's an octagon, so we'll start with a (polygon 8)
; and rotate it appropriately. This will be passed
; as the profile polygon for a Prism object, which is
; then shrunk to a thickness of 10 in the z direction,
; and expanded to be 100x100 in the x and y directions.
; Define the amount we need to scale up to get from the
; somewhat smaller octagon up to one that is 100x100.
(define octScaleUp (/ 1 (cos (/ pi 8))))
(object octPrism Prism
(profile (polyXform (2to3d (polygon 8))
(zRot (/ 360.0 16)))
)
(scale octScaleUp octScaleUp .1)
)
; An octagonal border for our sign, which will be white
; around the main red face. This is created with a sweep
; of a square profile. Note that we make the border a bit
; thicker than the main plate of the stop sign.
(define octBorder
(sweep
(closeList
(2to3d '((47.5 -7.5) (47.5 7.5) (52.5 7.5) (52.5 -7.5)))
)
8)
)
; construct our stop sign
(object stopSign Group
(add octPrism reflectiveRed
(translate 0 50 0)
)
(add octBorder whitePlaster
(compose
(yRot (/ 360.0 16))
(scale octScaleUp 1 octScaleUp)
(xRot 90)
(translate 0 50 0)
)
)
(add cube ltGrayPlaster
(scale .08 2 .08)
(translate 0 -100 0)
)
)
; a yellow double arrow sign
; Some materials for the arrow sign
(object reflectiveYellow Material
(color (hsv2rgb '(50 0.9 .5)))
(ambient 0.1)
(diffuse 0.75)
(roughness 0.1)
(specularity 0.8)
)
; first to build the yellow rectangular sign with rounded
; edges
; Start with a 100x50x5 cube, and shave off the corners
(define arrowSignWidth 100)
(define arrowSignHeight 50)
(define arrowSignThickness 5)
(define arrowSignCornerRadius 10)
(object cornerShaver Cube
(scale .01 .01 .01)
(scale arrowSignCornerRadius
arrowSignCornerRadius
(* 2 arrowSignThickness))
(zRot 45)
)
(object arrowSignNoCorners Difference
(add cube
(compose
(scale .01 .01 .01)
(scale arrowSignWidth
arrowSignHeight
arrowSignThickness)
)
)
(add cornerShaver
(translate (/ arrowSignWidth 2)
(/ arrowSignHeight 2)
0)
)
(add cornerShaver
(translate (- (/ arrowSignWidth 2))
(/ arrowSignHeight 2)
0)
)
(add cornerShaver
(translate (/ arrowSignWidth 2)
(- (/ arrowSignHeight 2))
0)
)
(add cornerShaver
(translate (- (/ arrowSignWidth 2))
(- (/ arrowSignHeight 2))
0)
)
)
; now, add rounded corners back in
(object arrowSignCorner Cylinder
(scale .01 .01 .01)
(scale arrowSignCornerRadius
arrowSignThickness
arrowSignCornerRadius)
(xRot 90)
)
; convenient values for translations below
(define xTrans
(- (/ arrowSignWidth 2) (/ arrowSignCornerRadius 2)))
(define yTrans
(- (/ arrowSignHeight 2) (/ arrowSignCornerRadius 2)))
(object arrowSignBlankNoBorder Group
(add arrowSignNoCorners)
(add arrowSignCorner
(translate xTrans yTrans 0)
)
(add arrowSignCorner
(translate (- xTrans) yTrans 0)
)
(add arrowSignCorner
(translate xTrans (- yTrans) 0)
)
(add arrowSignCorner
(translate (- xTrans) (- yTrans) 0)
)
)
; add a black border near the egde of the sign
(define xBorderScale .97)
(define yBorderScale .94)
(object arrowSignOuterBorder Difference
(add arrowSignBlankNoBorder)
(add arrowSignBlankNoBorder
(scale xBorderScale yBorderScale 1.1)
)
)
(object arrowSignInnerBorder Difference
(add arrowSignBlankNoBorder
(scale xBorderScale yBorderScale 1)
)
(add arrowSignBlankNoBorder
(scale (* xBorderScale xBorderScale)
(* yBorderScale yBorderScale) 1.1)
)
)
(object arrowSignBlank Group
(add arrowSignBlankNoBorder reflectiveYellow
(scale (* xBorderScale xBorderScale)
(* yBorderScale yBorderScale) 1)
)
(add arrowSignInnerBorder blackPlaster)
(add arrowSignOuterBorder reflectiveYellow)
)
; to add the arrow, we define a polygon of the appropriate
; shape to be used to create a Prism.
; Note: ideally, the polygon would be defined relative to the
; sign size constants above
(define arrowOutline
'((40 0) (20 -20) (25 -10) (-25 -10) (-20 -20)
(-40 0) (-20 20) (-25 10) (25 10) (20 20)))
(object arrow Prism
(profile (closeList (2to3d arrowOutline)))
(scale 1 1 (* .01 arrowSignThickness))
)
(object arrowSignPost Cube
(scale .05 2 .05)
(translate 0 -100 5)
)
; put it all together
(object arrowSign Group
(add arrowSignBlank)
(add arrow blackPlaster
(translate 0 0 -1)
)
(add arrowSignPost ltGrayPlaster
(translate (/ arrowSignWidth 3) 0 0))
(add arrowSignPost ltGrayPlaster
(translate (- (/ arrowSignWidth 3)) 0 0))
)
; some roads
; an asphalt material
(object asphalt Material
(color '(0.005 0.005 0.005))
;(color magenta)
(diffuse 0.1)
(ambient 0)
(roughness 25)
(specularity 0.1)
)
; shiny yellow paint for lines
(object shinyYellowPaint Material
(color yellow)
(diffuse 0.8)
(ambient 0.1)
(roughness 2)
(specularity 1)
)
; a piece of road roadWidth wide (x), 1 long (z), 10 deep (y)
(object roadSurfaceUnit Cube
(material asphalt)
(scale (/ roadWidth 100) .1 .01)
)
; road segment with double solid yellow lines
(define stripeWidth (/ roadWidth 30))
(object yellowStripe Cube
(material shinyYellowPaint)
; scale appropriately
(scale (/ stripeWidth 100) .1 .01)
; raise up so stripe is visible above the road surface
(translate 0 .01 0)
)
(object roadSurfaceNoPassing Group
(add roadSurfaceUnit)
(add yellowStripe
(translate stripeWidth 0 0))
(add yellowStripe
(translate (- stripeWidth) 0 0))
)
; our roads
(define zRoadLength 1000)
(define xRoadLength 100000)
(object roads Group
; road along the z-axis
(add roadSurfaceNoPassing
(compose
(scale 1 1 zRoadLength)
(translate 0 0
(- (- (/ zRoadLength 2))
(/ roadWidth 2)))
)
)
; road along the x-axis, the negative part
(add roadSurfaceNoPassing
(compose
(scale 1 1 xRoadLength)
(yRot 90)
(translate (- (- (/ xRoadLength 2))
(/ roadWidth 2)) 0 0)
)
)
; road along the x-axis, the positive part
(add roadSurfaceNoPassing
(compose
(scale 1 1 xRoadLength)
(yRot 90)
(translate (+ (/ xRoadLength 2)
(/ roadWidth 2)) 0 0)
)
)
; the intersection pavement
(add roadSurfaceUnit
(compose
(scale 1 1 roadWidth)
)
)
)
(tell scene
(add lighting)
(add (new Plane) greenPlaster)
; stop sign on the z-axis road
(add stopSign
(compose
(scale .5 .5 .5)
(translate (* .6 roadWidth) 100 (- roadWidth)))
)
; stop sign on the negative-bound x-axis road
(add stopSign
(compose
(scale .5 .5 .5)
(yRot -90)
(translate (* .6 roadWidth) 100 (* .6 roadWidth))
)
)
; stop sign on the positive-bound x-axis road
(add stopSign
(compose
(scale .5 .5 .5)
(yRot 90)
(translate (- (* .6 roadWidth)) 100
(- (* .6 roadWidth)))
)
)
(add roads)
(add arrowSign (translate 0 100 (* roadWidth .6)))
)
(tell image
(background '(0 0 .5))
(antiAlias 1)
)
; zoom in on the arrow sign
(tell camera
(pos '(0 150 -100))
(coi '(0 100 50))
(shoot))
; zoom in on illuminated sign of the closest stop sign
(tell camera
(pos '(250 150 -500))
(coi '(100 50 -100))
(shoot))
; now on one of the other stop signs
(tell camera
(pos '(750 250 0))
(coi '(0 0 0))
(shoot))
; the full scene -- at a larger resolution
(tell image (dimensions 1280 1024))
(tell camera
(pos '(0 300 -1000))
(shoot))
