From: Frank Duncan Date: Sun, 24 Apr 2016 04:55:06 +0000 (-0500) Subject: Prims - Implement die X-Git-Tag: v0.1.0~44 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=commitdiff_plain;h=b018550f2029475c8bececad3c6658048c8c80f0 Prims - Implement die --- diff --git a/bin/diagnose-view-test b/bin/diagnose-view-test index 9841e10..73dd422 100755 --- a/bin/diagnose-view-test +++ b/bin/diagnose-view-test @@ -44,10 +44,13 @@ scalafiledisplaypid=$! display $clfile & clfiledisplaypid=$! -echo -n "... and hit enter to finish" +echo -n "... and hit enter to close scala image" read kill $scalafiledisplaypid + +echo -n "... and hit enter to finish" +read kill $clfiledisplaypid rm $scalafile diff --git a/bin/runcmd.scala b/bin/runcmd.scala index f85ee7e..03bdc8d 100755 --- a/bin/runcmd.scala +++ b/bin/runcmd.scala @@ -35,7 +35,7 @@ workspace.mainRNG.setSeed(15) if(commands.length > 0) { workspace.runCompiledCommands(new api.SimpleJobOwner("test", workspace.world.mainRNG, api.AgentKind.Observer), workspace.compileCommands(commands, api.AgentKind.Observer)) } -if(input.length > 0) { +if(input.length > 1) { val reporter = input(1) System.out.println(org.nlogo.api.Dump.logoObject(workspace.runCompiledReporter(new api.SimpleJobOwner("test", workspace.world.mainRNG, api.AgentKind.Observer), workspace.compileReporter(reporter)))) } diff --git a/bin/viewruncmd.scala b/bin/viewruncmd.scala index c3abf26..fccc2ea 100755 --- a/bin/viewruncmd.scala +++ b/bin/viewruncmd.scala @@ -26,12 +26,10 @@ import collection.JavaConversions._ System.out.println("----") val workspace = HeadlessWorkspace.newInstance workspace.silent = true -workspace.openFromSource(url2String("file:resources/empty.nlogo")) +workspace.openFromSource(url2String("file:resources/empty55.nlogo")) val commands = io.Source.stdin.getLines.mkString("\n") -workspace.runCompiledCommands(new api.SimpleJobOwner("test", workspace.world.mainRNG, api.AgentKind.Observer), workspace.compileCommands("resize-world -5 5 -5 5", api.AgentKind.Observer)) - workspace.mainRNG.setSeed(15) workspace.runCompiledCommands(new api.SimpleJobOwner("test", workspace.world.mainRNG, api.AgentKind.Observer), workspace.compileCommands(commands, api.AgentKind.Observer)) diff --git a/resources/empty55.nlogo b/resources/empty55.nlogo new file mode 100644 index 0000000..61350dd --- /dev/null +++ b/resources/empty55.nlogo @@ -0,0 +1,75 @@ +@#$#@#$#@ +GRAPHICS-WINDOW +210 +10 +649 +470 +-1 +-1 +13.0 +1 +10 +1 +1 +1 +0 +1 +1 +1 +-5 +5 +-5 +5 +0 +0 +1 +ticks +30.0 + +@#$#@#$#@ +## WHAT IS IT? + +(a general understanding of what the model is trying to show or explain) + +## HOW IT WORKS + +(what rules the agents use to create the overall behavior of the model) + +## HOW TO USE IT + +(how to use the model, including a description of each of the items in the Interface tab) + +## THINGS TO NOTICE + +(suggested things for the user to notice while running the model) + +## THINGS TO TRY + +(suggested things for the user to try to do (move sliders, switches, etc.) with the model) + +## EXTENDING THE MODEL + +(suggested things to add or change in the Code tab to make the model more complicated, detailed, accurate, etc.) + +## NETLOGO FEATURES + +(interesting or unusual features of NetLogo that the model uses, particularly in the Code tab; or where workarounds were needed for missing features) + +## RELATED MODELS + +(models in the NetLogo Models Library and elsewhere which are of related interest) + +## CREDITS AND REFERENCES + +(a reference to the model's URL on the web if it has one, as well as any other necessary credits, citations, and links) +@#$#@#$#@ +@#$#@#$#@ +NetLogo (no version) +@#$#@#$#@ +@#$#@#$#@ +@#$#@#$#@ +@#$#@#$#@ +@#$#@#$#@ +@#$#@#$#@ +0 +@#$#@#$#@ diff --git a/src/main/interface.lisp b/src/main/interface.lisp index dd6c4ce..ba3efc5 100644 --- a/src/main/interface.lisp +++ b/src/main/interface.lisp @@ -45,10 +45,15 @@ (let ((color (nl-color->rgb (getf turtle :color)))) (gl:color (car color) (cadr color) (caddr color))) - (gl:with-pushed-matrix - (gl:translate (* (getf turtle :xcor) *patch-size*) (* (getf turtle :ycor) *patch-size*) 0) - (gl:rotate (getf turtle :heading) 0 0 -1) - (gl:call-list *turtle-list*))) + (mapcar + (lambda (x-modification y-modification) + (gl:with-pushed-matrix + (gl:translate (* (getf turtle :xcor) *patch-size*) (* (getf turtle :ycor) *patch-size*) 0) + (gl:translate x-modification y-modification 0) + (gl:rotate (getf turtle :heading) 0 0 -1) + (gl:call-list *turtle-list*))) + (list 0 (1- (world-width-in-pixels)) (- (1- (world-width-in-pixels))) 0 0) + (list 0 0 0 (1- (world-height-in-pixels)) (- (1- (world-height-in-pixels)))))) (clnl-nvm:current-state)) (gl:flush)) @@ -124,8 +129,8 @@ DESCRIPTION: (sb-int:with-float-traps-masked (:invalid) (cl-glut:init) (cl-glut:init-window-size - (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin))))) - (floor (* *patch-size* (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin)))))) + (world-width-in-pixels) + (world-height-in-pixels)) (cl-glut:init-display-mode :double :rgba) (cl-glut:create-window "CLNL Test Window") (setf *glut-window-opened* t) @@ -137,6 +142,12 @@ DESCRIPTION: (set-turtle-list) (cl-glut:main-loop))) +(defun world-width-in-pixels () + (floor (* *patch-size* (1+ (- (getf *dimensions* :xmax) (getf *dimensions* :xmin)))))) + +(defun world-height-in-pixels () + (floor (* *patch-size* (1+ (- (getf *dimensions* :ymax) (getf *dimensions* :ymin)))))) + (defun export-view () "EXPORT-VIEW => IMAGE-DATA @@ -174,8 +185,8 @@ DESCRIPTION: ; (floor (* *patch-size* (1+ (- ; (getf *dimensions* :xmax) ; (getf *dimensions* :xmin))))) - (width 143) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me) - (height 143)) + (width (world-width-in-pixels)) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me) + (height (world-height-in-pixels))) (gl:bind-framebuffer :framebuffer fbo) (gl:bind-renderbuffer :renderbuffer render-buf) (gl:renderbuffer-storage :renderbuffer :rgba8 width height) diff --git a/src/main/nvm/nvm.lisp b/src/main/nvm/nvm.lisp index 413bd55..b7e0087 100644 --- a/src/main/nvm/nvm.lisp +++ b/src/main/nvm/nvm.lisp @@ -31,6 +31,29 @@ DESCRIPTION: :ycor 0d0)))) (incf *current-id*)) +(defun die () + "DIE => RESULT + +ARGUMENTS AND VALUES: + + RESULT: undefined, commands don't return + +DESCRIPTION: + + The turtle or link dies + + A dead agent ceases to exist. The effects of this include: + - The agent will not execute any further code. + - The agent will disappear from any agentsets it was in, reducing the size of those agentsets by one. + - Any variable that was storing the agent will now instead have nobody in it. + - If the dead agent was a turtle, every link connected to it also dies. + - If the observer was watching or following the agent, the observer's perspective resets. + + See http://ccl.northwestern.edu/netlogo/docs/dictionary.html#die" + (when (not (turtle-p *self*)) (error "Gotta call die in turtle scope, dude (~A)" *self*)) + (setf (turtle-who *self*) -1) + (setf *turtles* (remove *self* *turtles*))) + (defun turtles () "TURTLES => ALL-TURTLES diff --git a/src/main/package.lisp b/src/main/package.lisp index b115db6..503af62 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -68,6 +68,7 @@ into an ast that can be transpiled later.")) ; API as used by transpiled NetLogo programs #:ask #:create-turtles + #:die #:forward #:random-float #:show diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp index d29980e..a7172fb 100644 --- a/src/main/transpile.lisp +++ b/src/main/transpile.lisp @@ -87,6 +87,7 @@ DESCRIPTION: (defprim :any? :reporter (lambda (agentset) `(> (length ,agentset) 0))) (defsimpleprim :ask :command clnl-nvm:ask) (defsimpleprim :crt :command clnl-nvm:create-turtles) +(defsimpleprim :die :command clnl-nvm:die) (defsimpleprim :fd :command clnl-nvm:forward) (defsimpleprim :random-float :reporter clnl-nvm:random-float) (defsimpleprim :show :command clnl-nvm:show) diff --git a/src/test/main.lisp b/src/test/main.lisp index 2a0da53..99dfe18 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -105,7 +105,7 @@ `(defsimpletest (format nil "Simple View - ~A" ,name) (lambda () - (clnl:boot "resources/empty.nlogo") + (clnl:boot "resources/empty55.nlogo") (clnl:run-commands ,commands) (let ((viewsum (checksum-view))) @@ -113,7 +113,7 @@ (format t "~c[1;35m-- For ~A, got ~A but expected ~A~c[0m~%" #\Esc ,name viewsum ,checksum #\Esc)) (checksum= ,checksum (checksum-view)))) (lambda () - (clnl:boot "resources/empty.nlogo") + (clnl:boot "resources/empty55.nlogo") (clnl:run-commands ,commands) (save-view-to-ppm) (format nil "~A" (checksum-view))) diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp index ac619ca..614c511 100644 --- a/src/test/simpletests.lisp +++ b/src/test/simpletests.lisp @@ -101,3 +101,9 @@ (defreportertestwithsetup "any? 2" "crt 10" "any? turtles" "true" "A925E39EC022967568D238D31F70F0A375024A89") + +(defsimplecommandtest "die 1" "crt 10 ask turtles [ die ]" + "A665C1BF95E1F9CAAE9B9F8B2FBE3DAA45453136") + +(defreportertestwithsetup "any? 3" "crt 10 ask turtles [ die ]" "any? turtles" "false" + "A665C1BF95E1F9CAAE9B9F8B2FBE3DAA45453136") diff --git a/src/test/viewtests.lisp b/src/test/viewtests.lisp index 587eb25..d3d45db 100644 --- a/src/test/viewtests.lisp +++ b/src/test/viewtests.lisp @@ -1,7 +1,16 @@ (in-package #:clnl-test) +(defviewtest "Nothing" "" + "1AF55686BD9B18D1CCE6AAF6BF18E81E6957F466") + (defviewtest "Basic 1" "crt 1" "A41D8146DD81EF27AF2B97955C66E982CFA0A465") (defviewtest "Basic 2" "crt 10 ask turtles [ fd 1 ]" '("DEC2ED793C08A1680DD601BD3E9B81927994C123" "788EAE5B41CE031672672C372EDBCDFD9B309E64")) + +(defviewtest "Wrapping" "crt 10 ask turtles [ fd 6 ]" + '("DCDA6106352BBB6B52878B7AA443BCD5B7D124FC" "36922B55C2307FF4C7F2240B0A84C6D7B52427F9")) + +(defviewtest "Die" "crt 10 ask turtles [ fd 1 ] ask turtles [ die ]" + "1AF55686BD9B18D1CCE6AAF6BF18E81E6957F466")