#lang scheme

(require parser-tools/lex
         (prefix-in : parser-tools/lex-sre)
         parser-tools/yacc)

(define-empty-tokens op-tokens (VERTEX NORMAL TEXTURE FACE))
(define-empty-tokens whitespace-tokens (NEWLINE EOF))
(define-tokens value-tokens (INTEGRAL NUMBER))

(define-lex-abbrevs 
  (digit (:/ #\0 #\9))
  (uint (:+ digit))
  (int (:: (:? #\-) uint))
  (ufloat (:or uint (:: (:? uint) #\. uint)))
  (float (:: (:? #\-) ufloat))
  (newline (:* (:or #\newline #\return)))
  (comment (:: #\# (:* (:~ #\newline)) #\newline))
  (spaces (:* (:or #\space #\tab))))

(define objl
  (lexer
   (comment (objl input-port))
   (#\f (token-FACE))
   ("vt" (token-TEXTURE))
   ("vn" (token-NORMAL))
   (#\v (token-VERTEX))
   (float (token-NUMBER (string->number lexeme)))
   (int (token-INTEGRAL (string->number lexeme)))
   (newline (token-NEWLINE))
   (spaces (objl input-port))
   ((eof) (token-EOF))))

(define objp
  (parser
   (tokens op-tokens whitespace-tokens value-tokens)
   (start parse)
   (error (lambda (a b c) (printf "~a ~a ~a~n" a b c)))
   (end EOF)
   (grammar
    (parse ((VERTEX NUMBER NUMBER NUMBER NEWLINE) (list 'vertex $2 $3 $4))
           ((TEXTURE NUMBER NUMBER NEWLINE) (list 'texture $2 $3))
           ((NORMAL NUMBER NUMBER NUMBER NEWLINE) (list 'normal $2 $3 $4))
           (() #f)))))

(define (test ip)
  (port-count-lines! ip)
  (letrec ((one-line
	    (lambda ()
	      (let ((result (objp (lambda () (objl ip)))))
		(when result
                  (printf "~a~n" result)
                  (one-line))))))
    (one-line)))

(call-with-input-file "foo.obj" test)

;contents of foo.obj:
;v 1 1 1
;v 1 1 1
;