Login
7 branches 0 tags
Ben (X13/Arch) Fixed memory leak 98c8bac 2 years ago 1094 Commits
nujel / stdlib_modules / app / gopher.nuj
;;; Nujel - Copyright (C) 2020-2021 - 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 #nil)
(def screen-height #nil)
(def scroll-interval 10)
(def last-char 0)

(def cur-url "gopher://sdf.org")
(def cur-type :1)
(def cur-data #nil)
(def cur-item #nil)
(def history #nil)

(defn gopher-type-name (data)
      (case (or (ref data :type) :un)
            (:0 "(TXT)")
            (:1 "(DIR)")
            (:i "     ")
            (otherwise " (?) ")))

(defn draw-map (data)
      (def y 0)
      (doseq (e data)
             (when (tree? e)
               (set-color :default :default)
               (move-cursor 2 (inc y))
               (put-string (gopher-type-name e))
               (when (and (not cur-item) (= :1 (ref e :type)))
                 (set! cur-item e))
               (move-cursor 8 (inc y))
               (when (not= :i (ref e :type))
                 (set-color :blue :default))
               (when (= e cur-item)
                 (set-color :yellow :blue))

               (put-string (ref e :display)))
             (when (> y screen-height) (return))
             (inc! y)))

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

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

(defn draw-screen ()
      (hide-cursor)
      (clear-screen)
      (draw-data cur-data)
      (show-cursor))

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

(defn beginning-of-line ()
      (set! (get-cur-buffer) :pos-x 0))

(defn clear-frame ()
      (dotimes (y (- screen-height 1))
               (move-cursor 0 y)
               (clear-line)))

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

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

(defn history-back ()
      (when-not history (return))
      (def e (car history))
      (set! history (cdr history))
      (set! cur-type (ref e :type))
      (set! cur-item (ref e :item))
      (set! cur-url (ref e :url))
      (set! cur-data (ref e :data)))

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

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

(defn read-escaped-input ()
      (def c (poll-input))
      (when (= c #\[)
        (return (read-bracketed-input)))
      (return (insert-char #\[)))

(defn read-cx-input ()
      (def c (poll-input))
      (when (= c 3)
        (return (quit))))

(defn read-input ()
      (def c (poll-input))
      (set! last-char c)
      (when (= c #x1B)
        (return (read-escaped-input)))
      (when (= c #x10) ; C-p
        (return (previous-line)))
      (when (= c #x0E) ; C-n
        (return (next-line)))
      (when (= c #x18) ; C-x
        (return (read-cx-input))))

(defn get-data (url)
      (def res (get url cur-type))
      (when (= cur-type :0)
        (set! res (split res "\n")))
      (set! cur-data res))

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