application/octet-stream
•
7.45 KB
•
250 lines
;;; Nujel - Copyright (C) 2020-2023 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
(import (VT100) :term/VT100)
(import (get) :net/gopher)
(def screen-width 0)
(def screen-height 0)
(def frame-height 0)
(def scroll-interval 8)
(def last-char 0)
(def cur-page { :url "gopher://sdf.org"
:type :1
:scrolly 0
:data #nil
:item #nil })
(def history #nil)
(def term (:new VT100))
(def gopher-type-map { :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 " " })
(defn gopher-type-name (data)
(or (ref gopher-type-map (or data.type :un)) " (?) "))
(defn get-modeline (page)
(def y (get-item-pos page))
(def scroll page.scrolly)
(def url page.url)
(fmt "{url}{}" (if (> y 0) (fmt " - L{y}") "")))
(defn draw-modeline (page)
(:move-cursor term 1 (dec screen-height))
(:set-color term :yellow :blue)
(def colored-modeline (cat " " (pad-end (get-modeline page) (dec screen-width))))
(:put-string term colored-modeline)
(:set-color term :default :default))
(defn draw-map (data page)
(def scroll-y page.scrolly)
(def y 0)
(doseq (e data)
(def cy (- y scroll-y))
(when (> cy frame-height) (return))
(when (>= cy 0)
(:move-cursor term 2 (inc cy))
(:put-string term (gopher-type-name e))
(when (and (not cur-page.item) (= :1 e.type))
(set! cur-page.item e))
(:move-cursor term 8 (inc cy))
(when (not= :i e.type)
(:set-color term :blue :default))
(when (= e cur-page.item)
(:set-color term :yellow :blue))
(:put-string term e.display)
(:set-color term :default :default))
(inc! y)))
(defn draw-text (data page)
(:set-color term :default :default)
(def scroll-y page.scrolly)
(def y 0)
(doseq (e data)
(def cy (- y scroll-y))
(when (> cy frame-height) (return))
(when (>= cy 0)
(:move-cursor term 2 (inc cy))
(:put-string term e))
(inc! y)))
(defn draw-page (page)
(when (nil? page.data)
(return))
(if (= page.type :1)
(draw-map page.data page)
(draw-text page.data page)))
(defn draw-screen ()
(:hide-cursor term)
(:clear-screen term)
(draw-page cur-page)
(draw-modeline cur-page)
(:show-cursor term)
(:flip term))
(defn quit ()
(:stop term)
(exit 0))
(defn previous-line ()
(when (not= :1 cur-page.type)
(return (page-up)))
(def last-entry cur-page.item)
(doseq (e cur-page.data)
(when (= e cur-page.item)
(set! cur-page.item last-entry)
(center-buffer cur-page)
(return))
(when (and (tree? e) (not= :i e.type))
(set! last-entry e))))
(defn next-line ()
(when (not= :1 cur-page.type)
(return (page-down)))
(def take-entry #f)
(doseq (e cur-page.data)
(when (and take-entry (not= :i e.type))
(set! cur-page :item e)
(center-buffer cur-page)
(return))
(when (= e 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? cur-page.item)
(set! history (cons cur-page history))
(def port cur-page.item.port)
(set! port (if (or (= 70 port) (= "70" port))
""
(fmt ":{port}")))
(def cur-url (fmt "gopher://{}{}{}" cur-page.item.host port cur-page.item.path))
(set! cur-page { :url cur-url
:type cur-page.item.type
:port port
:scrolly 0
:data #nil
:item #nil })))
(defn normalize-scroll ()
(set! cur-page.scrolly (max 0 (min (- (:length cur-page.data) frame-height)
cur-page.scrolly))))
(defn page-up ()
(set! cur-page.scrolly (- cur-page.scrolly scroll-interval))
(normalize-scroll))
(defn page-down ()
(set! cur-page.scrolly (+ cur-page.scrolly scroll-interval))
(normalize-scroll))
(defn read-bracketed-input ()
(def c (:poll-input term))
(case c
(#\A (previous-line))
(#\B (next-line))
(#\C (follow-link))
(#\D (history-back))
(#\5 (:poll-input term) (page-up))
(#\6 (:poll-input term) (page-down))))
(defn read-escaped-input ()
(def c (:poll-input term))
(case c
(#\[ (read-bracketed-input))))
(defn read-cx-input ()
(def c (:poll-input term))
(case c
(3 (quit))))
(defn read-input ()
(def c (:poll-input term))
(set! last-char c)
(case c
(#x1B (read-escaped-input))
(#x10 (previous-line))
(#x0E (next-line))
(#\h (history-back))
(#\j (next-line))
(#\J (page-down))
(#\k (previous-line))
(#\K (page-up))
(#\l (follow-link))
((#\q #\Q) (quit))
(#x18 (read-cx-input))))
(defn get-data (page)
(when-not page.data
(set! page.data (get page.url page.type))
(when (= page.type :1)
(doseq (e page.data)
(when (not= :i e.type)
(return (set! page.item e)))))
(when (= page.type :0)
(set! page.data (split page.data "\n")))))
(defn get-item-pos (page)
(def y 0)
(doseq (e page.data)
(when (= e page.item)
(return y))
(set! y (inc y)))
(return -1))
(defn center-buffer (page)
(def item-pos (get-item-pos page))
(when (< item-pos 0)
(return))
(while (> page.scrolly item-pos)
(set! page.scrolly (- page.scrolly scroll-interval)))
(def item-bottom-pos (- item-pos frame-height))
(while (< page.scrolly item-bottom-pos)
(set! page.scrolly (+ page.scrolly scroll-interval)))
(normalize-scroll))
(defn main (args)
:export
(:start term)
(:clear-screen term)
(def s (:get-size term))
(set! screen-width s.width)
(set! screen-height s.height)
(set! frame-height (- screen-height 3))
(set! scroll-interval (int (/ frame-height 2)))
(when (car args)
(set! cur-page.url (car args)))
(draw-screen)
(while #t
(get-data cur-page)
(draw-screen)
(read-input)))
