Page 1 of 1

SuperCollider - for newdep :)

Posted: Fri Nov 19, 2010 7:58 pm
by cormullion
Can't guarantee antimatter....

Code: Select all

#!/usr/bin/env newlisp

(load (append (env "NEWLISPDIR") "/guiserver.lsp"))

(gs:init)
(gs:frame 'SuperCollider 100 100 550 550 "SuperCollider") 
(gs:set-border-layout 'SuperCollider ) 
(gs:canvas 'MyCanvas  'SuperCollider) 
(gs:add-to 'SuperCollider 'MyCanvas "center") 
(gs:set-background 'MyCanvas gs:black)
(gs:set-anti-aliasing true) 

(set 'width 550 'height 550 
 'x (* 5 (- (rand 3) 1))  'y (* 5 (- (rand 3) 1)) 
 'delta-x (* 5 (- (rand 3) 1)) 
 'delta-y (* 5 (- (rand 3) 1)) 
 'circle-radius 4)

(gs:set-translation (/ width 2 ) (/ height 2))
(gs:set-size 'MyCanvas width height)

(set 'apoly1 '(
(-0 -85) (-23 -103)
(-55 -112) (-114 -90)
(-114 -90) (-75 -103)
(-38 -89) (-18 -57)
(-18 -33) (-25 -14)
(-52 9) (-73 14)
(-95 11) (-125 -10)
(-135 -50) (-134 -15)
(-121 11) (-72 41)
(-77 76) (-67 106)
(-21 142) (-50 118)
(-58 99) (-58 75)
(-38 42) (-0 27)
(38 42) (58 75)
(57 99) (50 118)
(21 142) (47 128)
(66 106) (76 76)
(72 40) (120 10)
(133 -16) (133 -52)
(123 -11) (94 11)
(71 14) (50 9)
(23 -14) (16 -33)
(17 -57) (37 -89)
(75 -103) (97 -99)
(113 -89) (112 -90)
(89 -105) (54 -112)
(22 -103) (0 -85)
))
(define (init)
 (gs:fill-rect 'Frame (/ (- width) 2) ( / (- height) 2) width height '(0.1 0.2 0.1))
 (gs:fill-polygon 'Container1 (flat apoly1) gs:black)
 (gs:fill-circle 'Electron x y circle-radius gs:green))

(set 'PI 3.14159 'TWOPI (add PI PI))

(define (angle2d x1 y1 x2 y2)
 ; Return the angle between two vectors 
 ;   The angle is from vector 1 to vector 2, positive anticlockwise
 ;   The result is between -pi -> pi
 (set 'theta1 (atan2 y1 x1))
 (set 'theta2 (atan2 y2 x2))
 (set 'dtheta (sub theta2 theta1))
 (while (> dtheta PI)
  (dec dtheta TWOPI))
 (while (< dtheta (- PI))
  (inc dtheta TWOPI))
 dtheta)

(define (inside? pt poly)
 ; point is a list (x y)
 ; poly is a list of points ((x y) (x y))
 ; uses "the worst algorithm in the world for testing points" 
 ; http://erich.realtimerendering.com/ptinpoly/
 (let ((inside nil)
       (len (length poly))
       (point-x (pt 0))
       (point-y (pt 1))
       (max-x 0) (min-x 0)
       (max-y 0) (min-y 0)
       (angle 0))
  (set 'max-x (first (apply (fn (a b) (if (>= (first a) (first b)) a b)) poly 2)))
  (set 'min-x (first (apply (fn (a b) (if (<= (first a) (first b)) a b)) poly 2)))
  (set 'max-y (last (apply (fn (a b) (if (>= (last a) (last b)) a b)) poly 2)))
  (set 'min-y (last (apply (fn (a b) (if (<= (last a) (last b)) a b)) poly 2)))
  (cond
   ; quick bounds check
   ((or  (< point-x min-x)
     (< point-y min-y)
     (> point-x max-x)
     (> point-y max-y)) inside)
   (true
    ; OK. Do it the hard way.
    (for (i 0 (- len 1)) 
     (set 'p1x (sub (first (nth i poly)) point-x))
     (set 'p1y (sub (last  (nth i poly))  point-y))
     (set 'p2x (sub (first (nth (% (+ i 1) len) poly))  point-x))
     (set 'p2y (sub (last  (nth (% (+ i 1) len) poly))  point-y))
     (set 'angle (add angle (angle2d p1x p1y p2x p2y))))
    (if (< (abs angle) PI)
     (set 'inside nil)
     (set 'inside true))))
  inside))

(define (init)
 (gs:fill-rect 'Frame (/ (- width) 2) ( / (- height) 2) width height '(0.2 0.2 0.3))
 (gs:fill-polygon 'Container1 (flat apoly1) gs:black)
 (gs:fill-circle 'Electron x y circle-radius gs:green))

(define (move-shape)
 ; hit walls, bounce back
 (if (<= x (+ circle-radius (- (/ width 2))))  (set 'delta-x (- delta-x)))
 (if (<= y (+ circle-radius (- (/ height 2)))) (set 'delta-y (- delta-y)))
 (if (>= x (- (/ width 2) circle-radius))      (set 'delta-x (- delta-x)))
 (if (>= y (- (/ height 2) circle-radius))     (set 'delta-y (- delta-y)))
 (inc x delta-x) (inc y delta-y)
 (gs:move-tag 'Electron delta-x delta-y)
 (if  (inside? (list x y) apoly1)
  (begin 
   ; change color of electron
   (gs:color-tag 'Electron gs:white)
   ; mark if we find something
   (if (= 0 (rand 6)) (gs:fill-circle 'Target x y circle-radius gs:yellow))
   ; randomize movement
   (set 'delta-x  (* 5 (- (rand 3) 1)))
   (set 'delta-y  (* 5 (- (rand 3) 1))))
  (gs:color-tag 'Electron gs:red))
 (gs:update))

(gs:set-visible 'SuperCollider true) 
(init)
(while (gs:check-event 1000) 
 (move-shape))
;eof

Re: SuperCollider - for newdep :)

Posted: Sat Nov 20, 2010 8:39 am
by newdep
Hahaha.. after 3 years of pinballs you though it was time for some reowrk on that ...heheh...

..its a great BioHazart Cormullion..thats actualy quiet some work getting those boundery's inthere i guess ;-)

I must say, seems like the guiserver became quicker... its running at least quicker here then befor..


Thanks for the show-off ;-)

Re: SuperCollider - for newdep :)

Posted: Sat Nov 20, 2010 9:25 am
by cormullion
Yes, it's not too slow, considering that the inside? algorithm is reckoned to be the slowest available (but elegant too, in its own way).

artwork is easily copied from an Adobe Illustrator file ;)

Re: SuperCollider - for newdep :)

Posted: Fri Nov 26, 2010 12:23 am
by joejoe
wild, corumullion.
impressive and wild.

Re: SuperCollider - for newdep :)

Posted: Fri Dec 03, 2010 5:33 pm
by hilti
Sooo crazy cormullion ;-)
I'm loving Your "brain exercices".

Re: SuperCollider - for newdep :)

Posted: Fri Dec 03, 2010 6:32 pm
by cormullion
Cool. :) Wish I had more time for more...