turtle-r7rs/server/web-server.scm

(define complete-history '())

(define buffer-list '())

(define index-page
  `(html
    (head
     (title "Turtle Canvas"))
    (body
     (div
      (|@| (style "position: relative;"))
      (canvas
       (|@| (id "BgCanvas")
            (width "1000")
            (height "1000")
            (style "position: absolute; left: 0; top: 0; z-index: 0;"))
       " ")
      (canvas
       (|@| (id "LineCanvas")
            (width "1000")
            (height "1000")
            (style "position: absolute; left: 0; top: 0; z-index: 1;"))
       " ")
      (canvas
       (|@| (id "TurtleCanvas")
            (width "1000")
            (height "1000")
            (style "position: absolute; left: 0; top: 0; z-index: 2;"))
       " ")
      (script
       (|@| (src "https://ajax.googleapis.com/ajax/libs/jquery/3.1.0/jquery.min.js"))
       " ")
      (script
       (|@| (src "/draw.js"))
       " ")))))

(define (api-new-id!)
  (set! buffer-list (cons (list-copy complete-history) buffer-list))
  (number->string (length buffer-list)))

(define (push-buffer-item! i)
  (set! complete-history (cons i complete-history))
  (set! buffer-list (map (lambda (buff) (cons i buff)) buffer-list)))

(define (api-push-buffer! s)
  (let ((p (open-input-string s)))
    (let ((input-result (read p)))
      (close-input-port p)
      (push-buffer-item! input-result)
      "true\n")))

(define (api-push-bulk-buffer! s)
  (let ((p (open-input-string s)))
    (let ((input-result (read p)))
      (close-input-port p)
      (for-each push-buffer-item! input-result)
      "true\n")))

(define (api-pull-buffer! s)
  (define n -1)
  (let ((p (open-input-string s)))
    (let ((input-result (read p)))
      (close-input-port p)
      (when (integer? input-result) (set! n input-result))
      (if (< (length buffer-list) n)
          #()
          (let ((result (list-ref buffer-list (- (length buffer-list) n))))
            (list-set! buffer-list (- (length buffer-list) n) '())
            (list->vector (reverse result)))))))

(define (api-clear-buffer!)
  (set! complete-history '())
  (set! buffer-list (make-list (length buffer-list) '())))