(define (lexer-aux inport res)
  (let ((token (read inport)))
    (if (eof-object? token)
        (reverse res)
        (lexer-aux inport (cons token res)))))

(define (lexer filename)
  (call-with-input-file filename
     (lambda (inport) 
        (lexer-aux inport '()))))

(define (parse-success val)
  (lambda (tokens idx)
    (list val idx)))

(define (parse-fail) 
  (lambda (tokens idx)
     (list #f #f)))

(define (parse-if pred?)
  (lambda (tokens idx)
     (let ((v (list-ref tokens idx)))
       (if (pred? v)
           (list v (+ idx 1))
           (list #f #f)))))

(define (parse-seq . parsers)
  (lambda (tokens idx)
     (let seq-loop ((parsers parsers)
                    (start idx)
                    (stop idx)
                    (seq-val '()))
         (if (null? parsers)
             (list (reverse seq-val) stop)
             (let ((v1 ((car parsers) tokens stop)))
                (if (cadr v1)
                    (seq-loop (cdr parsers) start (cadr v1)
                              (cons (car v1) seq-val))
                    (list #f #f)))))))

(define (parse-choice . parsers)
  (lambda (tokens idx)
     (let choice-loop ((parsers parsers))
         (if (null? parsers)
             (list #f #f)
             (let ((v1 ((car parsers) tokens idx)))
                (if (cadr v1)
                    v1 
                    (choice-loop (cdr parsers))))))))

(define (parse-repetition parser)
  (lambda (tokens idx)
    (let rep-loop ((start idx)
                   (res '()))
       (let ((v1 (parser tokens start)))
          (if (cadr v1)
              (rep-loop (cadr v1) (cons (car v1) res))
              (list (reverse res) start))))))

(define (parse-number n)
  (parse-if (lambda (x) (and (number? x) (= x n)))))

(define (parse-symbol s)
  (parse-if (lambda (x) (and (symbol? x) (eq? x s)))))
  
(define my-parser (parse-seq (parse-if (lambda (x) (eq? x 'hurz)))
                             (parse-if (lambda (x) (and (number? x) (= x 42))))))

(define my-parser-1
   (parse-seq (parse-if (lambda (x) (eq? x 'hurz)))
              (parse-if (lambda (x) (and (number? x) (= x 42))))
              (parse-if (lambda (x) (and (number? x) (= x 33))))))

(define my-parser-2 
   (parse-seq (parse-if (lambda (x) (eq? x 'hurz)))
              (parse-number 42)
              (parse-choice (parse-number 666) (parse-number 33))))

(display (my-parser '(hurz 42 33) 0))
(newline)
(display (my-parser-1 '(hurz 42 33) 0))
(newline)
(display (my-parser-2 '(hurz 42 33) 0))
(newline)
(display (my-parser-2 '(hurz 42 666) 0))
(newline)
(display (my-parser-2 '(hurz 42 555) 0))
(newline)

(define stl-parser
  (parse-seq (parse-symbol 'solid)
             (parse-if symbol?)
             (parse-repetition
               (parse-seq (parse-symbol 'facet)
                          (parse-seq (parse-symbol 'normal)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-symbol 'outer)
                          (parse-symbol 'loop)
                          (parse-seq (parse-symbol 'vertex)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-seq (parse-symbol 'vertex)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-seq (parse-symbol 'vertex)
                                     (parse-if number?)
                                     (parse-if number?)
                                     (parse-if number?))
                          (parse-symbol 'endloop)
                          (parse-symbol 'endfacet)))
               (parse-symbol 'endsolid)
               (parse-if symbol?)))

(define (transform-expr expr)
  (map (lambda (facet)
         (list (cadr facet)
               (cons 'vertex-1 (transform-point (cdr (list-ref facet 4))))
               (cons 'vertex-2 (transform-point (cdr (list-ref facet 5))))
               (cons 'vertex-3 (transform-point (cdr (list-ref facet 6))))))
       (list-ref expr 2)))

(define (transform-point p)
  (let* ((x0 55.0)
         (y0 55.0)
         (z0 25.0)
         (x (* 0.001 (- (car p) x0)))
         (y (* 0.001 (- (cadr p) y0)))
         (z (* 0.001 (- (caddr p) z0))))
     (list x y z)))

(define (read-mesh meshfile)
  (let* ((res (stl-parser (lexer (cadr (command-line))) 0))
         (ntokens (cadr res))
         (exp (car res)))
    (transform-expr exp)))

(define (go)
  (display (read-mesh (cadr (command-line))))
  (newline))

(go)