Show More
@@ -3,13 +3,16 b' BIN = sugar-qsp' | |||
|
3 | 3 | |
|
4 | 4 | LISP = sbcl |
|
5 | 5 | |
|
6 |
all: |
|
|
6 | all: $(BIN) | |
|
7 | ||
|
8 | graphs: diagrams.png | |
|
7 | 9 | |
|
8 | 10 | $(BIN): src/*.lisp src/*.ps |
|
9 | 11 | buildapp.$(LISP) --asdf-path .\ |
|
10 | 12 | --asdf-tree .qlot/dists\ |
|
11 | 13 | --load-system sugar-qsp\ |
|
12 | 14 | --entry sugar-qsp:entry-point\ |
|
15 | --compress-core\ | |
|
13 | 16 | --output $(BIN) |
|
14 | 17 | |
|
15 | 18 | install-deps: |
@@ -18,8 +21,19 b' install-deps:' | |||
|
18 | 21 | update-deps: |
|
19 | 22 | sbcl --load update-deps.lisp |
|
20 | 23 | |
|
21 | diagrams.png: diagrams.dot | |
|
24 | %.png: %.dot | |
|
22 | 25 | dot $< -T png -o $@ |
|
23 | 26 | |
|
27 | dist: $(BIN) | |
|
28 | tar cfvJ sugar-qsp.tar.xz $(BIN) extras | |
|
29 | ||
|
30 | distclean: clean clean-deps | |
|
31 | ||
|
24 | 32 | clean: |
|
25 | rm sugar-qsp | |
|
33 | -rm sugar-qsp | |
|
34 | ||
|
35 | clean-deps: | |
|
36 | -rm qlfile.lock | |
|
37 | -rm -rf .qlot | |
|
38 | ||
|
39 | .PHONY: all graphs install-deps update-deps clean |
@@ -1,6 +1,6 b'' | |||
|
1 | 1 | |
|
2 | 2 | * Save-load game in slots |
|
3 | * CLI build for Linux | |
|
3 | ||
|
4 | 4 | * CLI build for Windows |
|
5 | 5 | |
|
6 | 6 | * Reporting error lines in the parser |
@@ -10,5 +10,6 b'' | |||
|
10 | 10 | |
|
11 | 11 | * Build Istreblenie |
|
12 | 12 | * Build Π¦Π²Π΅ΡΠΎΡ ΠΈΠΌΠΈΡ |
|
13 | ||
|
13 | 14 | * Windows GUI (for the compiler) |
|
14 | 15 | * Resizable frames |
@@ -6,10 +6,5 b' ql flute' | |||
|
6 | 6 | ql cl-ppcre |
|
7 | 7 | ql anaphora |
|
8 | 8 | ql named-readtables |
|
9 | ql cl-unicode | |
|
10 | ql flexi-streams | |
|
11 | ql trivial-gray-streams | |
|
12 | ql parse-number | |
|
13 | ql iterate | |
|
14 | 9 | ql assoc-utils |
|
15 | 10 | ql let-over-lambda |
@@ -1,68 +1,40 b'' | |||
|
1 | 1 | ("quicklisp" . |
|
2 | 2 | (:class qlot/source/dist:source-dist |
|
3 | 3 | :initargs (:distribution "http://beta.quicklisp.org/dist/quicklisp.txt" :%version :latest) |
|
4 |
:version "2020-0 |
|
|
4 | :version "2020-04-27")) | |
|
5 | 5 | ("alexandria" . |
|
6 | 6 | (:class qlot/source/ql:source-ql |
|
7 | 7 | :initargs (:%version :latest) |
|
8 |
:version "ql-2020-0 |
|
|
8 | :version "ql-2020-04-27")) | |
|
9 | 9 | ("esrap" . |
|
10 | 10 | (:class qlot/source/ql:source-ql |
|
11 | 11 | :initargs (:%version :latest) |
|
12 |
:version "ql-2020-0 |
|
|
12 | :version "ql-2020-04-27")) | |
|
13 | 13 | ("parenscript" . |
|
14 | 14 | (:class qlot/source/ql:source-ql |
|
15 | 15 | :initargs (:%version :latest) |
|
16 |
:version "ql-2020-0 |
|
|
17 | ("cl-uglify-js" . | |
|
18 | (:class qlot/source/ql:source-ql | |
|
19 | :initargs (:%version :latest) | |
|
20 | :version "ql-2020-02-18")) | |
|
16 | :version "ql-2020-04-27")) | |
|
21 | 17 | ("flute" . |
|
22 | 18 | (:class qlot/source/ql:source-ql |
|
23 | 19 | :initargs (:%version :latest) |
|
24 |
:version "ql-2020-0 |
|
|
20 | :version "ql-2020-04-27")) | |
|
25 | 21 | ("cl-ppcre" . |
|
26 | 22 | (:class qlot/source/ql:source-ql |
|
27 | 23 | :initargs (:%version :latest) |
|
28 |
:version "ql-2020-0 |
|
|
24 | :version "ql-2020-04-27")) | |
|
29 | 25 | ("anaphora" . |
|
30 | 26 | (:class qlot/source/ql:source-ql |
|
31 | 27 | :initargs (:%version :latest) |
|
32 |
:version "ql-2020-0 |
|
|
28 | :version "ql-2020-04-27")) | |
|
33 | 29 | ("named-readtables" . |
|
34 | 30 | (:class qlot/source/ql:source-ql |
|
35 | 31 | :initargs (:%version :latest) |
|
36 |
:version "ql-2020-0 |
|
|
37 | ("parse-js" . | |
|
38 | (:class qlot/source/ql:source-ql | |
|
39 | :initargs (:%version :latest) | |
|
40 | :version "ql-2020-02-18")) | |
|
41 | ("cl-unicode" . | |
|
42 | (:class qlot/source/ql:source-ql | |
|
43 | :initargs (:%version :latest) | |
|
44 | :version "ql-2020-02-18")) | |
|
45 | ("flexi-streams" . | |
|
46 | (:class qlot/source/ql:source-ql | |
|
47 | :initargs (:%version :latest) | |
|
48 | :version "ql-2020-02-18")) | |
|
49 | ("trivial-gray-streams" . | |
|
50 | (:class qlot/source/ql:source-ql | |
|
51 | :initargs (:%version :latest) | |
|
52 | :version "ql-2020-02-18")) | |
|
53 | ("parse-number" . | |
|
54 | (:class qlot/source/ql:source-ql | |
|
55 | :initargs (:%version :latest) | |
|
56 | :version "ql-2020-02-18")) | |
|
57 | ("iterate" . | |
|
58 | (:class qlot/source/ql:source-ql | |
|
59 | :initargs (:%version :latest) | |
|
60 | :version "ql-2020-02-18")) | |
|
32 | :version "ql-2020-04-27")) | |
|
61 | 33 | ("assoc-utils" . |
|
62 | 34 | (:class qlot/source/ql:source-ql |
|
63 | 35 | :initargs (:%version :latest) |
|
64 |
:version "ql-2020-0 |
|
|
36 | :version "ql-2020-04-27")) | |
|
65 | 37 | ("let-over-lambda" . |
|
66 | 38 | (:class qlot/source/ql:source-ql |
|
67 | 39 | :initargs (:%version :latest) |
|
68 |
:version "ql-2020-0 |
|
|
40 | :version "ql-2020-04-27")) |
@@ -386,8 +386,41 b'' | |||
|
386 | 386 | hex)))) |
|
387 | 387 | (+ "#" (rgb-to-hex red) (rgb-to-hex green) (rgb-to-hex blue))))) |
|
388 | 388 | |
|
389 | (defun store-obj (key obj) | |
|
390 | (store-str key (btoa (encode-u-r-i-component (chain *j-s-o-n (stringify obj))))) | |
|
391 | (void)) | |
|
392 | (defun store-str (key str) | |
|
393 | (chain local-storage (set-item (+ "qsp_" key) str)) | |
|
394 | (void)) | |
|
395 | ||
|
396 | (defun load-obj (key) | |
|
397 | (chain *j-s-o-n (parse (encode-u-r-i-component (atob (load-str key)))))) | |
|
398 | (defun load-str (key) | |
|
399 | (chain local-storage (get-item (+ "qsp_" key)))) | |
|
400 | ||
|
389 | 401 | ;;; Saves |
|
390 | 402 | |
|
403 | (defun slot-savegame (slot comment) | |
|
404 | (let ((saves (load-obj "saves"))) | |
|
405 | (setf (@ saves slot) comment) | |
|
406 | (store-obj saves)) | |
|
407 | (store-str slot (state-to-base64)) | |
|
408 | (void)) | |
|
409 | ||
|
410 | (defun slot-loadgame (slot) | |
|
411 | (base64-to-state (load-str slot)) | |
|
412 | (void)) | |
|
413 | ||
|
414 | (defun slot-deletegame (slot) | |
|
415 | (let ((saves (load-obj "saves"))) | |
|
416 | (setf (@ saves slot) undefined) | |
|
417 | (store-obj saves)) | |
|
418 | (store-str slot undefined) | |
|
419 | (void)) | |
|
420 | ||
|
421 | (defun slot-listgames () | |
|
422 | (load-obj "saves")) | |
|
423 | ||
|
391 | 424 | (defun opengame () |
|
392 | 425 | (let ((element (chain document (create-element :input)))) |
|
393 | 426 | (chain element (set-attribute :type :file)) |
@@ -35,6 +35,7 b'' | |||
|
35 | 35 | top left |
|
36 | 36 | background-image background-color |
|
37 | 37 | color inner-text font-size font-family font-name |
|
38 | local-storage set-item get-item | |
|
38 | 39 | ;; lib |
|
39 | 40 | *number parse-int |
|
40 | 41 | to-string to-upper-case concat |
@@ -2,7 +2,7 b'' | |||
|
2 | 2 | (in-package sugar-qsp.main) |
|
3 | 3 | |
|
4 | 4 | (defmacro+ps api-call (name &rest args) |
|
5 | `(,(intern (string-upcase name) "API") ,@args)) | |
|
5 | `(,(intern (string-upcase name) "SUGAR-QSP.API") ,@args)) | |
|
6 | 6 | |
|
7 | 7 | (defpsmacro has (key obj) |
|
8 | 8 | `(chain ,obj (has-own-property ,key))) |
@@ -1,13 +1,17 b'' | |||
|
1 | 1 | |
|
2 | 2 | (in-package sugar-qsp) |
|
3 | 3 | |
|
4 | (defvar *app-name* "") | |
|
5 | ||
|
4 | 6 | (defun entry-point-no-args () |
|
5 | 7 | (entry-point uiop:*command-line-arguments*)) |
|
6 | 8 | |
|
7 | 9 | (defun entry-point (args) |
|
8 | (catch :terminate | |
|
9 | (let ((compiler (apply #'make-instance 'compiler (parse-opts args)))) | |
|
10 | (write-compiled-file compiler))) | |
|
10 | (setf *app-name* (first args)) | |
|
11 | (let ((*package* (find-package :sugar-qsp))) | |
|
12 | (catch :terminate | |
|
13 | (let ((compiler (apply #'make-instance 'compiler (parse-opts (rest args))))) | |
|
14 | (write-compiled-file compiler)))) | |
|
11 | 15 | (values)) |
|
12 | 16 | |
|
13 | 17 | (defun parse-opts (args) |
@@ -23,13 +27,10 b'' | |||
|
23 | 27 | ("--beautify" (setf (getf data :beautify) t)) |
|
24 | 28 | (t (push arg (getf data mode))))) |
|
25 | 29 | (unless (< 0 (length (getf data :sources))) |
|
26 | (print-usage) | |
|
27 | 30 | (report-error "There should be at least one source")) |
|
28 | 31 | (unless (> 1 (length (getf data :target))) |
|
29 | (print-usage) | |
|
30 | 32 | (report-error "There should be no more than one target")) |
|
31 | 33 | (unless (> 1 (length (getf data :body))) |
|
32 | (print-usage) | |
|
33 | 34 | (report-error "There should be no more than one body")) |
|
34 | 35 | (unless (getf data :target) |
|
35 | 36 | (setf (getf data :target) |
@@ -47,14 +48,25 b'' | |||
|
47 | 48 | :beautify (getf data :beautify)))) |
|
48 | 49 | |
|
49 | 50 | (defun print-usage () |
|
50 | (format t "USAGE: ")) | |
|
51 | (format t "Usage: ~A <source> [options]~%" *app-name*) | |
|
52 | (format t "Options:~%") | |
|
53 | (format t " -o <filename> - Output filename~%") | |
|
54 | (format t " --js <filenames...> - List of extra .js files to include in the game~%") | |
|
55 | (format t " --css <filenames...> - List of .css files to include in the game. Default is in extras/default.css~%") | |
|
56 | (format t " --body <filename> - Alternative page body. Default is in extras/body.html~%") | |
|
57 | (format t "~%") | |
|
58 | (format t " -c - Just compile the game to a .js file without making it a full web page~%") | |
|
59 | (format t " --beautify - Make the JS content pretty. By default it gets minified.~%") | |
|
60 | (format t "~%") | |
|
61 | (format t "Note that the files in extras/ are not actually used. They're just there for the reference")) | |
|
51 | 62 | |
|
52 | 63 | (defun parse-file (filename) |
|
53 | 64 | (p:parse 'sugar-qsp-grammar |
|
54 | 65 | (alexandria:read-file-into-string filename))) |
|
55 | 66 | |
|
56 | 67 | (defun report-error (fmt &rest args) |
|
57 |
(apply #'format |
|
|
68 | (format t "ERROR: ~A~%" (apply #'format nil fmt args)) | |
|
69 | (print-usage) | |
|
58 | 70 | (throw :terminate nil)) |
|
59 | 71 | |
|
60 | 72 | ;;; JS |
@@ -133,10 +145,13 b'' | |||
|
133 | 145 | (alexandria:read-file-into-string js-file)) |
|
134 | 146 | js)) |
|
135 | 147 | ;; Include css files |
|
136 |
( |
|
|
137 | (push (format nil "////// Included file ~A~%~A" css-file | |
|
138 | (alexandria:read-file-into-string css-file)) | |
|
139 | css))))) | |
|
148 | (when css-files | |
|
149 | ;; User option overrides the default css | |
|
150 | (setf css nil) | |
|
151 | (dolist (css-file css-files) | |
|
152 | (push (format nil "////// Included file ~A~%~A" css-file | |
|
153 | (alexandria:read-file-into-string css-file)) | |
|
154 | css)))))) | |
|
140 | 155 | |
|
141 | 156 | (defmethod write-compiled-file ((compiler compiler)) |
|
142 | 157 | (alexandria:write-string-into-file |
@@ -35,7 +35,7 b'' | |||
|
35 | 35 | (not (find char " !:&=<>+-*/,'\"()[]{}")))) |
|
36 | 36 | |
|
37 | 37 | (defun intern-first (list) |
|
38 |
(list* (intern (string-upcase (first list)) |
|
|
38 | (list* (intern (string-upcase (first list)) "SUGAR-QSP.LIB") | |
|
39 | 39 | (rest list))) |
|
40 | 40 | |
|
41 | 41 | (eval-when (:compile-toplevel :load-toplevel :execute) |
@@ -129,7 +129,7 b'' | |||
|
129 | 129 | (digit-char-p character))) |
|
130 | 130 | (p:defrule identifier-raw (and id-first (* id-next)) |
|
131 | 131 | (:lambda (list) |
|
132 |
(intern (string-upcase (p:text list)) |
|
|
132 | (intern (string-upcase (p:text list)) "SUGAR-QSP.LIB"))) | |
|
133 | 133 | |
|
134 | 134 | (p:defrule identifier (not-qsp-keyword-p identifier-raw)) |
|
135 | 135 | |
@@ -431,7 +431,7 b'' | |||
|
431 | 431 | (unless (<= ,min-arity (length arguments) ,max-arity) |
|
432 | 432 | (error "Intrinsic ~A expects between ~A and ~A arguments but ~A were provided:~%~S" |
|
433 | 433 | name ,min-arity ,max-arity (length arguments) arguments)) |
|
434 |
(list* ',(intern (string sym) |
|
|
434 | (list* ',(intern (string sym) "SUGAR-QSP.LIB") arguments)))) | |
|
435 | 435 | |
|
436 | 436 | (defintrinsics (intrinsic returning-intrinsic non-returning-intrinsic) |
|
437 | 437 | ;; Transitions |
@@ -495,9 +495,9 b'' | |||
|
495 | 495 | (main-clear nil 0 0 "*clear" "*clr") |
|
496 | 496 | ;; Aux window |
|
497 | 497 | (showstat nil 1 1) |
|
498 |
(stat-pl |
|
|
499 |
(stat-nl |
|
|
500 |
(stat-p |
|
|
498 | (stat-pl nil 1 1 "pl") | |
|
499 | (stat-nl nil 0 1 "nl") | |
|
500 | (stat-p nil 1 1 "p") | |
|
501 | 501 | (stattxt t 0 0) |
|
502 | 502 | (stat-clear nil 0 0 "clear" "clr") |
|
503 | 503 | (cls nil 0 0) |
@@ -505,9 +505,9 b'' | |||
|
505 | 505 | (msg nil 1 1) |
|
506 | 506 | ;; Acts |
|
507 | 507 | (showacts nil 1 1) |
|
508 |
(delact nil |
|
|
509 | (curact t 0 0) | |
|
508 | (delact nil 1 1 "delact" "del act") | |
|
510 | 509 | (curacts t 0 0) |
|
510 | (selact t 0 0) | |
|
511 | 511 | (cla nil 0 0) |
|
512 | 512 | ;; Objects |
|
513 | 513 | (showobjs nil 1 1) |
@@ -516,6 +516,7 b'' | |||
|
516 | 516 | (killobj nil 0 1) |
|
517 | 517 | (countobj t 0 0) |
|
518 | 518 | (getobj t 1 1) |
|
519 | (selobj t 0 0) | |
|
519 | 520 | ;; Menu |
|
520 | 521 | (menu nil 1 1) |
|
521 | 522 | ;; Images |
General Comments 0
You need to be logged in to leave comments.
Login now