Sound Machines

extensions [sound]

globals [
  selected    ;; lever that is currently selected
  dragged     ;; lever that is currently being dragged
]

breed [levers lever]
levers-own [
  neighbor1 neighbor2  ;; each holds an adjacent lever (or nobody)
  fixed?               ;; if true, lever only turns, never changes position
  spin                 ;; -1, 0, or 1
  len                  ;; this times SCALE slider equals size
  new-xcor new-ycor    ;; next values for xcor and ycor
  new-heading          ;; next value for heading
  xvel yvel            ;; x and y velocities
]

;;;
;;; SETUP PROCEDURES
;;;

to setup-begin
  clear-all
  set-default-shape levers "lever"
  create-ordered-levers num-levers [
    set heading 180
    set new-xcor 0
    set ycor ((who / num-levers) * world-height + min-pycor ) * -0.8
    set new-ycor ycor
    set fixed? false
    set len 0.5
    set neighbor1 turtle (who - 1)
    set neighbor2 turtle (who + 1)
  ]
  ask lever 0 [ set fixed? true ]
end 

to setup-dangle
  setup-begin
  ask turtle (num-levers - 4) [
    set len len * 2
    set spin 1
  ]
  setup-finish
end 

to setup-finish
  set selected last sort levers  ;; select last lever
  ask levers [ lever-display ]
  reset-ticks
end 

to setup-chaos-tentacle
  setup-begin
  ask levers
    [ set len (num-levers - who) * 0.1
      set spin (who mod 2) * 2 - 1
    ]
  ask first sort levers
    [ set new-xcor 0
      set new-ycor 0
      setxy 0 0
      set fixed? true
    ]
  setup-finish
end 

to setup-crazy-machine
  setup-begin
  ask levers
    [ ; choose random location, in the inner area of the world
      set new-xcor (random-float 1.6 - 0.8) * max-pxcor
      set new-ycor (random-float 1.6 - 0.8) * max-pycor
      setxy new-xcor new-ycor
      set fixed? (random 5 = 0)
      set spin one-of [-1 0 1]
      set len precision (0.5 + 0.5 * random 4) 1
      lever-display
    ]
  setup-finish
end 

;;;
;;; RUNTIME PROCEDURES
;;;

to go
  ask levers [ monitor-mouse ]
  ask levers [ lever! ]
  ask levers [ lever-display ]
  tick
end 

to lever!
  ifelse self = dragged
  [ ; if being dragged, then go there the mouse tells you
    set new-xcor mouse-xcor
    set new-ycor mouse-ycor
  ]
  [
    if not fixed?
    [ set xvel (xvel * f) + ((n1x2 - x1) + (n2x1 - x2)) * 0.5
      set yvel (yvel * f) + ((n1y2 - y1) + (n2y1 - y2)) * 0.5
      set yvel yvel - g * len
      set new-xcor xcor + xvel
      set new-ycor ycor + yvel
      if abs new-xcor > max-pxcor [ set xvel xvel * -0.99
                                    set new-xcor max-pxcor * sign new-xcor + xvel
                                    bonk! ycor ]
      if abs new-ycor > max-pycor [ set yvel yvel * -0.99
                                    set new-ycor max-pycor * sign new-ycor + yvel
                                    bonk! xcor ]
    ]
  ]
  ; calculate new heading of lever
  ; if node2 of neighbor1 is overlapping center, keep same heading
  ; otherwise, find heading to hook 2 of neighbor1
  let a 180 + heading
  let b heading
  if distancexy n1x2 n1y2 > 0
    [ set a 180 + towardsxy n1x2 n1y2 ]
  ; likewise hook 1 of neighbor2
  if distancexy n2x1 n2y1 > 0
    [ set b towardsxy n2x1 n2y1 ]
  ; use trig to take mean of a and b
  set new-heading atan (sin a + sin b)
                       (cos a + cos b)
                  + spin * spin-speed
end 

to lever-display
  setxy new-xcor new-ycor
  set heading new-heading
  set size 2 * scale * len
  let -s ""
  ifelse self = selected
  [ set -s "-s"
    let new-label (word "selected: " who " - " (precision len 2) " ")
    ask patch max-pxcor max-pycor [ set plabel new-label ]
    set label (word who " - " (precision len 2) " "  " ---->     ")
  ]
  [ set label "" ]
  set shape (word "lever"
                  ifelse-value fixed? ["-f"] [""]
                  item (spin + 1) ["-ws" "" "-cw"]
                  -s)
end 

;; lever procedures; these report the x and y coordinates
;; of this lever's hooks

to-report x1 report xcor - dx * scale * len end

to-report y1 report ycor - dy * scale * len end

to-report x2 report xcor + dx * scale * len end

to-report y2 report ycor + dy * scale * len end

;; lever procedures; these report the x and y coordinates
;; of our neighbor's hooks. if no neighbor, use own hook.

to-report n1x1 ifelse neighbor1 = nobody [ report x2 ] [ report [x1] of neighbor1 ] end

to-report n1y1 ifelse neighbor1 = nobody [ report y2 ] [ report [y1] of neighbor1 ] end

to-report n1x2 ifelse neighbor1 = nobody [ report x1 ] [ report [x2] of neighbor1 ] end

to-report n1y2 ifelse neighbor1 = nobody [ report y1 ] [ report [y2] of neighbor1 ] end

to-report n2x1 ifelse neighbor2 = nobody [ report x2 ] [ report [x1] of neighbor2 ] end

to-report n2y1 ifelse neighbor2 = nobody [ report y2 ] [ report [y1] of neighbor2 ] end

to-report n2x2 ifelse neighbor2 = nobody [ report x1 ] [ report [x2] of neighbor2 ] end

to-report n2y2 ifelse neighbor2 = nobody [ report y1 ] [ report [y2] of neighbor2 ] end

to-report sign [a]
  ifelse a = 0
    [ report 0 ]
    [ ifelse a < 0 [ report -1 ]
                   [ report 1 ] ]
end 

;;;
;;; SELECTION & DRAGGING PROCEDURES
;;;

to monitor-mouse
  let mouse-here? abs (mouse-xcor - xcor) < scale / 2 and
                  abs (mouse-ycor - ycor) < scale / 2
  ifelse mouse-here?
  [ if color != white [ set color white ] ]
  [ if color = white  [ set color item (who mod 14) base-colors ] ]
  ifelse mouse-down?
  [ if dragged = nobody and mouse-here?
    [ set dragged self
      set selected self
    ]
  ]
  [ set dragged nobody ]
end 

to select-lever [which-lever]
  let new lever (which-lever + [who] of selected)
  if new != nobody [ set selected new ]
end 

;;;
;;; SOUND PROCEDURES
;;;

to bonk! [coordinate]
  sound:play-note my-instrument (pitch coordinate) 90 0.05
end 

to-report pitch [coordinate]  ;; lever procedure
  report 16 + round (96 * (coordinate + max-pxcor) / world-width)
end 

to-report my-instrument  ;; lever procedure
  report item ((who + instrument) mod length sound:instruments)
              sound:instruments
end 


; Copyright 2005 Uri Wilensky. Includes code by James P. Steiner. 
; See Info tab for full copyright and license.