application/octet-stream
•
7.51 KB
•
240 lines
;;; Nujel - Copyright (C) 2020-2023 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
(import (Term) :core/term)
(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 Term))
(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 (ref data :type) :un)) " (?) "))
(defn get-modeline (page)
(def y (get-item-pos page))
(def scroll (ref page :scrolly))
(def url (ref 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 (ref 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 (ref cur-page :item)) (= :1 (ref e :type)))
(set! cur-page :item e))
(:move-cursor term 8 (inc cy))
(when (not= :i (ref e :type))
(:set-color term :blue :default))
(when (= e (ref cur-page :item))
(:set-color term :yellow :blue))
(:put-string term (ref e :display))
(:set-color term :default :default))
(inc! y)))
(defn draw-text (data page)
(:set-color term :default :default)
(def scroll-y (ref 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? (ref page :data))
(return))
(if (= (ref page :type) :1)
(draw-map (ref page :data) page)
(draw-text (ref 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 ()
(def last-entry (ref cur-page :item))
(doseq (e (ref cur-page :data))
(when (= e (ref cur-page :item))
(set! cur-page :item last-entry)
(center-buffer cur-page)
(return))
(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)))
(set! cur-page :item e)
(center-buffer cur-page)
(return))
(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 (or (= 70 port)
(= "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 normalize-scroll ()
(set! cur-page :scrolly (max 0 (min (- (:length (ref cur-page :data)) frame-height)
(ref cur-page :scrolly)))))
(defn page-up ()
(set! cur-page :scrolly (- (ref cur-page :scrolly) scroll-interval))
(normalize-scroll))
(defn page-down ()
(set! cur-page :scrolly (+ (ref 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))
(#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))
(set! 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)))
(def item-bottom-pos (- item-pos frame-height))
(while (< (ref page :scrolly) item-bottom-pos)
(set! page :scrolly (+ (ref page :scrolly) scroll-interval)))
(normalize-scroll))
(defn main (args)
:export
(:start term)
(:clear-screen term)
(def s (:get-size term))
(set! screen-width (ref s :width))
(set! screen-height (ref s :height))
(set! frame-height (- screen-height 3))
(set! scroll-interval (int (/ frame-height 2)))
(when (car args)
(set! cur-page :data (car args)))
(draw-screen)
(while #t
(get-data cur-page)
(draw-screen)
(read-input)))
