Commit 4c9701ef authored by Hugo Hörnquist's avatar Hugo Hörnquist

Add direct image output of maps to Emacs and Terminology.

parent 10e8d8bf
......@@ -63,6 +63,33 @@
(string-trim-right (bytevector->string bv transcoder)
(define (string->filename str)
(use-modules (ice-9 regex))
#f "[ ]" str
'pre "_" 'post))
;; Calls thunk with current working directory changed to dir
(define (call-with-cwd dir thunk)
(let ((old-dir #f))
(lambda ()
(set! old-dir (getcwd))
(chdir dir))
(lambda () (chdir old-dir)))))
;; Attempts to display the given image file through w3m's terminal image magick;
;; currently always places it in the top left corner.
(define (w3m-display-image filename)
(let ((pipe ((@ (ice-9 popen) open-output-pipe) "/usr/lib/w3m/w3mimgdisplay")))
(format pipe "0;1;0;0;64;64;;;;;~a~%;4;~%3;~%"
((@ (ice-9 popen) close-pipe) pipe)))
;; Constants
......@@ -109,6 +136,22 @@
(height get-height)
(name get-name))
;; My scheme level object above wolf map data
(define-record-type <wolf-map>
(make-wolf-map metadata data file)
(metadata get-metadata)
(data get-data)
(file get-file set-file!))
;; Emacs actually renders the #<Image: ...> tag!
(lambda (r p)
(if (get-file r)
(format p "#<Image: ~a>" (get-file r))
(format p "#<Wolf Map: ~a>" (-> r get-metadata get-name)))))
;; Pure procedures
......@@ -250,10 +293,13 @@ else insert the value as given"
(lambda (el) (put-bytevector port (mapper el)))
(define (dump-tilemap map-head tilemap)
(let ((fname (format #f "~a.ppm" (get-name map-head))))
(define (dump-tilemap! wolf-map)
(let ((fname (format #f "~a/~a.ppm"
(string->filename (get-name (get-metadata wolf-map))))))
(call-with-output-file fname
(lambda (port) (array->ppm port tilemap
(lambda (port) (array->ppm port (get-data wolf-map)
(lambda (tile) ; WL_GAME.C, 624
(cond ((= tile 0) rgb:black) ; floor
((<= 90 tile 101) rgb:brown) ; door
......@@ -261,34 +307,42 @@ else insert the value as given"
(else rgb:red))
#:binary #t)
(format #t "Wrote map to ~a~%" fname)))
(set-file! wolf-map fname)))
(define (main args)
(define og-dir (getcwd))
(chdir "/home/hugo/wolf/full/")
(let* ((maphead (call-with-input-file "MAPHEAD.WL6"
parse-maphead #:binary #t))
(mapmeta (call-with-input-file "GAMEMAPS.WL6"
(lambda (port) (parse-map-metadata maphead port)) #:binary #t)))
(when (or (= 1 (length args))
(member (cadr args) '("--help" "-h" "-?" "--list" "-l")))
(format #t "Available maps:~%")
(for-each (lambda (i m) (format #t "~2,a : ~a~%" i (get-name m)))
(iota (length mapmeta))
(let* ((maph (list-ref mapmeta (string->number (cadr args))))
(data (call-with-input-file "GAMEMAPS.WL6"
(lambda (port) (parse-map-data maph port))
#:binary #t)))
(chdir og-dir)
(let ((tilemap (-> data car tile-list->tilemap)))
(display-tilemap tilemap)
(dump-tilemap maph tilemap)))))
(define get-map
(lambda ()
(define map-file (open-input-file "GAMEMAPS.WL6" #:binary #t))
(let* ((maphead (call-with-input-file "MAPHEAD.WL6"
parse-maphead #:binary #t))
(mapmeta (parse-map-metadata maphead map-file)))
;; function bound to get-map
(lambda (idx)
(if (eq? idx 'list)
(zip (iota (length mapmeta))
(map get-name mapmeta))
(let ((maph (list-ref mapmeta idx)))
(make-wolf-map maph
(-> maph
(parse-map-data map-file)
car tile-list->tilemap)
(define (main args)
(when (or (= 1 (length args))
(member (cadr args) '("--help" "-h" "-?" "--list" "-l")))
(format #t "Available maps:~%~:{~2,a: ~a~%~}"
(get-map 'list))
(let ((wolf-map (get-map (string->number (cadr args)))))
(dump-tilemap! wolf-map)
(format #t "Wrote image to ~a~%" (get-file wolf-map))
(if (getenv "TERMINOLOGY")
(system* "tycat" (get-file wolf-map))
(w3m-display-image (get-file wolf-map)))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment