From 43bbc274299e58d2f4a6e0b05e5366ca5e2900ae Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sun, 28 Jun 2015 13:07:21 -0500 Subject: [PATCH] First pass at adding opengl interface Former-commit-id: 9471c42bfd29911653cefc4a68437fef7de0d9f4 --- .travis.yml | 8 ++ bin/buildtravisexec.sh | 24 ++++- bin/diagnose-test | 5 + bin/diagnose-view-test | 54 ++++++++++ bin/run.lisp | 1 + bin/runcmd.scala | 4 +- bin/viewruncmd.scala | 40 ++++++++ deps/tarpit/trivial-features_0.8.tar.gz | Bin 0 -> 10478 bytes deps/travissbcl.REMOVED.git-id | 2 +- src/main/clnl.asd | 3 +- src/main/interface.lisp | 131 ++++++++++++++++++++++++ src/main/main.lisp | 6 +- src/main/package.lisp | 8 +- src/test/clnl-test.asd | 6 +- src/test/main.lisp | 52 +++++++++- src/test/package.lisp | 2 +- src/test/viewtests.lisp | 4 + 17 files changed, 327 insertions(+), 23 deletions(-) create mode 100755 bin/diagnose-view-test create mode 100755 bin/viewruncmd.scala create mode 100644 deps/tarpit/trivial-features_0.8.tar.gz create mode 100644 src/main/interface.lisp create mode 100644 src/test/viewtests.lisp 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 0000000000000000000000000000000000000000..39360bdf009d56206244c1c3d83154ce7ce3edc1 GIT binary patch literal 10478 zcmV=o6qqDZn2@dx3Ne917HBo{4f{{1JArRbxWIYJqSJS z|FYG5wfVQ_OhK@9gYt@9(x-Ew|P?fX~VEu7CzOO5qcKWj@T>+T)(rqIW>b>IBFWsd=n?feB^8zmL^_}O;5ks zoa=tTy-i7^>Cf2zGJi(2%nAF%s{i%>u&Pc?YuEpOmAz)w?RJ&@{2dEs+@=OG=7(d4 z>29D+dB7wk7>bdxr;YiwW^TXQ`;M|s%u2;KJkt$iYoV>2t=E3DI=_Xcab-FBn01WF z#MEF!uDMm0HBicA%f9tm!2Q5amk4c(`#!4`=k0i*oyw0TOvlAq0@kY6*DHVa)GpHl zQlb1m7@Yoi*8k!C`Sa9qkNj`9BK@!A|K9e_UMc@yA{{vH!ZW9{fYlD_tPLa7U`N0T zHn7ZVZhAUn-&>CS{ZEjEbH~Th4nKMuK#PlnZ(6gaRPGvxa_zunkXgV`qzszB_T;n-sndjxv0at@F55oieNix_*`381N>2{-_5JgV}MKSRYd;uXO# zs2A9)N8MrAyKn?Ai5-AAVXos*eJs<>Ce;7F$A*J<=O4OfJ=Pzx)3d?9`-idi|BMw4Zoch7)4FeudZI4q)xlA>f81b)-Q(^LJt{Q-Drb~UG_UgE zeUENIeO>tf!Fhjhf=oFWoSdJ*Wdpi-b{-Y|&>!|1tb5iUB1hhx4UQWX6=e)L(>|wA?Uo&|GB1CKVqGu8D`V*rkmMmlDpCLucvQDp!bd0Yq2h> zKbls(Qpw(eg_}=*L6!NSWB~-Q%Z+!v?)e2MgN;k38=eEJm3e3drfc!a0U;H31W1LM zbGQ@X1|M|LJ5X2rR>%7d2HB2vV=!bNnQQ66#PQ~S1GFx{3pRKBfQW!j3}JzH**WZj zd_B1YC0j{0paF6m)_SBuyJA(WN*s3&2E$8wA}>B((o&D>;|8J;7nC*tENcNOW$4Vg ztZ=SWvmk`PNwNb}?Q{w#26a0%z4DRi0jgu5kYnAA32J(-UtuxCRB$CKpa(Pknpfg( zNzjzyEnu4f_`z)ki$20@G0ULBb3hE08y(=#!U>t7+w8_O16~p9^>4?z2OtE{h{M)2 zc`?#GvG@iS07Ot(YcMP_$6PlYU;KMp$HF3uwloWoL~IiQluyIc-T?@)pFg#Jj-Vqz zLtI6VfG^ljA6DG}QTzq0?k&8f2NfS+AiNNWXv8lZf)QsfFcT?2)t3iHog{~V9|rdj z%~lN4gPITs8SqvJ?l2r;b7C3-R>F;FN*VA8Z#I= z7crF&Pz?U^e)cUQHu#>g8BDZ|CawrBn+5MJ5CtHn5fV1|7_wAg zI66f}mV4#G=E!nJ%IYEqw*t)<)PPuKd9vwx4g%s$w2G8Sr7#uhe~(*S_c@K~Gt{x# z{@-rzw|27j-<_?UQvbh1TKi@*^u5iIX>W4-nhD$McaWI2p|N9UEG@&|!TUajmtPC? zk+03^zHM5Vt5T_r`NY+YD}BmYM@}A17%N$=1M6nC)-f#j$Kz9e>(=X)nrUlGN`UsK z`VSm?VopO(NG$CMNj1>Z=Nv=_+mLcWv*E@Dt7hMUYCT&(_s0_r?F}2OhWG%KEq1xsiijz60c9Ba?g=b5W;6-3sW`Jf8YDZ{Ge5VoAsNJGvxn@pS4X<4W>it&y zhM%f?bA)^h?Jf3HGk|HV26GFBkIWYT7&+qwOlKWt9~rhUYZmDGTFnetBhFW^v+vk~ z`=}&!cjkDe(Gb=nGzT#=XbKy54NWM@+}-$R&2k(UP>CmNKxHWF0)z_i&j`}CajYMq zOR}hL0q1QUp&yp7rC2aAJ@_MN*6Uef=_G4pSV4{d#)2g2d&;JpD7g8WA(N6c>P1a} zzMv^BYGl1$F!RP7fUV;qZXl_#!Gd};=wp+sDXsy71JAM8KZvHhse4lzJoO%IaL;o* z%?SfH#P{j$O_gQJXG_8?$~QuGre+X5d@pSP(;=_2DzvGpItvpjh&D9hX4`-yVWMch z3zL{hrbSbBYyzgy(Bi4NPy_sxlay^mT&$^eigvAAA=g0sj#&-pj(}%2)T+6TPZql* z-)q2EkPRlF#wm}ec76@*D~-0h&>9#Qz&YzPNwh}zz4m>YI=ocep29?zeONkKYS})A zBOhj(Y(l!liP<9GIeISm64$JLX~49#^%U1sYZ85dOa)X@%@zI4G;OP>SW!10(8COo z47Y@QikhCBFQ`^Pzerj2JrHj(zfCj7(nlN?9<`bt-ogW`#jJLAUkzmsaxuiM!B!ob z3JVf>*)DuFS(Lq97lOPf3lJHjEj%=!eb_QF4R2YK-THN?YN_ZbEVqDi3oO@OA#zk_ z^mxLPe3x&L%NF-ZJ50g-c`{Wj5>?zjq>5!+TU816Bd+iPm5{{#9+Vq4k4U{%7dRbm zePrm85l$1z>6;~$$vKEyyDnArF!dlBCkyl6LQs$oFDxmfdL&aNew29u{Z>l!WgfQ0 z3r1k#Od2H+TtPGaybkgfnitv%(#W^cn2+B)Q2Pie1_d(cZ?*POy+b6SIWD(R0C0Uy zuRp04Xq4v9xMgXw?bs;R5$cU~MD~O*Rmj0IZO&dZP`~B@j+%oZqO??P z#k}ixZ`K()ukdm6zDcH0i4K2r zU%T<`jaoke9ikbb=i!Wzs}WYCc1l$Y13wN8jyiKb8tbU2P*Ni1%4t}7v{)kPYxL?@ zL7B5apEAv2*FXKVQBCD-B^WDUSJb8i-ka;L0r)O%Q3evE0o!d3tEEI7z1|*oVHL`@ znS383F=qbGb6r7Mz-gnqCRWx`JXU}D31&^Lh@}M#QNn;*sfmuJKn-fpLfhkpW*+1+MYJ={+a3Y1uWUL37U8{jp{&$Ewo`X{ZTM}af+7QS(&681}zruYhPMZ>CHR6%A&HX z3qwoO>kHk#(qIMd(c2nLs_ZPIC5*gCFRFhFIcNc)j71@)3Yk8;>o(a3+Jm6|q7kQE z0i?zpo1SUg?Hz7-8wW1^^wVvQmrUAhZj`UUH7MIHPPv428_p%C<+`+>>QCTFRB|f3BXWO{sl&e#zfduWH#e` zow4b0@{(d5({{rk2WLeQ^qEpLQ-uVxAA(+S4oLL646)*DNN|q+al*`NCTtwah_%*w zT}A%LeY9$xXgYO3JKiF}p(OPUS5EcxpO`iG zRG)k$u>GJ5;FZ7u0WFDdL5@zU%ZLm$Nf`QYGFG zt;v;4F~grJE?73x{7I50n-Re#w6Hn-9hj66eAG_W{FUu}e63C0H5R&RE^fB-+jkuKbdd?Km|QUxi@@WAX^uf-#Vg)W@14rbIC=RP-nR%-2H3q zS_&%S<*Mc5l0_g|LwGQWS}u%CMfm?-_+OmF%GtE9b;}&1!@59oV(ClVP9fU@O&=+; zj8^!Cv_g98y?{~COv`Sx3yF}xD9J*xG|2DI8wq75%D_}m&Ie+OgMettd6@uaMYv2f zFxJ~eYMUw$B1clqXuG`7&nwlsDw$Ur1;q=LZPqJ5qIa^+ru+fa#3~Y!iUk=D0##qm zYanJYNsySY#bTvUs!;LNQIDp&o6`T}x2gb97|G;x$)++3VdSyj_!+;Xc~iIQT;iNi2cgZYl2M-9E|v(g~ph&3x%-<9#c;;KF(*R4;Wt zUzFsdU`)=Ef`zZCu;kN{;<05;b-sv_O_ZbseF>#_^C{n$?4F&Fy}}|2@cwsn#FQH` zZ2eAOufotPDU7NxtqJRo@^CEl|C7Fz&*fuwkN^M9&dy%e|G!n9|9hE~^*XM+&Lng$ zHp!1yXTkytQ(B*Z^mit3OSn_hW&qwGSf#wFrTg@VS5~-AqeV!$7)S2+O~$&+b$s6( zfqa^TI5jJ=X-S&o(EmTrjS7vH$N*`_ilj{kR3C127>7p+UypjucQP04W0B<&8=7HoFr0y z_pT3Oyg6+$SPWQrCqx`lt7E69o<36k?WQdd8|nEbdEc|KX5@rCN2_ZYI321J_ zp~VeY7>F@Mha1DO4er_T=vBxR=1>c8&4D`82OS5uLFFU=S=mJ6zFAW}>5S~(WK*PDQ<)ew@ zY89OTJiAKH#D1OTG8)=FGGm#6Ja|&M;)@$#ro!jY!Jas$gGW~}?m=`^MP42CPcA;H zi<92@+u@v zkdDheVS$mexrV#|25{eA57b!{HMrF63d~GsMZw@^kJvyqZKUJa$gvgF)e&5u9nwJ< zkTsw5u{>P#9#1AYZ+@0j4I~Rm2#{3Kk&L+FIS5vGITrv9fue6-^N7hGU+rDSKefFb zb#;1rkoXzjKklCn)$i`n>HDs_7@l^|4pJ9!q4%e!-Q;h4B057t79cZpff4z%2RhV^d|PkmtJPlYHm5cwh#Y2g7ztU1-QNSl9*Ruj?9nJ9y^m?ZJ^6 zGPoQN-5Y)3qcp?QHh4;Gk~}hoGa6`a3c8Gd@{Qsu6cTk;d}q#SvBPMxK+Ol+*jPLP z1#*MR(a~uwI&DaL}ba3>3*kS($okQc16sLIN zN@P0L;U$-c{7-=;l$CVJspo(enEQDCsDaYtVCKPE+HrxkXEP8Me)6bLXLIxB=7tWW zfOxp_>A+A*{cpZsz`KarWAm*uUTj|fBKp{z1@qJ)A)urEYWQLESMG;ENS`-#qZwXp z-Wk5vZf&|cp1t3UIOL8ef8n!3h4>$jbvkbd!0ain=8?mla<(?RBNRfF;)FCYY#K=S6(O%Nyq7Px&XNW+AWS$`k5i#Rwk%)*H zkBvs82K0$RiIBuo0~19}d18Dbr11Sx1#VPZwmCk$4WbdE;;0=` zBEwR8>cCo=t$lkVt&7+s?!|8>ZsDUX1Epf$tmAVJ#fsRFBJ$O{u zl8y^)CU-OaEON7K?Ts7{|=>koou*w^nUY5{cYmcE`Z*Ix@1z5IvqK zGM*=c5&E>7EaSQHF^tTq9vHZve#0#gc;pVX3My9;M@*`quB$oJ+{*_`jJIyHp%P&{ zeSxF(5X29(IW3P@h+`@xL%Xpm%;o9|(CmB0Lm>0ow`vTM&~~E9yD=&j1I9Ah=x!nt z3>3>}!fyv8GR32q%oN>?bK=H+7LvJ5wb&_au@mQc&Q*+BzlhCxzG9IYe+MDXEGt{S zzWJ(`DJ%AWlncg_qX6C)|95XUv;WiH+HIBbe_td$68|UX2I2m!Wkx&i4bO*>n|-+y zD3=1|QlMN4e7Q@3R76t4q61aY*;jdcsnJ>lIqf85ROH%^F;8W%Ny;8Sh;7aBJ+uZB z{OAZ5GK`rTKGwJYA!&vFmuBWaT>o$HZtZ9F|6Z$%|NA28k@`P5H%R}ZyLYVQ#cs_H zJQxxr??cvFz0~}r<}WpWsrkQX&A-edKtR9<7A`t^dt=rKZ9KHf$C^Kb$)qxHJDlTz zOJimR+@Q0$m|duJeLmjXVgD^IOdWpj$=@KcEVd;sLi@^gZfv%8JAtIEAclyyiW{c1 z(~Z)Xb$s)8&b9>=*K_a)lH+Nq>XR2ljEo=XH2}>Ap*r&L&{Fk^dp5VW+s(0MDf^>= zXYOm&lo+qFzfXCfrCMR&SqcnSImQj%I_q3JCi)7b+v+-W-a`idV~%Zsu;zgXX(B!~ zLFb^7jYlm4%!r~;W~;8nL5x(793gLNzRA`TS>+~luJOL9wx?xz-*N&Gm6>Hou=QdV zf7LtHEAXFi>3fE6K-`1>_ICjDW$<5nuRQXgA9T+(I=9-nIO!hu-e6y1bQg+a!hff~bqw_=OjNZ| zI7xvvssylLbZ#4UM08TSDXC(xEfM`E87?vl&XD$cts^n5ba;$I90`xy*8tZ9Ey!MH zS|T94+Fe&i$~}&!`#}h3tvHNxjlK{gMom^h=nlh0&x^l{av8%w5dtM}($>6GN@GUJ zDn@;i^|AGa=vnep76dLqhossh&uiyfg>h?AIc=B&56mjV0X-mRVUSyDZ7LgZbS6W_ zCqstGW5il?j2ORs5`WE+;aIj35kS>v4Dqvo(N_v-%;lvU1rz{z9@^^rEA%d$lg*Xt zrhs?xA^T=)#gubl$p!<|+Dix0s?7o2dwjy;=eY9Xu<}y*xQK(3$@nTUqF5l&_Rh$h zYNA>7bgoG~6ll5bZ>8s==%M&*4G01JnvyECUaLY|s|^4BWpAen z`jcu|TbDtIvmu|PEK$Mk(2^SKMmsdj+RLZ6cMow9f!fF zEErtH#BddsGc^qcx^3*MuqE`7CKJPyAc+m7RyLaP(8J?qE5Rw6PtmvVqAcwsGvhpe z_Coy+N-OL?QuF`u`+r;Q-2NZ@DD6KlksfLPNzM(j0R2EGm~vZyD%enI3Mx%Or75U1 z1%0KaAQi_8k6uQ4aYp-OM%su0SyIpoF3ovRc-&s`^#UNCuu5mgZY`4Eu=wchVh= zjdyAg21DU9MoK0VgjxguChvOw@VQu(@zir8Tewf+Y|vf#BB(1PNA1X_tp1i7!zISQ3AT zqL~FWONnGL&DytfKZ*mVaH#SVNI@pZsT+=eo5&_TN3y_*sZUkm2MOdiP~asBDSRQk zVD#B-6T^t0L=SiqiDSSNS%D-g-A|bGOOb9V^%yRrqecO$ixJuqE_{5oCwL&fKp>bW zJ~0Eb0R$s`fZz=@%5`qI=NgGFqjN*D%0FAreyM2{{-anb&tL$&H~w2YXa8&Ow@Uo? z66x{yFP2XYmB889lsWxIQ@m+>1@PCu_a!0 zskFY9u%bOIf5vw>UkLI@Kidac)`av{08GT5@Dtz@-q-E+J-}1ATW+`0VYLxF;@4s0 z$lA*TZO7~-7jF94s_u<7)6x6|$lTkE3nR8x!;hLtcl`_-QlA3u+|};7cl9cM)6+L^ zJE8Dumpk*xoAs>SHPK1(gr!fMJrnkQ*Z+9j>&Oqx37D-u?rON9F!^SBP2YT$j;I~i z*anoGtRO#MRA#mBPj096yz}acsh4(Z6&B*$v?C{G)i9iTa`X}du;rm>tfF3LjR75zMqrhk35WMo`hFtaHw+d5oihNaz zjg|Nx!zBLk_J$zfM}g~o*qP&UL-vM|HZRI06@ByLGDW! zSi-;(29_}JuMY#$rr0HL=N`jp3~Azww;8kEA0+=*>3{w_$3O1f|84DL_J3RZ`|Z;H z^CIc-`kyDQKfNd0ezfuwNU8Zt&0lK%uSWCBZ91~~OeSUr=9y!FfXIfP%7zNg7=c3j zhT_P14#tzs2jEg6-f|Cw^$2Sob2R*@0A$#pY@J2Mql^vdK0>2KP#iREl_jbAuilRz z24{!WqCM(+ElP>fIa3ri7iD{v+i2^0nEk0&U^o(1CS`eQ2y+y$=+@wFz(Cj>(!Ot9 zI(7~ZX?I+12FKt{gvm-dWj<&Jy>M?B10Kzxld+%U{?6{!3SY;yZ^e!-OQA_Evkxow zu}$1QHh1u!UHoV7)n1(~N1>vS?#-`vE&8)3{_I=HQgEkqzWh4UD*PXPwC;(kfP3-( z)?UW`*J^K-=YL)#Js$t3X9ukUj-qcLmIlCb8Bi_*%4NV`cNu`!vAioh{X-uZPMZf4 zeu0t4XV!_b2D3ZiL0Fqurr2d3FKm5o8X3gvt5C}d87G$|mRgpm_&$i@F@!8gXFs@xfX!`@Y}w$5+DNWwRlUrBiA#P{QOPo&)KGa&^jR=<<+Z& z%z3Sc0{+Y?tOp;$dM*#t<=vyr^YV1nUplSA|MQoz|F`$E=f7I}``cywrx!_&$N%%B z{r}LMnt|h3?D#2RpjulEb}$QVc22r-1X6Lv>+E~+gKGQdbgr9L6Qp5@{7d9tBL5Qk z|A|}w%P@QjJ{~V|a?H3jJ_xS?7IO`d%kYK=&jZI+>i?^kiT}8}y`A;{Yi*VBzh5Lh zLH}PR0l@LUN)Lb%0F(fr1OR`10I;T^{Uzi0mkNYf`UvDGe4Rc5q}D(};Yo6mdBfA* zLDqt{B-5X*+8>lw;y>p_@Lzj>KNtV8)hgrvyhwTi{&Q0JZ}6n}-{qEXiTg_2SK_`e z8u!sy3<^U~r+0nR5Td9=e=uw$_7CZ_YqWhxU(PZi2bHJWFra6H{$cExn9kg_$DU)3 zbEjhq>+YT%$7f3`fye2zV!`|LmMy!~gd^#6L9^mzTBoE-!K25{p^+dm}=C{aL( z0!kF{Wut(|wzKwaZ1PciGKGQs*1k=dilV%!yAQEOC<*(3?If(z4sY{&Me-ZqDVMYS z0fu{gh7vKD=>yVl9=bC{M-%pT@)-*bDE!%~@joK1!hik?egAE5zn$OzE8~B>NP0Z} z^Hbk{8$Rv(Z{_A+3I9s?SHi!q2>#Xlk#4qIHq`e-2g`^uI%H_zm?96lwT7 zJw13Pc)Sw-y^Q}iqQ0E}_fF~m{UYfJ_%8+j%Gkdp_A9YpiT(aVu-{)Q_HXJt2dR&d zq`r8t68dFnq(4xSBJ)5jSO5hPVKvA&*^q`z_&am)55Xeev2@S$bFiv_ls+FLnnJrH z{Oh~AXQ;n)f9ATnAd0{6<8w&q9Y~SA9X0}S2-JNcIe>bE)%JGa8A4K`{}tFbSK+_g zmpcEK-Ty`WSK9wxBt0Jg-6rwh$0u3;O2c0X{z~vyg1;{s{NeS-&vpJPE)a*7gFo-i zdOh*AgOlF5_z_vSKEPxed>H2Zx{Ao=zLxuEtCljAsZ3=mQ<=(CrZSbOOl2xlnaWhA kGL@-JWhzsd%2cK@m8nc+DpQ%t^g`+X0I^Ve%m6?E05S55#sB~S literal 0 HcmV?d00001 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")) -- 2.25.1