;;; Scheme Recursive Art Contest Entry
;;;
;;; Please do not include your name or personal info in this file.
;;;
;;; Title: Nostalgia, Inspiration, Imagination
;;;
;;; Description:
;;;   Simple childhood blocks
;;;    Legend among memories
;;;    	Birthplace of ideas
(define (draw)
  	(bgcolor "#99CCFF")
  	(hideturtle)
	(define green '(0.15 0.5 0))
	(define leaf_green '(0 0.5 0.27))
	(define brown '(0.5 0.2 0))
	(define grey '(0.43 0.43 0.43))
	(define light_blue '(0 0.9 1))
	(define gold '(1 0.78 0))
	(define black '(0 0 0))
	(define beige '(0.76 0.62 0.55))
	(define blue '(0 0.3 1))
	(define orange '(1 0.23 0))
	(define grass_scheme '(
		green green green green
		brown brown green brown
		brown brown brown brown
		brown brown brown brown
	))
	(define (createBlock type start)
	  (if (= 0 start) nil (cons type (createBlock type (- start 1))))
	)
	(define stone_scheme (createBlock 'grey 16))
	(define wood_scheme (createBlock 'brown 16))
	(define leaf_scheme (createBlock 'leaf_green 16))
	(define grass_top_scheme (createBlock 'green 16))
	(define dirt_scheme (createBlock 'brown 16))
	(define water_scheme (createBlock 'blue 16))
	(define lava_scheme (createBlock 'orange 16))
	(define (darken mask p)
		(if (null? mask)
			nil
			(cons
				(* p (car mask))
				(darken (cdr mask) p)
			)
		)
	)
	(define stoneMask '(
		0.95 1 0.9 1
		1 0.9 0.95 1
		0.8 1 0.95 0.9
		0.8 0.95 1 0.9
	))
	(define woodMask '(
		0.8 0.8 0.6 0.8
		0.8 0.6 0.6 0.8
		0.8 0.6 0.8 0.6
		0.8 0.6 0.8 0.6
	))
	(define leafMask '(
		0.7 1 0.5 1
		1 0.5 0.8 0.5
		0.7 0.5 1 0.5
		1 1 1 1
	))
	(define oreMask '(
		0.95 1 0.9 1
		1 1 0.9 1
		0.8 1 0.95 0.9
		0.8 0.7 1 1
	))
	(define grassMask '(
		1 1 1 1
		0.9 0.8 1 0.9
		1 0.9 0.9 1
		0.9 1 1 1
	))
	(define fluidMask '(
		1 1 1 1.1
		1 1.1 1 1
		1 1 1.1 1
		1 1.1 1 1
	))

(define (create_ore_scheme ore_color)
	(list
		grey grey grey grey
		grey ore_color grey grey
		grey grey grey grey
		grey grey ore_color grey
	)
)

(define block_size 6.5)
(define co (* block_size (cos (radians 30))))
(define si (* block_size (sin (radians 30))))

(define (side x y m)
  	(let 
  		(
  			(co (* co m))
  		)
  		(pu)
  		(goto x y)
  		(pd)
  		(begin_fill)
  		(goto (+ co x) (+ si y))
  		(goto (+ co x) (- (+ y si) block_size))
  		(goto x (- y block_size))
  		(goto x y)
  		(end_fill)
  	)
  )
(define (createTop x y m)
	(pu)
	(goto x y)
	(pd)
	(begin_fill)
	(goto (+ x co) (- y si))
	(goto x (- y (* 2 si)))
	(goto (- x co) (- y si))
	(goto x y)
	(end_fill)
)

(define (entire_row func x y side lst)
	(if (null? lst)
  		nil
	  	(begin
	  		(color (car lst))
	  		(func x y side)
	  		(entire_row func (+ x co) (+ y (* side si)) side (cdr lst))
	  	)
  	)
)
(define (entire_side x y ax ay func s matrix)
  	(if (null? matrix)
  		nil
	  	(begin
	  		(entire_row func x y s (car matrix))
	  		(entire_side (+ x ax) (+ y ay) ax ay func s (cdr matrix))
	  	)
  	)
) 
  (define (create_cube side1 side2 top)
  	(lambda (x y)
	  	(entire_side x y 0 (- block_size) side -1 side1)
	  	(entire_side (+ x (* co 3)) (- y (* si 3)) 0 (- block_size) side 1 side2)
	  	(entire_side (+ x (* co 3)) (+ y (* si 5)) (- co) (- si) createTop -1 top)
  	)
  )

  (define (toRGB c per)
  	(apply rgb (map (lambda (x) (if (> (* x per) 1) 1 (* x per))) c))
  )
  (define (merge mask colors)
  	(if
  		(null? mask)
  		nil
  		(cons
  		    (toRGB (if (symbol? (car colors)) (eval (car colors)) (car colors)) (car mask))
  			(merge (cdr mask) (cdr colors))
  		)
  	)
  )
(define (front i a) (if (or (= 0 i) (null? a)) nil (cons (car a) (front (- i 1) (cdr a)))))
(define (back i a) (if (or (= 0 i) (null? a)) a (back (- i 1) (cdr a))))
(define (split arr)
	(if (null? arr) nil
	(cons (front 4 arr) (split (back 4 arr)))
	)
)
(define (outline mask colors)
	(split (merge mask colors))
)

(define (render_row x y lst)
  	(if
  		(null? lst)
  		nil
  		(begin
  			(if (symbol? (car lst)) ((eval (car lst)) x y))
  			(render_row (+ x (* co 4)) (- y (* si 4)) (cdr lst))
  		)
  	)	
)

(define (render_stack x y stack)
	(if (null? stack)
		nil
		(begin
			(render_row x y (if (symbol? (car stack)) (eval (car stack)) (car stack)))
  			(render_stack (- x (* co 4)) (- y (* si 4)) (cdr stack))
		)
	)
)

(define (render_world x y world)
  	(if
  		(null? world)
  		nil
  		(begin
  			(render_stack x y (if (symbol? (car world)) (eval (car world)) (car world)))
  			(render_world x (+ y (* si 8)) (cdr world))
  		)
  	)	
)

(define (create_ore_cube ore_color)
	(let
		(
			(sc (create_ore_scheme ore_color))
		)
		(create_cube (outline oreMask sc) (outline (darken oreMask 0.6) sc) (outline (darken oreMask 1.3) sc))
	)
)

(define (strip start block)
	(if (= 1 start) (list block) (cons 0 (strip (- start 1) block)))
)

(define (default_strip block) (strip 8 block))

(define gb (create_cube (outline grassMask grass_scheme) (outline (darken grassMask 0.6) grass_scheme) (outline (darken grassMask 1.3) grass_top_scheme)))
(define db (create_cube (outline grassMask dirt_scheme) (outline (darken grassMask 0.6) dirt_scheme) (outline (darken grassMask 1.3) dirt_scheme)))
(define sb (create_cube (outline stoneMask stone_scheme) (outline (darken stoneMask 0.6) stone_scheme) (outline (darken stoneMask 1.3) stone_scheme)))
(define wb (create_cube (outline woodMask wood_scheme) (outline (darken woodMask 0.6) wood_scheme) (outline woodMask wood_scheme)))
(define lb (create_cube (outline leafMask leaf_scheme) (outline (darken leafMask 0.6) leaf_scheme) (outline (darken leafMask 1.3) leaf_scheme)))
(define wf (create_cube (outline fluidMask water_scheme) (outline (darken fluidMask 0.6) water_scheme) (outline (darken fluidMask 1.3) water_scheme)))
(define w2 (create_cube (outline (darken fluidMask 0.6) water_scheme) (outline (darken fluidMask 0.6) water_scheme) (outline (darken fluidMask 0.6) water_scheme)))
(define w3 (create_cube (outline fluidMask water_scheme) (outline (darken fluidMask 0.6) water_scheme) (outline (darken fluidMask 0.6) water_scheme)))
(define lf (create_cube (outline fluidMask lava_scheme) (outline (darken fluidMask 0.6) lava_scheme) (outline (darken fluidMask 1.3) lava_scheme)))
(define l2 (create_cube (outline fluidMask lava_scheme) (outline fluidMask lava_scheme) (outline fluidMask lava_scheme)))
(define l3 (create_cube (outline fluidMask lava_scheme) (outline (darken fluidMask 0.6) lava_scheme) (outline fluidMask lava_scheme)))
(define go (create_ore_cube 'gold))
(define do (create_ore_cube 'light_blue))
(define cl (create_ore_cube 'black))
(define io (create_ore_cube 'beige))

(define stone_strip (default_strip 'sb))
(define dirt_strip (default_strip 'db))
(define stone_layer '(
	stone_strip
	stone_strip
	stone_strip
	stone_strip
	stone_strip
	stone_strip
	stone_strip
	(sb sb sb sb sb sb sb sb)))
(define spike '(
	nil
	nil
	nil
	nil
	(00 00 00 sb 00 00 00 00)
))
(define (reverse a) (if (null? a) nil (append (reverse (cdr a)) (list (car a)))))
(define world '(
	(nil
	(00 00 00 00 lb 00 00 00)
	(00 00 00 lb lb lb 00 00)
	(00 00 00 00 lb 00 00 00))

	(nil
	(00 00 00 00 lb 00 00 00)
	(00 00 00 lb wb lb 00 00)
	(00 00 00 00 lb lb 00 00))

	((00 00 lb lb lb lb lb 00)
	(00 00 lb lb lb lb lb 00)
	(00 00 lb lb wb lb lb 00)
	(00 00 lb lb lb lb lb 00)
	(00 00 lb lb lb lb 00 00))

	((00 00 00 lb lb lb lb 00)
	(00 00 lb lb lb lb lb 00)
	(00 00 lb lb wb lb lb 00)
	(00 00 lb lb lb lb lb 00)
	(00 00 lb lb lb lb 00 00))

	(nil
	nil
	(00 00 00 00 wb 00 00 00))

	(nil
	nil
	(00 00 00 00 wb 00 00 00)
	nil
	nil
	nil
	nil
	(gb 00 00 00 00 00 00 00))

	((00 00 00 00 gb gb gb gb)
	(00 00 00 00 00 00 00 gb)
	(00 00 00 00 wb 00 00 00)
	nil
	nil
	nil
	(gb 00 00 00 00 00 00 00)
	(db gb gb 00 00 00 00 00))

	((gb gb gb gb gb gb gb db)
	(gb gb gb gb gb gb gb db)
	(gb gb wf gb gb gb gb gb)
	(gb gb wf wf gb gb gb gb)
	(gb gb wf wf gb 00 gb gb)
	(gb gb wf wf gb 00 00 gb)
	(db gb gb gb gb gb gb gb)
	(db db db gb gb gb gb gb))

	(dirt_strip
	dirt_strip
	(00 00 gb 00 00 00 00 db)
	(00 00 gb gb 00 00 00 db)
	(00 00 gb wf gb gb 00 db)
	(00 00 gb gb 00 gb gb db)
	dirt_strip
	(db db db db db db db db))

	(stone_strip
	stone_strip
	dirt_strip
	stone_strip
	dirt_strip
	stone_strip
	(00 00 sb 00 00 00 00 db)
	(sb sb w2 db db sb sb sb))

	stone_layer
	stone_layer
	stone_layer

	(stone_strip
	stone_strip
	(00 00 00 00 sb sb sb sb)
	(00 00 00 00 sb sb sb sb)
	stone_strip
	stone_strip
	stone_strip
	(sb sb sb sb cl cl sb sb))

	(stone_strip
	(00 00 00 sb sb sb sb sb)
	(00 00 00 sb 00 00 00 00)
	(00 00 00 00 00 00 00 00)
	(00 00 00 00 00 sb sb 00)
	stone_strip
	stone_strip
	(sb sb sb sb cl cl cl sb))

	((00 00 00 00 00 io io sb)
	(00 00 00 sb sb 00 00 00)
	(00 00 00 sb 00 00 00 00)
	(00 00 00 sb 00 00 00 00)
	stone_strip
	(00 00 00 00 00 sb sb sb)
	stone_strip
	(sb sb sb sb sb sb sb sb))

	(stone_strip
	(00 00 00 sb sb sb io io)
	(00 00 00 sb 00 00 00 00)
	(00 00 00 sb 00 00 00 sb)
	stone_strip
	(00 00 sb sb 00 00 00 sb)
	(00 00 sb sb 00 00 00 sb)
	(sb sb sb sb sb sb sb sb))

	(stone_strip
	stone_strip
	(00 00 00 00 sb sb sb sb)
	(00 00 00 00 sb sb sb sb)
	(00 sb 00 00 sb sb 00 sb)
	(00 sb wb 00 sb 00 00 sb)
	(00 sb wb 00 sb 00 00 sb)
	(sb sb 00 00 00 sb sb sb))

	(stone_strip
	stone_strip
	stone_strip
	stone_strip
	(00 sb 00 00 00 sb 00 sb)
	(00 sb 00 00 00 sb 00 sb)
	(00 sb 00 00 00 sb 00 sb)
	(sb 00 00 00 00 sb sb sb))

	(stone_strip
	stone_strip
	stone_strip
	(00 00 00 00 00 00 sb l2)
	(00 sb 00 00 00 sb 00 sb)
	(00 sb 00 00 00 sb 00 sb)
	(00 sb 00 00 00 sb 00 sb)
	(sb sb 00 00 00 sb sb sb))

	(stone_strip
	stone_strip
	stone_strip
	stone_strip
	(00 00 sb 00 sb 00 00 sb)
	(00 00 sb 00 sb 00 00 sb)
	(00 sb sb 00 sb 00 00 sb)
	(sb sb sb 00 sb sb sb sb))

	stone_layer
	stone_layer
	stone_layer

	(stone_strip
	stone_strip
	stone_strip
	stone_strip
	stone_strip
	(00 00 00 sb 00 00 00 sb)
	(00 00 sb sb 00 00 sb sb)
	(sb sb sb sb sb sb sb 00))

	(stone_strip
	stone_strip
	nil
	stone_strip
	stone_strip
	stone_strip
	(00 00 00 00 00 00 sb 00)
	(sb sb sb go go sb sb 00))

	(nil
	stone_strip
	stone_strip
	stone_strip
	(00 00 00 00 00 00 sb do)
	(00 00 00 00 00 00 sb sb)
	(00 00 00 00 00 00 sb 00)
	(00 sb sb sb sb sb 00 00))

	(nil
	(00 00 00 00 00 00 sb 00)
	(00 00 00 00 00 00 sb 00)
	(00 00 00 00 sb 00 00 00)
	(00 00 00 sb sb sb sb 00)
	(00 00 00 sb 00 00 00 00)
	(00 sb 00 sb sb sb 00 00)
	(00 00 00 00 sb 00 00 00))

	(nil
	nil
	nil
	(00 00 00 00 sb 00 00 00)
	(00 00 00 sb 00 00 00 00)
	(00 00 00 sb 00 00 00 00)
	(00 sb sb sb 00 00 00 00))

	(nil
	nil
	nil
	nil
	(00 00 00 sb 00 00 00 00)
	nil
	(00 sb 00 00 00 00 00 00))
	spike
	spike
	spike
	)
)
(render_world (- (* co 4)) -300 (reverse world))

(define (render_single_block offset_x offset_y x y z block)
	(block
		(+ offset_x (* co 4 (- z x)))
		(- offset_y (* si 4 (+ z x)) (* si -8 y))
	)
)
(define (draw_waterfall x z start_y end_y block)
	(if
		(<= start_y end_y)
		(begin
			(render_single_block (- (* co 4)) -300 x start_y z block)
			(draw_waterfall x z (+ start_y 1) end_y block)
		)
	)
)
(draw_waterfall 7 1 -20 21 w3)
(draw_waterfall 3 8 -20 12 l3)
(define (tri_top x y m)
	(pu)
	(goto x y)
	(pd)
	(begin_fill)
	(goto (- x (* m co)) (- y si block_size))
	(goto x (- y (* 2 si ) block_size))
	(goto (+ x (* m co)) (- y si))
	(goto x y)
	(end_fill)	
)

(define (render_tri_top_row x y m lst)
	(if
		(null? lst)
		nil
		(begin
			(color (car lst))
			(tri_top x y m)
			(render_tri_top_row (+ x co) (- y (* m si)) m (cdr lst))
		)
	)
)

(define (render_tri_top x y m lst)
	(if
		(null? lst)
		nil
		(begin
			(render_tri_top_row x y m (car lst))
			(render_tri_top (- x (* m co)) (- y si block_size) m (cdr lst))			
		)
	)
)
(define (triangle offset_x offset_y x y z flip lst)
	(render_tri_top
		(+ offset_x (* co 4 (- z x)))
		(- offset_y (* si 4 (+ z x)) (* si -8 y))
		flip
		lst
	)
)
(triangle (- (* co 4)) -300 3 13.25 8 -1 (outline (darken fluidMask 1.3) lava_scheme))
(triangle (- (* co 4)) -300 5 21 -0.25 1 (outline (darken fluidMask 1.3) water_scheme))
(speed 0)
 (exitonclick))

; Please leave this last line alone.  You may add additional procedures above
; this line.
(draw)