Ben / Nujel

;;; Nujel - Copyright (C) 2020-2023 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
(import (start stop show-cursor hide-cursor clear-line clear-screen get-size poll-input draw-box move-cursor put-char put-string set-color) :core/term)
(import (get) :net/gopher)

(def screen-width 0)
(def screen-height 0)
(def frame-height 0)
(def scroll-interval 10)
(def last-char 0)

(def cur-page { :url "gopher://sdf.org/phlogs"
                :type :1
                :scrolly 0
                :data #nil
                :item #nil })
(def history #nil)

(defn gopher-type-name (data)
      (case (or (ref data :type) :un)
            (:0 "(TXT)")
            (:1 "(DIR)")
            (:2 "(NAM)")
            (:3 "(ERR)")
            (:4 "(BHX)")
            (:5 "(DOS)")
            (:6 "(UUE)")
            (:7 "(FTS)")
            (:8 "(TEL)")
            (:9 "(BIN)")
            (:g "(GIF)")
            (:I "(IMG)")
            (:T "(IBM)")
            (:< "(SND)")
            (:d "(DOC)")
            (:h "(HTM)")
            (:p "(PNG)")
            (:r "(RTF)")
            (:s "(WAV)")
            (:P "(PDF)")
            (:X "(XML)")
            (:i "     ")
            (otherwise " (?) ")))

(defn get-modeline (page)
      (def y (get-item-pos page))
      (def scroll (ref page :scrolly))
      (def url (ref page :url))
      (fmt " Scroll: {scroll} - Y: {y}  -  {url} - KeyCode: {last-char:X}"))

(defn draw-modeline (page)
      (move-cursor 1 (dec screen-height))
      (set-color :yellow :blue)
      (def colored-modeline (cat " " (pad-end (get-modeline page) (dec screen-width))))
      (put-string colored-modeline)
      (set-color :default :default))

(defn draw-map (data page)
      (def scroll-y (ref page :scrolly))
      (def y 0)
      (doseq (e data)
             (when (> (- y scroll-y) frame-height) (return))
             (when (>= y scroll-y)
               (move-cursor 2 (inc y))
               (put-string (gopher-type-name e))
               (when (and (not (ref cur-page :item)) (= :1 (ref e :type)))
                 (set! cur-page :item e))
               (move-cursor 8 (inc y))
               (when (not= :i (ref e :type))
                 (set-color :blue :default))
               (when (= e (ref cur-page :item))
                 (set-color :yellow :blue))
               (put-string (ref e :display))
               (set-color :default :default))
             (inc! y)))

(defn draw-text (data page)
      (set-color :default :default)
      (def y 0)
      (doseq (e data)
             (move-cursor 2 (inc y))
             (put-string e)
             (when (> y frame-height)
               (return))
             (inc! y)))

(defn draw-page (page)
      (if (= (ref page :type) :1)
          (draw-map (ref page :data) page)
          (draw-text (ref page :data) page)))

(defn draw-screen ()
      (hide-cursor)
      (clear-screen)
      (draw-page cur-page)
      (draw-modeline cur-page)
      (show-cursor))

(defn quit ()
      (stop)
      (exit 0))

(defn previous-line ()
      (def last-entry (ref cur-page :item))
      (doseq (e (ref cur-page :data))
             (when (= e (ref cur-page :item))
               (return (set! cur-page :item last-entry)))
             (when (and (tree? e) (not= :i (ref e :type)))
               (set! last-entry e))))

(defn next-line ()
      (def take-entry #f)
      (doseq (e (ref cur-page :data))
             (when (and take-entry (not= :i (ref e :type)))
               (return (set! cur-page :item e)))
             (when (= e (ref cur-page :item))
               (set! take-entry #t))))

(defn history-back ()
      (when-not history (return))
      (set! cur-page (car history))
      (cdr! history))

(defn follow-link ()
      (when (tree? (ref cur-page :item))
        (set! history (cons cur-page history))
        (def port (ref (ref cur-page :item) :port))
        (set! port (if (= 70 port)
                       ""
                       (fmt ":{port}")))
        (def cur-url (fmt "gopher://{}{}{}" (ref (ref cur-page :item) :host) port (ref (ref cur-page :item) :path)))
        (def cur-type (ref (ref cur-page :item) :type))
        (set! cur-page { :url cur-url
                         :type cur-type
                         :port port
                         :scrolly 0
                         :data #nil
                         :item #nil })))

(defn read-bracketed-input ()
      (def c (poll-input))
      (case c
            (#\A (previous-line))
            (#\B (next-line))
            (#\C (follow-link))
            (#\D (history-back))))

(defn read-escaped-input ()
      (def c (poll-input))
      (case c
            (#\[ (read-bracketed-input))))

(defn read-cx-input ()
      (def c (poll-input))
      (case c
            (3 (quit))))

(defn read-input ()
      (def c (poll-input))
      (set! last-char c)
      (case c
            (#x1B (read-escaped-input))
            (#x10 (previous-line))
            (#x0E (next-line))
            (#x18 (read-cx-input))))

(defn get-data (page)
      (when-not (ref page :data)
                (set! page :data (get (ref page :url) (ref page :type)))
                (when (= (ref page :type) :1)
                  (doseq (e (ref page :data))
                         (when (not= :i (ref e :type))
                           (return (set! page :item e)))))
                (when (= (ref page :type) :0)
                  (set! page :data (split (ref page :data) "\n")))))

(defn get-item-pos (page)
      (def y 0)
      (doseq (e (ref page :data))
             (when (= e (ref page :item))
               (return y)
             (inc! y)))
      (return -1))

(defn center-buffer (page)
      (def item-pos (get-item-pos page))
      (when (< item-pos 0)
        (return))
      (while (> (ref page :scrolly) item-pos)
        (set! page :scrolly (- (ref page :scrolly) scroll-interval)))
      (set! page :scrolly (max (ref page :scrolly) 0))

      (def item-bottom-pos (- item-pos frame-height))
      (while (< (ref page :scrolly) item-bottom-pos)
        (set! page :scrolly (+ (ref page :scrolly) scroll-interval)))
      (set! page :scrolly (min (ref page :scrolly) (:length (ref page :data)))))

(defn main (args)
      :export
      (start)
      (clear-screen)
      (def s (get-size))
      (set! screen-width (ref s :width))
      (set! screen-height (ref s :height))
      (set! frame-height (- screen-height 2))
      (when (car args)
        (set! cur-page :data (car args)))
      (while #t
        (get-data cur-page)
        (center-buffer cur-page)
        (draw-screen)
        (read-input)))