feed-pict3d/main.rkt

#lang typed/racket
(require pict3d)

;; TODO:
;; - Calculate positions for lights
;; - Simple animations with a light attached to the camera

;; Convert character `C' to a number.
;; E.g. `(char->number #\5) => 5'.
(: char->number (-> Char Integer))
(define (char->number c)
  (- (char->integer c) 48))

;; Convert a string `STR' containng only digits to a list of numbers.
;; E.g. `(string->numbers "0123") => '(0 1 2 3)'.
(: string->numbers (-> String (Listof Integer)))
(define (string->numbers str) (map char->number (string->list str)))

(: calculate-base (-> (Listof Integer) Integer))
(define (calculate-base lst)
  (+ 1 (apply max lst)))

;; interpret a list of integers `NUM' as an integer in base `BASE'
;; E.g. `(interp->num '(1 1) 2) => 3'
(: interp-num (-> (Listof Integer) Integer Integer))
(define (interp-num num base)
  (let-values
      ;; TODO: typed/racket does not support the `#:result' argument in `FOR/FOLD`?
      ([(sum pow) 
        (for/fold ([sum : Integer 0]
                   [pow : Integer 1])
                  ([i (reverse num)])
          (values (+ sum (* i pow)) (* pow base)))])
    sum))

;; divide up the list into the sublists of size n.
;; E.g. `(div-list '(1 2 3 4 5) 3) => '((1 2 3) (4 5))' or
;; `(div-list '(1 2 3 4 5 6) 2) => '((1 2) (3 4) (5 6))'.
(: div-list (All (A) (-> (Listof A) Integer (Listof (Listof A)))))
(define (div-list lst n)
  (if (<= (length lst) n)
      (list lst)
      (let-values
          ([(a b) (split-at lst n)])
        (cons a (div-list b n)))))

;; calculate the permutations of the string as a list of coordinates
(: permute-string (-> (Listof Integer) Integer (Listof (Listof Integer))))
(define (permute-string str base)
  (for/list
      ([perm : (Listof Integer) (permutations str)])
    (map
     (lambda ([x : (Listof Integer)])
       (interp-num x base))
     (div-list perm (ceiling (/ (length str) 3))))))

;; Interpret a list of coordinate lists as a list of positions
(: get-positions (-> (Listof (Listof Integer)) (Listof Pos)))
(define (get-positions lst)
  (map
   (lambda ([p : (Listof Integer)])
     (match p
       [(list x y z) (pos x y z)]
       [(list x y)   (pos x y x)]
       [(list x)     (pos x x x)]))
   lst))

;; pick one element from a list, at random
(: pick-one (All (A) (-> (Listof A) A)))
(define (pick-one l)
    (list-ref l (random (length l))))

(define (random-emitted)
  (pick-one
   (list default-emitted default-emitted
         (emitted "lightgreen" (/ 1 (+ 2 (random 5))))
         (emitted "blue" (/ 1 (+ 1 (random 5)))))))

;; Plot a collection of cubes at the given positions
(: cubes (-> (Listof Pos) Pict3D))
(define (cubes lst)
  (combine
   (map (lambda ([p : Pos])
          (set-emitted (cube p (pick-one '(1/3 1/2 1/3 2/5))) (random-emitted)))
        lst)))


(define str "223345")
(printf "Processing string ~s..~n" str)
(define num (string->numbers str))
(define base (calculate-base num))

(define t
  (freeze (cubes (get-positions (permute-string num base)))))

(define outer-pos 2102)

;; Place some lights at various places
(define lights
  (combine (light (pos 0 0 0) (emitted "chocolate" 100))
           (light (pos (/ outer-pos 2) (/ outer-pos 2) (/ outer-pos 2)) (emitted "pink" 300))
           (light (pos (+ outer-pos 2) (+ outer-pos 2) (+ outer-pos 2)) (emitted "cyan" 200))
           (light (pos (+ outer-pos 2) -1 (+ outer-pos 2)) (emitted "blue" 170))
           (light (pos -1 (+ outer-pos 2) (+ outer-pos 2)) (emitted "red" 170))
           (light (pos (+ outer-pos 2) (+ outer-pos 2) 4) (emitted "green" 170))))

(define t+lights (combine t lights))

(current-pict3d-width 600)
(current-pict3d-height 600)
(current-pict3d-add-sunlight? #f)
(current-pict3d-add-indicators? #f)

(define t+sunlight
  (combine t
           (sunlight
            (dir (- (/ outer-pos 2)) (- outer-pos) (- (/ outer-pos 2)))
            (emitted "orange" 1/2))))
(time (send (pict3d->bitmap t+sunlight 2000 2000)
            save-file
            "out.png" 'png))
(displayln "Done, see out.png")