From: Frank Duncan Date: Mon, 7 Aug 2017 02:02:15 +0000 (-0500) Subject: Forever Buttons - Handle stop correctly X-Git-Tag: 0.1.1~6 X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=6cb99e3ea911190e3b73adab3a92e75ef36731f1;p=clnl Forever Buttons - Handle stop correctly --- diff --git a/.travis.yml b/.travis.yml index 53ba83d..074107d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -6,7 +6,7 @@ addons: before_install: - export DISPLAY=:99.0 - /sbin/start-stop-daemon --start --quiet --pidfile /tmp/custom_xvfb_99.pid --make-pidfile --background --exec /usr/bin/Xvfb -- :99 -ac -screen 0 1280x1024x24 - - wget http://frank.kank.net/travissbcl/clnl/a66006d/$(git rev-parse HEAD)/travissbcl + - wget http://frank.kank.net/travissbcl/clnl/6e06e22/$(git rev-parse HEAD)/travissbcl - chmod +x travissbcl script: - - ./travissbcl --dynamic-space-size 3072 --script bin/all.lisp + - ./travissbcl --dynamic-space-size 4096 --script bin/all.lisp diff --git a/bin/buildlinuxexec.sh b/bin/buildlinuxexec.sh index c384097..327e32d 100755 --- a/bin/buildlinuxexec.sh +++ b/bin/buildlinuxexec.sh @@ -15,7 +15,7 @@ cwd=$PWD mkdir -p tmp/deps/ ( cd tmp/deps && - tar zxf ../../deps/common-lisp/clnl-gltk_0.1.tar.gz && + tar zxf ../../deps/common-lisp/clnl-gltk_0.2.tar.gz && tar zxf ../../deps/common-lisp/3b-cl-opengl-993d627.tar.gz && tar zxf ../../deps/common-lisp/alexandria-b1c6ee0.tar.gz && tar zxf ../../deps/common-lisp/babel_0.5.0.tar.gz && diff --git a/bin/buildosxexec.sh b/bin/buildosxexec.sh index 88a451d..17657ee 100755 --- a/bin/buildosxexec.sh +++ b/bin/buildosxexec.sh @@ -19,7 +19,7 @@ cwd=$PWD mkdir -p tmp/deps/ ( cd tmp/deps && - tar zxf ../../deps/common-lisp/clnl-gltk_0.1.tar.gz && + tar zxf ../../deps/common-lisp/clnl-gltk_0.2.tar.gz && tar zxf ../../deps/common-lisp/3b-cl-opengl-993d627.tar.gz && tar zxf ../../deps/common-lisp/alexandria-b1c6ee0.tar.gz && tar zxf ../../deps/common-lisp/babel_0.5.0.tar.gz && diff --git a/bin/buildtravisexec.sh b/bin/buildtravisexec.sh index cdf9076..8ca2bf7 100755 --- a/bin/buildtravisexec.sh +++ b/bin/buildtravisexec.sh @@ -25,7 +25,7 @@ mkdir -p tmp/deps/ tar zxf ../../deps/common-lisp/nibbles-v0.12.tar.gz && tar zxf ../../deps/common-lisp/trivial-features_0.8.tar.gz && tar zxf ../../deps/common-lisp/style-checker_0.1.tar.gz && - tar zxf ../../deps/common-lisp/clnl-gltk_0.1.tar.gz && + tar zxf ../../deps/common-lisp/clnl-gltk_0.2.tar.gz && tar zxf ../../deps/common-lisp/docgen_0.3.tar.gz && tar zxf ../../deps/common-lisp/ieee-floats-92e481a.tar.gz && tar zxf ../../deps/common-lisp/strictmath_0.1.tar.gz diff --git a/bin/buildwindowsexec.sh b/bin/buildwindowsexec.sh index 6f67f3f..6978071 100755 --- a/bin/buildwindowsexec.sh +++ b/bin/buildwindowsexec.sh @@ -21,7 +21,7 @@ fi mkdir -p tmp/deps/ ( cd tmp/deps && - tar zxf ../../deps/common-lisp/clnl-gltk_0.1.tar.gz && + tar zxf ../../deps/common-lisp/clnl-gltk_0.2.tar.gz && tar zxf ../../deps/common-lisp/3b-cl-opengl-993d627.tar.gz && tar zxf ../../deps/common-lisp/alexandria-b1c6ee0.tar.gz && tar zxf ../../deps/common-lisp/babel_0.5.0.tar.gz && diff --git a/deps/common-lisp/clnl-gltk_0.1.tar.gz b/deps/common-lisp/clnl-gltk_0.1.tar.gz deleted file mode 100644 index 1d75dec..0000000 Binary files a/deps/common-lisp/clnl-gltk_0.1.tar.gz and /dev/null differ diff --git a/deps/common-lisp/clnl-gltk_0.2.tar.gz b/deps/common-lisp/clnl-gltk_0.2.tar.gz new file mode 100644 index 0000000..95489e2 Binary files /dev/null and b/deps/common-lisp/clnl-gltk_0.2.tar.gz differ diff --git a/resources/UI-test.nlogo b/resources/UI-test.nlogo index 51bc137..5b08fe0 100644 --- a/resources/UI-test.nlogo +++ b/resources/UI-test.nlogo @@ -1,6 +1,12 @@ to go ask turtles [ fd 1 ] end + +to create-and-move + if 40 < count turtles [ stop ] + crt 1 + ask turtles [ fd 1 ] +end @#$#@#$#@ GRAPHICS-WINDOW 219 @@ -97,6 +103,23 @@ NIL NIL 1 +BUTTON +66 +276 +161 +309 +stopping +create-and-move +T +1 +T +OBSERVER +NIL +NIL +NIL +NIL +1 + @#$#@#$#@ ## WHAT IS IT? diff --git a/src/main/model.lisp b/src/main/model.lisp index 3e7c951..0ab8c10 100644 --- a/src/main/model.lisp +++ b/src/main/model.lisp @@ -308,7 +308,12 @@ DESCRIPTION: (loop :while (find button *enabled-forever-buttons* :test #'equal) ; The sleep is necessary so that it gives other threads time - :do (progn (clnl:run-commands (button-code button)) (sleep .001)))) + :do + (let + ((result (funcall *current-callback* (button-code button)))) + (when (eql :stop result) + (setf *enabled-forever-buttons* (remove button *enabled-forever-buttons* :test #'equal))) + (sleep .001)))) :name (format nil "Forever button: ~A" (button-display button)))) (t (funcall *current-callback* (button-code button))))))) diff --git a/src/test/main.lisp b/src/test/main.lisp index a62cd60..6d3282d 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -169,7 +169,15 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (defmacro defmodelreportertest (name model commands reporter value checksum) `(defmodeltest (format nil "Model Reporter - ~A" ,name) ,model ,commands ,reporter ,value ,checksum)) -(defmacro defmodelfiletest (name file commands checksum) +(defun wait-for-forever () + (loop + :while + (find-if + (lambda (name) (cl-ppcre:scan "Forever button:" name)) + (mapcar #'sb-thread:thread-name (sb-thread:list-all-threads))) + :do (sleep .1))) + +(defmacro defmodelfiletest (name file commands checksum &optional wait-for-forever) `(defsimpletest ,(format nil "File Model - ~A" name) (lambda () @@ -181,6 +189,7 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (declaim (sb-ext:muffle-conditions cl:warning)) (eval (clnl:model->single-form-lisp model :netlogo-callback (lambda (f) (setf callback f)))) (when ,(clnl-commands commands) (funcall callback ,(clnl-commands commands))) + ,(when wait-for-forever `(wait-for-forever)) (checksum= ,checksum (checksum-world))) (let* ((pkg (make-package (gensym))) @@ -195,6 +204,7 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (funcall (symbol-function (intern "BOOT-ME" pkg))) (when ,(clnl-commands commands) (funcall (symbol-function (intern "NETLOGO-CALLBACK" pkg)) ,(clnl-commands commands))) + ,(when wait-for-forever `(wait-for-forever)) (checksum= ,checksum (checksum-world)))))) (lambda () (let @@ -205,6 +215,7 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (with-open-file (str ,file) (clnl-model:read-from-nlogo str)) :netlogo-callback (lambda (f) (setf callback f)))) (when ,(clnl-commands commands) (funcall callback ,(clnl-commands commands))) + ,(when wait-for-forever `(wait-for-forever)) (format nil "~A~A" (clnl-nvm:export-world) (checksum-world)))) diff --git a/src/test/modeltests.lisp b/src/test/modeltests.lisp index 133827d..d80f871 100644 --- a/src/test/modeltests.lisp +++ b/src/test/modeltests.lisp @@ -139,6 +139,11 @@ end" (":button \"setup\" :button \"go\" 1" "crt 10 go ask turtles [ rt 90 ] go") "4E0128F172B4D0085186E49FDBD7014F6E365ED7") +(defmodelfiletest "UI 4" "resources/UI-test.nlogo" + (":button \"stopping\"" "repeat 80 [ create-and-move ]") + "749DC971517EDE9020BF125D0F362A978980272F" + t) + (defmodelfiletest "Wolf Sheep 1" "resources/models/Wolf Sheep Predation.nlogo" "setup go go go go go go go go go go go go go go" "9777CCF18935E52D8380C9C6DC02BFFBEE1F1149")