From: Frank Duncan Date: Sat, 22 Apr 2017 22:38:04 +0000 (-0500) Subject: CLI moved from curses to opengl X-Git-Tag: 0.1.1~13 X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=04d53972b6d2865cfd82d888c35f75fffd840ec7;p=clnl CLI moved from curses to opengl --- diff --git a/.travis.yml b/.travis.yml index d52b800..53ba83d 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/31bdd7b/$(git rev-parse HEAD)/travissbcl + - wget http://frank.kank.net/travissbcl/clnl/a66006d/$(git rev-parse HEAD)/travissbcl - chmod +x travissbcl script: - - ./travissbcl --script bin/all.lisp + - ./travissbcl --dynamic-space-size 3072 --script bin/all.lisp diff --git a/README.md b/README.md index 80ceb76..18cc7a9 100644 --- a/README.md +++ b/README.md @@ -21,7 +21,7 @@ If you'd like to run it from source, you're going to need a few things: * alexandria * babel * cffi - * cl-charms + * clnl-gltk * cl-opengl * cl-ppcre * ironclad @@ -31,7 +31,7 @@ If you'd like to run it from source, you're going to need a few things: * strictmath * ieee-floats -[bin/nl](bin/nl) and [bin/run.lisp](bin/run.lisp) have been added for convenience to run the netlogo instance. It boots up the ncurses command line with an opengl view. Not very many commands are implemented, but it should alert you to that. A good test is +[bin/nl](bin/nl) and [bin/run.lisp](bin/run.lisp) have been added for convenience to run the netlogo instance. Not very many commands are implemented, but it should alert you to that. A good test is ``` crt 10 @@ -46,7 +46,7 @@ In order to run on OSX, you may have to build your own sbcl instance with thread ## Running on Windows -In order to run on Windows, you will need to install a copy of 32bit sbcl with threads enabled, as well as putting a copy of freeglut and pdcurses in that directory. See [bin/buildwindowsexec.sh](bin/buildwindowsexec.sh) for how it's done when releasing/testing. +In order to run on Windows, you will need to install a copy of 32bit sbcl with threads enabled, as well as putting a copy of freeglut in that directory. See [bin/buildwindowsexec.sh](bin/buildwindowsexec.sh) for how it's done when releasing/testing. # Running in a common lisp instance diff --git a/bin/all.lisp b/bin/all.lisp index eca1162..a31d09c 100644 --- a/bin/all.lisp +++ b/bin/all.lisp @@ -19,17 +19,21 @@ (sb-ext:exit :code 1)) (format t "~c[1;32m- Style Passed!~c[0m~%" #\Esc #\Esc) +(sb-ext:gc :full t) + (when (not (find-package :docgen)) (asdf:load-system :docgen)) (format t "~%~c[1;33mChecking Docs~c[0m~%" #\Esc #\Esc) (when (not (docgen:pretty-print-validate-packages :clnl :clnl-parser :clnl-random :clnl-transpiler :clnl-nvm - :clnl-lexer :clnl-interface :clnl-cli :clnl-model :clnl-code-parser + :clnl-lexer :clnl-interface :clnl-model :clnl-code-parser :clnl-extensions :clnl-extension-cli)) (format t "~c[1;31mFailed doc check!~c[0m~%" #\Esc #\Esc) (sb-ext:exit :code 1)) (format t "~c[1;32m- Doc Check Passed!~c[0m~%" #\Esc #\Esc) +(sb-ext:gc :full t) + (format t "~c[1;30m--------------~c[0m~%" #\Esc #\Esc) (format t "~c[1;32mBuild Success!~c[0m~%" #\Esc #\Esc) (sb-ext:exit :code 0) diff --git a/bin/buildlinuxexec.sh b/bin/buildlinuxexec.sh index d13d6fe..c384097 100755 --- a/bin/buildlinuxexec.sh +++ b/bin/buildlinuxexec.sh @@ -15,6 +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/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 && @@ -24,7 +25,6 @@ mkdir -p tmp/deps/ tar zxf ../../deps/common-lisp/mt19937-latest.tar.gz && 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/cl-charms-9bb94ef.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/buildosxexec.sh b/bin/buildosxexec.sh index 1d9351b..88a451d 100755 --- a/bin/buildosxexec.sh +++ b/bin/buildosxexec.sh @@ -19,6 +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/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 && @@ -28,7 +29,6 @@ mkdir -p tmp/deps/ tar zxf ../../deps/common-lisp/mt19937-latest.tar.gz && 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/cl-charms-9bb94ef.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/buildtravisexec.sh b/bin/buildtravisexec.sh index 5f8b14b..cdf9076 100755 --- a/bin/buildtravisexec.sh +++ b/bin/buildtravisexec.sh @@ -24,8 +24,8 @@ mkdir -p tmp/deps/ tar zxf ../../deps/common-lisp/mt19937-latest.tar.gz && 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/cl-charms-9bb94ef.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/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 @@ -38,9 +38,9 @@ SBCL_HOME="" tmp/sbcl/bin/sbcl --core tmp/sbcl/lib/sbcl/sbcl.core \ --eval "(asdf:load-system :cl-ppcre)" \ --eval "(asdf:load-system :mt19937)" \ --eval "(asdf:load-system :ironclad)" \ + --eval "(asdf:load-system :clnl-gltk)" \ --eval "(asdf:load-system :cl-opengl)" \ --eval "(asdf:load-system :cl-glut)" \ - --eval "(asdf:load-system :cl-charms)" \ --eval "(asdf:load-system :style-checker)" \ --eval "(asdf:load-system :docgen)" \ --eval "(asdf:load-system :strictmath)" \ diff --git a/bin/buildwindowsexec.sh b/bin/buildwindowsexec.sh index a1d2c28..6f67f3f 100755 --- a/bin/buildwindowsexec.sh +++ b/bin/buildwindowsexec.sh @@ -18,14 +18,10 @@ if [ ! -e "$sbcl_dir/freeglut.dll" ] ; then exit 1 fi -if [ ! -e "$sbcl_dir/pdcurses.dll" ] ; then - echo "Please copy deps/windows/pdcurses.dll into $sbcl_dir" - exit 1 -fi - mkdir -p tmp/deps/ ( cd tmp/deps && + tar zxf ../../deps/common-lisp/clnl-gltk_0.1.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 && @@ -35,7 +31,6 @@ mkdir -p tmp/deps/ tar zxf ../../deps/common-lisp/mt19937-latest.tar.gz && 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/cl-charms-9bb94ef.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/generatedocs.sh b/bin/generatedocs.sh index c445a35..e88c257 100755 --- a/bin/generatedocs.sh +++ b/bin/generatedocs.sh @@ -13,7 +13,6 @@ generatedoc() { generatedoc :clnl > wiki/DocsMain.md generatedoc :clnl-nvm > wiki/DocsNvm.md generatedoc :clnl-interface > wiki/DocsOtherPackages.md -generatedoc :clnl-cli > wiki/DocsOtherPackages.md generatedoc :clnl-lexer >> wiki/DocsOtherPackages.md generatedoc :clnl-parser >> wiki/DocsOtherPackages.md generatedoc :clnl-transpiler >> wiki/DocsOtherPackages.md diff --git a/deps/common-lisp/cl-charms-9bb94ef.tar.gz b/deps/common-lisp/cl-charms-9bb94ef.tar.gz deleted file mode 100644 index 4134340..0000000 Binary files a/deps/common-lisp/cl-charms-9bb94ef.tar.gz and /dev/null differ diff --git a/deps/common-lisp/clnl-gltk_0.1.tar.gz b/deps/common-lisp/clnl-gltk_0.1.tar.gz new file mode 100644 index 0000000..1d75dec Binary files /dev/null and b/deps/common-lisp/clnl-gltk_0.1.tar.gz differ diff --git a/src/main/cli.lisp b/src/main/cli.lisp deleted file mode 100644 index 4dcc8f0..0000000 --- a/src/main/cli.lisp +++ /dev/null @@ -1,103 +0,0 @@ -(in-package #:clnl-cli) - -(defvar *cli* nil) -(defvar *cli-dims* (list 0 0)) - -(defvar *info* nil) - -(defun run () - "RUN => RESULT - -ARGUMENTS AND VALUES: - - RESULT: undefined, should never get here - -DESCRIPTION: - - RUN runs the command line interface in the running terminal. - - This should become the main REPL for a CLNL program. If you want to use you're - own REPL, you should use the rest of the functions in CLNL to recreate it." - (initscr) - (init-interface) - (loop - :for str := (cffi:with-foreign-pointer-as-string (str 255) (wgetnstr *cli* str 255)) - :while str - :do (print-command-and-response str (execute str))) - (endwin) - (sb-ext:exit :abort t)) - -(defun execute (str) - (handler-case - (with-output-to-string (*standard-output*) - (clnl:run-commands str)) - (error (e) (format nil "Ok, something went wrong: ~A~%Try :help" e)))) - -; for ui, we need to do at a minimum: -; - cli, first pass, read things in, bottom of the screen, -; - just use getstr with a limit to be something like screen width - 10 for now -; - print what the user inputted, dont' bomb on error messages, give target for show -; - for overly long printing, go ahead and truncate with "..." -; - for info, this should put out a simple message about the program, maintainer, purpose, links, etc - -(defun init-interface () - (let - ((cli-height (min 10 (floor (* *lines* .3))))) - (setup-info (- *lines* cli-height) *cols*) - (setup-cli cli-height *cols* (- *lines* cli-height)))) - -(defun refresh-cli () - (wmove *cli* (1- (car *cli-dims*)) 0) - (whline *cli* (char-code #\Space) (cadr *cli-dims*)) - (mvwprintw *cli* (1- (car *cli-dims*)) 0 ">") - (wmove *cli* (1- (car *cli-dims*)) 2) - (wrefresh *cli*)) - -(defun print-command-and-response (command response) - (loop - :for i :from 1 :to (- (car *cli-dims*) 3) - :do (wmove *cli* i 0) - :do (whline *cli* (char-code #\Space) (cadr *cli-dims*))) - (mvwprintw *cli* 1 0 (format nil "> ~A" command)) - (mvwprintw *cli* 3 0 (format nil "~A" response)) - (refresh-cli)) - -(defun setup-cli (height width top) - (setf *cli* (newwin height width top 0)) - (setf *cli-dims* (list height width)) - (whline *cli* 0 (cadr *cli-dims*)) - (wmove *cli* (- (car *cli-dims*) 2) 0) - (whline *cli* (char-code #\.) (cadr *cli-dims*)) - (wmove *cli* (1- (car *cli-dims*)) 2) - (wrefresh *cli*) - (refresh-cli)) - -(defun setup-info (num-tall num-wide) - (let* - ((info " - / \\ - / \\ Welcome to CLNL version ~A! - / \\ - /_______\\ - - CLNL is an experiment at creating an alternate - implementation of NetLogo. - - You can enter in various netlogo commands below, - or use :q to quit the program. - - See http://github.com/frankduncan/clnl for more - information about CLNL and to keep apprised of - any updates that may happen.") - (info-height (length (cl-ppcre:split "\\n" info))) - (info-width (apply #'max (mapcar #'length (cl-ppcre:split "\\n" info))))) - (setf *info* (newwin - (+ 3 info-height) - (+ 2 info-width) - (max 0 (floor (- num-tall info-height) 2)) - (max 0 (floor (- num-wide info-width) 2)))) - (mvwprintw *info* 1 0 - (format nil info - (asdf:component-version (asdf:find-system :clnl)))) - (box *info* 0 0) - (wrefresh *info*))) diff --git a/src/main/clnl.asd b/src/main/clnl.asd index e70faf0..1158f65 100644 --- a/src/main/clnl.asd +++ b/src/main/clnl.asd @@ -25,6 +25,5 @@ (:file "transpile") (:file "random") (:file "interface") - (:file "cli") (:file "main")) - :depends-on #-travis(:cl-ppcre :mt19937 :cl-opengl :cl-glu :cl-glut :cl-charms :ieee-floats :strictmath) #+travis nil) + :depends-on #-travis(:cl-ppcre :mt19937 :cl-opengl :cl-glu :cl-glut :ieee-floats :strictmath :clnl-gltk) #+travis nil) diff --git a/src/main/extensions/cli/cli.lisp b/src/main/extensions/cli/cli.lisp index 3ca0983..4a44546 100644 --- a/src/main/extensions/cli/cli.lisp +++ b/src/main/extensions/cli/cli.lisp @@ -16,7 +16,6 @@ DESCRIPTION: (list :name :help :type :command :args '((:token :optional)) :precedence 20 :func #'help))) (defun shut-down () - (cl-charms/low-level:endwin) (sb-ext:exit :abort t)) (defun load-file (file) diff --git a/src/main/interface.lisp b/src/main/interface.lisp index 88dfac5..b18ca5a 100644 --- a/src/main/interface.lisp +++ b/src/main/interface.lisp @@ -5,9 +5,14 @@ (defvar *glut-window-opened* nil) (defvar *dimensions* nil) +(defvar *window-width* 1024) +(defvar *window-height* 768) (defvar *default-shapes* nil) +(defvar *textbox* nil) +(defvar *inputbox* nil) + ; For now, shapes can live in here ; header is ; * name @@ -214,70 +219,130 @@ (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 - (floor (* (- (getf *dimensions* :xmin) 0.5) (patch-size))) - (floor (* (+ (getf *dimensions* :xmax) 0.5) (patch-size))) - (floor (* (- (getf *dimensions* :ymin) 0.5) (patch-size))) - (floor (* (+ (getf *dimensions* :ymax) 0.5) (patch-size))) - 0 5000) - (gl:matrix-mode :modelview) - (gl:load-identity) - (destructuring-bind (turtles patches) (clnl-nvm:current-state) - (mapcar - (lambda (patch) - (let - ((color (nl-color->rgb (getf patch :color)))) - (gl:color (car color) (cadr color) (caddr color))) - (gl:with-pushed-matrix - (gl:translate (* (getf patch :xcor) (patch-size)) (* (getf patch :ycor) (patch-size)) 0) - (gl:translate (floor (* -.5d0 (patch-size))) (floor (* -.5d0 (patch-size))) 0) - (gl:scale (patch-size) (patch-size) 1) - (gl:call-list *patch-list*))) - patches) - (mapcar - (lambda (turtle) - (let - ((color (nl-color->rgb (getf turtle :color)))) - (gl:color (car color) (cadr color) (caddr color))) + (gl:with-pushed-matrix + (gl:load-identity) + (gl:ortho + (floor (* (- (getf *dimensions* :xmin) 0.5) (patch-size))) + (floor (* (+ (getf *dimensions* :xmax) 0.5) (patch-size))) + (floor (* (- (getf *dimensions* :ymin) 0.5) (patch-size))) + (floor (* (+ (getf *dimensions* :ymax) 0.5) (patch-size))) + 0 5000) + (gl:matrix-mode :modelview) + (gl:with-pushed-matrix + (gl:load-identity) + (destructuring-bind (turtles patches) (clnl-nvm:current-state) (mapcar - (lambda (x-modification y-modification) + (lambda (patch) + (let + ((color (nl-color->rgb (getf patch :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:translate x-modification y-modification 0) - (let - ((turtle-list (find (getf turtle :shape) *turtle-lists* :test #'string= :key #'car))) - (when turtle-list - (when (second turtle-list) - (gl:rotate (getf turtle :heading) 0 0 -1)) - (gl:scale (patch-size) (patch-size) 1) - (gl:scale (getf turtle :size) (getf turtle :size) 1) - (gl:call-list (third 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)))))) - turtles)) + (gl:translate (* (getf patch :xcor) (patch-size)) (* (getf patch :ycor) (patch-size)) 0) + (gl:translate (floor (* -.5d0 (patch-size))) (floor (* -.5d0 (patch-size))) 0) + (gl:scale (patch-size) (patch-size) 1) + (gl:call-list *patch-list*))) + patches) + (mapcar + (lambda (turtle) + (let + ((color (nl-color->rgb (getf turtle :color)))) + (gl:color (car color) (cadr color) (caddr color))) + (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) + (let + ((turtle-list (find (getf turtle :shape) *turtle-lists* :test #'string= :key #'car))) + (when turtle-list + (when (second turtle-list) + (gl:rotate (getf turtle :heading) 0 0 -1)) + (gl:scale (patch-size) (patch-size) 1) + (gl:scale (getf turtle :size) (getf turtle :size) 1) + (gl:call-list (third 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)))))) + turtles))) + (gl:matrix-mode :projection)) (gl:flush)) +(defun render-widgets () + (clnl-gltk:render *textbox*) + (clnl-gltk:render *inputbox*)) + +(defun render () + (gl:clear :color-buffer-bit :depth-buffer-bit) + (let + ((width (world-width-in-pixels)) + (height (world-height-in-pixels))) + (gl:viewport 0 0 *window-width* *window-height*) + + (gl:matrix-mode :projection) + (gl:with-pushed-matrix + (gl:load-identity) + (gl:ortho 0 *window-width* 0 *window-height* 0 5000) + (render-widgets) + + (gl:begin :lines) + (gl:vertex (- *window-width* width 10) (- *window-height* height 10)) + (gl:vertex (- *window-width* width 10) (- *window-height* 9)) + + (gl:vertex (- *window-width* width 10) (- *window-height* 9)) + (gl:vertex (- *window-width* 9) (- *window-height* 9)) + + (gl:vertex (- *window-width* 9) (- *window-height* 9)) + (gl:vertex (- *window-width* 9) (- *window-height* height 10)) + + (gl:vertex (- *window-width* 9) (- *window-height* height 10)) + (gl:vertex (- *window-width* width 10) (- *window-height* height 10)) + (gl:end)) + + (gl:viewport (- *window-width* width 10) (- *window-height* height 10) width height) + (render-scene))) + (defun display () - (render-scene) + (render) (cl-glut:swap-buffers)) (defun idle () (cl-glut:post-redisplay)) (defun close-func () + ;(glut:leave-main-loop) (sb-ext:exit :abort t)) (defun reshape (width height) (when (and (/= 0 width) (/= 0 height)) - (gl:viewport 0 0 width height))) + (setf *window-width* width) + (setf *window-height* height) + (let + ((box-width (truncate (- width 12) clnl-gltk:*font-width*))) + (clnl-gltk:resize *textbox* box-width 12) + (clnl-gltk:resize *inputbox* box-width 1)))) + +(defun execute (str) + (handler-case + (with-output-to-string (*standard-output*) + (clnl:run-commands str)) + (error (e) (format nil "Ok, something went wrong: ~A~%Try :help" e)))) + +(defun key-pressed (key x y) + (declare (ignore x y)) + (if (eql key 13) + (let* + ((cmd (clnl-gltk:value *inputbox*)) + (resp (execute cmd))) + (setf (clnl-gltk:textbox-text *textbox*) (format nil "> ~A~%~%~A" cmd resp)) + (clnl-gltk:clear *inputbox*)) + (clnl-gltk:key-pressed *inputbox* key))) (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)) +(cffi:defcallback key-pressed :void ((key :uchar) (x :int) (y :int)) (key-pressed key x y)) +(cffi:defcallback special-key-pressed :void ((key glut:special-keys) (x :int) (y :int)) (key-pressed key x y)) (defun set-turtle-lists () (setf @@ -308,6 +373,20 @@ (gl:vertex 1 0 0) (gl:end))) +(defvar *initial-banner* + " + / \\ + / \\ Welcome to CLNL version ~A! + / \\ + /_______\\ + +CLNL is an experiment at creating an alternate implementation of NetLogo. + +You can enter in various netlogo commands below, or use :q to quit the program. + +See http://github.com/frankduncan/clnl for more information about CLNL and to +keep apprised of any updates that may happen.") + (defun initialize (&key dims) "INITIALIZE &key DIMS => RESULT @@ -328,9 +407,7 @@ DESCRIPTION: the interface lives. From here, one can go into headless or running mode, but for certain things this interface will still need to act, and also allows for bringing up and taking down of visual elements." - (setf *dimensions* dims) - (when *glut-window-opened* - (cl-glut:reshape-window (world-width-in-pixels) (world-height-in-pixels)))) + (setf *dimensions* dims)) (defun run () "RUN => RESULT @@ -350,9 +427,7 @@ DESCRIPTION: ; want to investigate until simply ignoring them becomes a problem. (sb-int:with-float-traps-masked (:invalid :inexact :divide-by-zero :overflow :underflow) (cl-glut:init) - (cl-glut:init-window-size - (world-width-in-pixels) - (world-height-in-pixels)) + (cl-glut:init-window-size *window-width* *window-height*) (cl-glut:init-display-mode :double :rgba) (cl-glut:create-window "CLNL Test Window") (setf *glut-window-opened* t) @@ -361,8 +436,20 @@ DESCRIPTION: (glut:reshape-func (cffi:callback reshape)) (cl-glut:idle-func (cffi:get-callback 'idle)) (cl-glut:close-func (cffi:get-callback 'close-func)) + (cl-glut:keyboard-func (cffi:get-callback 'key-pressed)) + (cl-glut:special-func (cffi:get-callback 'special-key-pressed)) + (gl:depth-func :lequal) + (gl:blend-func :src-alpha :one-minus-src-alpha) + (gl:enable :blend) (set-turtle-lists) (set-patch-list) + (clnl-gltk:setup) + (setf *textbox* + (clnl-gltk:textbox + 5 (+ clnl-gltk:*font-height* 14) + 10 12 + (format nil *initial-banner* (asdf:component-version (asdf:find-system :clnl))))) + (setf *inputbox* (clnl-gltk:inputbox 5 5 10)) (cl-glut:main-loop))) (defun patch-size () (getf *dimensions* :patch-size)) @@ -402,16 +489,7 @@ DESCRIPTION: (let ((fbo (first (gl:gen-framebuffers 1))) (render-buf (first (gl:gen-renderbuffers 1))) - ;(width - ; (floor (* (patch-size) (1+ (- - ; (getf *dimensions* :ymax) - ; (getf *dimensions* :ymin)))))) - ;(height - ; (floor (* (patch-size) (1+ (- (getf *world-dims* :xmax) (getf *world-dims* :xmin)))))) - ; (floor (* (patch-size) (1+ (- - ; (getf *dimensions* :xmax) - ; (getf *dimensions* :xmin))))) - (width (world-width-in-pixels)) ; Hard coded for now, yay v1 (if you see this comment in a year, please cry for me) + (width (world-width-in-pixels)) (height (world-height-in-pixels))) (gl:bind-framebuffer :framebuffer fbo) (gl:bind-renderbuffer :renderbuffer render-buf) diff --git a/src/main/main.lisp b/src/main/main.lisp index b0d82eb..42ec55b 100644 --- a/src/main/main.lisp +++ b/src/main/main.lisp @@ -25,7 +25,6 @@ DESCRIPTION: RUN starts up the CLNL system." (boot) - (sb-thread:make-thread #'clnl-cli:run) (clnl-interface:run)) (defvar *callback* nil) diff --git a/src/main/package.lisp b/src/main/package.lisp index 73ae492..2f2c5c6 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -83,16 +83,6 @@ The NetLogo view interface using opengl. This is responsible for taking the current state of the enging and displaying it. Will not house any interface components.")) -(defpackage #:clnl-cli - (:use :common-lisp :cl-charms/low-level) - (:export #:run) - (:documentation - "CLNL CLI - -The main NetLogo interface for interacting with the program. Since CLNL is -a command line interface program with a view for display purposes only, this -is where all the features that the traditional NetLogo UI lives.")) - (defpackage #:clnl-model (:use :common-lisp) (:export #:default-model #:read-from-nlogo #:world-dimensions #:widget-globals #:code)