PasteRack.org
Paste # 86509
2019-08-25 08:21:59

Fork as a new paste.

Paste viewed 480 times.


Embed:

#lang racket

(require 2htdp/image
         colors
         lang/posn
         racket/date)

(define COLOR-ON "yellow")
(define COLOR-OFF "black")

(define (hex-on)
  (regular-polygon 60 6 "solid" (vector-ref yellows (random (vector-length yellows)))))

(define (hex-off alpha)
  (regular-polygon 60 6 "solid" (color 0 0 0 alpha)))

(define BASE-HEX-SIDE-LENGTH 60)
(define BASE-HEX-SIDE-INCS (/ BASE-HEX-SIDE-LENGTH 4))
(define BASE-HEX (regular-polygon BASE-HEX-SIDE-LENGTH 6 "solid" "white"))
(define BASE-W (image-width BASE-HEX))
(define BASE-H (image-height BASE-HEX))
(define BASE-HEX-CENTER-X (/ BASE-W 2))
(define BASE-HEX-CENTER-Y (/ BASE-H 2))
(define HEX-LAYERS 2)
(define HEX-MODIFIER 1.1320754716981132)
(define HALF-HEX (/ BASE-HEX-SIDE-LENGTH HEX-MODIFIER))

;; Colors
(define lagoon (color 15 63 102))
(define cerulean (color 39 100 175))
(define cornflower (color 83 136 199))
(define cyan (color 36 160 218))
(define yellow (color 250 237 49))
(define sunflower (color 255 202 55))

(define blues (vector lagoon cerulean cornflower cyan))
(define yellows (vector yellow sunflower))

(define (get-blue) (vector-ref blues (random (vector-length blues))))

(define (make-color-hex)
  (regular-polygon BASE-HEX-SIDE-LENGTH 6 "solid"
                   (color (random 255) (random 255) (random 255) 150)))

(define (stacked-hex)
  (define hex-layers 1)
  (define posns
    (for/list ([i (in-range hex-layers)])
      (make-posn BASE-HEX-CENTER-X BASE-HEX-CENTER-Y)))
  (define hexes
    (append 
     (for/list ([i (in-range (sub1 hex-layers))])
       (regular-polygon (random BASE-HEX-SIDE-LENGTH)
                        6 "solid" (get-blue)))
     (list (regular-polygon BASE-HEX-SIDE-LENGTH
                        6 "solid" (get-blue)))))

  (place-images hexes posns
                (rectangle BASE-W BASE-H "outline" "transparent")))


(define half-on (place-image/align (rotate 30 (hex-on))
                   0 BASE-HEX-SIDE-LENGTH "center" "center"
                   (rectangle HALF-HEX BASE-W "outline" "transparent")))

(define (half-off)
  (define hex (rotate 30 (stacked-hex)))
  (place-image/align hex
                     0 BASE-HEX-SIDE-LENGTH "center" "center"
                     (rectangle HALF-HEX BASE-W "outline" "transparent")))

(define (split-hex)
   (beside (rotate 180 (half-off)) (half-off)))

(define (make-row n)
  (for/fold ([scene (rectangle (* BASE-W n) BASE-W "outline" "transparent")])
            ([i (in-range n)])
    (place-image (rotate (* i BASE-HEX-SIDE-LENGTH) (if (= 0 (random 5)) (rotate 90 (hex-on)) (split-hex)))
                 (+ (* i BASE-H) (/ BASE-H 2)) BASE-HEX-SIDE-LENGTH
                 scene)))

(define (make-rows w n)
  (for/list ([i (in-range n)])
    (make-row w)))


(define (scene-width rows)
  (- (image-width (car rows)) (image-width (split-hex))))

(define (scene-height rows)
  (* (length rows) (/ (image-height (split-hex)) 2)))

(define (stack-rows rows)
  (define-values (sum image)
    (for/fold ([sum 0]
             [scene (rectangle (scene-width rows)
                               (scene-height rows)
                               "outline" "transparent")])
            ([row rows])
    (values
     (add1 sum)
     (place-image row
                  (+ (/ (image-width scene) 2) (if (even? sum) 0 HALF-HEX))
                  (* sum (/ (image-height (split-hex)) 1.3333333333333333))
                  scene))))
  image)

;(make-rows 10 5)
(define img (stack-rows (make-rows 11 15)))
;(save-svg-image img (~a "hex-d-simple2-" (date->seconds (current-date)) ".svg"))
img

=>

standard-module-name-resolver: collection not found
  for module path: colors
  collection: "colors"
  in collection directories:
   /home/pasterack/.racket/7.3/collects
   /home/pasterack/racket73/collects
   ... [166 additional linked and package directories]
  context...:
   show-collection-err
   standard-module-name-resolver
   syntax-local-module-exports
   /home/pasterack/racket73/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket73/collects/racket/private/reqprov.rkt:571:24
   /home/pasterack/racket73/collects/racket/private/reqprov.rkt:559:5
   /home/pasterack/racket73/collects/racket/require-transform.rkt:266:2: expand-import
   /home/pasterack/racket73/collects/racket/private/reqprov.rkt:266:21: try-next
   /home/pasterack/racket73/collects/racket/private/reqprov.rkt:348:21: try-next
   /home/pasterack/racket73/collects/racket/private/reqprov.rkt:243:2: require
   apply-transformer-in-context
   apply-transformer52
   dispatch-transformer41
   do-local-expand50
   /home/pasterack/racket73/collects/syntax/wrap-modbeg.rkt:46:4: do-wrapping-module-begin
   apply-transformer-in-context
   ...