Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon. Entire thread

TGA loader in LISP

Name: Anonymous 2010-12-26 3:20

`class` macro automatically generates everything

class Tga
  idLength   = U1  // 00h Size of Image ID field
  cmapType   = U1  // 01h Color map type
  imageType  = U1  // 02h Image type code
  cmapStart  = U2  // 03h Color map origin
  cmapLength = U2  // 05h Color map length
  cmapDepth  = U1  // 07h Depth of color map entries
  xOffset    = U2  // 08h X origin of image
  yOffset    = U2  // 0Ah Y origin of image
  width      = U2  // 0Ch Width of image
  height     = U2  // 0Eh Heigth of image
  bpp        = U1  // 10h Image pixel size
  descriptor = U1  // 11h Image descriptor byte
  idField    = idLength++U1
  cmap       = cmapLength++U1
  bmap       = (width*height*bpp%8)++U1

Name: Anonymous 2010-12-26 16:52

>>21
Thanks, you give me inspiration.
I've done a simple macro that does what I said in >>20
And also a defun macro with an optional "aux:"
(define-syntax (my-let stx)
  (syntax-case stx ()
    ((_ ((x y) ...) b ...)
     #'(let ((x y) ...) b ...))
    ((_ (x y) b ...)
     #'(let ((x y)) b ...))
    ((_ (x ...) b ...)
     #`(let #,(let loop ((xs #'(x ...))
                         (r '()))
                (if (stx-null? xs) (reverse r)
                    (let ((x (stx-car xs)))
                      (cond ((and (stx-pair? x)
                                  (stx-null? (stx-cdr x))) (loop (stx-cdr xs)
                                                                 (cons (list (stx-car x) ''()) r)))
                            ((stx-pair? x) (loop (stx-cdr xs)
                                                 (cons x r)))
                            (else (loop (stx-cdr xs)
                                        (cons (list x ''()) r)))))))
         b ...))
    ((_ x b ...)
     #'(let ((x '())) b ...))))
(define-syntax defun
  (syntax-rules (aux:)
    ((defun f a aux: (x ...) b ...)
     (define f (lambda a (my-let (x ...) b ...))))
    ((defun f a aux: x b ...)
     (define f (lambda a (my-let x b ...))))
    ((defun f a b ...)
     (define f (lambda a b ...)))))
(my-let ((x 2) ; x = 2
         (y) ; y = '()
         z ; z = '()
         )
   (displayln (format "~a~a~a" x y z)))
(my-let (x 2) ; x = 2
   (displayln x))
(my-let x x) ; x = '()
(my-let (x) x) ; same
#;(my-let (x 2 y 2) x) ; this doesn't work, though, I'm too lazy to check wheter it is a valid (let) binding or not.
(my-let ((x 1)
         (y 2)
         (z 3)) ; you can still use it as normal let
    (+ x y z))
(my-let ()
   '())

(defun fun (l)
  aux: x       ; x = '()
  (cons l x))

(fun 2) ; => (2)

(defun f (xs)
  aux: (x y z)
  ;do something here
  )

Newer Posts
Don't change these.
Name: Email:
Entire Thread Thread List