traffic lights on junctions

;extensions [time]
;__includes [
;           "drawRoads.nls"
;            ]

globals [
  entrances
  junction_light_list
  junction_phase_list
]

breed [cars car]
cars-own[
  nextTarget lastTarget speed
  birthtime
]

breed [nodes node]
directed-link-breed [roads road]

breed [junctions junction]
junctions-own [
  jc
  phase_list
  current_phase
  own_lights
]

nodes-own[
  name
  node_type    ; 0 - exit, 1 - entrance
  is_light
  is_active
  link_end
]




;MAIN FUNCTION;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to setup
  clear-all
  ;init-roadnetwork
  draw-roads

  reset-ticks
end 

to go
  tick
  jgo
  movecars
  create-car-at-entrance
end 



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;                      go functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to jgo
  ask junctions [
    ifelse jc = 1
    [ tl ]
    [ set jc jc - 1 ]
  ]
end 

to tl
  let next-phase 0
  ifelse current_phase >= (length phase_list - 1)
  [
    set current_phase 0
    set next-phase first phase_list
  ];else
  [
    set current_phase current_phase + 1
    set next-phase item current_phase phase_list
  ]
  setting_light_color next-phase
  ifelse next-phase = [ 0 0 0 0 ]
  [ set jc jc_lenth / 2 ]
  [ set jc jc_lenth ]
end 

to setting_light_color [phase]
  (foreach own_lights phase [ [?1 ?2] ->
      ask ?1 [
        ifelse ?2 = 0
        [ set color red ]
        [ set color green]
      ]
  ])
end 


;CARS;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

to create-car-at-entrance
  if (random 100 < spawn-propabilty)
  [
    let rndNode one-of nodes with [node_type = 1 and count cars-here < 1]
    if rndNode != nobody
    [
      create-cars 1 [
        set xcor [xcor] of rndNode
        set ycor [ycor] of rndNode
        set size 1
        set color yellow
        set lastTarget rndNode

        set nextTarget one-of [link_end] of lastTarget
        if nextTarget = nobody [
          output-show "ERROR: nextTarget is nobody"
          die]

        face nextTarget
        set birthtime ticks
      ]
    ]
  ]
end 

to updateTarget
  set lastTarget nextTarget
  ifelse length [link_end] of nextTarget > 0
  [ set nextTarget one-of [link_end] of nextTarget ]
  [ die ]
end 

to movecars
  ask cars
  [
    if speed > 0 and distance nextTarget < speed-limit [
      updateTarget
      face nextTarget
  ]
    set-car-speed
    fd speed
  ]
end 


;; set the turtles' speed based on whether they are at a red traffic light or the speed of the
;; turtle (if any) on the patch in front of them

to set-car-speed  ;; turtle procedure
  ifelse [color] of nextTarget = red and distance nextTarget < speed-limit * 2
  [ set speed 0 ]
  [
    following-car-ahead-speed speed-limit * 1.5
  ]
end 

;; set the speed variable of the car to an appropriate value (not exceeding the
;; speed limit) based on whether there are cars on the patch in front of the car

to following-car-ahead-speed [ dis-ahead ]
  ;; get the cars on the patch in front of the turtle
  let cars-ahead cars in-cone dis-ahead 10 with [ who != [who] of myself ]
  ;; if there are turtles in front of the turtle, slow down
  ;; otherwise, speed up
  ifelse any? cars-ahead
  [
    let car0 min-one-of cars-ahead [distance myself]
    set speed [speed] of car0
  ]
  [
    speed-up
  ]
end 

;; decrease the speed of the turtle

to slow-down  ;; turtle procedure
  ifelse speed <= 0
  [ set speed 0 ]
  [ set speed speed - deceleration ]
end 

;; increase the speed of the turtle

to speed-up  ;; turtle procedure
  ifelse speed > speed-limit
  [ set speed speed-limit ]
  [ set speed speed + acceleration ]
end 

to draw-roads

  let node_list
  [
    ;cross 1
    ["C1N1" [-14 -10]]
    ["C1N2" [-14 -6]]
    ["C1N3" [-14 6]]
    ["C1N4" [-14 10]]
    ["C1S1" [-11 10]]
    ["C1S2" [-11 6]]
    ["C1S3" [-11 -6]]
    ["C1S4" [-11 -10]]
    ["C1W1" [-20 -1]]
    ["C1W2" [-16 -1]]
    ["C1W3" [-9 -1]]
    ["C1W3r" [-9 -2]]
    ["C1W4" [-4 -1]]
    ["C1W4r" [-4 -2]]
    ["C1E1" [-4 1]]
    ["C1E1r" [-4 2]]
    ["C1E2" [-9 1]]
    ["C1E2r" [-9 2]]
    ["C1E3" [-16 1]]
    ["C1E4" [-20 1]]

    ;cross 2
    ["C2N1" [6 -10]]
    ["C2N1r" [5 -10]]
    ["C2N2" [6 -6]]
    ["C2N2r" [5 -6]]
    ["C2N3" [6 6]]
    ["C2N3r" [5 6]]
    ["C2N3l" [9 2]]
    ["C2N4" [6 10]]
    ["C2N4r" [5 10]]
    ["C2S1" [10 10]]
    ["C2S1r" [11 10]]
    ["C2S2" [10 6]]
    ["C2S2r" [11 6]]
    ["C2S3" [10 -6]]
    ["C2S3r" [11 -6]]
    ["C2S3l" [9 -4]]
    ["C2S4" [10 -10]]
    ["C2S4r" [11 -10]]
    ["C2W1" [0 -1]]
    ["C2W1r" [0 -2]]
    ["C2W2" [4 -1]]
    ["C2W2l" [8 0]]
    ["C2W2r" [4 -2]]
    ["C2W3" [14 -1]]
    ["C2W3r" [14 -2]]
    ["C2W4" [18 -1]]
    ["C2W4r" [18 -2]]
    ["C2E1" [18 1]]
    ["C2E1r" [18 2]]
    ["C2E2" [14 1]]
    ["C2E2l" [9 0]]
    ["C2E2r" [14 2]]
    ["C2E3" [4 1]]
    ["C2E3r" [4 2]]
    ["C2E4" [0 1]]
    ["C2E4r" [0 2]]
  ]

  let link_list
  [
    ; straight line
    ["C1N4" "C1N3"]
    ["C1N3" "C1N2"]
    ["C1N2" "C1N1"]
    ["C1S4" "C1S3"]
    ["C1S3" "C1S2"]
    ["C1S2" "C1S1"]
    ["C1E1" "C1E2"]
    ["C1E2" "C1E3"]
    ["C1E3" "C1E4"]
    ["C1W1" "C1W2"]
    ["C1W2" "C1W3"]
    ["C1W3" "C1W4"]
    ; right-turn line
    ["C1E1r" "C1E2r"]
    ["C1S3" "C1W3r"]
    ["C1W3r" "C1W4r"]
    ["C1W2" "C1N2"]
    ["C1N3" "C1E3"]
    ["C1E2" "C1S2"]
    ; left-turn line
    ["C1S3" "C1E3"]
    ["C1W2" "C1S2"]
    ["C1N3" "C1W3"]
    ["C1E2" "C1N2"]
    ; cross 1 to cross 2
    ["C1E1" "C2E4"]
    ["C1E1r" "C2E4r"]
    ["C1W4" "C2W1"]
    ["C1W4r" "C2W1r"]

    ; cross 2
    ["C2N4" "C2N3"]
    ["C2N4r" "C2N3r"]
    ["C2N3" "C2N3l"]
    ["C2N3l" "C2W3"]
    ["C2N3" "C2N2"]
    ["C2N3r" "C2N2r"]
    ["C2N3r" "C2E3r"]
    ["C2E3" "C2E4"]
    ["C2E3r" "C2E4r"]

    ["C2E1" "C2E2"]
    ["C2E1r" "C2E2r"]
    ["C2E2" "C2E3"]
    ["C2E2" "C2E2l"]
    ["C2E2l" "C2N2"]
    ["C2E2r" "C2E3r"]
    ["C2E2r" "C2S2r"]

    ["C2S2" "C2S1"]
    ["C2S2r" "C2S1r"]

    ["C2S3" "C2S3l"]
    ["C2S3l" "C2E3"]
    ["C2S3" "C2S2"]
    ["C2S3r" "C2S2r"]
    ;
    ["C2W1" "C2W2"]
    ["C2W1r" "C2W2r"]
    ["C2W1r" "C2N2r"]
    ["C2W1" "C2W2l"]

    ["C2S4" "C2S3"]
    ["C2S4r" "C2S3r"]

    ["C2S3r" "C2W3r"]

    ["C2W3" "C2W4"]
    ["C2W3r" "C2W4r"]

    ["C2W2" "C2W3"]
    ["C2W2l" "C2S2"]

    ;
    ["C2W2r" "C2N2r"]
    ["C2W2r" "C2W3r"]
    ["C2N2" "C2N1"]
    ["C2N2r" "C2N1r"]
  ]

  set junction_light_list
  [
    ; junction 1
    ["C1S3" "C1N3" "C1E2" "C1W2"]
    ; junction 2
    ["C2S3" "C2S3r" "C2S3l" "C2N3" "C2N3r" "C2N3l" "C2E2r" "C2E2" "C2E2l" "C2W2r" "C2W2" "C2W2l"]
  ]


  set junction_phase_list
  [
    ; junction1
    [
      [1 1 0 0][0 0 0 0][0 0 1 1][0 0 0 0]
    ]
    ; junction2:["C2S3" "C2S3r" "C2S3l" "C2N3" "C2N3r" "C2N3l" "C2E2r" "C2E2" "C2E2l" "C2W2r" "C2W2" "C2W2l"]
    [
      [0 0 0 0 0 0 0 0 0 0 0 0]
      [1 1 0 1 1 0 0 0 0 0 0 0]
      [0 0 0 0 0 0 0 0 0 0 0 0]
      [0 0 1 0 0 1 0 0 0 0 0 0]
      [0 0 0 0 0 0 0 0 0 0 0 0]
      [0 0 0 0 0 0 1 1 0 1 1 0]
      [0 0 0 0 0 0 0 0 0 0 0 0]
      [0 0 0 0 0 0 0 0 1 0 0 1]
      [0 0 0 0 0 0 0 0 0 0 0 0]
    ]
  ]

  let entrance_list ["C1N4" "C1S4" "C1W1" "C2N4" "C2N4r" "C2S4" "C2S4r" "C2E1" "C2E12"]

  let l length node_list
  create-nodes l
  [
    set shape "circle"
    set color gray
    set size 0.75
    set link_end [ ]
  ]

  ; set label and position
  (foreach sort nodes node_list [ [?1 ?2]->
    ask ?1 [
      set name first ?2
      if display_label? [set label name]
      set xcor first last ?2
      set ycor last last ?2
    ]
  ])


  ; set entrance points
  (foreach entrance_list [ [?]-> ask nodes with [name = ?][ set node_type 1 ] ])
  ;
  set entrances nodes with [out-link-neighbors = nobody]

  ;; building links
  foreach link_list
  [ [?]->
    ask nodes with [name = first ?]
    [
      let new_end one-of nodes with [name = last ? ]
      set link_end lput new_end link_end
      create-road-to new_end
      ;ask links [die]
    ]
  ]


  ; set exit points
  ask nodes with [ my-out-roads = nobody ][ set node_type 0 ]

  init-junctions
end 

to init-junctions
  if length junction_phase_list != length junction_light_list
  [
    print "ERROR!! junction_phase_list != length junction_light_list"
    stop
  ]
  let n length junction_phase_list
  create-junctions n [
    set hidden? true
    set jc jc_lenth
    set own_lights [ ]
  ]

  (foreach (sort junctions) junction_light_list junction_phase_list [
    [?1 ?2 ?3]->
    ; mark nodes as light
    ask ?1 [
      foreach ?2 [ [?]-> set own_lights lput one-of nodes with [name = ?] own_lights ]

      set current_phase 0

  (foreach own_lights [[?]->
        ask ? [
         set is_light true
         set color red
         set is_active true
         ]
      ])

      set phase_list ?3
      setting_light_color first ?3

    ]
  ])
end