Interlisp.org
Loading Bitmaps / Images from host to Medley? #2329
|
I was just about to write a PBM (P1 or P4 loader) today and then recalled that there was mention of some existing image loaders (or had been) to go from host to Medley. I thought I'd ask here so hopefully people can see answers should they search for bitmaps images etc. I suppose I'll ask a few questions since I have them.
|
Replies: 8 comments 15 replies
|
@phantomics wrote some tools for importing and exporting PBM images into and out of Medley but as far as I know the code is not public. There is a useful discussion here on the file format used by the Interlisp functions |
You're mostly correct:
The 4 by 4 pattern is represented as a small integer. Bitmaps are stored internally as a sequence of 16-bit words, with a header that Image Streams are regular (output) streams which also have associated with them a You might look at the READAIS and AISBLT packages in lispusers. Array of Intensity Samples was a format |
|
Thanks for the pointers, I'll take a peek! It's not a show stopper though. ;) |
|
@nbriggs I yanked mine after seeing a bug or three to quickly fix in the P1. Anyway this is the P1 loader (I misstated earlier as a P4). EDIT (for a few typos and mislabels) 
|
|
Here is the code. Remember it only provides and associative list of attributes and the bits for a binary image via a BIT array at the end... ;;;; PBMP1READ.LISP
;;;; Ryan Burnside 2025
;;;; code is provide as-is
(defparameter *whitespace-bag* (list #\Space #\Newline #\Backspace #\Tab
#\Linefeed #\Page #\Return #\Rubout))
(defun bisect (object seq)
"Splits an sequence once upon the first encounter of object, dropping object."
(let ((n (position object seq)))
(when n
(list (subseq seq 0 n)
(subseq seq (1+ n))))))
(defun whitespace-trim (string)
"Remove Space, Newline, Backspace, Tab, Linefeed, Page, Return, Rubout"
(string-trim *whitespace-bag* string))
(defun read-header (stream)
"Read the header, upcase it or return nil if invalid."
(let ((header (string-upcase (whitespace-trim (read-line stream)))))
(when (string= header "P1")
header)))
(defun read-comments-and-size (stream)
"Returns a list of (comment ... comment-n (width height)) nil if invalid."
(loop with comments = nil
with sizes = nil
;; Collect comments with #
for l = (whitespace-trim (read-line stream))
do (if (char= (char l 0) #\#)
(push l comments)
(progn
(setf sizes (mapcar #'parse-integer (bisect #\Space l)))
(if (and (every #'integerp sizes) (= 2 (length sizes)))
(return (list (reverse comments) sizes))
(return nil))))))
(defun read-body (stream num-pixels)
"Hooo boy, this is going to be slow trash... *ahem* returns bit array or empty array if 0 size."
(loop with buffer = (make-array num-pixels :element-type 'bit
:initial-element 0)
with cur-elt = 0
for ch = (read-char stream nil nil)
while ch
do (case ch
((#\0) (incf cur-elt))
((#\1) (setf (aref buffer cur-elt) 1)
(incf cur-elt)))
finally (return buffer)))
;;; Driver
(defun read-pbm-p1 (file)
"Returns a list containing (comments width height num-pixels and bit array for pixels."
(with-open-file (s file)
(let* ((header (read-header s))
(coms-and-size (read-comments-and-size s))
(comments (first coms-and-size))
(width (first (second coms-and-size)))
(height (second (second coms-and-size)))
(pixel-count (* width height))
(body-bit-array (read-body s pixel-count)))
(unless (and header width height)
(error "Problem with file found"))
(print (* width height))
(return-from read-pbm-p1 `((comments ,comments)
(width . ,width)
(height . ,height)
(pixel-count . ,pixel-count)
(body-bit-array . ,body-bit-array)))))) |
|
No, I sent mine to only you in e-mail to avoid posting a spoiler if you saw it through the webpage. |
|
Ah, ok. I thought the email notification was pointing to this thread. I'll finish mine and try yours. |
|
Testing load speed on an 800x800 PBM "P4" bitmap on an old slow MacBook Air (1.4 GHz Dual-Core Intel Core i5): |
|
I realised that I had the P1 version implemented. |
|
If you want -- it's in your e-mail, I can post it here too. It works for files that don't have extra whitespace (but it's OK with/without comments). Should be an easy fix for the whitespace. |
|
Feel free, you've earned it. :) |
|
Guess I have the code :D (LAMBDA (FILE)
(* ; "Edited 28-Oct-2025 16:38 by briggs")
(CL:WITH-OPEN-FILE (S FILE :DIRECTION :INPUT)
(SELECTQ (RATOM S READ-LINE-RDTBL)
(P4 (LET (LINE WIDTH HEIGHT)
(READC S READ-LINE-RDTBL)
(* ; "eat the eol")
(while (EQ 35 (CHCON1 (SETQ LINE (RSTRING S READ-LINE-RDTBL))))
do
(READC S READ-LINE-RDTBL)
(* ; " eat the eol")
(SETQ LINE (RSTRING S READ-LINE-RDTBL)))
(SETQ WIDTH (RATOM S))
(SETQ HEIGHT (RATOM S))
(SETQ BM (BITMAPCREATE WIDTH HEIGHT))
(to HEIGHT bind (RBASE ← (fetch (BITMAP BITMAPBASE)
of BM))
(RWIDTH ← (fetch (BITMAP BITMAPRASTERWIDTH)
of BM))
(BYTEWIDTH ← (SUB1 (IQUOTIENT (IPLUS WIDTH 7)
8)))
do
(for OFFSET from 0 to BYTEWIDTH do (\PUTBASEBYTE RBASE OFFSET
(BIN S)))
(SETQ RBASE (\ADDBASE RBASE RWIDTH)))
BM))
(HELP "Not a PBM format we can read")))) |
|
I fixed it a little - |
|
We had some discussion about pasting code directly into SEdit today. |
|
It works correctly if you shift-select within SEdit (or between two SEdits), but the text it sends to a foreign destination is the Interlisp form where the |
|
Working on my P1 loader but it turned into an Australian P1 loader. 
|
|
Here is the P1 loader. Some polish to do yet but now we have P1 and P4 (via @nbriggs ) support. ;;;; PBMP1READ.LISP
;;;; Ryan Burnside 2025
;;;; code is provided as-is
(defparameter *whitespace-bag* (list #\Space #\Newline #\Backspace #\Tab
#\Linefeed #\Page #\Return #\Rubout))
(defun bisect (object seq)
"Splits an sequence once upon the first encounter of object, dropping object."
(let ((n (position object seq)))
(when n
(list (subseq seq 0 n)
(subseq seq (1+ n))))))
(defun whitespace-trim (string)
"Remove Space, Newline, Backspace, Tab, Linefeed, Page, Return, Rubout"
(string-trim *whitespace-bag* string))
(defun read-header (stream)
"Read the header, upcase it or return nil if invalid."
(let ((header (string-upcase (whitespace-trim (read-line stream)))))
(when (string= header "P1")
header)))
(defun read-comments-and-size (stream)
"Returns a list of ((comment ... comment-n) (width height)) nil if invalid."
(loop with comments = nil
with sizes = nil
;; Collect comments with #
for l = (whitespace-trim (read-line stream))
do (if (char= (char l 0) #\#)
(push l comments)
(progn
(setf sizes (mapcar #'parse-integer (bisect #\Space l)))
(if (and (every #'integerp sizes) (= 2 (length sizes)))
(return (list (reverse comments) sizes))
(return nil))))))
(defun build-bitmap (stream width height)
"Return a binary bitmap given PBM characters in stream"
(let ((BM (IL:BITMAPCREATE width height)))
(loop with x = 0
with y = (1- height)
for ch = (read-char stream nil nil)
while ch
do (case ch
((#\0) (incf x))
((#\1) (IL:BITMAPBIT bm x y 1) (incf x)))
(when (>= x width)
(setf x 0)
(decf y))
finally (return BM))))
;;; Driver
(defun read-pbm-p1 (file)
"Returns a binary bitmap from a PBM P1 ASCII file"
(with-open-file (s file)
(let* ((header (read-header s))
(coms-and-size (read-comments-and-size s))
(comments (first coms-and-size)) ; not used for now
(width (first (second coms-and-size)))
(height (second (second coms-and-size))))
(unless (and header width height)
(error "Problem with file found"))
(build-bitmap s width height))))
|
|
I believe P1 and P4 have the same header format, so if you allowed either P1 or P4 in the read-header code, you could trivially select the correct reader for the rest of the file, say, build-bitmap-p1 or build-buitmap-p4 where that would use the hack I used to read byte-at-a-time straight into the bitmap storage. |
|
Yep, I think dispatching on the header is the correct approach. |
|
I'd suggest you rewrite mine in Common Lisp, in good style, just using the knowledge of the internal structure of the bitmap memory it incorporates to |
|
OK, I can probably do that. I'll get sucked into the Autumn Lisp Game Jam here shortly however. |
I fixed it a little -