1 ;;; pico8.el --- major mode for editing PICO-8 cartridges
3 ;; Author: Joe Wreschnig <joe.wreschnig@gmail.com>
4 ;; Package-Version: 20170620
5 ;; Package-Requires: ((emacs "25") (polymode "20170307") (lua-mode "20151025") (dash "2.12.0"))
6 ;; URL: https://git.korewanetadesu.com/pico8.git
7 ;; Keywords: convenience
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 3 of the License, or (at
12 ;; your option) any later version.
16 ;; This mode (ab)uses polymode to fit six modes into one buffer, one of
17 ;; which is "real Lua" text and the other five of which have diverse
18 ;; strict formatting requirements.
20 ;; It provides keybindings and commands for inter-mode actions.
32 "Support for PICO-8 (.p8) cartridge files."
36 (defcustom pico8-executable-paths
37 '("/Applications/PICO-8.app/Contents/MacOS/pico8" ; macOS
38 "/usr/lib/pico8/pico8" ; PocketCHIP
39 "pico8") ; Normal systems
40 "The locations to search for the PICO-8 executable."
42 :tag "PICO-8 Executable Paths"
43 :type '(repeat string))
45 (defcustom pico8-preserve-output-on-exit nil
46 "Whether to keep the output buffer when PICO-8 exits.
48 PICO-8 processes are long-lived with little surprising output, so
49 their output buffers are killed by default when they exit.
50 However, this is not usual behavior in Emacs, and can be disabled
51 by setting this to t."
53 :tag "Preserve PICO-8 Output On Exit"
56 (defcustom pico8-lua-indent-level 1
57 "Default indentation for PICO-8 Lua mode.
59 This overrides ‘lua-indent-level’ in ‘pico8-lua-mode’.
60 ‘lua-mode’ uses a default indentation is 3, which is both
61 idiosyncratic and quite large when viewed in the PICO-8 editor,
62 where the convention is 1."
64 :tag "PICO-8 Lua Indent Level")
66 (defconst pico8-colors
67 (mapcar #'symbol-value
68 (list (defconst pico8-color-0 "#000000")
69 (defconst pico8-color-1 "#1D2B53")
70 (defconst pico8-color-2 "#7E2553")
71 (defconst pico8-color-3 "#008751")
72 (defconst pico8-color-4 "#AB5236")
73 (defconst pico8-color-5 "#5F574F")
74 (defconst pico8-color-6 "#C2C3C7")
75 (defconst pico8-color-7 "#FFF1E8")
76 (defconst pico8-color-8 "#FF004D")
77 (defconst pico8-color-9 "#FFA300")
78 (defconst pico8-color-a "#FFEC27")
79 (defconst pico8-color-b "#00E436")
80 (defconst pico8-color-c "#29ADFF")
81 (defconst pico8-color-d "#83769C")
82 (defconst pico8-color-e "#FF77A8")
83 (defconst pico8-color-f "#FFCCAA"))))
85 (defconst pico8-data-characters
86 (append "0123456789abcdef" nil))
89 '((t (:inherit fixed-pitch)))
90 "Face for PICO-8 binary data.")
92 (define-derived-mode pico8-data-mode fundamental-mode
94 "Major mode for non-text PICO-8 cartridge sections.
96 This is an 'abstract' mode and should not be used
97 as an actual major mode, only to derive new modes.")
99 (defun pico8-data-self-insert-command (n)
100 "Insert the data character you type N times.
102 PICO-8 cartridges represent binary data using fixed-length
103 strings of 0-f, one character per nybble. This command will only
104 insert the typed character if it is one of these characters,
105 overwriting one of these characters."
107 (when (memq (char-after) pico8-data-characters)
108 (let ((overwrite-mode 'overwrite-mode-textual))
109 (self-insert-command (prefix-numeric-value n)))))
111 (let ((map pico8-data-mode-map))
112 (suppress-keymap map)
113 (dolist (c (mapcar #'char-to-string pico8-data-characters))
114 (define-key map c 'pico8-data-self-insert-command)))
116 (defun pico8-goto-char (position)
117 "Set point to POSITION, a number.
119 The position is global to the cartridge, and the buffer is
120 widened if necessary to reach it."
121 (unless (<= (point-min) position (point-max))
123 (goto-char position))
125 (defun pico8-executable ()
126 "Look up the PICO-8 executable."
127 (or (car (delete nil (mapcar 'executable-find pico8-executable-paths)))
128 (error "The PICO-8 executable could not be found.
129 Make sure it is installed, and present in ‘pico8-executable-paths’")))
131 (defun pico8--create-output-buffer ()
132 "Create and return a buffer for PICO-8 output."
133 (let* ((output-name (generate-new-buffer-name "*PICO-8*"))
134 (output (get-buffer-create output-name)))
135 (display-buffer output)
136 (with-current-buffer output
137 (insert "(Use C-r within PICO-8 to reload changes from Emacs.)\n")
138 ;; Setting the point in the buffer doesn't have a lasting
139 ;; effect, we need to change it in the window it opened in.
140 ;; https://emacs.stackexchange.com/questions/21464/
141 (set-window-point (get-buffer-window output) (point-max))
145 (defun pico8--process-sentinel (process signal)
146 "Delete buffers and windows for PROCESS if SIGNAL is exit."
147 (when (and (not pico8-preserve-output-on-exit)
148 (process-buffer process)
149 (memq (process-status process) '(exit signal)))
150 (let ((buffer (process-buffer process)))
151 (dolist (window (get-buffer-window-list buffer))
152 (quit-restore-window window))
153 (kill-buffer buffer))))
155 (defun pico8--execute (&rest params)
156 "Run PICO-8 with the provided PARAMS after saving etc."
157 (let ((pico8 (pico8-executable))
158 (cartridge-file-name (buffer-file-name (buffer-base-buffer))))
159 (when (and (buffer-modified-p)
160 (y-or-n-p (format "Save %s? " cartridge-file-name)))
162 (let* ((output (pico8--create-output-buffer))
163 (process-args (append params (list cartridge-file-name)))
164 (process (apply #'start-file-process "PICO-8" output pico8
166 (set-process-sentinel process 'pico8--process-sentinel))))
168 (defun pico8-run-cartridge ()
169 "Run the current PICO-8 cartridge."
171 (pico8--execute "-run"))
173 (defun pico8-load-cartridge ()
174 "Load the current cartridge in PICO-8."
179 (defun pico8-cartridge-section-header (name)
180 "Return the header string for cartridge section NAME."
181 (format "__%s__" name))
183 (defconst pico8-cartridge-sections
184 '("lua" "gfx" "gff" "map" "sfx" "music"))
186 (defconst pico8-cartridge-keywords
187 (mapcar #'pico8-cartridge-section-header pico8-cartridge-sections))
189 (defconst pico8-cartridge-header
190 "pico-8 cartridge // http://www.pico-8.com\nversion [0-9]+")
192 (define-derived-mode pico8-cartridge-mode fundamental-mode
194 "Major mode for showing PICO-8 cartridge structure."
195 (font-lock-add-keywords
196 nil (list (regexp-opt pico8-cartridge-keywords 'symbols)
197 (cons pico8-cartridge-header font-lock-comment-face)))
198 (suppress-keymap pico8-cartridge-mode-map))
200 (defun pico8-cartridge-point-of-section (name)
201 "Find the point where the data for section NAME begins."
205 (goto-char (point-min))
206 (let ((token (format "^%s\n" (pico8-cartridge-section-header name))))
207 (if (not (or (re-search-forward token nil t)
208 (re-search-forward token nil t)))
209 (error "Unable to find a %s section in current buffer" name)))
212 (defun pico8-cartridge-goto-section (name)
213 "Go to the beginning of section NAME."
214 (interactive "sGoto PICO-8 cartridge section: ")
215 (pico8-goto-char (pico8-cartridge-point-of-section name)))
217 (defmacro pico8-cartridge-with-section (section &rest body)
218 "Go to and narrow SECTION and evaluate BODY there."
221 (pico8-cartridge-goto-section ,section)
225 (defconst pico8-lua-builtins
227 '("abs" "add" "all" "atan2" "btn" "btnp" "camera"
228 "cartdata" "circ" "circfill" "clip" "cls" "cocreate"
229 "coresume" "costatus" "color" "cos" "cstore" "cursor"
230 "del" "dget" "dset" "fget" "flip" "flr" "folder" "foreach"
231 "fset" "info" "line" "load" "ls" "map" "max" "memcpy"
232 "memset" "menuitem" "mget" "mid" "min" "mset" "music"
233 "pairs" "pal" "palt" "peek" "pget" "poke" "print"
234 "printh" "pset" "reboot" "rect" "rectfill" "reload"
235 "resume" "rnd" "run" "save" "sfx" "sget" "sin" "spr"
236 "sqrt" "srand" "sset" "sspr" "stat") 'symbols))
238 (define-derived-mode pico8-lua-mode lua-mode
240 "Major mode for editing Lua code in PICO-8 cartridges."
241 (font-lock-add-keywords
242 nil `((,pico8-lua-builtins . font-lock-builtin-face)))
243 (set (make-local-variable 'lua-indent-level) pico8-lua-indent-level))
246 (defun pico8-gff-current-position ()
247 "Calculate the flag position of the cursor."
248 (pm-with-narrowed-to-span (pm-get-innermost-span)
249 (let ((row (1- (line-number-at-pos)))
250 (col (min 255 (current-column))))
251 (+ (/ col 2) (* row 128)))))
253 (defun pico8-gff-lighter ()
254 "Calculate the flag under the cursor."
255 (pm-with-narrowed-to-span (pm-get-innermost-span)
256 (let ((row (1- (line-number-at-pos)))
257 (col (current-column)))
258 (+ (* 128 row) (/ col 2)))))
260 (defun pico8-gff-eldoc ()
261 "Show information about the flag under the point."
263 (when (cl-oddp (current-column))
265 (when (looking-at "..")
266 (let* ((hex (substring-no-properties (match-string 0)))
267 (int (string-to-number hex 16)))
268 (format "%08d %3d %02x"
269 (let ((calc-number-radix 2))
270 (string-to-number (math-format-radix int)))
273 (defconst pico8-gff-font-lock-keywords
276 ;; TODO: Lots of work to do here…
277 (let ((pdl (or (car (overlays-at (match-beginning 0)))
278 (make-overlay (match-beginning 0) (match-end 0)))))
279 (overlay-put pdl 'after-string " "))))))
282 (define-derived-mode pico8-gff-mode pico8-data-mode
283 '(:eval (format "Flag[%d]" (pico8-gff-lighter)))
284 "Major mode for editing flags in PICO-8 cartridges."
285 (font-lock-add-keywords nil pico8-gff-font-lock-keywords)
286 (setq-local eldoc-documentation-function #'pico8-gff-eldoc))
288 (defun pico8-gff-offset-of-flag (flag)
289 "Calculate the offset of of flag number FLAG."
290 (unless (<= 0 flag 255)
291 (error "Valid flag numbers are 0 to 255, inclusive"))
292 (+ (* 2 flag) (if (> flag 128) 1 0)))
296 '((t (:inherit pico8-data :height 100)))
297 "Face for PICO-8 sprite “pixels.”"
300 (defconst pico8-gfx-font-lock-keywords
302 ;; If the \n isn't in the smaller face the line is taller to
303 ;; accommodate the full sized point at the end-of-line.
304 '("\n" . 'pico8-pixel)
308 0 '(face (:inherit pico8-pixel :foreground ,c))))
312 (defun pico8-gfx-current-position ()
313 "Calculate the sprite and in-sprite position of the cursor."
314 ;; FIXME: Ensure the span we got was actually the gfx one.
315 (pm-with-narrowed-to-span (pm-get-innermost-span)
316 (let ((row (1- (line-number-at-pos)))
317 (col (min 127 (current-column))))
318 (list (+ (* 16 (/ row 8)) (/ col 8))
319 (% col 8) (% row 8)))))
321 (defun pico8-forward-sprite (n)
322 "Move the point N sprites forward (backward if N is negative)."
324 (let* ((n (prefix-numeric-value n))
325 (current (pico8-gfx-current-position))
326 (offset (pico8-gfx-offset-of-sprite
327 (% (+ 256 n (nth 0 current)) 256)
330 (pm-with-narrowed-to-span (pm-get-innermost-span)
331 (goto-char (+ (point-min) offset)))))
333 (defun pico8-backward-sprite (n)
334 "Move the point N sprites backward (forward if N is negative)."
336 (pico8-forward-sprite (- (prefix-numeric-value n))))
338 (defun pico8-gfx-lighter ()
339 "Show a short description of the current sprite position."
340 (let ((current (pico8-gfx-current-position)))
341 (if current (apply #'format (cons "Sprite[%d:%d,%d]" current))
344 (define-derived-mode pico8-gfx-mode pico8-data-mode
345 '(:eval (pico8-gfx-lighter))
346 "Major mode for editing sprites in PICO-8 cartridges."
347 (font-lock-add-keywords nil pico8-gfx-font-lock-keywords)
350 (defun pico8-gfx-offset-of-sprite (sprite &optional x y)
351 "Calculate the point of SPRITE's X,Y pixel (0,0 by default)."
354 (line (* (/ sprite 16) 8))
355 (row (* (% sprite 16) 8)))
356 ;; A limit of 4x4 is kind of arbitrary but if you're using sprites
357 ;; larger than that you probably aren't going to be doing so in a
358 ;; way that this command is useful anyway.
359 (unless (and (<= 0 x 31) (<= 0 y 31))
360 (error "Valid sprite offsets are 0 to 31, inclusive"))
361 (unless (<= 0 sprite 255)
362 (error "Valid sprite numbers are 0 to 255, inclusive"))
363 (+ (* 129 (+ y line)) row x)))
365 (define-key pico8-gfx-mode-map "q" 'pico8-backward-sprite)
366 (define-key pico8-gfx-mode-map "w" 'pico8-forward-sprite)
368 (defface pico8-map-tile
369 '((t (:inherit pico8-data :height 100)))
370 "Face for PICO-8 map 'tiles'."
373 (defconst pico8-map-font-lock-keywords
374 '(("[0-9a-f]+" . 'pico8-map-tile)
375 ("\n" . 'pico8-map-tile)))
377 (defun pico8-map-lighter ()
378 "Calculate the map tile under the cursor."
379 (pm-with-narrowed-to-span (pm-get-innermost-span)
380 (let ((row (- (line-number-at-pos) 1))
381 (col (current-column)))
382 ;; TODO: Show sprite number and flags value
383 (format "%d,%d" (/ col 2) row))))
385 (define-derived-mode pico8-map-mode pico8-data-mode
386 '(:eval (format "Map[%s]" (pico8-map-lighter)))
387 "Major mode for editing map data in PICO-8 cartridges."
388 (setq font-lock-defaults '(pico8-map-font-lock-keywords)))
390 (defun pico8-sfx-lighter ()
391 "Calculate the sound effect under the cursor."
392 (pm-with-narrowed-to-span (pm-get-innermost-span)
393 (let ((row (- (line-number-at-pos) 1)))
396 (define-derived-mode pico8-sfx-mode pico8-data-mode
397 '(:eval (format "Sound[%s]" (pico8-sfx-lighter)))
398 "Major mode for editing sound data in PICO-8 cartridges.")
400 (defun pico8-music-lighter ()
401 "Calculate the map tile under the cursor."
402 (pm-with-narrowed-to-span (pm-get-innermost-span)
403 (let ((row (- (line-number-at-pos) 1)))
406 (define-derived-mode pico8-music-mode pico8-data-mode
407 '(:eval (format "Pattern[%s]" (pico8-music-lighter)))
408 "Major mode for editing music data in PICO-8 cartridges.")
410 (defun pico8-goto-sprite (sprite &optional x y)
411 "Set point to the top-left pixel of SPRITE (or the X,Y pixel)."
412 (interactive "nGo to sprite [0-255]: ")
413 (let ((base (pico8-cartridge-point-of-section "gfx"))
414 (offset (pico8-gfx-offset-of-sprite sprite x y)))
415 (pico8-goto-char (+ base offset))))
417 (defun pico8-goto-flag (flag)
418 "Set point to the start of flag number FLAG."
419 (interactive "nGo to flag [0-255]: ")
420 (let ((base (pico8-cartridge-point-of-section "gff"))
421 (offset (pico8-gff-offset-of-flag flag)))
422 (pico8-goto-char (+ base offset))))
424 (defun pico8--string-to-number (string)
425 "Convert STRING to a number, guessing the base.
427 Returns nil, not 0, if the string was not converted."
428 (cond ((string-match-p "^0[xX][0-9a-fA-F]+$" string)
429 (string-to-number (substring string 2) 16))
430 ((string-match-p "^0[0-9]+$" string)
431 (string-to-number (substring string 1) 8))
432 ((string-match-p "^[0-9]+$" string)
433 (string-to-number string 10))
436 (defun pico8-sprite-relevant-to-point ()
437 "Get the sprite number relevant to the point.
439 When editing a flag, this is the flag number. When editing a
440 map, this is the value at the map. When editing Lua code, this
441 is the numeric literal in the code."
443 ((derived-mode-p 'pico8-gff-mode) (pico8-gff-current-position))
445 ;; The sprite for a map is the data at the map location, which is
446 ;; to say, the hexadecimal interpretation of the two character
447 ;; string beginning at the previous even column.
448 ((derived-mode-p 'pico8-map-mode)
449 (let ((beg (- (point) (% (min 255 (current-column)) 2))))
450 (string-to-number (buffer-substring beg (+ beg 2)) 16)))
452 ;; In Lua, the sprite is a numeric literal.
453 ((derived-mode-p 'lua-mode)
454 (pico8--string-to-number (or (word-at-point) "")))
459 (defun pico8-goto-sprite-relevant-to-point ()
460 "Go to the sprite number relevant to the text at the point.
462 When editing a flag, this is the flag number. When editing a
463 map, this is the value at the map. When editing Lua code, this
464 is the numeric literal in the code."
466 (let ((sprite (pico8-sprite-relevant-to-point)))
467 (if sprite (pico8-goto-sprite sprite)
468 (error "No sprite number was found at the point"))))
471 (defun pico8-goto-thing-relevant-to-point ()
472 "Go to the thing relevant to the text at the point.
474 When editing a flag or map, this is the corresponding sprite.
475 When editing a sprite, this is the corresponding flag. When
476 editing Lua code, how lucky are you feeling?
478 This function needs a lot of work.."
480 (cond ((derived-mode-p 'pico8-gfx-mode)
481 (pico8-goto-flag (car (pico8-gfx-current-position))))
483 ((or (derived-mode-p 'pico8-gff-mode)
484 (derived-mode-p 'pico8-map-mode))
485 (pico8-goto-sprite-relevant-to-point))
487 ((derived-mode-p 'lua-mode)
488 (let ((n (or (pico8--string-to-number (word-at-point)) 0))
490 (and (re-search-backward "\\<f[gs]et\\|s?spr\\>"
493 (cond ((= c ?f) (pico8-goto-flag n))
494 ((= c ?s) (pico8-goto-sprite n))
495 (t (error "There's nothing obvious to go to")))))
497 (t (error "There's no obvious thing to go to"))))
500 ;; Flycheck Integration
502 ;; This is more or less the same as the default Lua checkers, but we
503 ;; need to write out a temporary file so it doesn't check the non-Lua
504 ;; parts of the file.
506 (defun pico8--lua-only (f &rest args)
507 "If this is a PICO-8 buffer, run F(ARGS) on only the current section."
508 (if (derived-mode-p 'pico8-lua-mode)
509 (pico8-cartridge-with-section "lua"
510 (let ((mainbuf (current-buffer))
514 (insert "\n\n\n") ;; match line number with stripped header
515 (insert-buffer-substring mainbuf from to)
516 (insert " -- start __gfx__") ;; otherwise last line is ignored
520 (defconst pico8--lua-luacheckrc
523 (file-name-directory (or load-file-name buffer-file-name))))
528 (with-eval-after-load 'flycheck
529 (advice-add 'flycheck-save-buffer-to-file :around #'pico8--lua-only)
531 (flycheck-define-checker pico8-lua
532 "A PICO-8 Lua syntax checker using the Lua compiler.
533 See URL ‘http://www.lua.org/'."
534 :command ("luac" "-p" source)
538 ;; Skip the name of the luac executable.
539 (minimal-match (zero-or-more not-newline))
540 ":" line ": " (message) line-end))
541 :modes pico8-lua-mode)
543 (flycheck-define-checker pico8-luacheck
544 "A PICO-8 Lua syntax checker using luacheck.
545 See URL ‘https://github.com/mpeterv/luacheck’."
547 "--formatter" "plain"
548 "--codes" ; Show warning codes
550 (option "--config" pico8--lua-luacheckrc)
551 "--filename" source-original
555 (optional (file-name))
557 ": (" (id "W" (one-or-more digit)) ") "
560 (optional (file-name))
561 ":" line ":" column ":"
562 ;; ‘luacheck’ before 0.11.0 did not output codes for errors, hence
563 ;; the ID is optional here
564 (optional " (" (id "E" (one-or-more digit)) ") ")
566 :modes pico8-lua-mode)
568 (add-to-list 'flycheck-checkers 'pico8-lua)
569 (add-to-list 'flycheck-checkers 'pico8-luacheck))
573 ;; Finally - pico8-mode!
575 (defmacro pico8--defchunkmode (name)
576 "Define a PICO-8 polymode chunk for section NAME."
577 `(defconst ,(intern (concat "pico8--pm-inner-" name))
578 (pm-hbtchunkmode :mode ',(intern (format "pico8-%s-mode" name))
580 :head-reg ,(format "^__%s__\n" name)
581 :tail-reg "^__[a-z]\\{3,5\\}__\n\\|^\n\\'")))
583 (defconst pico8--pm-poly
586 (defconst pico8--pm-host
587 (pm-bchunkmode :mode 'pico8-cartridge-mode))
589 (pico8--defchunkmode "lua")
590 (pico8--defchunkmode "gfx")
591 (pico8--defchunkmode "gff")
592 (pico8--defchunkmode "map")
593 (pico8--defchunkmode "sfx")
594 (pico8--defchunkmode "music"))))
596 (define-polymode pico8-mode pico8--pm-poly
598 :keymap '(("\C-c\C-r" . pico8-run-cartridge)
599 ("\C-c\C-e" . pico8-load-cartridge)
600 ("\M-gs" . pico8-goto-sprite)
601 ("\M-gS" . pico8-goto-sprite-relevant-to-point)
602 ("\M-gf" . pico8-goto-flag)
603 ("\M-g." . pico8-goto-thing-relevant-to-point))
604 (toggle-truncate-lines 1))
606 (add-to-list 'auto-mode-alist '("\\.p8$" . pico8-mode))
607 (add-to-list 'magic-mode-alist '("pico-8 cartridge" . pico8-mode))
611 ;;; pico8.el ends here
614 ;; sentence-end-double-space: t