SuperCollider - for newdep :)

Guiserver, GTK-server, OpenGL, PostScript,
HTML 5, MIDI, IDE

SuperCollider - for newdep :)

Postby cormullion » Fri Nov 19, 2010 7:58 pm

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
cormullion
 
Posts: 2037
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W

Re: SuperCollider - for newdep :)

Postby newdep » Sat Nov 20, 2010 8:39 am

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 ;-)
-- (define? (Cornflakes))
newdep
 
Posts: 2019
Joined: Mon Feb 23, 2004 7:40 pm
Location: Netherlands

Re: SuperCollider - for newdep :)

Postby cormullion » Sat Nov 20, 2010 9:25 am

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 ;)
cormullion
 
Posts: 2037
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W

Re: SuperCollider - for newdep :)

Postby joejoe » Fri Nov 26, 2010 12:23 am

wild, corumullion.
impressive and wild.
joejoe
 
Posts: 140
Joined: Thu Jun 25, 2009 5:09 pm

Re: SuperCollider - for newdep :)

Postby hilti » Fri Dec 03, 2010 5:33 pm

Sooo crazy cormullion ;-)
I'm loving Your "brain exercices".
--()o Dragonfly web framework for newLISP
http://dragonfly.apptruck.de
hilti
 
Posts: 139
Joined: Sun Apr 19, 2009 10:09 pm
Location: Hannover, Germany

Re: SuperCollider - for newdep :)

Postby cormullion » Fri Dec 03, 2010 6:32 pm

Cool. :) Wish I had more time for more...
cormullion
 
Posts: 2037
Joined: Tue Nov 29, 2005 8:28 pm
Location: latiitude 50N longitude 3W


Return to newLISP Graphics & Sound

Who is online

Users browsing this forum: No registered users and 3 guests

cron