Racket/3D-boll

Från Täpp-Anders
Hoppa till navigeringHoppa till sök

Version "snurra själv"

#lang racket
(require plot)
(require racket/pretty)
;; En pixelboll iracket
;; Från Buzzern skrivet under påskhelgen

(define π (acos -1))
(define VERTICAL-SPLIT 16)
(define HORIZONTAL-SPLIT 16)
(define PARTICLE-SIZE (* VERTICAL-SPLIT HORIZONTAL-SPLIT))
(define particles (for/vector ([i (in-range PARTICLE-SIZE)])
                    (make-vector 3)))

;; from scheme.com since normal scheme lacks for/vector
(define make-matrix
  (lambda (rows columns)
    (do ((m (make-vector rows))
         (i 0 (+ i 1)))
        ((= i rows) m)
        (vector-set! m i (make-vector columns)))))


(define (to->deg rad)
  (* rad (/ 180 π)))

(define (print-dots amount)
  (let myloop ((count 0))
    (if (>= count amount)
        '()
        (begin
        (println count)
        (myloop (+ count 1))))))

(define (generate-xyz radius θ ϕ)
  (let* ([x (* radius (sin θ) (cos ϕ))]
         [y (* radius (sin θ) (sin ϕ))]
         [z (* radius (cos θ))]
         )
  (vector x y z)))

(define (test-loop amount)
  (let loop ((count 0))
    (if (>= count amount)
        '()
        (begin
        (println count)
        (loop (+ count 1))))))

(define (get-angle index split)
  (* 2 π index (/ split)))

(define (generate-dots particles)
  (let* ([index-y -1])
  (for ([row (in-vector particles)]
        [index (in-naturals)])
    (set! index-y (if (= 0 (modulo index HORIZONTAL-SPLIT))
        (+ index-y 1)
        index-y))
    ;(printf " ~a ~a\n" (modulo index HORIZONTAL-SPLIT) index-y)
    (define new-θ (get-angle (modulo index HORIZONTAL-SPLIT) HORIZONTAL-SPLIT))
    (define new-ϕ (get-angle (modulo index-y VERTICAL-SPLIT) VERTICAL-SPLIT))
    (printf " ~a ~a \n" (to->deg new-θ) (to->deg new-ϕ))
    ;;(vector-set! row 0 )
    (vector-set! particles index (generate-xyz 1.0 new-θ new-ϕ)))))

;;(test-loop HORIZONTAL-SPLIT)
;;(generate-xyz 1 π (* 2.0 π))
(generate-dots particles)
(plot3d (points3d particles))



Version "snurrar själv"

#lang racket
(require plot)
(require racket/gui/base)
(require racket/pretty)
;; En pixelboll i racket
;; Från Buzzern skrivet under påskhelgen

(define π (acos -1))
(define HEIGHT 600)
(define WIDTH 800)
(define VERTICAL-SPLIT 16)
(define HORIZONTAL-SPLIT 16)
(define RADIUS 100.0)
(define PARTICLE-SIZE (* VERTICAL-SPLIT HORIZONTAL-SPLIT))
(define particles (for/vector ([i (in-range PARTICLE-SIZE)])
                    (make-vector 3)))

;; from scheme.com since normal scheme lacks for/vector
(define make-matrix
  (lambda (rows columns)
    (do ((m (make-vector rows))
         (i 0 (+ i 1)))
      ((= i rows) m)
      (vector-set! m i (make-vector columns)))))


(define (to->deg rad)
  (* rad (/ 180 π)))

(define (to->rad deg)
  (/ (* deg π) 180 ))

(define (print-dots amount)
  (let myloop ((count 0))
    (if (>= count amount)
        '()
        (begin
          (println count)
          (myloop (+ count 1))))))

(define (generate-xyz radius θ ϕ)
  (let* ([x (* radius (sin θ) (cos ϕ))]
         [y (* radius (sin θ) (sin ϕ))]
         [z (* radius (cos θ))]
         )
    (vector x y z)))

(define (projection x y z width height)
  (let* ([camera-distance 300.0]  ; Push the object away from the camera
         [scale-factor 250.0]     ; Keep the object visible after pushing it back         
         ; Translate Z away from the viewer
         [z-translated (+ z camera-distance)]         
         ; Prevent divide-by-zero (just in case a point hits exactly 0)
         [z-safe (if (= z-translated 0.0) 0.001 z-translated)]
         
         ; Perspective projection with scaling
         [xp (* x (/ scale-factor z-safe))]
         [yp (* y (/ scale-factor z-safe))])
    ;over to screen coords
    (vector (+ xp (/ width 2.0)) (+ (/ height 2.0) yp))
    ))
    
(define (get-angle index split)
  (* 2 π index (/ split)))

(define (generate-dots particles)
  (let* ([index-y -1])
    (for ([row (in-vector particles)]
          [index (in-naturals)])
      (set! index-y (if (= 0 (modulo index HORIZONTAL-SPLIT))
                        (+ index-y 1)
                        index-y))
      (define new-θ (get-angle (modulo index HORIZONTAL-SPLIT) HORIZONTAL-SPLIT))
      (define new-ϕ (get-angle (modulo index-y VERTICAL-SPLIT) VERTICAL-SPLIT))
      (vector-set! particles index (generate-xyz RADIUS new-θ new-ϕ)))))

(define (rotateX x y z angle)
  (let ([y-new (-(* y (cos angle)) (* z (sin angle)))]
        [z-new (+ (* y (sin angle)) (* z (cos angle)))])
    (vector x y-new z-new)))

(define (rotateY x y z angle)
  (let ([x-new (+(* x (cos angle)) (* z (sin angle)))]
        [z-new (+ (* (- x) (sin angle)) (* z (cos angle)))])
    (vector x-new y z-new)))

(define angleX 0.1)
(define angleXspeed 0)
(define angleY 0.1)
(define angleYspeed 0)

(define deltaTime (current-milliseconds))
(define my-pen (new pen% [color "blue"] [width 2]))

(define (paint canvas dc)
  (send dc clear)
  (send dc set-pen
          my-pen)
  (for ([row (in-vector particles)])
    (let* ([rotX (rotateX (vector-ref row 0) (vector-ref row 1) (vector-ref row 2) (to->rad angleXspeed))]
           [rotY (rotateY (vector-ref rotX 0) (vector-ref rotX 1) (vector-ref rotX 2) (to->rad angleYspeed))]
           [xy (projection (vector-ref rotY 0) (vector-ref rotY 1) (vector-ref rotY 2) WIDTH HEIGHT)])
      (send dc draw-point (vector-ref xy 0) (vector-ref xy 1)))))

(define frame (new frame% [label "Animation"] [width WIDTH] [height HEIGHT]))
(define canvas (new canvas% [parent frame] [paint-callback paint]))

(generate-dots particles)

(define timer (new timer% [notify-callback
                           (lambda ()
                             ;(set! x (add1 x))
                             (set! deltaTime (- (current-milliseconds) deltaTime))
                             (set! angleXspeed (* angleX deltaTime))
                             (set! angleYspeed (* angleY deltaTime))
                             ;(printf "~a\n" (current-milliseconds))
                             (send canvas refresh)
                             ;(send timer start 16)
                             )]
                   [interval #f]
                   [just-once? #f]
                   ))
(send frame show #t)
(send timer start 16) ; ~60 FPS in best case i guess...