Ben / Nujel

(def cur-buffer #nil)

(defn set-cur-buffer! (buf)
      :export
      (set! cur-buffer buf))

(defn get-cur-buffer ()
      :export
      cur-buffer)

(defn new-buffer (filename)
      :export
      (def lines [(buffer/allocate 16)])
      (def buf { :lines lines
                 :lines-clean []
                 :filename filename
                 :changed #f
                 :pos-x 0
                 :pos-y 0
                 :scroll-x 0
                 :scroll-y 0})
      (return buf))

(defn get-line (buf line-y)
      :export
      (def lines (ref buf :lines))
      (if (or (< line-y 0)
              (>= line-y (array/length lines)))
          #nil
          (ref lines line-y)))

(defn line-length (pos-y)
      :export
      (def buf cur-buffer)
      (def line (get-line buf pos-y))
      (when-not line (return 0))
      (dotimes (i (buffer/length line) (buffer/length line))
               (when (zero? (ref line i))
                 (return i))))

(defn backward-delete-line ()
      :export
      (def buf cur-buffer)
      (def lines (ref buf :lines))
      (def ll (- (array/length lines) 1))
      (def pos-y (ref buf :pos-y))
      (when (zero? pos-y) (return))
      (while (< pos-y ll)
        (set! lines pos-y (inc pos-y))
        (inc! pos-y))
      (array/length! lines (max 0 ll))
      (set! buf :pos-y (- (ref buf :pos-y) 1))
      (line-clean! buf (ref buf :pos-y) #f)
      (set! buf :pos-x (inc (line-length (ref buf :pos-y)))))

(defn backward-char ()
      :export
      (def buf cur-buffer)
      (def pos-x (ref buf :pos-x))
      (when (< pos-x 1)
        (def pos-y (ref buf :pos-y))
        (when (< pos-y 1)
          (return))
        (set! buf :pos-y (dec pos-y))
        (line-clean! buf (ref buf :pos-y) #f)
        (set! buf :pos-x (line-length (dec pos-y)))
        (return))
      (set! buf :pos-x (dec pos-x)))

(defn previous-line ()
      :export
      (def buf cur-buffer)
      (def pos-x (ref buf :pos-x))
      (def pos-y (ref buf :pos-y))
      (when (< pos-y 1)
        (return))
      (set! buf :pos-y (dec pos-y))
      (line-clean! buf (ref buf :pos-y) #f)
      (set! buf :pos-x (min pos-x (line-length (dec pos-y)))))

(defn next-line ()
      :export
      (def buf cur-buffer)
      (def pos-x (ref buf :pos-x))
      (def pos-y (ref buf :pos-y))
      (def lines (ref buf :lines))
      (def ll (- (array/length lines) 1))
      (when (>= pos-y ll)
        (return))
      (set! buf :pos-y (inc pos-y))
      (line-clean! buf (ref buf :pos-y) #f)
      (set! buf :pos-x (min pos-x (line-length (inc pos-y)))))

(defn forward-char ()
      :export
      (def buf cur-buffer)
      (def pos-x (ref buf :pos-x))
      (def pos-y (ref buf :pos-y))
      (def ll (line-length pos-y))
      (when (>= pos-x ll)
        (when (>= (inc pos-y) (array/length (ref buf :lines)))
          (return))
        (set! buf :pos-x 0)
        (set! buf :pos-y (inc pos-y))
        (line-clean! buf (ref buf :pos-y) #f)
        (return))
      (set! buf :pos-x (inc pos-x)))

(defn delete-forward-char ()
      :export
      (def buf cur-buffer)
      (def line (get-line buf (ref buf :pos-y)))
      (when-not line (return))
      (def pos-x (ref buf :pos-x))
      (def bl (- (buffer/length line) 2))
      (while (<= pos-x bl)
        (set! line pos-x (ref line (inc pos-x)))
        (inc! pos-x))
      (set! line (- (buffer/length line) 1) 0))

(defn backward-delete-char ()
      :export
      (def buf cur-buffer)
      (def line (get-line buf (ref buf :pos-y)))
      (when-not line (return))
      (def pos-x (ref buf :pos-x))
      (when (< pos-x 1)
        (backward-delete-line)
        (return))
      (def bl (- (buffer/length line) 1))
      (while (<= pos-x bl)
        (set! line (- pos-x 1) (ref line pos-x))
        (inc! pos-x))
      (set! line bl 0)
      (set! buf :pos-x (- (ref buf :pos-x) 1)))

(defn insert-char (c)
      :export
      (def buf cur-buffer)
      (def line (get-line buf (ref buf :pos-y)))
      (when-not line
                ; ToDo: add line?
                (return))
      (def pos-x (ref buf :pos-x))
      (def i (- (buffer/length line) 1))
      (when-not (zero? (ref line i))
                (buffer/length! line (+ (buffer/length line) 16))
                (def i (- (buffer/length line) 1)))
      (while (> i pos-x)
        (set! line i (ref line (dec i)))
        (dec! i))
      (set! line pos-x c)
      (set! buf :pos-x (inc pos-x)))

(defn insert-newline ()
      :export
      (def buf cur-buffer)
      (def lines (ref buf :lines))
      (def lines-clean (ref buf :lines-clean))
      (array/length! lines (inc (array/length lines)))
      (array/length! lines-clean (array/length lines))
      (set! lines (- (array/length lines) 1) (buffer/allocate 16))
      (set! buf :pos-x 0)
      (set! buf :pos-y (inc (ref buf :pos-y)))
      (line-clean! buf (ref buf :pos-y) #f))

(defn get-buf-name (buf)
      :export
      (def filename (ref buf :filename))
      (def saved (if (ref buf :changed) "*" ""))
      (fmt "{filename}{saved}"))

(defn line-clean? (buf line)
      :export
      (def lines-clean (ref buf :lines-clean))
      (when (>= line (array/length lines-clean)) (return #f))
      (or (ref lines-clean line) #f))

(defn line-clean! (buf line clean)
      :export
      (def lines-clean (ref buf :lines-clean))
      (when (>= line (array/length lines-clean))
        (array/length! lines-clean (inc line)))
      (set! lines-clean line clean))