NetLogo version NetLogo 4.0.4
Running with NetLogoLite.jar version 404.
NetLogo Version: NetLogo 4.0.4
;; By James Steiner globals [ min-edge-length ;; if the edge length is less than this, the linked nodes are "decorated" max-edge-length ] ;; decora (singular decorum, like "data" and "datum") are turtles that decorate nodes when the link is too short ;; place first so that these turtles appear UNDER other turtles ;; make sure to define a shape "decorum" that has the appearance desired. ;; note that shapes scale proportionally, so "dumbbell" or other linear shapes may not perform as desired breed [ decora decorum ] decora-own [ my-edge ] ;; the other breeds for the netwrk breed [ nodes node ] undirected-link-breed [ edges edge ] edges-own [ my-decorum ;; used to track link decorations old-length ;; used to track change in link length over time ] to startup setup end to reset setup end to setup ca set min-edge-length 2 ;; defines default shape for decora setup-decora ;; creates the network, including the decora setup-network 25 ;; arranges the network for initial display repeat 100 [ update-network-display ] update-decora-display end to go every .015 [ ;; copy min-length from slider, ;; put in min-edge-length set min-edge-length min-length set max-edge-length min-length * 1.5 update-network-display mouse:go ;; if any link stretches too far, it breadks ;; this means that the links of the dragged node may ;; not be the links that break. let stressed edges with [ link-length - old-length > 1 and link-length > max-edge-length ] if any? stressed [ ask stressed [ die ] ask decora with [ not is-turtle? my-edge ] [ die ] ] ;; if a node is dragged too close to another node, they link ;; not the reference to the proterties of the pointer if is-node? [ mouse-dragged ] of one-of pointers [ ask [ mouse-dragged ] of one-of pointers [ let close other nodes in-radius (min-edge-length * .5) with [ not edge-neighbor? myself] ask close [ create-decorated-edge myself ] ] ] ;; always do this after all other display-changers are done ;; e.g. after mouse drag may have changed link length. update-decora-display tick ] end to create-decorated-edge [ that-node ] let this-node self create-edge-with that-node [ set thickness .5 set color white let this-edge self ;; only turtles can use hatch, so we'll ;; get the calling turtle to hatch ;; the decorum we need ask this-node [ hatch-decora 1 [ ;; decorum keeps a reference to the edge it decorates set my-edge this-edge ;; decorum is initially hidden hide-turtle ;; this updates the size and position of the decorum update-decorum-display ] ] ] end to set-node-color set color (who * 10 + 5) mod 139 end to setup-network [ node-pop ] set-default-shape nodes "node" create-nodes node-pop [ set-node-color create-decorated-edge one-of other nodes setxy random-xcor random-ycor ] update-network-display end to update-network-display ask edges [ set old-length link-length ] layout-spring nodes edges pull min-length push end to setup-decora ;; defaine default shape for a decorum set-default-shape decora "decorum" end to update-decora-display ask decora [ update-decorum-display ] end to update-decorum-display ;; update the position, heading, and visibility of a decorum setxy [ edge-xcor ] of my-edge [ edge-ycor ] of my-edge ;; the sizing formula used depends on the look desired. ;; this formula makes the decorum fit around both end-points, with ;; margin equal half to the larger endpoint size, and includes the length of the edge let edge-length [ link-length ] of my-edge set size [ link-length + 2 * max [ size ] of both-ends ] of my-edge ;; if the size of the link <= 0, then there is no heading, otherwise, get a heading set heading [ ifelse-value (link-length = 0) [ 0 ] [ link-heading ] ] of my-edge ;; hide or un-hide the decorum ifelse hidden? [ if edge-length <= min-edge-length [ show-turtle ] ][ if edge-length > min-edge-length [ hide-turtle ] ] end to-report edge-xcor report ( .5 * ( [ xcor ] of end1 + [ xcor ] of end2 ) ) end to-report edge-ycor report ( .5 * ( [ ycor ] of end1 + [ ycor ] of end2 ) ) end ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; MOUSE STUFF ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Mouse interface copyright 2009 James P. Steiner ;; You are free to use this interface code framwork in your own models ;; Please retain this copyright notice when you paste or include the code ;; the breed for the mouse pointer ;; defined last so pointer is on top of all other shapes breed [ pointers pointer ] pointers-own [ mouse-dragged mouse-hovered mouse-hover-radius^2 mouse-click-time mouse-outside? mouse-in-click? mouse-x mouse-y ] to mouse:go if not any? pointers [ mouse:setup-pointer ] ask pointers [ ifelse mouse-inside? [ ;; mouse is inside ;; -- get the coordinates set mouse-x mouse-xcor set mouse-y mouse-ycor ;; move the pointer setxy mouse-x mouse-y ;; did it just come inside? if mouse-outside? [ set mouse-outside? false mouse:do-go-inside ] ifelse mouse-down? [ ;; mouse is down ;; did it just go down? if not mouse-in-click? [ set mouse-in-click? true mouse:do-click-start ] ;; do continuous mouse-down stuff mouse:do-down ] [ ;; mouse is up ;; did it just come up? if mouse-in-click? [ set mouse-in-click? false mouse:do-click-end ] ;; do continuous mouse-up/hover stuff mouse:do-hover ] ] [ ;; mouse is outside ;; did it just come outside if not mouse-outside? [ set mouse-outside? true mouse:do-go-outside ] ;; do continuous mouse outside stuff mouse:do-outside ] ] end to mouse:do-go-inside set mouse-outside? false ;; do anything special that happens only ;; when the mouse first returns inside. ;; usually this is empty--the regu end to mouse:do-click-start ;; stuff that happens when the mouse button first goes down. if is-turtle? mouse-hovered [ mouse:hover-drop ] if not is-node? mouse-dragged [ if any? nodes [ set mouse-dragged min-one-of nodes with [ mouse:quick-distance myself < 4 ] [ mouse:quick-distance myself ] ] ] end to mouse:do-down ;; stuff that happens *while* the mouse button is down if is-node? mouse-dragged [ ask mouse-dragged [ setxy [ mouse-x ] of myself [ mouse-y ] of myself ] ] end to mouse:do-click-end debug-print "click-end" ;; stuff that happens when the mouse button comes back up set mouse-dragged nobody end to mouse:do-go-outside debug-print "go-outside" ;; stuff that happens when the mouse pointer first crosses outside the view edge set mouse-dragged nobody if is-turtle? mouse-hovered [ mouse:hover-drop ] end to mouse:do-outside ;; stuff that happens while the mouse is outside the view ;; such as hiding the pointer setxy (.9 * xcor + .1 * (1 * cos ( timer * 360))) (.9 * ycor + .1 * (1 * sin (timer * 360) )) end to mouse:do-hover ifelse is-turtle? mouse-hovered [ ifelse mouse:quick-distance mouse-hovered > mouse-hover-radius^2 [ mouse:hover-drop ] [ ] ] [ mouse:hover-pickup ] end to mouse:hover-pickup debug-print "get-hovered" let hoverable nodes with [ mouse:quick-distance myself < 9 ] if any? hoverable [ set mouse-hovered max-one-of hoverable [ who ] ask mouse-hovered [ set color 9.9 set size 3] set mouse-hover-radius^2 9 debug-print (word "(" mouse-hovered ")" ) ] end to mouse:hover-drop debug-print "drop-hovered" ask mouse-hovered [ set-node-color set size 1] set mouse-hovered nobody end to-report mouse:quick-distance [ agent ] ;; reports the square of the distance ;; avoids the slow square root function ;; useful when simply looking for nearest ;; or comparing distance ;; or comparing to a known squared distance let xx [ xcor ] of agent - xcor let yy [ ycor ] of agent - ycor report (xx * xx + yy * yy) end to mouse:setup-pointer create-pointers 1 [ set shape "pointer" set color white set size 7 set heading 0 set mouse-dragged nobody set mouse-in-click? false set mouse-outside? true set mouse-hovered nobody ] end to debug-print [ message ] ; output-print message end
View or download the complete model file (to download: right-click, save-link-as):
-- Download network-build-modify --