Tune-Town 2

extensions [ sound dialog]
__includes [ "mouse-driver-2022-2.nls" ]

globals [
  tempo
  velocity
  beats-per-measure
  last-note ;; not really used yet

  prototype-list
  prototype-set

  is-playing?

  field-margin
  field-top
  field-patches

  erase?

  all-sights
  prior-prop

  dragroot
  dragleaf
  dragset

  curr-button
  prior-button

  curr-prop-shape
  curr-prop-instrument
  drawing-mode ; "CAR" "ROAD" "prop" erase" "portal" "one-way"

  #prop-picker

  selected-prototype

  go-button
  stop-button

  note-labels

]

turtles-own [ base-color
]

breed [ toolbars  toolbar ]
breed [ controls control ]
breed [ icons icon ]
breed [ labelers labeler ]
breed [ newthings newthing]
breed [ roads road ]
breed [ roadsigns roadsign ]
breed [ props prop ]
breed [ cars car ]
breed [ portals portal ]
breed [ prototypes prototype ]
breed [ markers marker ]
breed [ staves staff ]
directed-link-breed [ marker-links marker-link ]
directed-link-breed [ portal-links portal-link]
portal-links-own [ expires ]

toolbars-own
[ slotx sloty padding gap button-spacing left-margin top-margin right-margin ]

controls-own
[ control-name
  control-type
  name
  my-icon
  my-labeler
  my-prototype
  prop-id
  control-click-action
  control-tooltip

  kind       ;; drum or note
  instrument ;; instrument name
  note       ;; keynumber 0-127
  new-note   ;; used in UI
  duration   ;; seconds

  base-color
  ]

icons-own [
  icon-shape
  my-control
  base-color
]

labelers-own [ my-control
  base-color
  text ]

newthings-own
[ new-breed
  base-color
]

patches-own
[ base-pcolor
]

roads-own
[ style
  sights
  kind ;; (blank)default; portal
  base-color
]
portals-own
[ destination
  pulse
  base-color
]

props-own
[ prop-id
  my-prototype
  my-button
  name
  kind
  instrument ;; string instrument name
  note       ;; keynumber 0-127
  new-note
  duration   ;; seconds
  base-velocity   ;; base velocity
  base-color ;; color when not playing
   ;; anon command to play correct sound
  my-sound-command

  prop-shape
]

prototypes-own
[ prop-id
  name
  kind
  instrument ;; string instrument name
  note       ;; keynumber 0-127
  duration
  base-velocity
  my-sound-command
  my-control
  icon-shape
  prop-shape
  my-button
]

roadsigns-own
[ name
  kind
  my-action
  base-color
]

cars-own
[ ; base-color
  next-road
  road-head
  exit-head ;; road-head or +/- 90 for turns
  next-exit-head
  sights ;; props visible beside car
  start-position
  start-heading
  sight-patch
  sight-heading
  step
  base-color
]

markers-own
[ my-snap
  drag-axis-x ;; used to force drag marks to stay on a certain axis
  drag-axis-y
  base-color
]

; m:controls-own [ kind instrument ]

to-report filename report "tune-town-2022-prop-list.txt" end

to-report field-color report green + random-float 4 - 2 end

to-report border-color report gray end

to-report icon-regular-color report gray + 2 end

to-report icon-hover-color report white - 1 end

to-report icon-press-color report lime end

to-report icon-selected-color report yellow + 2 end

to-report icon-spacing report 2 end

to-report button-regular-size report 3 end

to-report icon-regular-size report icon-spacing - 6 / patch-size end

to-report icon-hover-size report icon-spacing + 3 / patch-size end

to-report icon-press-size report icon-regular-size * .80 end

to-report icon-selected-size report icon-regular-size + 2 / patch-size end

to-report prop-hit-color report white end

to-report road-color report gray end

to-report intersection-color report turquoise end

to-report hot-color report sky end

to-report cold-color report yellow - 2   end

to-report no-tasks report [] end

to no-action end

to choose-DRUM
  set is-playing? false
  dialog:user-one-of (word "Choose a new sound for " control-name ".") sound:DRUMs
  [ selection ->
    output-write selection
    if selection != false [ set instrument selection ] ]
end 

to startup
  __setup
end 

to send-message [ $text ]
  ask patch (max-pxcor - 10) max-pycor [ set plabel $text ]
end 

to Play-sample [ #note ]
  ifelse
  ( kind = "DRUM" )
  [ sound:play-DRUM instrument velocity ]
  [ ;;sound:play-note instrument keynumber velocity duration
    sound:play-note instrument #note velocity duration
  ]
end 

to play-my-sound
   run my-sound-command
end 

to-report q [ string ]
  report (word "\"" string "\"")
end 

to-report pad-right [ string width ]
  report substring (word string "                                        ") 0 width
end 

to-report pad-left [ string width ]
  report reverse substring (word reverse (word string) "                                        ") 0 width
end 

to props-list-generator
  let i 0
  let s " "
  let pad1 2 + max map length prop-shapes
  let pad2 2 + max map length sound:instruments
 output-print "["
  let DRUM-index 0
  foreach prop-shapes
  [ fullname ->
    let nickname (substring fullname 3 length fullname)
    let inst item DRUM-index sound:DRUMs
   output-print ( word s
      s "["
      s pad-left i 3
      s pad-right q nickname pad1

      s q "DRUM"
      s pad-right q inst pad2
      s 64
      s "]"
    )
    set i i + 1
    set DRUM-index DRUM-index + 1
    ;; OPEN HI HAT MIDI SOUND is BROKEN on MY (and other) Computers
    ;; it will cause problems (like not sounding, or never turning off)
    ;; sklip it!
    if DRUM-index = 11 [ set DRUM-index DRUM-index + 1 ]
  ]
 output-print "]"
end 

to-report load-prototype-list
  ;; load prototype-data into prototype-list
  let $list []
  carefully
  [ file-open filename
    set $list file-read
    file-close
    ;; correct item numbering issues that arise
    ;; from manually editing the arrangement of props
  ]
  [ file-close
    print error-message
    user-message "Unable to load props"
    set $list prototype-list-default
  ]
  report $list
end 

to setup-prototypes
  let $list load-prototype-list
  ( foreach $list (range length $list)
    [ [ row index ] ->
      create-prototypes 1
      [ set prop-id index
        set name item 1 row
        set kind uppercase item 2 row
        set instrument item 3 row
        set base-velocity 64
        set note 60 ;; middle C
        set duration 0.25
        set prop-shape ( word "_p:" name )
        set icon-shape ( word "_p:" name )
        carefully [ set shape "circle" set shape prop-shape ][]
        ifelse kind = "DRUM" [ set my-sound-command [-> sound:play-drum instrument velocity ] ]
        ; sound:play-note instrument keynumber velocity duration
        [ set my-sound-command [-> sound:play-note instrument note velocity duration ] ]
        hide-turtle
      ]
    ]
  )
  set prototype-list sort-on [ prop-id ] prototypes
end 

to-report  format-prototype-list
  let id-len 4
  let name-len 3 + max [ length name ] of prototypes
  let kind-len 3 + max [ length kind ] of prototypes
  let inst-len 3 + max [ length instrument ] of prototypes
  let num-len 4
  let -- "  "
  let table-out "[\n"

  ( foreach (sort-on [ prop-id ] prototypes) (range count prototypes)
    [ [ prop-in index ] ->
      let row-out [(word
        --
        "["
        -- pad-left index id-len
        -- pad-right (q name) name-len
        -- pad-right (q kind) kind-len
        -- pad-right (q instrument) inst-len
        -- "]\n"
      )] of prop-in
      set table-out (word table-out row-out)
    ]
  )
  set table-out (word table-out "]\n")
  report table-out
end 

to save-prop-list
  let new-list format-prototype-list
  carefully
  [ file-close-all
    if file-exists? filename
    [ file-delete filename
    ]
    file-open filename
    file-type new-list
    file-close
  ]
  [ file-close-all
    print error-message
    user-message (word "Unable to save prop list '" filename "'")
  ]
end 

to-report prototype-list-default
  report
[
  [     0  "cat"              "DRUM"   "OPEN TRIANGLE"          64  0 0 ]
  [     1  "cow"              "DRUM"   "COWBELL"                64  0 0]
  [     2  "dog"              "DRUM"   "MUTE CUICA"             64  0 0]
  [     3  "frog"             "DRUM"   "LONG GUIRO"             64  0 0]
  [     4  "moose"            "DRUM"   "CRASH CYMBAL 2"         64  0 0]
  [     5  "crate"            "DRUM"   "PEDAL HI HAT"           64 0 0 ]
  [     6  "barrel"           "DRUM"   "ACOUSTIC BASS DRUM"     64  0 0]
  [     7  "garbage can"      "DRUM"   "CHINESE CYMBAL"         64  0 0]
  [     8  "hydrant"          "DRUM"   "SPLASH CYMBAL"          64  0 0]
  [     9  "mailbox"          "DRUM"   "CRASH CYMBAL 1"         64  0 0]
  [    10  "pram"             "DRUM"   "LOW CONGA"              64  0 0 ]
  [    11  "box-1"            "DRUM"   "LOW TOM"                64  0 0]
  [    12  "box-2"            "DRUM"   "LOW MID TOM"            64  0 0]
  [    13  "box-3"            "DRUM"   "HI MID TOM"             64  0 0]
  [    14  "box-4"            "DRUM"   "HI TOM"                 64  0 0]
  [    15  "box-5"            "DRUM"   "HI FLOOR TOM"           64  0 0]
  [    16  "box-6"            "DRUM"   "MARACAS"                64  0 0]
  [    17  "brick-wall-1"     "DRUM"   "MARACAS"                64  0 0]
  [    18  "brick-wall-2"     "DRUM"   "MARACAS"                64  0 0]
  [    19  "brick-wall-3"     "DRUM"   "MARACAS"                64  0 0]
  [    20  "tree"             "DRUM"   "CABASA"                 64  0 0]
  [    21  "evergreen"        "DRUM"   "LOW WOOD BLOCK"         64  0 0]
  [    22  "cactus"           "DRUM"   "HI WOOD BLOCK"          64  0 0]
  [    23  "flower"           "DRUM"   "ACOUSTIC SNARE"         64  0 0]
  [    24  "plant-1"          "DRUM"   "VIBRASLAP"              64  0 0]
  [    25  "plant-2"          "DRUM"   "RIDE CYMBAL 2"          64  0 0]
  [    26  "plant-3"          "DRUM"   "HI BONGO"               64  0 0]
  [    27  "plant-4"          "DRUM"   "LOW BONGO"              64  0 0]
  [    28  "fisher"           "DRUM"   "HI MID TOM"             64  0 0]
  [    29  "police"           "DRUM"   "LONG WHISTLE"           64  0 0]
  [    30  "cross-guard"      "DRUM"   "OPEN HI CONGA"          64  0 0]
  [    31  "road-crew"        "DRUM"   "HI TIMBALE"             64  0 0]
  [    32  "thief"            "DRUM"   "HI TIMBALE"             64  0 0]
  [    33  "service"          "DRUM"   "MARACAS"                64  0 0]
  [    34  "lumberjack"       "DRUM"   "MARACAS"                64  0 0]
  [    35  "doctor"           "DRUM"   "MARACAS"                64  0 0]
  [    36  "ghost"            "DRUM"   "OPEN CUICA"             64  0 0]
  [    37  "traffic-cone"     "DRUM"   "TAMBOURINE"             64  0 0]
  [    38  "stop-sign"        "DRUM"   "HI AGOGO"               64  0 0]
  [    39  "yield-sign"       "DRUM"   "LOW AGOGO"              64  0 0]
  [    40  "exit-sign"        "DRUM"   "RIDE BELL"              64  0 0]
  [    41  "speed-limit-25"   "DRUM"   "LOW WOOD BLOCK"         64  0 0]
  [    42  "speed-limit-55"   "DRUM"   "HI WOOD BLOCK"          64  0 0]
  [    43  "flag"             "DRUM"   "HAND CLAP"              64  0 0]
]
end 

to redraw-neighbor-roads  ask roads-on neighbors4 [ apply-road-shape ] end

to update-pcolor [ hue ]
  set base-pcolor hue
  set pcolor hue
end 

to update-base-color [ hue ]
  set base-color hue
  set color base-color
end 

to set-road-color
  ifelse (is-grid-intersection?)
      [ update-base-color intersection-color ]
      [ update-base-color road-color ]
end 

to-report is-field-patch?
  report ( (pxcor >= min-pxcor + 1) and (pxcor <= max-pxcor - 1) and (pycor >= min-pycor + 1) and  (pycor <= field-top))
end 

to set-field-color
  ifelse (is-field-patch?)
  [
    ifelse (is-grid-intersection?)
    [ update-pcolor black + 2]
    [ update-pcolor black ]
  ]
  [ update-pcolor gray + (random 6) / 5   set plabel-color black ]
end 

to make-road-here [ event ]
  if any? props-here
  [ ask props-here [ die ]
  ]
  if not any? roads-here
  [ sprout-roads 1
    [ carefully [ set shape (word road-style "new") ] []
      set size 1
      set breed roads
      set heading 0
      set kind ""
      ;; animate-new-item
      set-road-color
      set-field-color
      apply-road-shape
      ]
    redraw-neighbor-roads
  ]
end 

to apply-road-shape
  let new-shape shape
  let others-set roads-on neighbors4
  let others sort-on [ towards myself ]  others-set
  ( ifelse
    ( length others = 0 )
    [ set new-shape ( word road-style "island" ) ]
    ( length others = 1 )
    [ set new-shape ( word road-style "u-turn" )
      set heading 180 + towards first others
    ]
    ( length others = 2 )
    [ set heading 180 + towards first others
      let d subtract-headings heading towards last others
      ( ifelse
        ( d =   0 ) [ set new-shape ( word road-style "straight" ) ]
        ( d = -90 ) [ set new-shape ( word road-style "right" ) ]
        ( d =  90 ) [ set new-shape ( word road-style "left" ) ]
      )
    ]
    ( length others = 3 )
    [ set new-shape ( word road-style "tee" )
      set heading  sum [ -1 * towards myself ] of others-set
      ; if heading = 0 or heading = 180 [ rt 180 ]
    ]
    ( length others = 4 )
    [ set new-shape ( word road-style "crossing" ) ]
  )
  set shape new-shape
end 

to-report prop-shapes
  report sort filter [$name -> 0 = position "_p:" $name ] shapes
end 

to-report random-prop
  report one-of prop-shapes
end 

to-report can-prop-go-here?
  report (any? roads-on neighbors4) and not (any? roads-here or any? props-here )
end 

to make-prop-here [ $prototype $event]
  ;; run by patch
  ifelse ($event = e:drag and erase?) or ($event = e:click and any? props-here )  [ ask props-here [ die ] ]
  [
    if can-prop-go-here?
    [ let here self
      ask $prototype
      [ hatch-props 1
        [ move-to here
          set shape prop-shape
          set color black
          set note last-note
          if kind = "NOTE" [ set label (word (item (note mod 12) note-labels) "-" int (note / 12 - 1) ) ]
          show-turtle
          run my-sound-command
        ]
      ]
    ]
  ]
end 

to make-roadsign-here [ $kind ]
  if can-roadsign-go-here? $kind
  [ ifelse any?  roadsigns-here
    [ let this-sign one-of roadsigns-here
      ask this-sign
      [ if kind = "one-way"
        [ rt 90 sfx-click ]
      ]
    ]
    [ sfx-click
      sprout-roadsigns 1
      [
        set name $kind
        set-shape-safely (word "_sign_" $kind)
        set kind $kind
        set heading 0
        update-base-color white
        if kind = "one-way"
        [ set heading [ heading ] of one-of roads-here ]
      ]
    ]
  ]
end 

to set-shape-safely [ shape-name ]
  if position shape-name shapes != false
  [ set shape shape-name ]
end 

to make-portal-here
  ifelse any? portals-here
  [ if user-yes-or-no? "Delete portal? This will break all links to this portal!"
    [ sfx-whoosh
      ask portals-here [ die ]
    ]
  ]
  [ if can-portal-go-here?
    [ sfx-whoosh
      sprout-portals 1
      [ set shape "_sign_portal"
        set color who * 10 + red + 2
        set size 1.5
        set pulse 1
        set destination nobody
        if any? other portals
        [ set destination one-of other portals
          create-portal-link-to destination
          [ set thickness 3 / patch-size
            set shape "portal-link-to"
            set expires 20
            set color [ color ] of myself
          ]
        ]
      ]
      select-portal-destination
    ]
  ]
end 

to-report can-portal-go-here?
  report any? roads-here and not any? portals-here
end 

to-report can-one-way-go-here?
  report can-roadsign-go-here? "one-way"
end 

to-report can-roadsign-go-here? [ $kind ]
  report any? roads-here
end 

to make-one-way-here
  make-roadsign-here "one-way"
end 

to-report can-car-go-here?
  report ( any? roads-here )
end 

to sfx-beep-beep
  sound:play-note-later .2 "FIFTHS" 72 velocity .1  sound:play-note "FIFTHS" 72 velocity .1
end 

to sfx-click
  sound:play-DRUM "SIDE STICK" velocity
end 

to sfx-wah-wah
  sound:play-note-later .2 "trombone" 45 velocity .3 sound:play-note "trombone" 49 velocity .3
end 

to sfx-whoosh
  sound:play-DRUM "VIBRASLAP" velocity
end 

to make-car-here [ event ]
  ;; run by pointer
  ifelse (erase? or event = e:click) and any? cars-here
  [ ask cars-here [ die ] sfx-wah-wah ]
  [ if ( can-car-go-here? )
    [ sprout-cars 1
      [
        set start-position patch-here
        set shape "_car_3_90"
        set base-color color
        set heading 0
        set sights no-turtles
        if any? roads-on neighbors4
        [ face one-of roads-on neighbors4 set shape (word "_car_3_" heading) ]
        set start-heading heading
      ]
       sfx-beep-beep
    ]
  ]
end 

to _setup-field-patches
  output-print "defining field-patches"
  set field-patches patches with [ is-field-patch? ]
  output-print "defining events for field-patches"
  let n 0
  ask field-patches
  [
    output-type "X"
    set n n + 1
    if ( n mod ( world-width - 4 ) = 0 ) [ output-print ""]
    m:listen-for e:click-start [ -> do-click-start  ]
    m:listen-for e:click       [ -> do-click  ]
    m:listen-for e:drag-start  [ -> do-drag-start ]
    m:listen-for e:drag-enter  [ -> do-drag-enter ]
    m:listen-for e:drag-exit   [ -> do-drag-exit  ]
    m:listen-for e:drag-drop   [ -> do-drag-drop ]
    m:listen-for e:patch-enter [ -> do-patch-enter ]
    m:listen-for e:patch-exit  [ -> do-patch-exit ]
    m:listen-for e:drag-cancel [ -> do-drag-cancel ]
    m:listen-for e:long-click-start [ -> do-long-click-start ]
  ]
  output-print ""
  output-print "patch events added."

  output-print "coloring field-patches"
  ask patches
  [ set-field-color
  ]
end 

to draw-prop-enter
  ifelse can-prop-go-here?
  [ set pcolor green
    send-message "CLICK TO PLACE prop HERE"
  ]
  [
    set pcolor red - 2
    send-message "PLACE PROPS NEXT TO ROADS"
  ]
end 

to draw-car-enter
  ifelse can-car-go-here?
  [ set pcolor green
    send-message "CLICK TO PLACE CAR HERE"
  ]
  [
    set pcolor red - 2
    send-message "PLACE CARS ON ROADS"
  ]
end 

to draw-portal-enter
  ifelse can-portal-go-here?
  [
    ; set pcolor green
    m:set-color green
    send-message "CLICK TO PLACE PORTAL HERE"
  ]
  [ ifelse any? portals-here
    [ ; m:set-shape "_sign_portal"
      send-message "CLICK TO REMOVE PORTAL. LONG-CLICK TO CHANGE DESTINATION."
      ;; show link to other portal, if a portal is here
      ask portals-here
      [ if not any? my-out-links
        [ if is-portal? destination
          [ create-portal-link-to destination
            [ set shape "portal-link-to"
              set thickness 4 / patch-size
              set color [ color ] of end2
              set expires 100
            ]
            ask destination
            [ create-portal-link-to myself
              [ set shape "portal-link-from"
                set thickness 4 / patch-size
                set color [ color ] of end2
                set expires 100
              ]
            ]
          ]
        ]
      ]
    ]
    [
      set pcolor red - 2
      ; m:set-shape "NO"
      send-message "PLACE PORTALS ON ROADS"
    ]
  ]
end 

to draw-oneway-enter
end 

to do-patch-enter
  ifelse is-field-patch?
  [ m:show
    ( ifelse
      ( drawing-mode = "PROP" ) [ draw-prop-enter ]
      (drawing-mode = "CAR" ) [ draw-car-enter ]

      ( drawing-mode = "PORTAL" ) [ draw-portal-enter ]
      ( drawing-mode = "ONEWAY" ) [ ifelse can-one-way-go-here?  [ set pcolor green send-message "CLICK TO PLACE ONEWAY HERE" ] [ set pcolor red - 2  send-message "PLACE SIGNS NEXT TO ROADS"] ]

    [ set pcolor green ]
    )
  ]
  [ ; m:hide
  ]
end 

to do-patch-exit
  if is-field-patch?
  [
    set pcolor base-pcolor
  ]
  ask portals-here [ ask my-portal-links [ die ] ]
end 

to-report slotx++
  report  slotx  ;; the toolbar
end 

to-report sloty++
  let sloty-- sloty
  set slotx slotx + button-spacing
  if slotx >= right-margin
  [
    set slotx left-margin
    set sloty sloty - button-spacing
  ]

  report sloty--
end 

to _setup-toolbar
  let this-toolbar nobody
  create-toolbars 1
  [ hide-turtle
    setxy min-pxcor min-pycor
    set button-spacing 2
    set padding 0
    set left-margin  min-pxcor  + ( padding  )
    set right-margin max-pxcor  - ( padding  )
    set top-margin   max-pycor  - ( padding  ) - 1
    set slotx left-margin
    set sloty top-margin
    set this-toolbar self
  ]

    ;; btndata format is:
  ;; [1 "box-2" "DRUM" "BASS DRUM 1" Velocity]
  ;; let this nobody
  let btninfo []


  ask this-toolbar
  [
    make-spacer
    make-spacer
    ask make-button "TOGGLE" "_icon_grid"       "TOGGLE GRID MARKS"        [ -> set-gridspacing m:hide] [ set control-name "GRID" ask my-icon [ set label precision beats-per-measure 0 ] ]
    ask make-button "CMD" "_icon_road"       "BUILD ROADS MODE"            [ -> set drawing-mode "ROAD" m:set-shape "m-pointer-3" m:show]  [ ]
    ask make-button "CMD" "_icon_car"        "ADD/REMOVE CARS MODE"        [ -> set drawing-mode "CAR"  m:set-shape "_tool_car"   m:show ]   [ ]
    ask make-button "CMD" "_icon_erase"      "ERASER MODE"                 [ -> set drawing-mode "ERASE" m:set-shape "_tool_erase" m:show ] [ ]
    make-spacer
    ask make-button "CMD" "_icon_drive"      "START DRIVING"               [ -> set is-playing? true ] []
    ask make-button "CMD" "_icon_stop"       "STOP DRIVING"                [ -> set is-playing? false  ] []
    ask make-button "CMD" "_icon_rewind"     "RETURN TO START"             [ -> rewind-cars            ] []
    make-spacer
    ask make-button "VALUE"   "_icon_vol-plus"   "PLAY MORE LOUDLY"               [ -> get-louder]  []
    ask make-button "DISPLAY" "_icon_speaker"    "CURRENT VELOCITY (LOUDNESS)" [-> set velocity 64 ] [ set control-name "VELOCITY" ask my-icon [ set label precision velocity 0 ]  ]
    ask make-button "VALUE"   "_icon_vol-minus"  "PLAY MORE QUIETLY"             [ ->  get-softer ]  []
    ; make-spacer
    ask make-button "VALUE"   "_icon_tempo-down" "DRIVE MORE SLOWLY"             [ ->  get-slower ] []
    ask make-button "DISPLAY" "_icon_speed"      "CURRENT TEMPO (SPEED)"       [-> ] [ set control-name "TEMPO" ask my-icon [ set label precision tempo 0 ]  ]
    ask make-button "VALUE"   "_icon_tempo-up"   "DRIVE MORE QUICKLY"            [ ->  get-faster  ] []
    make-spacer
    ask make-button "EFX"     "_icon_one-way"   "ADD ONE-WAY SIGN"           [ ->  set drawing-mode "ONEWAY" m:set-shape "m-pointer-3" ][]
    ask make-button "PORTAL"  "_icon_portal"   "ADD PORTAL TO ROAD"          [ -> set drawing-mode "PORTAL" m:set-shape "_sign_portal" ][]
    make-spacer
    ask make-button "CMD"     "_icon_question"   "ADD/REMOVE PROPS MODE, select random prop"       [ -> random-prop-button ]       [ set control-name "RANDOPROP" ]
    ;;
    ;; now make the buttons for all the props in the props-list
    foreach prototype-list [ p -> make-prop-button p ]
    set field-top sloty - button-spacing - 1
  ]
end 

to random-prop-button
  let rando one-of controls with [ control-type = "PROP" ]
  ask rando [ run control-click-action ]
end 

to set-gridspacing
  set beats-per-measure beats-per-measure + 1
  if beats-per-measure >= 5 [ set beats-per-measure 0 ]
  if beats-per-measure = 1 [ set beats-per-measure 2 ]
  ask roads [ set-road-color ]
  ask field-patches [ set-field-color ]
  ask [ my-icon ] of one-of (Controls with [ control-name = "GRID" ] )
  [ set label precision beats-per-measure 0 ]
end 

to get-softer
   set velocity ifelse-value ( velocity <= 0) [ 0 ] [ (max (list 1 int (velocity *  .8 ))) ]
  ask [ my-icon ] of one-of (Controls with [ control-name = "VELOCITY" ] )
  [ set label precision velocity 0 ]
end 

to get-louder
  set velocity ifelse-value ( velocity < 1) [ 1 ] [ (min (list 127 (velocity + max (list 1 int (velocity * .1 ))))) ]
  ask [ my-icon ] of one-of (Controls with [ control-name = "VELOCITY" ] )
  [ set label precision velocity 0 ]
end 

to get-faster
  set tempo tempo + 10
  ask [ my-icon ] of one-of (Controls with [ control-name = "TEMPO" ] )
  [ set label precision tempo 0 ]
end 

to get-slower
  set tempo tempo - 10
  ask [ my-icon ] of one-of (controls with [ control-name = "TEMPO" ] )
  [ set label precision tempo 0 ]
end 

to rewind-cars
  ask cars [ move-to start-position set heading start-heading]
end 

to make-spacer
  ask make-button "GAP" "_icon_blank" "" [->] [ set shape "__blank__"]
end 

to-report  char-to-upper [ c ]
  let lower  "abcdefghijklmnopqrstuvwxyz"
  let upper  "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  let p position c lower
  report ifelse-value ( p = false ) [ c ] [ item p upper ]
end 

to-report split-string [ s ]
  report n-values length s [ i -> item i s ]
end 

to-report uppercase [ s ]
  report reduce word map  char-to-upper (split-string s)
end 

to-report my-linked-patches
  report patches at-points [ [ 0 0 ] [ 0 -1 ] [ 1 0 ] [ 1 -1 ] ]
end 

to do-long-press-prop
  m:cancel-long-click
  let prompt ""
  let choices []
  let no-change "- NO CHANGE -"
  ifelse( kind = "DRUM" )
  [ set prompt (word "Select a new DRUM for " control-name)
    set choices fput no-change ifelse-value ( sort-inst-list? ) [ sort DRUM-list ] [ DRUM-list ]
  ]
  [ set prompt (word "Select a new instrument for " control-name)
    set choices fput no-change instrument-list
  ]

  let new-inst user-one-of prompt choices
  if ( new-inst != no-change and first new-inst != "-" )
  [
    ask my-prototype [ set instrument new-inst ]
    set instrument new-inst
    update-prop-tooltip
    save-prop-list
  ]
end 

to do-long-click-start
  if any? portals-here [ select-portal-destination ]
end 

to select-portal-destination
  m:cancel-long-click
  let this one-of portals-here
  ask this
  [ let pSET other portals
    if any? pset
    [ set color white
      let pLIST sort pSet
      let pnum 0
      let clabels [ "red" "yellow" "green" "blue" "purple" "orange" "turquoise" "pink" ]
      let alabels [ "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ]
      let ccolors [ red yellow green blue violet orange turquoise pink ]
      (foreach plist range length plist
        [ [ pp index] ->
          ask pp
          [ set color item (index mod (length ccolors)) ccolors
            set label-color item (index mod (length ccolors)) ccolors
            set label (word ITEM (index mod (length alabels)) alabels index "-" item (index mod (length clabels)) clabels)
          ]
      ])
      create-portal-links-to pset
      [ set label [ label ] of other-end
        set color [ color ] of other-end
        set label-color color
        set shape "portal-link-to"
        set thickness 3 / patch-size
        set expires 20
      ]
      create-portal-links-from pset
      [ set label [ label ] of other-end
        set color [ color ] of other-end
        set label-color color
        set shape "portal-link-from"
        set thickness 2 / patch-size
        set expires 20
      ]
      ;; player chooses a destiantion
      let label-list fput "NO DESTINATION" sort [ label ] of pset
      let pchoice user-one-of "select destination of this portal" label-list
      ask this [ set destination one-of portals with [ label = pchoice ] ]
      ask pset [ set label "" ]
      ask my-portal-links [ die ]
      sfx-whoosh
    ]
  ]
end 

to-report make-button [ $type $icon-shape $tooltip $click-action ]
  ;; run by a toolbar
  let this nobody
  let b-x slotx++
  let b-y sloty++

  hatch-controls 1
  [ set this self
    set size button-regular-size
    set heading 0

    set control-tooltip $tooltip
    set control-type $type
    set control-name remove "_icon" $icon-shape

    update-pcolor icon-regular-color
    set label-color black
    set shape "_C:BUTTON"
    UPDATE-base-color icon-regular-color
    show-turtle
    setxy int b-x int b-y
    ask my-linked-patches

    [ set linked-control myself
      m:listen-for e:patch-enter [-> ask linked-control [ do-button-enter ] ]
      m:listen-for e:patch-exit [-> ask linked-control [ do-button-exit ] ]
      m:listen-for e:click [-> ask linked-control [ do-button-click ] ]
      m:listen-for e:click-start [-> ask linked-control [ do-button-down ] ]
      m:listen-for e:click-end [-> ask linked-control [ do-button-up ] ]
    ]
    setxy b-x b-y

    let this-icon nobody

    hatch-icons 1
    [ set heading 0
      set size icon-regular-size
      update-base-color icon-regular-color
      set-shape-safely $icon-shape
      set my-control myself
      set this-icon self
      setxy xcor + .25 * icon-regular-size ycor - .25 * icon-regular-size

    ]
    set my-icon this-icon
    set control-click-action $click-action
  ]
  report this
end 

to update-prop-tooltip
  set control-tooltip (word "THIS " control-name " PLAYS " instrument " (hold button down to change instrument)")
end 

to make-prop-button [ $prototype ]
  ask (make-button "PROP" [name] of $prototype "" [->])
  [ set prop-id [ prop-id ] of $prototype
    set kind [ kind ] of $prototype
    set instrument [ instrument ] of $prototype
    set control-name uppercase [ name ] of $prototype
    ask my-icon [ set shape [ icon-shape ] of $prototype ]
    set my-prototype $prototype
    ask $prototype [ set my-button myself ]
    update-prop-tooltip
    ;; temp move to patch-center
    let xx xcor let yy ycor
    setxy int xx int yy
    ;; figure out linked patches
    ask my-linked-patches
    [ set linked-control myself
      m:listen-for e:long-click-start  [-> ask linked-control [ do-long-press-prop ] ]
      m:listen-for e:long-click-end    [-> ask linked-control [ set color icon-regular-color ] ]
      m:listen-for e:long-click-cancel [-> ask linked-control [ set color icon-regular-color ] ]

    ]
    ;; return to original position
    setxy xx yy

    set control-click-action
    [ ->

      set drawing-mode "PROP"
      ;; de-select old selected prop
      if is-prototype? selected-prototype and selected-prototype != my-prototype
      [ ;; deselect prior selection
        ask selected-prototype
        [ ask my-button
          [ ask my-icon
            [ set size icon-regular-size
              set color base-color
            ]
          ]
        ]
      ]
      set selected-prototype my-prototype
      ask my-icon
      [ set size icon-selected-size
        set color icon-selected-color
      ]

      m:set-shape "m-grab" m:show
    ]
  ]
end 

to do-button-enter
  ;; patch makes linked control run this
  ;; only on button change
  if self != curr-button
  [
    set curr-button self
    ifelse selected-prototype = my-prototype
    or drawing-mode = control-name
    [ ask my-icon [ set size icon-selected-size set color icon-selected-color ] ]
    [ ask my-icon [ set size icon-hover-size set color icon-hover-color ] ]
    send-message control-tooltip
  ]
end 

to do-button-exit
  ;; patch makes linked control run this
  ;; this happens when pointer has left this patch
  ;; only on button change
  ;; if linked-control of m:prior-patch (this patch, this control )
  ;; is not linked-control of m:curr-patch patch about to be entered...
  ;; change curr control
  let new-control nobody
if is-patch? m:curr-patch
  [ set new-control  [ linked-control ] of m:curr-patch ]
  if new-control != self
  [ ;; control change... what kind?
    ;; first...
    ;; un-current this control
    set curr-button nobody

    ifelse is-prototype? selected-prototype and my-prototype = selected-prototype
     or control-name = drawing-mode
    [ ;; return to "selected" appearance
      ask my-icon [ set size icon-selected-size set color icon-selected-color ]
    ]
    [ ;; return to normal apprearance
      ask my-icon [ set size icon-regular-size set color icon-regular-color ]
    ]
    send-message ""
    if not is-control? new-control
    [ ;; no new control
      ;; hide pointer decoration
      m:hide
    ]
  ]
end 

to do-button-click
  m:hide
  m:reset-shape
  run control-click-action
end 

to do-button-down
  m:reset-shape
  ask my-icon [ set size icon-press-size set color icon-press-color]
  if control-type = "PROP"  [  ask my-prototype [ run my-sound-command ] ]
end 

to do-button-up
end 

to-report DRUM-list report
  [
    "ACOUSTIC BASS DRUM"
    "BASS DRUM 1"
    "-"
    "ACOUSTIC SNARE"
    "ELECTRIC SNARE"
    "-"
    "LOW AGOGO"
    "HI AGOGO"
    "LOW BONGO"
    "HI BONGO"
    "LOW CONGA"
    "OPEN HI CONGA"
    "MUTE HI CONGA"
    "HI TIMBALE"
    "LOW TIMBALE"
    "-"
    "LOW TOM"
    "LOW MID TOM"
    "HI MID TOM"
    "HI TOM"
    "LOW FLOOR TOM"
    "HI FLOOR TOM"
    "-"
    "CHINESE CYMBAL"
    "CRASH CYMBAL 1"
    "CRASH CYMBAL 2"
    ;; "RIDE BELL" ;; ride bell causes issues with some midi implementations
    "RIDE CYMBAL 1"
    "RIDE CYMBAL 2"
    "SPLASH CYMBAL"
    "-"
    "CLOSED HI HAT"
    "OPEN HI HAT"
    "PEDAL HI HAT"
    "-"
    "CABASA"
    "CLAVES"
    "COWBELL"
    "HAND CLAP"
    "MARACAS"
    "SIDE STICK"
    "TAMBOURINE"
    "MUTE TRIANGLE"
    "OPEN TRIANGLE"
    "LOW WOOD BLOCK"
    "HI WOOD BLOCK"
    "-"
    "OPEN CUICA"
    "MUTE CUICA"
    "SHORT GUIRO"
    "LONG GUIRO"
    "VIBRASLAP"
    "-"
    "SHORT WHISTLE"
    "LONG WHISTLE"
  ]
end 

to-report instrument-list
  ;; observer> print "[" foreach sound:instruments [ x -> type "  " write x print "" ] print "]"
    report [
    "-- KEYBOARDS"
    "ACOUSTIC GRAND PIANO"
    "BRIGHT ACOUSTIC PIANO"
    "ELECTRIC GRAND PIANO"
    "HONKY-TONK PIANO"
    "ELECTRIC PIANO 1"
    "ELECTRIC PIANO 2"
    "HARPSICHORD"
    "CLAVI"
    "CELESTA"
    "--Struck Keyboards"
    "GLOCKENSPIEL"
    "MUSIC BOX"
    "VIBRAPHONE"
    "MARIMBA"
    "XYLOPHONE"
    "TUBULAR BELLS"
    "DULCIMER"
    "--Organs"
    "DRAWBAR ORGAN"
    "PERCUSSIVE ORGAN"
    "ROCK ORGAN"
    "CHURCH ORGAN"
    "--Blown / Reed Keyboards"
    "REED ORGAN"
    "ACCORDION"
    "HARMONICA"
    "TANGO ACCORDION"
    "--Guitars"
    "NYLON STRING GUITAR"
    "STEEL ACOUSTIC GUITAR"
    "JAZZ ELECTRIC GUITAR"
    "CLEAN ELECTRIC GUITAR"
    "MUTED ELECTRIC GUITAR"
    "OVERDRIVEN GUITAR"
    "DISTORTION GUITAR"
    "GUITAR HARMONICS"
    "--Basses"
    "ACOUSTIC BASS"
    "FINGERED ELECTRIC BASS"
    "PICKED ELECTRIC BASS"
    "FRETLESS BASS"
    "SLAP BASS 1"
    "SLAP BASS 2"
    "SYNTH BASS 1"
    "SYNTH BASS 2"
    "--Strings"
    "VIOLIN"
    "VIOLA"
    "CELLO"
    "CONTRABASS"
    "TREMOLO STRINGS"
    "PIZZICATO STRINGS"
    "ORCHESTRAL HARP"
    "TIMPANI"
    "STRING ENSEMBLE 1"
    "STRING ENSEMBLE 2"
    "SYNTH STRINGS 1"
    "SYNTH STRINGS 2"
    "--Voices"
    "CHOIR AAHS"
    "VOICE OOHS"
    "SYNTH VOICE"
    "--Orchestra Hit"
    "ORCHESTRA HIT"
    "--Brass"
    "TRUMPET"
    "TROMBONE"
    "TUBA"
    "MUTED TRUMPET"
    "FRENCH HORN"
    "BRASS SECTION"
    "SYNTH BRASS 1"
    "SYNTH BRASS 2"
    "SOPRANO SAX"
    "ALTO SAX"
    "TENOR SAX"
    "BARITONE SAX"
    "--Woodwind"
    "OBOE"
    "ENGLISH HORN"
    "BASSOON"
    "CLARINET"
    "--Flute"
    "PICCOLO"
    "FLUTE"
    "RECORDER"
    "PAN FLUTE"
    "BLOWN BOTTLE"
    "SHAKUHACHI"
    "WHISTLE"
    "OCARINA"
    "--Synth Pads"
    "SQUARE WAVE"
    "SAWTOOTH WAVE"
    "CALLIOPE"
    "CHIFF"
    "CHARANG"
    "VOICE"
    "FIFTHS"
    "BASS AND LEAD"
    "NEW AGE"
    "WARM"
    "POLYSYNTH"
    "CHOIR"
    "BOWED"
    "METAL"
    "HALO"
    "SWEEP"
    "RAIN"
    "SOUNDTRACK"
    "CRYSTAL"
    "ATMOSPHERE"
    "BRIGHTNESS"
    "GOBLINS"
    "ECHOES"
    "SCI-FI"
    "--World Instr"
    "SITAR"
    "BANJO"
    "SHAMISEN"
    "KOTO"
    "KALIMBA"
    "BAG PIPE"
    "FIDDLE"
    "SHANAI"
    "TINKLE BELL"
    "--Percussion"
    "AGOGO"
    "STEEL DRUMS"
    "WOODBLOCK"
    "TAIKO DRUM"
    "MELODIC TOM"
    "SYNTH DRUM"
    "REVERSE CYMBAL"
    "--SFX"
    "GUITAR FRET NOISE"
    "BREATH NOISE"
    "SEASHORE"
    "BIRD TWEET"
    "TELEPHONE RING"
    "HELICOPTER"
    "APPLAUSE"
    "GUNSHOT"
  ]
end 

to do-click-start
  ( ifelse
    ( drawing-mode = "PROP" ) [ set erase? any? props-here ]
    ( drawing-mode = "ROAD" ) [ set erase? any? roads-here ]
   [ set erase? false ]
  )
end 

to do-click
  draw-thing e:click
end 

to do-drag-start
  ( ifelse
    ( drawing-mode = "ROAD" or drawing-mode = "ERASE" )
    [ draw-line-of-road-drag-start ]
    ( drawing-mode = "PROP" )
    [ let dp [ props-here with [ kind = "NOTE" ] ] of m:drag-patch
      if any? dp
      [ set dp one-of dp
        let dpx [ pxcor ] of m:drag-patch
        let y-diff [ pycor ] of m:curr-patch - [ pycor] of m:drag-patch
        let dpnote [ note ] of dp
        let temp-note y-diff + dpnote
        if temp-note > 127 [ set temp-note 127 ]
        let note-name (word (item (temp-note mod 12) note-labels) "-" int (temp-note / 12 - 1) )
        ask dp
        [ play-sample temp-note
          ask neighbors ;; apply note labels
          [
          ;  set plabel note-name
          ;  set pcolor white
          ;  set plabel-color black
            ask turtles-here with [ breed != m:pointers ] [ hide-turtle ]
          ]
        ]
        ask field-patches with [ pxcor = dpx ]
        [ set temp-note dpnote + pycor - [ pycor ] of m:drag-patch
          set plabel (word (item (temp-note mod 12) note-labels) "-" int (temp-note / 12 - 1) )
          ask patches at-points [[ -1 0 ] [ 0 0  ] [ 1 0] ]
          [ set pcolor white
            set plabel-color black
          ]
        ]
      ]
    ]
    []
  )
end 

to do-drag-enter
  ( ifelse
    (drawing-mode = "ROAD" or drawing-mode = "ERASE") [ draw-line-of-road-drag-enter]
    (drawing-mode = "PROP") [
      if any? [ props-here with [ kind = "NOTE" ]] of m:drag-patch
      [
        ask m:drag-patch
        [ let ny [ pycor ] of m:curr-patch - [ pycor] of m:down-patch
          ask props-here
          [
            play-sample (note + ny)
          ]
          ask patch pxcor [ pycor ] of m:curr-patch [ ask patches at-points [ [ -1 0][0 0][1 0]] [ set pcolor gray + 2]]
        ]

      ]
    ]
    []
  )
end 

to do-drag-exit
  ( ifelse
    (drawing-mode = "PROP")
    [
      if any? [ props-here with [ kind = "NOTE" ]] of m:drag-patch
      [
        ask m:drag-patch
        [
        ask patch pxcor [ pycor ] of m:prior-patch [ ask patches at-points [ [ -1 0][0 0][1 0]] [ set pcolor white]]
        ]
      ]
    ]
    []
  )
end 

to do-drag-drop
  ( ifelse
    ( drawing-mode = "ROAD" or drawing-mode = "ERASE") [ draw-line-of-road-drag-drop ]
    ( drawing-mode = "PROP" )
    [ ask m:drag-patch
      [ if any? [ props-here with [ kind = "NOTE" ] ] of m:drag-patch
        [ let dp [ props-here with [ kind = "NOTE" ] ] of m:drag-patch
          if any? dp
          [ set dp one-of dp
            let dpx [ pxcor ] of m:drag-patch
            let y-diff [ pycor ] of m:curr-patch - [ pycor] of m:drag-patch
            let dpnote [ note ] of dp
            let temp-note y-diff + dpnote
            if temp-note > 127 [ set temp-note 127 ]
            let note-name (word (item (temp-note mod 12) note-labels) "-" int (temp-note / 12 - 1) )
            ask dp
            [ ;; play-sample temp-note
              ask neighbors ;; apply note labels
              [ set plabel ""
                ask turtles-here with [ breed != m:pointers ] [ show-turtle ]
                set pcolor base-pcolor
              ]
              set note temp-note
              set duration .25 * (1 + abs ( pxcor - [ pxcor ] of m:drop-patch ) )
            ]
            ask field-patches with [ pxcor = dpx ]
            [ ask patches at-points [[ -1 0 ] [ 0 0  ] [ 1 0] ]
             [  set plabel ""
              set pcolor base-pcolor
              set plabel-color white
            ]]
          ]
        ]
      ]
    ]
    []
  )
end 

to do-drag-cancel
  ask m:Mouse [ m:do-event e:drag-exit m:curr-patch set dragging? false]
  if is-patch-set? dragset [ ask dragset [set pcolor base-pcolor ] ]
  ask markers [ die ]
end 

to draw-thing [ event ]
  (ifelse
    (drawing-mode = "ROAD") [ ifelse erase? [ erase-things] [ make-road-here event ] ]
    (drawing-mode = "PROP") [ sfx-click make-prop-here selected-prototype event  ]
    (drawing-mode = "CAR" ) [ make-car-here event ]
    (drawing-mode = "ERASE" ) [ erase-things ]
    (drawing-mode = "PORTAL" )  [  make-portal-here ]
    (drawing-mode = "ONEWAY" ) [ make-one-way-here ]
  )
end 

to draw-line-of-road-drag-start
  ;; run by ddrag-patch aka prior-patch
  let dxa abs ( [ pxcor ] of m:curr-patch  - pxcor )
  let dya abs ( [ pycor ] of m:curr-patch  - pycor )
  ifelse dxa != 0 and dya != 0
  [ ask m:mouse [ m:do-event e:drag-cancel drag-patch ]  ]
  [
    sprout-markers 1
    [ update-base-color lime
      set my-snap myself
      set drag-axis-x 1
      set drag-axis-y 1
      set dragroot self
    ]
    sprout-markers 1
    [ update-base-color lime
      set shape "m-control-decorator-target"
      move-to [ curr-patch ] of m:mouse
      set drag-axis-y dxa
      set drag-axis-x dya

      set my-snap m:mouse
      set dragleaf self
      create-marker-link-from dragroot
    ]
  ]
end 

to draw-line-of-road-drag-enter
  if is-marker? dragleaf and is-marker? dragroot
  [ ask dragleaf
    [ let px [ pxcor ] of my-snap
      let py [ pycor ] of my-snap
      let rx [ pxcor ] of dragleaf
      let ry [ pycor ] of dragleaf
      let nx (px * drag-axis-y ) + (rx * drag-axis-x)
      let ny (py * drag-axis-x ) + (ry * drag-axis-y)
      if is-patch? patch nx ny
      [ setxy nx ny ]

    ]
    let p no-patches
    ask dragroot
    [ let d distance dragleaf
      if d > 0
      [ let h towards dragleaf
        set heading h
        set p patches in-cone d .1
      ]
    ]
    if is-patch-set? dragset [ ask dragset [ set pcolor base-pcolor ] ]
    set dragset p
    ask dragset
    [ set pcolor ifelse-value ( ( int (distance dragroot) ) mod beats-per-measure) = 0 [ red ] [green ] ]
    let n int ( ( (count dragset ) - 1 ) / beats-per-measure )
    sound:play-note "clavi" (n * 5 + 32) velocity / 2 .05
    ;;; sound:play-note instrument keynumber velocity duration
  ]
end 

to-report  is-grid-intersection?
  report  ifelse-value ( beats-per-measure = 0 ) [ false ] [ (( pxcor mod beats-per-measure) = 0 ) and ( (pycor mod beats-per-measure)  = 0) ]
end 

to draw-line-of-road-drag-drop
  let temp nobody
  if is-patch-set? dragset
  [ ask dragset [ set pcolor base-pcolor ]
    ifelse (drawing-mode = "ERASE")
    [ ask dragset [ erase-things-partial ]
      ask dragset [ redraw-neighbor-roads ]
    ]
    [ ask dragset [ make-road-here e:null-event ] ]

  ]
  ask markers [ die ]
end 

to erase-things
  let also-roads? any? roads-here
  ask props-here [ die ]
  ask cars-here [ die ]
  erase-portals-here
  ask roadsigns-here [ die ]
  if also-roads?
  [ ask roads-here [ die ]
    ask (props-on neighbors4 ) with [ not any? roads-on neighbors4 ] [ die ]
    redraw-neighbor-roads
  ]
  set-field-color
end 

to erase-things-partial
  let also-roads? any? roads-here
  ask props-here [ die ]
  ask cars-here [ die ]
  erase-portals-here
  ask roadsigns-here [ die ]
  if also-roads?
  [ ask roads-here [ die ]
    ask (props-on neighbors4 ) with [ not any? roads-on neighbors4 ] [ die ]
  ]
  set-field-color
end 

to erase-portals-here
  ask portals-here
  [ ask portals with [ destination = myself ]
    [ set destination nobody ]
    die
  ]
end 

to update-mouse-label
   ask m:mouse
    [ let t drawing-mode
      if drawing-mode = "PROP" [ if is-turtle? selected-prototype [ set t [name] of selected-prototype ] ]
      set label (word "\n\n\n" t "              ")
    ]
end 

to _edit
  every .01
  [ m:go-mouse
    update-mouse-label
  ]
  every .1
  [ ask portals [ rt 5 if color mod 10 < 5 or color mod 10 > 8 [ set pulse -1 * pulse ] set color color + pulse  ]
    ask portal-links [ set color [ color] of end1 set expires expires - 1 if expires <= 0 [ die ] ]
  ]
end 

to _play
  every ( 15 / tempo ) [ if is-playing? [ _drive ] ]
end 

to _drive
  ; if ( playing? = true )
  ; [
  ask cars
  [
    let this-car self
    set sight-patch patch-here
    set sight-heading heading
    let choices no-turtles
    let choice nobody
    let this-sign nobody
    ;let signs-near (roadsigns-on neighbors4 ) with [ kind = "one-way" ]
    ;ifelse any? signs-near
    ;[ set this-sign one-of signs-near
    ;  set choices roads-on (patch-set
    ;    patch-at-heading-and-distance [ heading ] of this-sign 1
    ;  )
    ;]
    ;[
    let this-patch sight-patch
      set choices roads-on ((patch-set
      patch-ahead 1
      patch-at-heading-and-distance (90 + heading) 1
      patch-at-heading-and-distance (-90 + heading) 1
    ) with [ not any? (roadsigns-here with [ kind = "one-way" and 0 = subtract-headings heading [180 + towards myself] of this-patch ] ) ] )
    ;]
    ifelse (any? choices)
    [ set choice one-of choices
      set sight-patch [ patch-here ] of choice
      set sight-heading towards choice
    ] ;; jump 1
    [ ifelse ( any? roads-on patch-ahead -1 )
      [ set sight-patch patch-ahead -1
        set sight-heading heading + 180
      ]
      [ set sight-heading heading + 90
      ]
    ]

    ;; jump 1
    ;; handle portals
    ;; if there's a portal, look at the destination
    let ppp portals-on sight-patch
    if any? ppp with [ is-portal? destination ] [ set sight-patch [ destination ] of one-of ppp ask ppp [ create-portal-link-to destination [ set shape "portal-link-to" set color white set expires 2 ]] ]

    set sights [ props-on neighbors4 ] of sight-patch
  ]
  if is-turtle-set? all-sights [ ask all-sights [ set color base-color ] ]
  set all-sights (turtle-set [ sights ] of cars )
  ask all-sights [ play-my-sound ]
  ask cars [ set heading sight-heading set shape (word "_car_3_" heading ) move-to sight-patch ]
  ask all-sights [ set color prop-hit-color ]
end 

to __setup
  clear-all
  send-message "GETTING READY FOR FUN!"

  output-print "calling mouse setup"
  m:setup-mouse-driver
  ask m:mouse [ set shape "m-pointer-1" ]


  set tempo 120
  set velocity 64
  set beats-per-measure 4
  set last-note 60 ;; middle c
  setup-prototypes

  _setup-toolbar

  _setup-field-patches

  ask patches with [ (pxcor = min-pxcor or pxcor = max-pxcor) and (pycor = min-pycor or pycor = max-pycor) ]
  [ m:listen-for e:screen-exit [ -> do-drag-cancel ] ]

  set note-labels [ "C" "C#" "D" "D#" "E" "F" "F#" "G" "G#" "A" "A#" "B" ]
  output-print ""

  set drawing-mode "ROAD"

  set is-playing? false
  reset-ticks
  output-print "all done!"
  send-message "WELCOME TO TOON-TOWN! -- PRESS PLAY TO BEGIN"
end