Symta documentation

I don't know who the hell the in Symta guy is or why he's hiding the documentation these days, but here's an old Symta version that still has a lot of relevant documentation and example code.

http://symtadev.blogspot.be/

I haven't tried it out yet, because I'm too lazy to install the required emacs packages. Maybe someone should look into it? I'll post some of the included files here, for the lazy.

I guess this was meant to be posted here (not the author)

Here are (my) PNG routines, part of greater framework...

(defun png-load (s)
  (setf s (png-parse s))
  (let* ((g nil)
         (c 0)
         (IHDR (gethash "IHDR" s))
         (IDAT (gethash "IDAT" s))
         (PLTE (gethash "PLTE" s))
         (tRNS (gethash "tRNS" s)))
    (unless IHDR (gfx-load-error "Missing IHDR"))
    (unless IDAT (gfx-load-error "Missing IDAT"))
    (deser IHDR ((width     msb 4)
                 (height    msb 4)
                 (depth     1) ; depth of color channel in bits: 1 2 4 8 16
                 (type      1)
                 (enc       1)
                 (filter    1)
                 (interlace 1))
      (unless (= enc 0) (gfx-load-error "Unsupported encoding (~a)" enc))
      (unless (= filter 0) (gfx-load-error "Unsupported filter method (~a)" filter))

      (setf c (case type
                (0 1) ; grayscale
                (2 3) ; truecolor
                (3 1) ; indexed
                (4 4) ; grayscale with alpha
                (6 4) ; truecolor with alpha
                (otherwise (gfx-load-error "Invalid color type (~d)" type))))

      (case depth
        ((1 2 4) (when (/= c 1)
                   (gfx-load-error "Invalid color type (~a) for depth ~a" type depth)))
        (8)
        (otherwise (gfx-load-error "Unsupported channel-depth (~a)" depth)))

      (setf g (gfx width height :c c))
      (png-defilter g (zlib:unpack IDAT) depth)
      (case interlace
        (0 ) ; no interlace
        (1 (gfx-load-error "Interlaced PNGs are not supported")) ;(png-deinterlace-adam7 g))
        (otherwise (gfx-load-error "Invalid interlace type (~d)" interlace)))
      (when (= c 1)
        (let ((m (if PLTE
                     (u1-u4 3 PLTE)
                     (sc u4 (loop as i below 256 collect (rgb i i i))))))
          (when tRNS (times i (length tRNS)
                       (w/rgb (r g b) (aref m i)
                         (setf (aref m i) (rgb r g b (- #xFF (aref tRNS i)))))))
          (setf (gfx-m g) m)))
      g)))


(defun png-make (g)
  (bind-struct gfx g (w h c d m)
    (let* ((o (%new))
           (d  (cond ((= c 4) (colors-to-bytes (r g b a) (r g b (u- #xFF a)) d))
                     ((= c 3) (colors-to-bytes (r g b) (r g b) d))
                     (t (u4-u1 1 d)))))
      (ser o (magic arr 1 +png-header+))
      (png-chunk o "IHDR"
        (ser t
          (width  msb 4 w)
          (height msb 4 h)
          (depth     1 8)
          (type 1 (case c
                    (1 3) ; indexed
                    (3 2) ; truecolor
                    (4 6) ; truecolor with alpha
                    (otherwise (error "png-create: cant save this image type"))
                    ))
          (enc       1 0) ; compression: 0=zlib
          (filter    1 0) ; pre-compression-filter: 0=default
          (interlace 1 0)))
      (when (= c 1)
        (png-chunk o "PLTE" (u4-u1 3 m))
        (let ((tRNS (vec 256 u1))
              (emit nil))
          (times i 256
            (w/rgb (_ _ _ a) (aref m i)
              (setf (aref tRNS i) (u- #xFF a))
              (when (/= a 0) (setf emit t))))
          (when emit (png-chunk o "tRNS" tRNS))))
      (png-chunk o "IDAT" (zlib:pack (png-filter w h c d)))
      (png-chunk o "IEND" #())
      (%crop o)
      )))