+addons:
+ apt:
+ packages:
+ - freeglut3
+ - freeglut3-dev
+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
script:
- deps/travissbcl --script bin/travis.lisp
( cd tmp &&
tar jxf ../deps/tarpit/sbcl-1.2.6-x86-64-linux-binary.tar.bz2 &&
cd sbcl-1.2.6-x86-64-linux/ &&
- INSTALL_ROOT=$cwd/tmp/sbcl/ bash install.sh )
+ SBCL_HOME="" INSTALL_ROOT=$cwd/tmp/sbcl/ bash install.sh )
mkdir -p tmp/deps/
( cd tmp/deps &&
+ tar zxf ../../deps/tarpit/3b-cl-opengl-993d627.tar.gz &&
+ tar zxf ../../deps/tarpit/alexandria-b1c6ee0.tar.gz &&
+ tar zxf ../../deps/tarpit/babel_0.5.0.tar.gz &&
+ tar zxf ../../deps/tarpit/cffi_0.15.0.tar.gz &&
tar zxf ../../deps/tarpit/cl-ppcre.tar.gz &&
tar zxf ../../deps/tarpit/ironclad.tar.gz &&
tar zxf ../../deps/tarpit/mt19937-latest.tar.gz &&
tar zxf ../../deps/tarpit/nibbles-v0.12.tar.gz &&
+ tar zxf ../../deps/tarpit/trivial-features_0.8.tar.gz &&
ln -s cl-ppcre-2.0.10/cl-ppcre.asd . &&
ln -s ironclad_0.33.0/ironclad.asd . &&
ln -s mt19937-1.1.1/mt19937.asd . &&
- ln -s nibbles-0.12/nibbles.asd .
+ ln -s nibbles-0.12/nibbles.asd . &&
+ ln -s 3b-cl-opengl-993d627/cl-glut.asd . &&
+ ln -s frank/.sbcl/site/3b-cl-opengl-993d627/cl-opengl.asd . &&
+ ln -s alexandria-b1c6ee0/alexandria.asd . &&
+ ln -s babel_0.5.0/babel-streams.asd . &&
+ ln -s babel_0.5.0/babel.asd . &&
+ ln -s cffi_0.15.0/cffi-examples.asd . &&
+ ln -s cffi_0.15.0/cffi.asd . &&
+ ln -s cffi_0.15.0/cffi-libffi.asd . &&
+ ln -s cffi_0.15.0/cffi-grovel.asd . &&
+ ln -s cffi_0.15.0/cffi-uffi-compat.asd . &&
+ ln -s trivial-features_0.8/trivial-features.asd .
)
-tmp/sbcl/bin/sbcl --core tmp/sbcl/lib/sbcl/sbcl.core \
+SBCL_HOME="" tmp/sbcl/bin/sbcl --core tmp/sbcl/lib/sbcl/sbcl.core \
--eval "(require 'asdf)" \
--eval '(setf asdf:*central-registry* (list #p"tmp/deps/"))' \
--eval "(asdf:load-system :cl-ppcre)" \
--eval "(asdf:load-system :mt19937)" \
--eval "(asdf:load-system :ironclad)" \
+ --eval "(asdf:load-system :cl-opengl)" \
+ --eval "(asdf:load-system :cl-glut)" \
--eval "(asdf:clear-output-translations)" \
--eval '(sb-ext:save-lisp-and-die "deps/travissbcl" :executable t)' \
scalaprog=$(runtestfn "test-scala-prog")
+if [ -z $scalaprog ] ; then
+ echo "Scala prog empty, so use view diagnosis rather than this one"
+ exit 1
+fi
+
scalafile=$(mktemp -u -p . --suffix .scala.dat)
clfile=$(mktemp -u -p . --suffix .cl.dat)
--- /dev/null
+#!/bin/bash
+
+if ! [ -n "$1" ] ; then
+ echo "Uhm, need a test name, yo"
+ exit 1
+fi
+TEST=$@
+
+sbcl --eval "(asdf:load-system :clnl-test)" --eval "(quit)" &> /dev/null
+
+runtestfn() {
+ sbcl \
+ --noinform --disable-ldb --lose-on-corruption --end-runtime-options \
+ --eval "(asdf:load-system :clnl-test)" \
+ --eval "(clnl-test::$1 \"$TEST\")" \
+ --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2
+}
+
+scalaprog=bin/viewruncmd.scala
+
+scalafile=$(mktemp -u -p . --suffix .scala.png)
+clfile=$(mktemp -u -p . --suffix .cl.ppm)
+
+runtestfn "test-scala-input" | $scalaprog | sed -n '/^----$/,$p' | tail -n +2
+mv scala.png $scalafile
+checksum=$(runtestfn "test-debug")
+mv cl.ppm $clfile
+
+echo
+echo "If the images are equal, use $checksum for CL checksum (note that you may get a different checksum on travis, see as of yet unwritten documentation for details)"
+echo "The compare result is (Less than 1500 is probably equivalent):"
+compare -metric RMSE $clfile $scalafile NULL:
+echo
+echo
+echo "Here are the results of identify (make sure they are the same size):"
+identify $clfile
+identify $scalafile
+echo "Make sure that turtles are on top of each other correctly and all correct colors."
+echo -n "Hit enter to view them ..."
+read
+
+display $scalafile &
+scalafiledisplaypid=$!
+display $clfile &
+clfiledisplaypid=$!
+
+echo -n "... and hit enter to finish"
+read
+
+kill $scalafiledisplaypid
+kill $clfiledisplaypid
+
+rm $scalafile
+rm $clfile
(require 'asdf)
(push #p"deps/" asdf:*central-registry*)
(asdf:load-system :clnl)
+(sb-thread:make-thread #'clnl-interface:run)
(clnl:run)
libraryDependencies ++= Seq(
"asm" % "asm-all" % "3.3.1",
"org.picocontainer" % "picocontainer" % "2.13.6",
- "org.nlogo" % "NetLogo" % "6.0.0-M3" from "http://ccl.northwestern.edu/devel/6.0.0-M3/NetLogo.jar",
"org.nlogo" % "NetLogoHeadless" % "6.0.0-M3" from "http://ccl.northwestern.edu/devel/6.0.0-M3/NetLogoHeadless.jar"
)
*/
import org.nlogo.nvm
import org.nlogo.util.Utils.url2String
+import collection.JavaConversions._
+
System.out.println("----")
val workspace = HeadlessWorkspace.newInstance
workspace.silent = true
workspace.world.exportWorld(new java.io.PrintWriter(System.out, true), true)
System.out.println(org.nlogo.headless.Checksummer.calculateChecksum(workspace.world.exportWorld(_, true)))
+
workspace.dispose
--- /dev/null
+#!/bin/sh
+exec scalas "$0" -q "$@"
+!#
+
+/***
+ logLevel := Level.Error
+
+ logLevel in Global := Level.Error
+
+ scalaVersion := "2.10.3"
+
+ libraryDependencies ++= Seq(
+ "asm" % "asm-all" % "3.3.1",
+ "org.picocontainer" % "picocontainer" % "2.13.6",
+ "org.nlogo" % "NetLogoHeadless" % "6.0.0-M3" from "http://ccl.northwestern.edu/devel/6.0.0-M3/NetLogoHeadless.jar"
+ )
+*/
+
+import org.nlogo.headless.HeadlessWorkspace
+import org.nlogo.api
+import org.nlogo.nvm
+import org.nlogo.util.Utils.url2String
+
+import collection.JavaConversions._
+
+System.out.println("----")
+val workspace = HeadlessWorkspace.newInstance
+workspace.silent = true
+workspace.openFromSource(url2String("file:resources/empty.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))
+
+workspace.exportView("scala.png", "PNG")
+
+workspace.dispose
-733ddb17df353334504f8eece18fd73419604f22
\ No newline at end of file
+650da2544c51bb2842aca26d8d3c584de4aefa8e
\ No newline at end of file
(:file "nvm")
(:file "transpile")
(:file "random")
+ (:file "interface")
(:file "main")))
(asdf:defsystem clnl
:version "0.0.1"
:maintainer "Frank Duncan (frank@kank.com)"
:author "Frank Duncan (frank@kank.com)"
- :depends-on (:cl-ppcre :mt19937 :clnl.internal))
+ :depends-on (:cl-ppcre :mt19937 :cl-opengl :cl-glut :clnl.internal))
--- /dev/null
+(in-package #:clnl-interface)
+
+(defvar *patch-size* 13d0)
+(defvar *world-dims* '(:xmin -5 :xmax 5 :ymin -5 :ymax 5))
+
+(defvar *turtle-list* nil)
+(car clnl-nvm::*turtles*)
+
+; It may be useful to keep windows around
+(defvar *glut-window-opened* nil)
+
+(defvar *colors*
+ '((140 140 140) ; gray (5)
+ (215 48 39) ; red (15)
+ (241 105 19) ; orange (25)
+ (156 109 70) ; brown (35)
+ (237 237 47) ; yellow (45)
+ (87 176 58) ; green (55)
+ (42 209 57) ; lime (65)
+ (27 158 119) ; turquoise (75)
+ (82 196 196) ; cyan (85)
+ (43 140 190) ; sky (95)
+ (50 92 168) ; blue (105)
+ (123 78 163) ; violet (115)
+ (166 25 105) ; magenta (125)
+ (224 126 149) ; pink (135)
+ (0 0 0) ; black
+ (255 255 255))) ; white
+
+(defun nl-color->rgb (color)
+ (let*
+ ((step (+ (/ (- (mod (floor (* color 10)) 100) 50) 50.48) 0.012)))
+ (mapcar
+ (lambda (x) (/ (+ x (floor (* (if (< step 0d0) x (- 255 x)) step))) 255))
+ (nth (floor color 10) *colors*))))
+
+(defun render-scene ()
+ (gl:clear :color-buffer-bit :depth-buffer-bit)
+ (gl:matrix-mode :projection)
+ (gl:load-identity)
+ (gl:ortho -71 71 -71 71 1 5000)
+ (gl:matrix-mode :modelview)
+ (gl:load-identity)
+ (mapcar
+ (lambda (turtle)
+ (let
+ ((color (nl-color->rgb (clnl-nvm::turtle-color turtle))))
+ (gl:color (car color) (cadr color) (caddr color)))
+ (gl:with-pushed-matrix
+ (gl:translate (* (clnl-nvm::turtle-xcor turtle) *patch-size*) (* (clnl-nvm::turtle-ycor turtle) *patch-size*) 0)
+ (gl:rotate (clnl-nvm::turtle-heading turtle) 0 0 -1)
+ (gl:call-list *turtle-list*)))
+ clnl-nvm::*turtles*)
+ (gl:flush))
+
+(defun display ()
+ (render-scene)
+ (cl-glut:swap-buffers))
+
+(defun idle ()
+ (cl-glut:post-redisplay))
+
+(defun close-func ()
+ (sb-ext:exit))
+
+(defun reshape (width height)
+ (when (and (/= 0 width) (/= 0 height))
+ (gl:viewport 0 0 width height)))
+
+(cffi:defcallback display :void () (display))
+(cffi:defcallback idle :void () (idle))
+(cffi:defcallback close-func :void () (close-func))
+(cffi:defcallback reshape :void ((width :int) (height :int)) (reshape width height))
+
+(defun set-turtle-list ()
+ (setf *turtle-list* (gl:gen-lists 1))
+ (gl:with-new-list (*turtle-list* :compile)
+ (gl:rotate 180 0 0 -1)
+ (gl:scale (* (/ 1d0 300d0) 13) (* (/ 1d0 300d0) 13) 1)
+ (gl:translate -150 -150 -4.0)
+ (gl:begin :polygon)
+ (gl:vertex 150 5 0)
+ (gl:vertex 40 250 0)
+ (gl:vertex 150 205 0)
+ (gl:vertex 260 250 0)
+ (gl:end)))
+
+(defun run ()
+ ; I do this because I don't know who or what in the many layers
+ ; is causing the floating point errors, but I definitely don't
+ ; want to investigate until simply ignoring them becomes a problem.
+ (sb-int:with-float-traps-masked (:invalid)
+ (cl-glut:init)
+ (gl:clear-color 0 0 0 1)
+ (cl-glut:init-window-size
+ (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin)))))
+ (floor (* *patch-size* (1+ (- (getf *world-dims* :ymax) (getf *world-dims* :ymin))))))
+ (setf *glut-window-opened* t)
+ (cl-glut:create-window "CLNL Test Window")
+ (cl-glut:init-display-mode :double :rgba)
+ (cl-glut:display-func (cffi:get-callback 'display))
+ (glut:reshape-func (cffi:callback reshape))
+ (cl-glut:idle-func (cffi:get-callback 'idle))
+ (cl-glut:close-func (cffi:get-callback 'close-func))
+ (set-turtle-list)
+ (cl-glut:main-loop)))
+
+(defun export-view ()
+ (sb-int:with-float-traps-masked (:invalid)
+ (when (not *glut-window-opened*)
+ (cl-glut:init)
+ (gl:clear-color 0 0 0 1)
+ (cl-glut:init-window-size 1 1)
+ (cl-glut:create-window "CLNL Test Window")
+ (set-turtle-list)
+ (setf *glut-window-opened* t))
+ (let
+ ((fbo (first (gl:gen-framebuffers 1)))
+ (render-buf (first (gl:gen-renderbuffers 1)))
+ (width 143) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me)
+ (height 143)
+ ;(width (floor (* *patch-size* (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin))))))
+ ;(height (floor (* *patch-size* (1+ (- (getf *world-dims* :ymax) (getf *world-dims* :ymin))))))
+ )
+ (gl:bind-framebuffer :framebuffer fbo)
+ (gl:bind-renderbuffer :renderbuffer render-buf)
+ (gl:renderbuffer-storage :renderbuffer :rgba8 width height)
+ (gl:framebuffer-renderbuffer :draw-framebuffer :color-attachment0 :renderbuffer render-buf)
+ (gl:viewport 0 0 width height)
+ (render-scene)
+ (gl:read-pixels 0 0 width height :rgba :unsigned-byte))))
(defun run ()
(loop for str = (progn (format t "> ") (force-output) (read-line))
while str
- do (p (e (r str)))))
+ do (p (e (r str))))
+ (sb-ext:exit))
(defun boot ()
(clnl-random:set-seed 15)
- (clnl-nvm:create-world)
- )
+ (clnl-nvm:create-world))
(defun run-commands (cmds)
(eval (clnl-transpiler:transpile-commands (clnl-parser:parse (clnl-lexer:lex cmds)))))
#:forward
#:random-float
#:show
- #:turtles
-
- ))
+ #:turtles))
(defpackage #:clnl-lexer
(:use :common-lisp)
(:export :lex))
(defpackage #:clnl-interface
- (:use :common-lisp))
-
+ (:use :common-lisp)
+ (:export :run :export-view))
(asdf:defsystem clnl-test.internal
:components ((:file "package")
(:file "main")
- (:file "simpletests")))
+ (:file "simpletests")
+ (:file "viewtests")))
(asdf:defsystem clnl-test
:name "Experiment Tests"
:maintainer "Frank Duncan (frank@kank.com)"
:author "Frank Duncan (frank@kank.com)"
:serial t
- :components ((:file "package")
- (:file "main")
- (:file "simpletests"))
:depends-on (:ironclad :clnl clnl-test.internal))
(list ,name ,test-fn ,debug-fn ,scala-prog ,scala-input)
*tests*)))
+(defun checksum= (expected got)
+ (if (stringp expected)
+ (string= got expected)
+ (find got expected :test #'string=)))
+
; To be used only with the simplest of tests, just a list of commands and a checksum of the
; world after they've been run.
(defmacro defsimplecommandtest (name commands checksum)
`(defsimpletest
- ,name
+ (format nil "Simple Command - ~A" ,name)
(lambda ()
(clnl:boot)
(clnl:run-commands ,commands)
- (string= ,checksum (checksum-world)))
+ (checksum= ,checksum (checksum-world)))
(lambda ()
(clnl:boot)
(clnl:run-commands ,commands)
(defmacro defsimplereportertest (name reporter value checksum)
`(defsimpletest
- ,name
+ (format nil "Simple Reporter - ~A" ,name)
(lambda ()
(clnl:boot)
(and
(string= (clnl-nvm:dump-object (clnl:run-reporter ,reporter)) ,value)
- (string= ,checksum (checksum-world))))
+ (checksum= ,checksum (checksum-world))))
(lambda ()
(clnl:boot)
(format nil "~A~%~A~A"
"bin/runreporter.scala"
(format nil "~A~%" ,reporter)))
+(defmacro defviewtest (name commands checksum)
+ `(defsimpletest
+ (format nil "Simple View - ~A" ,name)
+ (lambda ()
+ (clnl:boot)
+ (clnl:run-commands ,commands)
+ (let
+ ((viewsum (checksum-view)))
+ (when (not (checksum= ,checksum viewsum))
+ (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)
+ (clnl:run-commands ,commands)
+ (save-view-to-ppm)
+ (format nil "~A" (checksum-view)))
+ ""
+ (format nil "~A~%" ,commands)))
+
(defun checksum-world ()
(format nil "~{~2,'0X~}"
(map 'list #'identity
:sha1
(map '(vector (unsigned-byte 8)) #'char-code (clnl-nvm:export-world))))))
+(defun checksum-view ()
+ (format nil "~{~2,'0X~}"
+ (map 'list #'identity
+ (ironclad:digest-sequence :sha1 (coerce (clnl-interface:export-view) '(vector (unsigned-byte 8)))))))
+
+(defun save-view-to-ppm ()
+ (let
+ ((height 143) (width 143)) ; hardcoded in interface, hardcoded here, cry for me
+ (with-open-file (str "cl.ppm" :direction :output :if-exists :supersede :if-does-not-exist :create :element-type '(unsigned-byte 8))
+ (write-sequence (map 'vector #'char-code (format nil "P6~%")) str)
+ (write-sequence (map 'vector #'char-code (format nil "143 143~%")) str)
+ (write-sequence (map 'vector #'char-code (format nil "255~%")) str)
+ (let
+ ((image-data (clnl-interface:export-view)))
+ (dotimes (i width)
+ (dotimes (j height)
+ (write-byte (aref image-data (+ 0 (* 4 (+ (* (- (1- height) i) width) j)))) str)
+ (write-byte (aref image-data (+ 1 (* 4 (+ (* (- (1- height) i) width) j)))) str)
+ (write-byte (aref image-data (+ 2 (* 4 (+ (* (- (1- height) i) width) j)))) str)))))))
+
(defun run ()
(loop for str = (progn (format t "> ") (force-output) (read-line))
while str
-(defpackage #:clnl-test (:use :common-lisp :clnl)
+(defpackage #:clnl-test (:use :common-lisp)
(:export :run-all-tests :run :test-debug))
--- /dev/null
+(in-package #:clnl-test)
+
+(defviewtest "Basic 1" "crt 1" "FE38C1C9873FD97451A41EB89CE47E60DAB0DD03")
+(defviewtest "Basic 2" "crt 10 ask turtles [ fd 1 ]" '("99673570760F0A2E3B49B858AFC8CCDAE16C78D5" "9A7CB6E13203687AB09CBA4CEFF7912534D69542"))
projects / clnl / commitdiff