From: Frank Duncan Date: Sun, 28 Jun 2015 18:07:21 +0000 (-0500) Subject: First pass at adding opengl interface X-Git-Tag: v0.0.0~8 X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=43bbc274299e58d2f4a6e0b05e5366ca5e2900ae;p=clnl First pass at adding opengl interface Former-commit-id: 9471c42bfd29911653cefc4a68437fef7de0d9f4 --- diff --git a/.travis.yml b/.travis.yml index 3740e0d..03b4b90 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,2 +1,10 @@ +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 diff --git a/bin/buildtravisexec.sh b/bin/buildtravisexec.sh index eb951f5..a198de2 100755 --- a/bin/buildtravisexec.sh +++ b/bin/buildtravisexec.sh @@ -6,28 +6,46 @@ cwd=$PWD ( 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)' \ diff --git a/bin/diagnose-test b/bin/diagnose-test index 23b1603..52d7c4c 100755 --- a/bin/diagnose-test +++ b/bin/diagnose-test @@ -17,6 +17,11 @@ runtestfn() { 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) diff --git a/bin/diagnose-view-test b/bin/diagnose-view-test new file mode 100755 index 0000000..9841e10 --- /dev/null +++ b/bin/diagnose-view-test @@ -0,0 +1,54 @@ +#!/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 diff --git a/bin/run.lisp b/bin/run.lisp index 481cbbe..8b46a2a 100644 --- a/bin/run.lisp +++ b/bin/run.lisp @@ -2,4 +2,5 @@ (require 'asdf) (push #p"deps/" asdf:*central-registry*) (asdf:load-system :clnl) +(sb-thread:make-thread #'clnl-interface:run) (clnl:run) diff --git a/bin/runcmd.scala b/bin/runcmd.scala index 8afdc36..90a1d4d 100755 --- a/bin/runcmd.scala +++ b/bin/runcmd.scala @@ -12,7 +12,6 @@ exec scalas "$0" -q "$@" 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" ) */ @@ -22,6 +21,8 @@ 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 @@ -34,4 +35,5 @@ workspace.runCompiledCommands(new api.SimpleJobOwner("test", workspace.world.mai 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 diff --git a/bin/viewruncmd.scala b/bin/viewruncmd.scala new file mode 100755 index 0000000..c3abf26 --- /dev/null +++ b/bin/viewruncmd.scala @@ -0,0 +1,40 @@ +#!/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 diff --git a/deps/tarpit/trivial-features_0.8.tar.gz b/deps/tarpit/trivial-features_0.8.tar.gz new file mode 100644 index 0000000..39360bd Binary files /dev/null and b/deps/tarpit/trivial-features_0.8.tar.gz differ diff --git a/deps/travissbcl.REMOVED.git-id b/deps/travissbcl.REMOVED.git-id index 20b7632..5164fa3 100644 --- a/deps/travissbcl.REMOVED.git-id +++ b/deps/travissbcl.REMOVED.git-id @@ -1 +1 @@ -733ddb17df353334504f8eece18fd73419604f22 \ No newline at end of file +650da2544c51bb2842aca26d8d3c584de4aefa8e \ No newline at end of file diff --git a/src/main/clnl.asd b/src/main/clnl.asd index a17f3ee..91fdf1e 100644 --- a/src/main/clnl.asd +++ b/src/main/clnl.asd @@ -15,6 +15,7 @@ (:file "nvm") (:file "transpile") (:file "random") + (:file "interface") (:file "main"))) (asdf:defsystem clnl @@ -22,4 +23,4 @@ :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)) diff --git a/src/main/interface.lisp b/src/main/interface.lisp new file mode 100644 index 0000000..ad09762 --- /dev/null +++ b/src/main/interface.lisp @@ -0,0 +1,131 @@ +(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)))) diff --git a/src/main/main.lisp b/src/main/main.lisp index 562304b..594e787 100644 --- a/src/main/main.lisp +++ b/src/main/main.lisp @@ -14,12 +14,12 @@ (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))))) diff --git a/src/main/package.lisp b/src/main/package.lisp index 790064a..133d9b4 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -23,14 +23,12 @@ #: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)) diff --git a/src/test/clnl-test.asd b/src/test/clnl-test.asd index a4c0820..15721dd 100644 --- a/src/test/clnl-test.asd +++ b/src/test/clnl-test.asd @@ -2,7 +2,8 @@ (asdf:defsystem clnl-test.internal :components ((:file "package") (:file "main") - (:file "simpletests"))) + (:file "simpletests") + (:file "viewtests"))) (asdf:defsystem clnl-test :name "Experiment Tests" @@ -10,7 +11,4 @@ :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)) diff --git a/src/test/main.lisp b/src/test/main.lisp index b14aa93..19c9667 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -41,15 +41,20 @@ (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) @@ -61,12 +66,12 @@ (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" @@ -76,6 +81,25 @@ "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 @@ -83,6 +107,26 @@ :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 diff --git a/src/test/package.lisp b/src/test/package.lisp index 3947b64..2d31027 100644 --- a/src/test/package.lisp +++ b/src/test/package.lisp @@ -1,2 +1,2 @@ -(defpackage #:clnl-test (:use :common-lisp :clnl) +(defpackage #:clnl-test (:use :common-lisp) (:export :run-all-tests :run :test-debug)) diff --git a/src/test/viewtests.lisp b/src/test/viewtests.lisp new file mode 100644 index 0000000..bd8c663 --- /dev/null +++ b/src/test/viewtests.lisp @@ -0,0 +1,4 @@ +(in-package #:clnl-test) + +(defviewtest "Basic 1" "crt 1" "FE38C1C9873FD97451A41EB89CE47E60DAB0DD03") +(defviewtest "Basic 2" "crt 10 ask turtles [ fd 1 ]" '("99673570760F0A2E3B49B858AFC8CCDAE16C78D5" "9A7CB6E13203687AB09CBA4CEFF7912534D69542"))