zongor
/
mmo-project
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

add www, add server, add new client

This commit is contained in:
zongor 2023-12-16 15:06:29 -05:00
parent ee06a7c8ab
commit 28b5ac413f
30 changed files with 561 additions and 119 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
lisp/README.md
View File

@ -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)

5
lisp/client/README.md
View File

@ -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)

36
lisp/client/common-lisp/client.lisp Normal file
View File

@ -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)

10
lisp/client/mmo-client-sbcl/README.md
View File

@ -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

21
lisp/client/mmo-client-sbcl/mmo-client-sbcl.asd
View File

@ -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)))

49
lisp/client/mmo-client-sbcl/src/main.lisp
View File

@ -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)))))))))

11
lisp/client/mmo-client-sbcl/tests/main.lisp
View File

@ -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))))

10
lisp/server/README.md
View File

@ -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
* 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

8
lisp/server/server.lisp Normal file
View File

@ -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)

3
lisp/client/mmo-client-sbcl/.gitignore → lisp/www/.gitignore vendored
View File

@ -1,4 +1,3 @@
*.abcl
*.fasl
*.dx32fsl
*.dx64fsl
@ -6,4 +5,4 @@
*.lx64fsl
*.x86f
*~
.#*
.#*

14
lisp/www/README.md
View File

@ -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

39
lisp/www/app.lisp Normal file
View File

@ -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*)

7
lisp/www/db/schema.sql Normal file
View File

@ -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);

45
lisp/www/src/config.lisp Normal file
View File

@ -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"))

23
lisp/www/src/db.lisp Normal file
View File

@ -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))

30
lisp/www/src/main.lisp Normal file
View File

@ -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)))

51
lisp/www/src/view.lisp Normal file
View File

@ -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))

60
lisp/www/src/web.lisp Normal file
View File

@ -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 <web> (<app>) ())
(defvar *web* (make-instance '<web>))
(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 <web>) (code (eql 404)))
(declare (ignore app))
(merge-pathnames #P"_errors/404.html"
*template-directory*))

4
lisp/www/start.lisp Normal file
View File

@ -0,0 +1,4 @@
(load "~/quicklisp/setup.lisp")
(push #P"~/mmo-project/lisp/www" asdf:*central-registry*)
(ql:quickload :www)
(www:start :port 9090)

2
lisp/www/start.sh Executable file
View File

@ -0,0 +1,2 @@
#!/bin/sh
sbcl --load start.lisp

33
lisp/www/static/css/main.css Normal file
View File

@ -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;
}
}

47
lisp/www/templates/_errors/404.html Normal file
View File

@ -0,0 +1,47 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8">
<title>404 NOT FOUND</title>
<style type="text/css">
html {
height: 100%;
}
body {
height: 100%;
font-family: 'Myriad Pro', Calibri, Helvetica, Arial, sans-serif;
background-color: #DFDFDF;
}
#main {
display: table;
width: 100%;
height: 100%;
}
.error {
display: table-cell;
text-align: center;
vertical-align: middle;
}
.error .code {
font-size: 1600%;
font-weight: bold;
}
.error .message {
font-size: 400%;
}
</style>
</head>
<body>
<div id="main">
<div class="error">
<div class="code">404</div>
<div class="message">NOT FOUND</div>
</div>
</div>
</body>
</html>

13
lisp/www/templates/done.html Normal file
View File

@ -0,0 +1,13 @@
{% extends "layouts/default.html" %}
{% block title %}MMO Testing Game{% endblock %}
{% block content %}
<header>
<h1>MMO Testing Game</h1>
</header>
<main>
<p>
Signup was successful, you can log into the client now.
</p>
</main>
{% endblock %}

53
lisp/www/templates/index.html Normal file
View File

@ -0,0 +1,53 @@
{% extends "layouts/default.html" %}
{% block title %}MMO Testing Game{% endblock %}
{% block content %}
<header>
<h1>MMO Testing Game</h1>
</header>
<main>
<p>
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.
</p>
<form method="post" action="/signup">
<h5>Signup Form</h5>
<label for="username">Username: (max length 32 characters)</label><br />
<input
required
type="text"
id="username"
name="username"
maxlength="32"
value=""
/><br />
<label for="password"
>Password: (Must be between 8 and 24 characters and include 1
Lowercase Character, 1 Capital, 1 Number, and 1 Symbol)</label
><br />
<input
required
pattern="^(?=.*\d)(?=.*[a-z])(?=.*[A-Z])(?=.*[a-zA-Z]).{8,}$"
minlength="8"
maxlength="24"
type="password"
id="password"
name="password"
value=""
/><br />
<label for="appearance">Appearance:</label><br />
<input
required
type="color"
value="#000000"
id="appearance"
name="appearance"
/>
<br /><br />
<button type="submit">Submit</button>
</form>
</main>
{% endblock %}

11
lisp/www/templates/layouts/default.html Normal file
View File

@ -0,0 +1,11 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8">
<title>{% block title %}{% endblock %}</title>
<link rel="stylesheet" type="text/css" media="screen" href="/css/main.css">
</head>
<body>
{% block content %}{% endblock %}
</body>
</html>

BIN
lisp/www/test.db3 Normal file
View File

Binary file not shown.

7
lisp/www/test.sqbpro Normal file
View File

@ -0,0 +1,7 @@
<?xml version="1.0" encoding="UTF-8"?><sqlb_project><db path="/Users/chakr/mmo-project/lisp/www/test.db3" readonly="0" foreign_keys="1" case_sensitive_like="0" temp_store="0" wal_autocheckpoint="1000" synchronous="2"/><attached/><window><main_tabs open="structure browser pragmas query" current="1"/></window><tab_structure><column_width id="0" width="300"/><column_width id="1" width="0"/><column_width id="2" width="100"/><column_width id="3" width="1080"/><column_width id="4" width="0"/><expanded_item id="0" parent="1"/><expanded_item id="1" parent="1"/><expanded_item id="2" parent="1"/><expanded_item id="3" parent="1"/></tab_structure><tab_browse><current_table name="4,5:mainusers"/><default_encoding codec=""/><browse_table_settings><table schema="main" name="users" show_row_id="0" encoding="" plot_x_axis="" unlock_view_pk="_rowid_"><sort/><column_widths><column index="1" value="18"/><column index="2" value="59"/><column index="3" value="59"/><column index="4" value="74"/><column index="5" value="75"/><column index="6" value="76"/><column index="7" value="39"/><column index="8" value="39"/><column index="9" value="60"/><column index="10" value="48"/></column_widths><filter_values/><conditional_formats/><row_id_formats/><display_formats/><hidden_columns/><plot_y_axes/><global_filter/></table></browse_table_settings></tab_browse><tab_sql><sql name="SQL 1">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);
</sql><current_tab id="0"/></tab_sql></sqlb_project>

12
lisp/www/tests/www.lisp Normal file
View File

@ -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)

11
lisp/www/www-test.asd Normal file
View File

@ -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)))

30
lisp/www/www.asd Normal file
View File

@ -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"))))