diff --git a/lisp/README.md b/lisp/README.md index 3626ec2..d1ab29c 100644 --- a/lisp/README.md +++ b/lisp/README.md @@ -1,28 +1,27 @@ # Lisp MMO Project Implementation -The interesting thing about lisp is that for being the 2nd oldest language, it has some of the most flavors of any programming language. - -Lisp is much easier to implement from a compiler/interpreter point of view due to its structure, so it makes sense that it has so many implementations. - -Note for lfarm, for real world please use their Kerberos/GSSAPI implementation instead of my simple password implementation. Its going to be infinitely better. - [lisp-µhttpd (game website & webserver) ](./www/README.md) -http://8arrow.org/caveman/ -https://github.com/fukamachi/datafly -https://github.com/fukamachi/sxql -https://github.com/dnaeon/cl-bcrypt +* [:caveman2](http://8arrow.org/caveman/) +* [:datafly](https://github.com/fukamachi/datafly) +* [:sxql](https://github.com/fukamachi/sxql) +* [:cl-bcrypt](https://github.com/dnaeon/cl-bcrypt) [lisp-mmo-server (game backend) using picolisp](./server/README.md) -https://github.com/lmj/lfarm -https://github.com/fukamachi/datafly -https://github.com/fukamachi/sxql -https://github.com/dnaeon/cl-bcrypt +* [:usocket](https://github.com/usocket/usocket) +* [:simple-actors](https://github.com/j3pic/simple-actors) +* [:bordeaux-threads](https://github.com/sionescu/bordeaux-threads) +* [:datafly](https://github.com/fukamachi/datafly) +* [:sxql](https://github.com/fukamachi/sxql) +* [:cl-bcrypt](https://github.com/dnaeon/cl-bcrypt) [lisp-mmo-client (game frontend / UI) using common lisp](./client/README.md) -https://github.com/raysan5/raylib -https://github.com/defun-games/claylib -https://github.com/lmj/lfarm -https://github.com/dnaeon/cl-bcrypt +* [raylib (external library)](https://github.com/raysan5/raylib) +* [:cl-raylib](https://github.com/longlene/cl-raylib) +* [:3d-vectors](https://quickref.common-lisp.net/3d-vectors.html) +* [:usocket](https://github.com/usocket/usocket) +* [:simple-actors](https://github.com/j3pic/simple-actors) +* [:bordeaux-threads](https://github.com/sionescu/bordeaux-threads) +* [:cl-bcrypt](https://github.com/dnaeon/cl-bcrypt) diff --git a/lisp/client/README.md b/lisp/client/README.md index 19e6191..43cf031 100644 --- a/lisp/client/README.md +++ b/lisp/client/README.md @@ -1,2 +1,7 @@ # lisp client +[finished common lisp client](./mmo-client-sbcl/README.md) + +[unfinished picolisp client](./picolisp/README.md) + +[unfinished racket client](./racket/README.md) diff --git a/lisp/client/common-lisp/client.lisp b/lisp/client/common-lisp/client.lisp new file mode 100644 index 0000000..dc4fbce --- /dev/null +++ b/lisp/client/common-lisp/client.lisp @@ -0,0 +1,36 @@ +(load "~/quicklisp/setup.lisp") ; need to load quicklisp +(ql:quickload '(:cl-raylib :cl-bcrypt :usocket :simple-actors :bordeaux-threads)) + +(defpackage :mmo-client + (:use :common-lisp :cl-raylib :3d-vectors)) + +(in-package :mmo-client) + +(defun main () + (let* ((screen-width 800) + (screen-height 450) + (username "username") + (title "mmo client - common lisp") + (camera (make-camera3d :position (vec 4.0 2.0 4.0) + :target (vec 0.0 0.5 0.0) + :up (vec 0.0 1.0 0.0) + :fovy 60.0 + :projection :camera-perspective)) + (cube-screen-pos (vec 0.0 0.0))) + (with-window (screen-width screen-height title) + (disable-cursor) + (set-target-fps 60) ; Set our game to run at 60 FPS + (loop + until (window-should-close) ; detect window close button or ESC key + do (update-camera camera :camera-third-person) + (setf cube-screen-pos (get-world-to-screen (v+ (camera3d-target camera) (vec 0 1.0 0)) camera)) + (with-drawing + (clear-background :raywhite) + (with-mode-3d (camera) + (draw-cube (camera3d-target camera) 1.0 1.0 1.0 :red) + (draw-cube-wires (camera3d-target camera) 1.0 1.0 1.0 :maroon) + (draw-grid 20 1.0)) + (draw-text username (- (floor (vx cube-screen-pos)) (floor (measure-text username 20) 2)) + (floor (vy cube-screen-pos) ) 20 :black)))))) + +(main) diff --git a/lisp/client/mmo-client-sbcl/README.md b/lisp/client/mmo-client-sbcl/README.md deleted file mode 100644 index 9a0f60a..0000000 --- a/lisp/client/mmo-client-sbcl/README.md +++ /dev/null @@ -1,10 +0,0 @@ -# Mmo-Client-Sbcl - -https://github.com/raysan5/raylib -https://github.com/defun-games/claylib -https://github.com/lmj/lfarm -https://github.com/dnaeon/cl-bcrypt - -## Usage - -## Installation diff --git a/lisp/client/mmo-client-sbcl/mmo-client-sbcl.asd b/lisp/client/mmo-client-sbcl/mmo-client-sbcl.asd deleted file mode 100644 index 0367e87..0000000 --- a/lisp/client/mmo-client-sbcl/mmo-client-sbcl.asd +++ /dev/null @@ -1,21 +0,0 @@ -(defsystem "mmo-client-sbcl" - :version "0.1.0" - :author "" - :license "" - :depends-on ("claylib") - :components ((:module "src" - :components - ((:file "main")))) - :description "" - :in-order-to ((test-op (test-op "mmo-client-sbcl/tests")))) - -(defsystem "mmo-client-sbcl/tests" - :author "" - :license "" - :depends-on ("mmo-client-sbcl" - "rove") - :components ((:module "tests" - :components - ((:file "main")))) - :description "Test system for mmo-client-sbcl" - :perform (test-op (op c) (symbol-call :rove :run c))) diff --git a/lisp/client/mmo-client-sbcl/src/main.lisp b/lisp/client/mmo-client-sbcl/src/main.lisp deleted file mode 100644 index 6120477..0000000 --- a/lisp/client/mmo-client-sbcl/src/main.lisp +++ /dev/null @@ -1,49 +0,0 @@ -(defpackage mmo-client-sbcl - (:use :cl :claylib)) -(in-package :mmo-client-sbcl) - -(defvar *mouse-delta* (make-vector2 0 0)) - -(defun reset-up (camera) - (setf (x (up camera)) 0 - (y (up camera)) 1 - (z (up camera)) 0)) - -(defun pro-mvmt (key1 key2) - (if (or (is-key-down-p key1) (is-key-down-p key2)) 0.1 0)) - -(defun pro-mode-update (camera) - (get-mouse-delta :vec *mouse-delta*) - (setf (x (movement camera)) (- (pro-mvmt +key-w+ +key-up+) - (pro-mvmt +key-s+ +key-down+)) - (y (movement camera)) (- (pro-mvmt +key-d+ +key-right+) - (pro-mvmt +key-a+ +key-left+)) - (x (rot camera)) (* 0.05 (x *mouse-delta*)) - (y (rot camera)) (* 0.05 (y *mouse-delta*)) - (zoom camera) (* 2 (get-mouse-wheel-move)))) - -(defun main () - (with-window (:title "raylib [core] example - 3d camera first person") - (let ((camera (make-camera-3d 0 2 4 - 0 2 0 - 0 1 0 - :fovy 60.0 - :projection +camera-perspective+ - :mode +camera-first-person+)) - (scene (make-scene () - ((ground (make-plane 0 0 0 32 32 +lightgray+)) - (blue (make-cube -16 2.5 0 - 1 5 32 - +blue+)) - (green (make-cube 16 2.5 0 - 1 5 32 - +lime+)) - (yellow (make-cube 0 2.5 16 - 32 5 1 - +gold+)))))) - (with-scenes scene () - (do-game-loop (:livesupport t) - (compute-camera camera) - (with-drawing () - (with-3d-mode camera - (draw-scene scene '(ground blue green yellow))))))))) diff --git a/lisp/client/mmo-client-sbcl/tests/main.lisp b/lisp/client/mmo-client-sbcl/tests/main.lisp deleted file mode 100644 index cda513c..0000000 --- a/lisp/client/mmo-client-sbcl/tests/main.lisp +++ /dev/null @@ -1,11 +0,0 @@ -(defpackage mmo-client-sbcl/tests/main - (:use :cl - :mmo-client-sbcl - :rove)) -(in-package :mmo-client-sbcl/tests/main) - -;; NOTE: To run this test file, execute `(asdf:test-system :mmo-client-sbcl)' in your Lisp. - -(deftest test-target-1 - (testing "should (= 1 1) to be true" - (ok (= 1 1)))) diff --git a/lisp/server/README.md b/lisp/server/README.md index c4890b3..f9d6600 100644 --- a/lisp/server/README.md +++ b/lisp/server/README.md @@ -1,4 +1,6 @@ -https://github.com/lmj/lfarm -https://github.com/fukamachi/datafly -https://github.com/fukamachi/sxql -https://github.com/dnaeon/cl-bcrypt \ No newline at end of file +* https://github.com/usocket/usocket +* https://github.com/j3pic/simple-actors +* https://github.com/sionescu/bordeaux-threads +* https://github.com/fukamachi/datafly +* https://github.com/fukamachi/sxql +* https://github.com/dnaeon/cl-bcrypt \ No newline at end of file diff --git a/lisp/server/server.lisp b/lisp/server/server.lisp new file mode 100644 index 0000000..5458303 --- /dev/null +++ b/lisp/server/server.lisp @@ -0,0 +1,8 @@ +(load "~/quicklisp/setup.lisp") +(ql:quickload '(:usocket :simple-actors :bordeaux-threads :cl-bcrypt :datafly :sxql)) + +(defpackage :mmo-server + (:use :common-lisp :usocket :simple-actors :bordeaux-threads) + (:export :accept-connections)) + +(in-package :mmo-server) diff --git a/lisp/client/mmo-client-sbcl/.gitignore b/lisp/www/.gitignore similarity index 83% rename from lisp/client/mmo-client-sbcl/.gitignore rename to lisp/www/.gitignore index b9fa3c1..7d8d59e 100644 --- a/lisp/client/mmo-client-sbcl/.gitignore +++ b/lisp/www/.gitignore @@ -1,4 +1,3 @@ -*.abcl *.fasl *.dx32fsl *.dx64fsl @@ -6,4 +5,4 @@ *.lx64fsl *.x86f *~ -.#* +.#* \ No newline at end of file diff --git a/lisp/www/README.md b/lisp/www/README.md index 9677fb0..5e09ee2 100644 --- a/lisp/www/README.md +++ b/lisp/www/README.md @@ -1,4 +1,10 @@ -http://8arrow.org/caveman/ -https://github.com/fukamachi/datafly -https://github.com/fukamachi/sxql -https://github.com/dnaeon/cl-bcrypt +# www + +* http://8arrow.org/caveman/ +* https://github.com/fukamachi/datafly +* https://github.com/fukamachi/sxql +* https://github.com/dnaeon/cl-bcrypt + +## Usage + +## Installation diff --git a/lisp/www/app.lisp b/lisp/www/app.lisp new file mode 100644 index 0000000..3b10267 --- /dev/null +++ b/lisp/www/app.lisp @@ -0,0 +1,39 @@ +(ql:quickload :www) + +(defpackage www.app + (:use :cl) + (:import-from :lack.builder + :builder) + (:import-from :ppcre + :scan + :regex-replace) + (:import-from :www.web + :*web*) + (:import-from :www.config + :config + :productionp + :*static-directory*)) +(in-package :www.app) + +(builder + (:static + :path (lambda (path) + (if (ppcre:scan "^(?:/images/|/css/|/js/|/robot\\.txt$|/favicon\\.ico$)" path) + path + nil)) + :root *static-directory*) + (if (productionp) + nil + :accesslog) + (if (getf (config) :error-log) + `(:backtrace + :output ,(getf (config) :error-log)) + nil) + :session + (if (productionp) + nil + (lambda (app) + (lambda (env) + (let ((datafly:*trace-sql* t)) + (funcall app env))))) + *web*) diff --git a/lisp/www/db/schema.sql b/lisp/www/db/schema.sql new file mode 100644 index 0000000..75eba67 --- /dev/null +++ b/lisp/www/db/schema.sql @@ -0,0 +1,7 @@ +CREATE TABLE users + (id INTEGER PRIMARY KEY ASC, + username TEXT, password TEXT, + appearance_r INTEGER, appearance_g INTEGER, appearance_b INTEGER, + x_pos REAL, y_pos REAL, logged_in INTEGER, + created INTEGER); + diff --git a/lisp/www/src/config.lisp b/lisp/www/src/config.lisp new file mode 100644 index 0000000..bff1d57 --- /dev/null +++ b/lisp/www/src/config.lisp @@ -0,0 +1,45 @@ +(in-package :cl-user) +(defpackage www.config + (:use :cl) + (:import-from :envy + :config-env-var + :defconfig) + (:export :config + :*application-root* + :*static-directory* + :*template-directory* + :appenv + :developmentp + :productionp)) +(in-package :www.config) + +(setf (config-env-var) "APP_ENV") + +(defparameter *application-root* (asdf:system-source-directory :www)) +(defparameter *static-directory* (merge-pathnames #P"static/" *application-root*)) +(defparameter *template-directory* (merge-pathnames #P"templates/" *application-root*)) + +(defconfig :common + `(:databases + ((:maindb :sqlite3 :database-name ,(merge-pathnames #P"test.db3" *application-root*))))) + +(defconfig |development| + '()) + +(defconfig |production| + '()) + +(defconfig |test| + '()) + +(defun config (&optional key) + (envy:config #.(package-name *package*) key)) + +(defun appenv () + (uiop:getenv (config-env-var #.(package-name *package*)))) + +(defun developmentp () + (string= (appenv) "development")) + +(defun productionp () + (string= (appenv) "production")) diff --git a/lisp/www/src/db.lisp b/lisp/www/src/db.lisp new file mode 100644 index 0000000..9b20ca5 --- /dev/null +++ b/lisp/www/src/db.lisp @@ -0,0 +1,23 @@ +(in-package :cl-user) +(defpackage www.db + (:use :cl) + (:import-from :www.config + :config) + (:import-from :datafly + :*connection*) + (:import-from :cl-dbi + :connect-cached) + (:export :connection-settings + :db + :with-connection)) +(in-package :www.db) + +(defun connection-settings (&optional (db :maindb)) + (cdr (assoc db (config :databases)))) + +(defun db (&optional (db :maindb)) + (apply #'connect-cached (connection-settings db))) + +(defmacro with-connection (conn &body body) + `(let ((*connection* ,conn)) + ,@body)) diff --git a/lisp/www/src/main.lisp b/lisp/www/src/main.lisp new file mode 100644 index 0000000..2ae34ea --- /dev/null +++ b/lisp/www/src/main.lisp @@ -0,0 +1,30 @@ +(in-package :cl-user) +(defpackage www + (:use :cl) + (:import-from :www.config + :config) + (:import-from :clack + :clackup) + (:export :start + :stop)) +(in-package :www) + +(defvar *appfile-path* + (asdf:system-relative-pathname :www #P"app.lisp")) + +(defvar *handler* nil) + +(defun start (&rest args &key server port debug &allow-other-keys) + (declare (ignore server port debug)) + (when *handler* + (restart-case (error "Server is already running.") + (restart-server () + :report "Restart the server" + (stop)))) + (setf *handler* + (apply #'clackup *appfile-path* args))) + +(defun stop () + (prog1 + (clack:stop *handler*) + (setf *handler* nil))) diff --git a/lisp/www/src/view.lisp b/lisp/www/src/view.lisp new file mode 100644 index 0000000..ef81e13 --- /dev/null +++ b/lisp/www/src/view.lisp @@ -0,0 +1,51 @@ +(in-package :cl-user) +(defpackage www.view + (:use :cl) + (:import-from :www.config + :*template-directory*) + (:import-from :caveman2 + :*response* + :response-headers) + (:import-from :djula + :add-template-directory + :compile-template* + :render-template* + :*djula-execute-package*) + (:import-from :datafly + :encode-json) + (:export :render + :render-json)) +(in-package :www.view) + +(djula:add-template-directory *template-directory*) + +(defparameter *template-registry* (make-hash-table :test 'equal)) + +(defun render (template-path &optional env) + (let ((template (gethash template-path *template-registry*))) + (unless template + (setf template (djula:compile-template* (princ-to-string template-path))) + (setf (gethash template-path *template-registry*) template)) + (apply #'djula:render-template* + template nil + env))) + +(defun render-json (object) + (setf (getf (response-headers *response*) :content-type) "application/json") + (encode-json object)) + + +;; +;; Execute package definition + +(defpackage www.djula + (:use :cl) + (:import-from :www.config + :config + :appenv + :developmentp + :productionp) + (:import-from :caveman2 + :url-for)) + +(setf djula:*djula-execute-package* (find-package :www.djula)) diff --git a/lisp/www/src/web.lisp b/lisp/www/src/web.lisp new file mode 100644 index 0000000..56da030 --- /dev/null +++ b/lisp/www/src/web.lisp @@ -0,0 +1,60 @@ +(in-package :cl-user) +(defpackage www.web + (:use :cl + :caveman2 + :www.config + :www.view + :www.db + :datafly + :sxql + :cl-bcrypt) + (:export :*web*)) +(in-package :www.web) + +;; for @route annotation +(syntax:use-syntax :annot) + +;; +;; Application + +(defclass () ()) +(defvar *web* (make-instance ')) +(clear-routing-rules *web*) + +;; +;; Routing rules + +(defroute "/" () + (render #P"index.html")) + + +(defroute ("/signup" :method :POST) (&key _parsed) + (destructuring-bind ((v1 . username) (v2 . password) (v3 . appearance)) _parsed + (with-connection (db) + (datafly:execute + (insert-into :users + (:username :password :appearance_r :appearance_g :appearance_b :x_pos :y_pos :logged_in :created) + (list username + (bcrypt:encode (bcrypt:make-password password)) + (hex2rgb appearance :r) + (hex2rgb appearance :g) + (hex2rgb appearance :b) 0 0 0 + (encode-universal-time 0 0 0 1 1 1970 0)))))) + (render #P"done.html")) + +(defun hex2rgb (hex v) + (ecase v + (:r + (parse-integer (subseq hex 1 3) :radix 16)) + (:g + (parse-integer (subseq hex 3 5) :radix 16)) + (:b + (parse-integer (subseq hex 5 7) :radix 16)))) + +;; +;; Error pages + +(defmethod on-exception ((app ) (code (eql 404))) + (declare (ignore app)) + (merge-pathnames #P"_errors/404.html" + *template-directory*)) diff --git a/lisp/www/start.lisp b/lisp/www/start.lisp new file mode 100644 index 0000000..6d27db4 --- /dev/null +++ b/lisp/www/start.lisp @@ -0,0 +1,4 @@ +(load "~/quicklisp/setup.lisp") +(push #P"~/mmo-project/lisp/www" asdf:*central-registry*) +(ql:quickload :www) +(www:start :port 9090) diff --git a/lisp/www/start.sh b/lisp/www/start.sh new file mode 100755 index 0000000..cafdfe1 --- /dev/null +++ b/lisp/www/start.sh @@ -0,0 +1,2 @@ +#!/bin/sh +sbcl --load start.lisp diff --git a/lisp/www/static/css/main.css b/lisp/www/static/css/main.css new file mode 100644 index 0000000..77a712b --- /dev/null +++ b/lisp/www/static/css/main.css @@ -0,0 +1,33 @@ +@charset "UTF-8"; + +html, +input, +body { + background-color: black; + color: white; +} + +input:invalid { + border: 2px dashed white; +} + +input:valid { + border: 2px solid white; +} + +@media screen and (prefers-color-scheme: light) { + html, + input, + body { + background-color: white; + color: black; + } + + input:invalid { + border: 2px dashed black; + } + + input:valid { + border: 2px solid black; + } +} diff --git a/lisp/www/templates/_errors/404.html b/lisp/www/templates/_errors/404.html new file mode 100644 index 0000000..5d0d4ae --- /dev/null +++ b/lisp/www/templates/_errors/404.html @@ -0,0 +1,47 @@ + + + + + 404 NOT FOUND + + + +
+
+
404
+
NOT FOUND
+
+
+ + diff --git a/lisp/www/templates/done.html b/lisp/www/templates/done.html new file mode 100644 index 0000000..1de4e7a --- /dev/null +++ b/lisp/www/templates/done.html @@ -0,0 +1,13 @@ + +{% extends "layouts/default.html" %} +{% block title %}MMO Testing Game{% endblock %} +{% block content %} +
+

MMO Testing Game

+
+
+

+ Signup was successful, you can log into the client now. +

+
+{% endblock %} diff --git a/lisp/www/templates/index.html b/lisp/www/templates/index.html new file mode 100644 index 0000000..977ff34 --- /dev/null +++ b/lisp/www/templates/index.html @@ -0,0 +1,53 @@ +{% extends "layouts/default.html" %} +{% block title %}MMO Testing Game{% endblock %} +{% block content %} +
+

MMO Testing Game

+
+
+

+ I wanted to create this design document to better define the style and + what features will be in the testing game. The testing game is going to + be a extremely simplified 3D MMORPG in the spirit of Runescape 2. An + environment where players can move around the environment and chat with + each other. +

+ +
+
Signup Form
+
+
+
+
+
+ +

+ +
+
+{% endblock %} diff --git a/lisp/www/templates/layouts/default.html b/lisp/www/templates/layouts/default.html new file mode 100644 index 0000000..6dba578 --- /dev/null +++ b/lisp/www/templates/layouts/default.html @@ -0,0 +1,11 @@ + + + + + {% block title %}{% endblock %} + + + + {% block content %}{% endblock %} + + diff --git a/lisp/www/test.db3 b/lisp/www/test.db3 new file mode 100644 index 0000000..8e5379e Binary files /dev/null and b/lisp/www/test.db3 differ diff --git a/lisp/www/test.sqbpro b/lisp/www/test.sqbpro new file mode 100644 index 0000000..bfb1141 --- /dev/null +++ b/lisp/www/test.sqbpro @@ -0,0 +1,7 @@ +
CREATE TABLE users + (id INTEGER PRIMARY KEY ASC, + username TEXT, password TEXT, + appearance_r INTEGER, appearance_g INTEGER, appearance_b INTEGER, + x_pos REAL, y_pos REAL, logged_in INTEGER, + created INTEGER); +
diff --git a/lisp/www/tests/www.lisp b/lisp/www/tests/www.lisp new file mode 100644 index 0000000..2af2489 --- /dev/null +++ b/lisp/www/tests/www.lisp @@ -0,0 +1,12 @@ +(in-package :cl-user) +(defpackage www-test + (:use :cl + :www + :prove)) +(in-package :www-test) + +(plan nil) + +;; blah blah blah. + +(finalize) diff --git a/lisp/www/www-test.asd b/lisp/www/www-test.asd new file mode 100644 index 0000000..e90c04c --- /dev/null +++ b/lisp/www/www-test.asd @@ -0,0 +1,11 @@ +(defsystem "www-test" + :defsystem-depends-on ("prove-asdf") + :author "zongor" + :license "" + :depends-on ("www" + "prove") + :components ((:module "tests" + :components + ((:test-file "www")))) + :description "Test system for www" + :perform (test-op (op c) (symbol-call :prove-asdf :run-test-system c))) diff --git a/lisp/www/www.asd b/lisp/www/www.asd new file mode 100644 index 0000000..e81c0b6 --- /dev/null +++ b/lisp/www/www.asd @@ -0,0 +1,30 @@ +(defsystem "www" + :version "0.1.0" + :author "zongor" + :license "" + :depends-on ("clack" + "lack" + "caveman2" + "envy" + "cl-ppcre" + "uiop" + + ;; for @route annotation + "cl-syntax-annot" + + ;; HTML Template + "djula" + + ;; for DB + "datafly" + "sxql" + "cl-bcrypt") + :components ((:module "src" + :components + ((:file "main" :depends-on ("config" "view" "db")) + (:file "web" :depends-on ("view")) + (:file "view" :depends-on ("config")) + (:file "db" :depends-on ("config")) + (:file "config")))) + :description "" + :in-order-to ((test-op (test-op "www-test"))))