├── Makefile ├── .gitignore ├── .travis.yml ├── test ├── commands.jsonl └── asciinema │ ├── test_runner.cljs │ ├── vt │ ├── test_macros.clj │ └── parser_test.cljc │ └── vt_test.cljc ├── src └── asciinema │ ├── vt │ ├── parser_macros.clj │ ├── main.cljs │ ├── parser.cljc │ └── screen.cljc │ ├── cljs │ └── patch.cljs │ └── vt.cljc ├── liner.js ├── README.md ├── project.clj ├── resources └── codepoint-polyfill.js └── LICENSE /Makefile: -------------------------------------------------------------------------------- 1 | test-main: 2 | cat test/commands.jsonl | node main.js 3 | 4 | .PHONY: test-main 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | /out 11 | /.repl 12 | .nrepl-history 13 | /main.js 14 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | lein: 2.6.1 3 | script: 4 | - env PROPERTY_TESTS_MULTIPLIER=10 lein test 5 | - lein doo phantom test once 6 | - lein cljsbuild once main 7 | - make test-main 8 | -------------------------------------------------------------------------------- /test/commands.jsonl: -------------------------------------------------------------------------------- 1 | {"cmd": "new", "width": 20, "height": 4} 2 | {"cmd": "feed-str", "str": "abc"} 3 | {"cmd": "feed-str", "str": "d\u001b[31me\u001b[0mf\nqwe"} 4 | {"cmd": "dump-screen"} 5 | {"cmd": "dump-str"} 6 | {"cmd": "feed-str", "str": "abc"} 7 | {"cmd": "dump-screen"} 8 | {"cmd": "dump-str"} 9 | -------------------------------------------------------------------------------- /test/asciinema/test_runner.cljs: -------------------------------------------------------------------------------- 1 | (ns asciinema.test-runner 2 | (:require [doo.runner :refer-macros [doo-tests]] 3 | [asciinema.vt-test] 4 | [asciinema.vt.parser-test])) 5 | 6 | (enable-console-print!) 7 | 8 | (doo-tests 9 | 'asciinema.vt-test 10 | 'asciinema.vt.parser-test) 11 | -------------------------------------------------------------------------------- /src/asciinema/vt/parser_macros.clj: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt.parser-macros 2 | (:require [clojure.string :as str])) 3 | 4 | (defn event-seq [event] 5 | (if (keyword? event) 6 | (let [[low high] (str/split (name event) #"-") 7 | low (Long/decode low) 8 | high (Long/decode high)] 9 | (range low (inc high))) 10 | [event])) 11 | 12 | (defmacro events [& items] 13 | `(set '~(mapcat event-seq items))) 14 | -------------------------------------------------------------------------------- /liner.js: -------------------------------------------------------------------------------- 1 | // Copied from examples of Node.js Streams API by Marc Harter: 2 | // https://strongloop.com/strongblog/practical-examples-of-the-new-node-js-streams-api/ 3 | 4 | var stream = require('stream') 5 | var liner = new stream.Transform( { objectMode: true } ) 6 | 7 | liner._transform = function (chunk, encoding, done) { 8 | var data = chunk.toString() 9 | if (this._lastLineData) data = this._lastLineData + data 10 | 11 | var lines = data.split('\n') 12 | this._lastLineData = lines.splice(lines.length-1,1)[0] 13 | 14 | lines.forEach(this.push.bind(this)) 15 | done() 16 | } 17 | 18 | liner._flush = function (done) { 19 | if (this._lastLineData) this.push(this._lastLineData) 20 | this._lastLineData = null 21 | done() 22 | } 23 | 24 | module.exports = liner 25 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # asciinema virtual terminal 2 | 3 | [![Build Status](https://travis-ci.org/asciinema/vt.svg?branch=master)](https://travis-ci.org/asciinema/vt) 4 | 5 | This repository contains the source code of virtual terminal emulator used 6 | by [asciinema-player](https://github.com/asciinema/asciinema-player). 7 | 8 | The emulator is based on 9 | [Paul Williams' parser for ANSI-compatible video terminals](https://www.vt100.net/emu/dec_ansi_parser). 10 | It covers only the output (display) part of the emulation as only this is needed 11 | by asciinema-player. Handling of escape sequences is fully compatible 12 | with most modern terminal emulators like xterm, Gnome Terminal, iTerm, mosh etc. 13 | 14 | ## License 15 | 16 | Copyright © 2015-2019 Marcin Kulik. 17 | 18 | All code is licensed under the Apache License, Version 2.0. See LICENSE file for details. 19 | -------------------------------------------------------------------------------- /test/asciinema/vt/test_macros.clj: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt.test-macros 2 | (:require [environ.core :refer [env]])) 3 | 4 | (defmacro property-tests-multiplier [] 5 | (let [multiplier-str (get env :property-tests-multiplier "1")] 6 | (Integer/parseInt multiplier-str))) 7 | 8 | (defmacro expect-lines [vt expected] 9 | `(~'is (= (-> ~vt :screen screen/lines) ~expected))) 10 | 11 | (defmacro expect-first-line [vt expected] 12 | `(~'is (= (-> ~vt :screen screen/lines first) ~expected))) 13 | 14 | (defmacro expect-cursor 15 | ([vt expected-x expected-y] 16 | `(let [{:keys [~'x ~'y]} (-> ~vt :screen screen/cursor)] 17 | (~'is (= ~'x ~expected-x)) 18 | (~'is (= ~'y ~expected-y)))) 19 | ([vt expected-x expected-y expected-visible] 20 | `(let [{:keys [~'x ~'y ~'visible]} (-> ~vt :screen screen/cursor)] 21 | (~'is (= ~'x ~expected-x)) 22 | (~'is (= ~'y ~expected-y)) 23 | (~'is (= ~'visible ~expected-visible))))) 24 | 25 | (defmacro expect-tabs [vt tabs] 26 | `(~'is (= (-> ~vt :screen :tabs) ~tabs))) 27 | -------------------------------------------------------------------------------- /src/asciinema/cljs/patch.cljs: -------------------------------------------------------------------------------- 1 | (ns asciinema.cljs.patch 2 | (:refer-clojure :exclude [js->clj])) 3 | 4 | ; Optimized js->clj implementation by Darrick Wiebe (http://dev.clojure.org/jira/browse/CLJS-844) 5 | (defn js->clj 6 | ([x] (js->clj x :keywordize-keys false)) 7 | ([x & opts] 8 | (cond 9 | (satisfies? IEncodeClojure x) 10 | (-js->clj x (apply array-map opts)) 11 | (seq opts) 12 | (let [{:keys [keywordize-keys]} opts 13 | keyfn (if keywordize-keys keyword str) 14 | f (fn thisfn [x] 15 | (cond 16 | (seq? x) 17 | (doall (map thisfn x)) 18 | (coll? x) 19 | (into (empty x) (map thisfn) x) 20 | (array? x) 21 | (persistent! 22 | (reduce #(conj! %1 (thisfn %2)) 23 | (transient []) x)) 24 | (identical? (type x) js/Object) 25 | (persistent! 26 | (reduce (fn [r k] (assoc! r (keyfn k) (thisfn (aget x k)))) 27 | (transient {}) (js-keys x))) 28 | :else x))] 29 | (f x))))) 30 | -------------------------------------------------------------------------------- /src/asciinema/vt/main.cljs: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt.main 2 | (:refer-clojure :exclude [js->clj]) 3 | (:require [asciinema.cljs.patch :refer [js->clj]] 4 | [asciinema.vt :as vt] 5 | [asciinema.vt.screen :as screen] 6 | [cljs.nodejs :as nodejs] 7 | [clojure.string :as str])) 8 | 9 | (nodejs/enable-util-print!) 10 | 11 | (def liner (nodejs/require "./liner")) 12 | 13 | (def vt (atom (vt/make-vt 80 24))) 14 | 15 | (defn to-json [obj] 16 | (-> obj clj->js JSON.stringify)) 17 | 18 | (defn print-result [data] 19 | (println (to-json {:result data}))) 20 | 21 | (defmulti process-command :cmd) 22 | 23 | (defmethod process-command "new" [msg] 24 | (reset! vt (vt/make-vt (:width msg) (:height msg)))) 25 | 26 | (defmethod process-command "feed-str" [msg] 27 | (swap! vt vt/feed-str (:str msg))) 28 | 29 | (defmethod process-command "dump-str" [msg] 30 | (print-result (vt/dump @vt))) 31 | 32 | (defmethod process-command "dump-screen" [msg] 33 | (let [screen {:lines (-> @vt :screen screen/lines) 34 | :cursor (-> @vt :screen screen/cursor)}] 35 | (print-result screen))) 36 | 37 | (defn process-line [line] 38 | (let [line (-> line str str/trim)] 39 | (when (not= line "") 40 | (let [payload (-> line 41 | str 42 | JSON.parse 43 | (js->clj :keywordize-keys true))] 44 | (process-command payload))))) 45 | 46 | (defn -main [& args] 47 | (let [stdin (.-stdin nodejs/process)] 48 | (.pipe stdin liner) 49 | (.on liner "readable" (fn [] 50 | (when-let [line (.read liner)] 51 | (process-line line) 52 | (recur)))))) 53 | 54 | (set! *main-cli-fn* -main) 55 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject vt "0.1.0-SNAPSHOT" 2 | :description "asciinema virtual terminal" 3 | :url "https://github.com/asciinema/vt" 4 | :license {:name "Apache 2.0" 5 | :url "http://www.apache.org/licenses/LICENSE-2.0"} 6 | 7 | :dependencies [[org.clojure/clojure "1.9.0"] 8 | [org.clojure/clojurescript "1.10.520"] 9 | [org.clojure/test.check "0.9.0"] 10 | [org.clojure/core.match "0.3.0-alpha5"] 11 | [cljsjs/nodejs-externs "1.0.4-1"] 12 | [doo "0.1.8"] 13 | [prismatic/schema "1.1.6"]] 14 | 15 | :plugins [[lein-cljsbuild "1.1.7"] 16 | [lein-doo "0.1.8"]] 17 | 18 | :min-lein-version "2.5.3" 19 | 20 | :clean-targets ^{:protect false} ["resources/js" "target" "out" "main.js"] 21 | 22 | :source-paths ["src"] 23 | 24 | :profiles {:dev {:dependencies [[com.cemerick/piggieback "0.2.1"] 25 | [org.clojure/tools.nrepl "0.2.10"] 26 | [environ "1.0.1"]] 27 | :plugins [[refactor-nrepl "1.1.0"]]} 28 | :repl {:plugins [[cider/cider-nrepl "0.10.0"]]}} 29 | 30 | :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]} 31 | 32 | :cljsbuild {:builds {:test {:source-paths ["src" "test"] 33 | :compiler {:output-to "out/test.js" 34 | :source-map true 35 | :foreign-libs [{:file "resources/codepoint-polyfill.js" 36 | :provides ["asciinema.vt.codepoint-polyfill"]}] 37 | :optimizations :none 38 | :pretty-print false 39 | :main "asciinema.test-runner"}} 40 | :main {:source-paths ["src"] 41 | :compiler {:output-to "main.js" 42 | :foreign-libs [{:file "resources/codepoint-polyfill.js" 43 | :provides ["asciinema.vt.codepoint-polyfill"]}] 44 | :optimizations :advanced 45 | :pretty-print false 46 | :elide-asserts true 47 | :target :nodejs 48 | :main "asciinema.vt.main"}}}}) 49 | -------------------------------------------------------------------------------- /resources/codepoint-polyfill.js: -------------------------------------------------------------------------------- 1 | /*! http://mths.be/fromcodepoint v0.1.0 by @mathias */ 2 | if (!String.fromCodePoint) { 3 | (function() { 4 | var defineProperty = (function() { 5 | // IE 8 only supports `Object.defineProperty` on DOM elements 6 | try { 7 | var object = {}; 8 | var $defineProperty = Object.defineProperty; 9 | var result = $defineProperty(object, object, object) && $defineProperty; 10 | } catch(error) {} 11 | return result; 12 | }()); 13 | var stringFromCharCode = String.fromCharCode; 14 | var floor = Math.floor; 15 | var fromCodePoint = function() { 16 | var MAX_SIZE = 0x4000; 17 | var codeUnits = []; 18 | var highSurrogate; 19 | var lowSurrogate; 20 | var index = -1; 21 | var length = arguments.length; 22 | if (!length) { 23 | return ''; 24 | } 25 | var result = ''; 26 | while (++index < length) { 27 | var codePoint = Number(arguments[index]); 28 | if ( 29 | !isFinite(codePoint) || // `NaN`, `+Infinity`, or `-Infinity` 30 | codePoint < 0 || // not a valid Unicode code point 31 | codePoint > 0x10FFFF || // not a valid Unicode code point 32 | floor(codePoint) != codePoint // not an integer 33 | ) { 34 | throw RangeError('Invalid code point: ' + codePoint); 35 | } 36 | if (codePoint <= 0xFFFF) { // BMP code point 37 | codeUnits.push(codePoint); 38 | } else { // Astral code point; split in surrogate halves 39 | // http://mathiasbynens.be/notes/javascript-encoding#surrogate-formulae 40 | codePoint -= 0x10000; 41 | highSurrogate = (codePoint >> 10) + 0xD800; 42 | lowSurrogate = (codePoint % 0x400) + 0xDC00; 43 | codeUnits.push(highSurrogate, lowSurrogate); 44 | } 45 | if (index + 1 == length || codeUnits.length > MAX_SIZE) { 46 | result += stringFromCharCode.apply(null, codeUnits); 47 | codeUnits.length = 0; 48 | } 49 | } 50 | return result; 51 | }; 52 | if (defineProperty) { 53 | defineProperty(String, 'fromCodePoint', { 54 | 'value': fromCodePoint, 55 | 'configurable': true, 56 | 'writable': true 57 | }); 58 | } else { 59 | String.fromCodePoint = fromCodePoint; 60 | } 61 | }()); 62 | } 63 | 64 | /*! http://mths.be/codepointat v0.1.0 by @mathias */ 65 | if (!String.prototype.codePointAt) { 66 | (function() { 67 | 'use strict'; // needed to support `apply`/`call` with `undefined`/`null` 68 | var codePointAt = function(position) { 69 | if (this == null) { 70 | throw TypeError(); 71 | } 72 | var string = String(this); 73 | var size = string.length; 74 | // `ToInteger` 75 | var index = position ? Number(position) : 0; 76 | if (index != index) { // better `isNaN` 77 | index = 0; 78 | } 79 | // Account for out-of-bounds indices: 80 | if (index < 0 || index >= size) { 81 | return undefined; 82 | } 83 | // Get the first code unit 84 | var first = string.charCodeAt(index); 85 | var second; 86 | if ( // check if it’s the start of a surrogate pair 87 | first >= 0xD800 && first <= 0xDBFF && // high surrogate 88 | size > index + 1 // there is a next code unit 89 | ) { 90 | second = string.charCodeAt(index + 1); 91 | if (second >= 0xDC00 && second <= 0xDFFF) { // low surrogate 92 | // http://mathiasbynens.be/notes/javascript-encoding#surrogate-formulae 93 | return (first - 0xD800) * 0x400 + second - 0xDC00 + 0x10000; 94 | } 95 | } 96 | return first; 97 | }; 98 | if (Object.defineProperty) { 99 | Object.defineProperty(String.prototype, 'codePointAt', { 100 | 'value': codePointAt, 101 | 'configurable': true, 102 | 'writable': true 103 | }); 104 | } else { 105 | String.prototype.codePointAt = codePointAt; 106 | } 107 | }()); 108 | } 109 | -------------------------------------------------------------------------------- /src/asciinema/vt/parser.cljc: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt.parser 2 | (:require #?(:clj [asciinema.vt.parser-macros :refer [events]])) 3 | #?(:cljs (:require-macros [asciinema.vt.parser-macros :refer [events]]))) 4 | 5 | (def c0-prime? (events :0x00-0x17 0x19 :0x1C-0x1F)) 6 | 7 | (def anywhere-state 8 | {(events 0x18 0x1A :0x80-0x8F :0x91-0x97 0x99 0x9A) {:action :execute, :transition :ground} 9 | (events 0x9C) {:transition :ground} 10 | (events 0x1B) {:transition :escape} 11 | (events 0x98 0x9E 0x9F) {:transition :sos-pm-apc-string} 12 | (events 0x90) {:transition :dcs-entry} 13 | (events 0x9D) {:transition :osc-string} 14 | (events 0x9B) {:transition :csi-entry}}) 15 | 16 | (def states* 17 | {:ground 18 | {c0-prime? {:action :execute} 19 | (events :0x20-0x7F :0xA0-0xFF) {:action :print}} 20 | 21 | :escape 22 | {:on-enter :clear 23 | c0-prime? {:action :execute} 24 | (events :0x20-0x2F) {:action :collect, :transition :escape-intermediate} 25 | (events :0x30-0x4F :0x51-0x57 0x59 0x5A 0x5C :0x60-0x7E) {:action :esc-dispatch, :transition :ground} 26 | (events 0x5B) {:transition :csi-entry} 27 | (events 0x5D) {:transition :osc-string} 28 | (events 0x50) {:transition :dcs-entry} 29 | (events 0x58 0x5E 0x5F) {:transition :sos-pm-apc-string} 30 | (events 0x7f) {:action :ignore}} 31 | 32 | :escape-intermediate 33 | {c0-prime? {:action :execute} 34 | (events :0x20-0x2F) {:action :collect} 35 | (events :0x30-0x7E) {:action :esc-dispatch, :transition :ground} 36 | (events 0x7f) {:action :ignore}} 37 | 38 | :csi-entry 39 | {:on-enter :clear 40 | c0-prime? {:action :execute} 41 | (events :0x40-0x7E) {:action :csi-dispatch, :transition :ground} 42 | (events :0x30-0x39 0x3B) {:action :param, :transition :csi-param} 43 | (events :0x3C-0x3F) {:action :collect, :transition :csi-param} 44 | (events 0x3A) {:transition :csi-ignore} 45 | (events :0x20-0x2F) {:action :collect, :transition :csi-intermediate} 46 | (events 0x7f) {:action :ignore}} 47 | 48 | :csi-param 49 | {c0-prime? {:action :execute} 50 | (events :0x30-0x39 0x3B) {:action :param} 51 | (events 0x3A :0x3C-0x3F) {:transition :csi-ignore} 52 | (events :0x20-0x2F) {:action :collect, :transition :csi-intermediate} 53 | (events :0x40-0x7E) {:action :csi-dispatch, :transition :ground} 54 | (events 0x7f) {:action :ignore}} 55 | 56 | :csi-intermediate 57 | {c0-prime? {:action :execute} 58 | (events :0x20-0x2F) {:action :collect} 59 | (events :0x40-0x7E) {:action :csi-dispatch, :transition :ground} 60 | (events :0x30-0x3F) {:transition :csi-ignore} 61 | (events 0x7f) {:action :ignore}} 62 | 63 | :csi-ignore 64 | {c0-prime? {:action :execute} 65 | (events :0x20-0x3F) {:action :ignore} 66 | (events :0x40-0x7E) {:transition :ground} 67 | (events 0x7f) {:action :ignore}} 68 | 69 | :dcs-entry 70 | {:on-enter :clear 71 | c0-prime? {:action :ignore} 72 | (events :0x20-0x2F) {:action :collect, :transition :dcs-intermediate} 73 | (events 0x3A) {:transition :dcs-ignore} 74 | (events :0x30-0x39 0x3B) {:action :param, :transition :dcs-param} 75 | (events :0x3C-0x3F) {:action :collect, :transition :dcs-param} 76 | (events :0x40-0x7E) {:transition :dcs-passthrough} 77 | (events 0x7f) {:action :ignore}} 78 | 79 | :dcs-param 80 | {c0-prime? {:action :ignore} 81 | (events :0x20-0x2F) {:action :collect, :transition :dcs-intermediate} 82 | (events :0x30-0x39 0x3B) {:action :param} 83 | (events 0x3A :0x3C-0x3F) {:transition :dcs-ignore} 84 | (events :0x40-0x7E) {:transition :dcs-passthrough} 85 | (events 0x7f) {:action :ignore}} 86 | 87 | :dcs-intermediate 88 | {c0-prime? {:action :ignore} 89 | (events :0x20-0x2F) {:action :collect} 90 | (events :0x30-0x3F) {:transition :dcs-ignore} 91 | (events :0x40-0x7E) {:transition :dcs-passthrough} 92 | (events 0x7f) {:action :ignore}} 93 | 94 | :dcs-passthrough 95 | {:on-enter :hook 96 | c0-prime? {:action :put} 97 | (events :0x20-0x7E) {:action :put} 98 | (events 0x7f) {:action :ignore} 99 | :on-exit :unhook} 100 | 101 | :dcs-ignore 102 | {c0-prime? {:action :ignore} 103 | (events :0x20-0x7f) {:action :ignore}} 104 | 105 | :osc-string 106 | {:on-enter :osc-start 107 | (disj c0-prime? 0x07) {:action :ignore} 108 | (events :0x20-0x7F) {:action :osc-put} 109 | (events 0x07) {:transition :ground} ; 0x07 is xterm non-ANSI variant of transition to :ground 110 | :on-exit :osc-end} 111 | 112 | :sos-pm-apc-string 113 | {c0-prime? {:action :ignore} 114 | (events :0x20-0x7F) {:action :ignore}}}) 115 | 116 | (defn- get-transition [rules input] 117 | (some (fn [[pred cfg]] (when (pred input) cfg)) rules)) 118 | 119 | (defn parse* [current-state input] 120 | (let [current-state-cfg (get states* current-state) 121 | transition (or (get-transition anywhere-state input) 122 | (get-transition current-state-cfg (if (>= input 0xa0) 0x41 input))) 123 | transition-action (:action transition)] 124 | (if-let [new-state (:transition transition)] 125 | (let [new-state-cfg (get states* new-state) 126 | exit-action (:on-exit current-state-cfg) 127 | entry-action (:on-enter new-state-cfg) 128 | actions (vec (remove nil? [exit-action transition-action entry-action]))] 129 | [new-state actions]) 130 | [current-state (if transition-action [transition-action] [])]))) 131 | 132 | (defn build-lookup-table [] 133 | (apply merge (for [state (keys states*)] 134 | {state (mapv (partial parse* state) (range 0xa0))}))) 135 | 136 | (def states (build-lookup-table)) 137 | 138 | (defn parse [current-state input] 139 | (let [input (if (>= input 0xa0) 0x41 input)] 140 | (-> states current-state (get input)))) 141 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright 2015-2017 Marcin Kulik 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /test/asciinema/vt/parser_test.cljc: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt.parser-test 2 | #?(:cljs (:require-macros [cljs.test :refer [is are deftest testing]])) 3 | (:require #?(:clj [clojure.test :refer [is are deftest testing]] 4 | :cljs [cljs.test]) 5 | [asciinema.vt.parser :as parser :refer [parse]])) 6 | 7 | (defn test-event [initial-state input expected-state expected-actions] 8 | (is (= (parse initial-state input) [expected-state expected-actions]))) 9 | 10 | (defn test-high-events 11 | ([initial-state] (test-high-events initial-state [])) 12 | ([initial-state exit-actions] 13 | (doseq [input (range 0x80 (inc 0x8f))] 14 | (test-event initial-state input :ground (concat exit-actions [:execute]))) 15 | 16 | (test-event initial-state 0x90 :dcs-entry (concat exit-actions [:clear])) 17 | 18 | (doseq [input (range 0x91 (inc 0x97))] 19 | (test-event initial-state input :ground (concat exit-actions [:execute]))) 20 | 21 | (test-event initial-state 0x98 :sos-pm-apc-string exit-actions) 22 | 23 | (doseq [input (range 0x99 (inc 0x9a))] 24 | (test-event initial-state input :ground (concat exit-actions [:execute]))) 25 | 26 | (test-event initial-state 0x9b :csi-entry (concat exit-actions [:clear])) 27 | (test-event initial-state 0x9c :ground exit-actions) 28 | (test-event initial-state 0x9d :osc-string (concat exit-actions [:osc-start])) 29 | (test-event initial-state 0x9e :sos-pm-apc-string exit-actions) 30 | (test-event initial-state 0x9f :sos-pm-apc-string exit-actions))) 31 | 32 | (deftest parse-test 33 | (testing "all" 34 | (doseq [state (keys parser/states) 35 | input (range (inc 0x9f))] 36 | (is (not= (parse state input) nil)))) 37 | 38 | (testing "ground" 39 | (doseq [input (range 0x00 (inc 0x1a))] 40 | (test-event :ground input :ground [:execute])) 41 | 42 | (test-event :ground 0x1b :escape [:clear]) 43 | 44 | (doseq [input (range 0x1c (inc 0x1f))] 45 | (test-event :ground input :ground [:execute])) 46 | 47 | (doseq [input (range 0x20 (inc 0x7f))] 48 | (test-event :ground input :ground [:print])) 49 | 50 | (test-high-events :ground)) 51 | 52 | (testing "escape" 53 | (doseq [input (range 0x00 (inc 0x17))] 54 | (test-event :escape input :escape [:execute])) 55 | 56 | (test-event :escape 0x18 :ground [:execute]) 57 | (test-event :escape 0x19 :escape [:execute]) 58 | 59 | (test-event :escape 0x1a :ground [:execute]) 60 | (test-event :escape 0x1b :escape [:clear]) 61 | 62 | (doseq [input (range 0x1c (inc 0x1f))] 63 | (test-event :escape input :escape [:execute])) 64 | 65 | (doseq [input (range 0x20 (inc 0x2f))] 66 | (test-event :escape input :escape-intermediate [:collect])) 67 | 68 | (doseq [input (range 0x30 (inc 0x4f))] 69 | (test-event :escape input :ground [:esc-dispatch])) 70 | 71 | (test-event :escape 0x50 :dcs-entry [:clear]) 72 | 73 | (doseq [input (range 0x51 (inc 0x57))] 74 | (test-event :escape input :ground [:esc-dispatch])) 75 | 76 | (test-event :escape 0x58 :sos-pm-apc-string []) 77 | (test-event :escape 0x59 :ground [:esc-dispatch]) 78 | (test-event :escape 0x5a :ground [:esc-dispatch]) 79 | (test-event :escape 0x5b :csi-entry [:clear]) 80 | (test-event :escape 0x5c :ground [:esc-dispatch]) 81 | (test-event :escape 0x5d :osc-string [:osc-start]) 82 | (test-event :escape 0x5e :sos-pm-apc-string []) 83 | (test-event :escape 0x5f :sos-pm-apc-string []) 84 | 85 | (doseq [input (range 0x60 (inc 0x7e))] 86 | (test-event :escape input :ground [:esc-dispatch])) 87 | 88 | (test-event :escape 0x7f :escape [:ignore]) 89 | 90 | (test-high-events :escape)) 91 | 92 | (testing "escape-intermediate" 93 | (doseq [input (range 0x00 (inc 0x17))] 94 | (test-event :escape-intermediate input :escape-intermediate [:execute])) 95 | 96 | (test-event :escape-intermediate 0x18 :ground [:execute]) 97 | (test-event :escape-intermediate 0x19 :escape-intermediate [:execute]) 98 | (test-event :escape-intermediate 0x1a :ground [:execute]) 99 | (test-event :escape-intermediate 0x1b :escape [:clear]) 100 | 101 | (doseq [input (range 0x1c (inc 0x1f))] 102 | (test-event :escape-intermediate input :escape-intermediate [:execute])) 103 | 104 | (doseq [input (range 0x20 (inc 0x2f))] 105 | (test-event :escape-intermediate input :escape-intermediate [:collect])) 106 | 107 | (doseq [input (range 0x30 (inc 0x7e))] 108 | (test-event :escape-intermediate input :ground [:esc-dispatch])) 109 | 110 | (test-event :escape-intermediate 0x7f :escape-intermediate [:ignore]) 111 | 112 | (test-high-events :escape-intermediate)) 113 | 114 | (testing "csi-entry" 115 | (doseq [input (range 0x00 (inc 0x17))] 116 | (test-event :csi-entry input :csi-entry [:execute])) 117 | 118 | (test-event :csi-entry 0x18 :ground [:execute]) 119 | (test-event :csi-entry 0x19 :csi-entry [:execute]) 120 | (test-event :csi-entry 0x1a :ground [:execute]) 121 | (test-event :csi-entry 0x1b :escape [:clear]) 122 | 123 | (doseq [input (range 0x1c (inc 0x1f))] 124 | (test-event :csi-entry input :csi-entry [:execute])) 125 | 126 | (doseq [input (range 0x20 (inc 0x2f))] 127 | (test-event :csi-entry input :csi-intermediate [:collect])) 128 | 129 | (doseq [input (range 0x30 (inc 0x39))] 130 | (test-event :csi-entry input :csi-param [:param])) 131 | 132 | (test-event :csi-entry 0x3a :csi-ignore []) 133 | (test-event :csi-entry 0x3b :csi-param [:param]) 134 | 135 | (doseq [input (range 0x3c (inc 0x3f))] 136 | (test-event :csi-entry input :csi-param [:collect])) 137 | 138 | (doseq [input (range 0x40 (inc 0x7e))] 139 | (test-event :csi-entry input :ground [:csi-dispatch])) 140 | 141 | (test-event :csi-entry 0x7f :csi-entry [:ignore]) 142 | 143 | (test-high-events :csi-entry)) 144 | 145 | (testing "csi-param" 146 | (doseq [input (range 0x00 (inc 0x17))] 147 | (test-event :csi-param input :csi-param [:execute])) 148 | 149 | (test-event :csi-param 0x18 :ground [:execute]) 150 | (test-event :csi-param 0x19 :csi-param [:execute]) 151 | (test-event :csi-param 0x1a :ground [:execute]) 152 | (test-event :csi-param 0x1b :escape [:clear]) 153 | 154 | (doseq [input (range 0x1c (inc 0x1f))] 155 | (test-event :csi-param input :csi-param [:execute])) 156 | 157 | (doseq [input (range 0x20 (inc 0x2f))] 158 | (test-event :csi-param input :csi-intermediate [:collect])) 159 | 160 | (doseq [input (range 0x30 (inc 0x39))] 161 | (test-event :csi-param input :csi-param [:param])) 162 | 163 | (test-event :csi-param 0x3a :csi-ignore []) 164 | (test-event :csi-param 0x3b :csi-param [:param]) 165 | 166 | (doseq [input (range 0x3c (inc 0x3f))] 167 | (test-event :csi-param input :csi-ignore [])) 168 | 169 | (doseq [input (range 0x40 (inc 0x7e))] 170 | (test-event :csi-param input :ground [:csi-dispatch])) 171 | 172 | (test-event :csi-param 0x7f :csi-param [:ignore]) 173 | 174 | (test-high-events :csi-param)) 175 | 176 | (testing "csi-intermediate" 177 | (doseq [input (range 0x00 (inc 0x17))] 178 | (test-event :csi-intermediate input :csi-intermediate [:execute])) 179 | 180 | (test-event :csi-intermediate 0x18 :ground [:execute]) 181 | (test-event :csi-intermediate 0x19 :csi-intermediate [:execute]) 182 | (test-event :csi-intermediate 0x1a :ground [:execute]) 183 | (test-event :csi-intermediate 0x1b :escape [:clear]) 184 | 185 | (doseq [input (range 0x1c (inc 0x1f))] 186 | (test-event :csi-intermediate input :csi-intermediate [:execute])) 187 | 188 | (doseq [input (range 0x20 (inc 0x2f))] 189 | (test-event :csi-intermediate input :csi-intermediate [:collect])) 190 | 191 | (doseq [input (range 0x30 (inc 0x3f))] 192 | (test-event :csi-intermediate input :csi-ignore [])) 193 | 194 | (doseq [input (range 0x40 (inc 0x7e))] 195 | (test-event :csi-intermediate input :ground [:csi-dispatch])) 196 | 197 | (test-event :csi-intermediate 0x7f :csi-intermediate [:ignore]) 198 | 199 | (test-high-events :csi-intermediate)) 200 | 201 | (testing "csi-ignore" 202 | (doseq [input (range 0x00 (inc 0x17))] 203 | (test-event :csi-ignore input :csi-ignore [:execute])) 204 | 205 | (test-event :csi-ignore 0x18 :ground [:execute]) 206 | (test-event :csi-ignore 0x19 :csi-ignore [:execute]) 207 | (test-event :csi-ignore 0x1a :ground [:execute]) 208 | (test-event :csi-ignore 0x1b :escape [:clear]) 209 | 210 | (doseq [input (range 0x1c (inc 0x1f))] 211 | (test-event :csi-ignore input :csi-ignore [:execute])) 212 | 213 | (doseq [input (range 0x20 (inc 0x3f))] 214 | (test-event :csi-ignore input :csi-ignore [:ignore])) 215 | 216 | (doseq [input (range 0x40 (inc 0x7e))] 217 | (test-event :csi-ignore input :ground [])) 218 | 219 | (test-event :csi-ignore 0x7f :csi-ignore [:ignore]) 220 | 221 | (test-high-events :csi-ignore)) 222 | 223 | (testing "dcs-entry" 224 | (doseq [input (range 0x00 (inc 0x17))] 225 | (test-event :dcs-entry input :dcs-entry [:ignore])) 226 | 227 | (test-event :dcs-entry 0x18 :ground [:execute]) 228 | (test-event :dcs-entry 0x19 :dcs-entry [:ignore]) 229 | (test-event :dcs-entry 0x1a :ground [:execute]) 230 | (test-event :dcs-entry 0x1b :escape [:clear]) 231 | 232 | (doseq [input (range 0x1c (inc 0x1f))] 233 | (test-event :dcs-entry input :dcs-entry [:ignore])) 234 | 235 | (doseq [input (range 0x20 (inc 0x2f))] 236 | (test-event :dcs-entry input :dcs-intermediate [:collect])) 237 | 238 | (doseq [input (range 0x30 (inc 0x39))] 239 | (test-event :dcs-entry input :dcs-param [:param])) 240 | 241 | (test-event :dcs-entry 0x3a :dcs-ignore []) 242 | (test-event :dcs-entry 0x3b :dcs-param [:param]) 243 | 244 | (doseq [input (range 0x3c (inc 0x3f))] 245 | (test-event :dcs-entry input :dcs-param [:collect])) 246 | 247 | (doseq [input (range 0x40 (inc 0x7e))] 248 | (test-event :dcs-entry input :dcs-passthrough [:hook])) 249 | 250 | (test-event :dcs-entry 0x7f :dcs-entry [:ignore]) 251 | 252 | (test-high-events :dcs-entry)) 253 | 254 | (testing "dcs-param" 255 | (doseq [input (range 0x00 (inc 0x17))] 256 | (test-event :dcs-param input :dcs-param [:ignore])) 257 | 258 | (test-event :dcs-param 0x18 :ground [:execute]) 259 | (test-event :dcs-param 0x19 :dcs-param [:ignore]) 260 | (test-event :dcs-param 0x1a :ground [:execute]) 261 | (test-event :dcs-param 0x1b :escape [:clear]) 262 | 263 | (doseq [input (range 0x1c (inc 0x1f))] 264 | (test-event :dcs-param input :dcs-param [:ignore])) 265 | 266 | (doseq [input (range 0x20 (inc 0x2f))] 267 | (test-event :dcs-param input :dcs-intermediate [:collect])) 268 | 269 | (doseq [input (range 0x30 (inc 0x39))] 270 | (test-event :dcs-param input :dcs-param [:param])) 271 | 272 | (test-event :dcs-param 0x3a :dcs-ignore []) 273 | (test-event :dcs-param 0x3b :dcs-param [:param]) 274 | 275 | (doseq [input (range 0x3c (inc 0x3f))] 276 | (test-event :dcs-param input :dcs-ignore [])) 277 | 278 | (doseq [input (range 0x40 (inc 0x7e))] 279 | (test-event :dcs-param input :dcs-passthrough [:hook])) 280 | 281 | (test-event :dcs-param 0x7f :dcs-param [:ignore]) 282 | 283 | (test-high-events :dcs-param)) 284 | 285 | (testing "dcs-intermediate" 286 | (doseq [input (range 0x00 (inc 0x17))] 287 | (test-event :dcs-intermediate input :dcs-intermediate [:ignore])) 288 | 289 | (test-event :dcs-intermediate 0x18 :ground [:execute]) 290 | (test-event :dcs-intermediate 0x19 :dcs-intermediate [:ignore]) 291 | (test-event :dcs-intermediate 0x1a :ground [:execute]) 292 | (test-event :dcs-intermediate 0x1b :escape [:clear]) 293 | 294 | (doseq [input (range 0x1c (inc 0x1f))] 295 | (test-event :dcs-intermediate input :dcs-intermediate [:ignore])) 296 | 297 | (doseq [input (range 0x20 (inc 0x2f))] 298 | (test-event :dcs-intermediate input :dcs-intermediate [:collect])) 299 | 300 | (doseq [input (range 0x30 (inc 0x3f))] 301 | (test-event :dcs-intermediate input :dcs-ignore [])) 302 | 303 | (doseq [input (range 0x40 (inc 0x7e))] 304 | (test-event :dcs-intermediate input :dcs-passthrough [:hook])) 305 | 306 | (test-event :dcs-intermediate 0x7f :dcs-intermediate [:ignore]) 307 | 308 | (test-high-events :dcs-intermediate)) 309 | 310 | (testing "dcs-passthrough" 311 | (doseq [input (range 0x00 (inc 0x17))] 312 | (test-event :dcs-passthrough input :dcs-passthrough [:put])) 313 | 314 | (test-event :dcs-passthrough 0x18 :ground [:unhook :execute]) 315 | (test-event :dcs-passthrough 0x19 :dcs-passthrough [:put]) 316 | (test-event :dcs-passthrough 0x1a :ground [:unhook :execute]) 317 | (test-event :dcs-passthrough 0x1b :escape [:unhook :clear]) 318 | 319 | (doseq [input (range 0x1c (inc 0x7e))] 320 | (test-event :dcs-passthrough input :dcs-passthrough [:put])) 321 | 322 | (test-event :dcs-passthrough 0x7f :dcs-passthrough [:ignore]) 323 | 324 | (test-high-events :dcs-passthrough [:unhook])) 325 | 326 | (testing "dcs-ignore" 327 | (doseq [input (range 0x00 (inc 0x17))] 328 | (test-event :dcs-ignore input :dcs-ignore [:ignore])) 329 | 330 | (test-event :dcs-ignore 0x18 :ground [:execute]) 331 | (test-event :dcs-ignore 0x19 :dcs-ignore [:ignore]) 332 | (test-event :dcs-ignore 0x1a :ground [:execute]) 333 | (test-event :dcs-ignore 0x1b :escape [:clear]) 334 | 335 | (doseq [input (range 0x1c (inc 0x7f))] 336 | (test-event :dcs-ignore input :dcs-ignore [:ignore])) 337 | 338 | (test-high-events :dcs-ignore)) 339 | 340 | (testing "osc-string" 341 | (doseq [input (range 0x00 (inc 0x06))] 342 | (test-event :osc-string input :osc-string [:ignore])) 343 | 344 | (test-event :osc-string 0x07 :ground [:osc-end]) 345 | 346 | (doseq [input (range 0x08 (inc 0x17))] 347 | (test-event :osc-string input :osc-string [:ignore])) 348 | 349 | (test-event :osc-string 0x18 :ground [:osc-end :execute]) 350 | (test-event :osc-string 0x19 :osc-string [:ignore]) 351 | (test-event :osc-string 0x1a :ground [:osc-end :execute]) 352 | (test-event :osc-string 0x1b :escape [:osc-end :clear]) 353 | 354 | (doseq [input (range 0x1c (inc 0x1f))] 355 | (test-event :osc-string input :osc-string [:ignore])) 356 | 357 | (doseq [input (range 0x20 (inc 0x7f))] 358 | (test-event :osc-string input :osc-string [:osc-put])) 359 | 360 | (test-high-events :osc-string [:osc-end])) 361 | 362 | (testing "sos-pm-apc-string" 363 | (doseq [input (range 0x00 (inc 0x17))] 364 | (test-event :sos-pm-apc-string input :sos-pm-apc-string [:ignore])) 365 | 366 | (test-event :sos-pm-apc-string 0x18 :ground [:execute]) 367 | (test-event :sos-pm-apc-string 0x19 :sos-pm-apc-string [:ignore]) 368 | (test-event :sos-pm-apc-string 0x1a :ground [:execute]) 369 | (test-event :sos-pm-apc-string 0x1b :escape [:clear]) 370 | 371 | (doseq [input (range 0x1c (inc 0x7f))] 372 | (test-event :sos-pm-apc-string input :sos-pm-apc-string [:ignore])) 373 | 374 | (test-high-events :sos-pm-apc-string))) 375 | -------------------------------------------------------------------------------- /src/asciinema/vt.cljc: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt 2 | (:refer-clojure :exclude [print]) 3 | (:require [asciinema.vt.screen :as screen] 4 | [asciinema.vt.parser :as parser] 5 | [schema.core :as s #?@(:cljs [:include-macros true])] 6 | [clojure.string :as str] 7 | #?(:cljs [asciinema.vt.codepoint-polyfill]) 8 | #?(:clj [clojure.core.match :refer [match]] 9 | :cljs [cljs.core.match :refer-macros [match]]) 10 | #?(:cljs [asciinema.vt.screen :refer [Screen]])) 11 | #?(:clj (:import [asciinema.vt.screen Screen]))) 12 | 13 | ;; References: 14 | ;; http://invisible-island.net/xterm/ctlseqs/ctlseqs.html 15 | ;; http://www.inwap.com/pdp10/ansicode.txt 16 | ;; http://manpages.ubuntu.com/manpages/lucid/man7/urxvt.7.html 17 | ;; http://en.wikipedia.org/wiki/ANSI_escape_code 18 | ;; http://vt100.net/emu/dec_ansi_parser 19 | ;; http://ttssh2.sourceforge.jp/manual/en/about/ctrlseq.html 20 | ;; http://real-world-systems.com/docs/ANSIcode.html 21 | ;; http://www.shaels.net/index.php/propterm/documents 22 | ;; http://vt100.net/docs/vt102-ug/chapter5.html 23 | 24 | (s/defrecord VT 25 | [parser-state :- s/Keyword 26 | parser-params :- [s/Int] 27 | parser-intermediates :- [s/Int] 28 | screen :- Screen]) 29 | 30 | (s/defn make-vt :- VT 31 | [width :- s/Num 32 | height :- s/Num] 33 | (map->VT {:parser-state :ground 34 | :parser-params [] 35 | :parser-intermediates [] 36 | :screen (screen/blank-screen width height)})) 37 | 38 | ;; helper functions 39 | 40 | (defn set-mode [vt intermediate param] 41 | (match [intermediate param] 42 | [nil 4] (update vt :screen screen/enable-insert-mode) 43 | [nil 20] (update vt :screen screen/enable-new-line-mode) 44 | [0x3f 6] (update vt :screen #(-> % screen/enable-origin-mode screen/move-cursor-to-home)) 45 | [0x3f 7] (update vt :screen screen/enable-auto-wrap-mode) 46 | [0x3f 25] (update vt :screen screen/show-cursor) 47 | [0x3f 47] (update vt :screen screen/switch-to-alternate-buffer) 48 | [0x3f 1047] (update vt :screen screen/switch-to-alternate-buffer) 49 | [0x3f 1048] (update vt :screen screen/save-cursor) 50 | [0x3f 1049] (update vt :screen #(-> % screen/save-cursor screen/switch-to-alternate-buffer)) 51 | :else vt)) 52 | 53 | (defn reset-mode [vt intermediate param] 54 | (match [intermediate param] 55 | [nil 4] (update vt :screen screen/disable-insert-mode) 56 | [nil 20] (update vt :screen screen/disable-new-line-mode) 57 | [0x3f 6] (update vt :screen #(-> % screen/disable-origin-mode screen/move-cursor-to-home)) 58 | [0x3f 7] (update vt :screen screen/disable-auto-wrap-mode) 59 | [0x3f 25] (update vt :screen screen/hide-cursor) 60 | [0x3f 47] (update vt :screen screen/switch-to-primary-buffer) 61 | [0x3f 1047] (update vt :screen screen/switch-to-primary-buffer) 62 | [0x3f 1048] (update vt :screen screen/restore-cursor) 63 | [0x3f 1049] (update vt :screen #(-> % screen/switch-to-primary-buffer screen/restore-cursor)) 64 | :else vt)) 65 | 66 | (defn split-coll [elem coll] 67 | (loop [coll coll 68 | parts [] 69 | part []] 70 | (if-let [e (first coll)] 71 | (if (= e elem) 72 | (recur (rest coll) (conj parts part) []) 73 | (recur (rest coll) parts (conj part e))) 74 | (if (seq part) 75 | (conj parts part) 76 | parts)))) 77 | 78 | (defn reduce-param [chars] 79 | (let [digits (map #(- % 0x30) chars) 80 | components (map * (reverse digits) (iterate #(* 10 %) 1))] 81 | (reduce + 0 components))) 82 | 83 | (defn get-intermediate [vt n] 84 | (-> vt :parser-intermediates (get n))) 85 | 86 | (def get-cached-params (memoize (fn [chars] 87 | (let [groups (split-coll 0x3b chars)] 88 | (map reduce-param groups))))) 89 | 90 | (defn get-params [vt] 91 | (get-cached-params (:parser-params vt))) 92 | 93 | (defn get-param [vt n default] 94 | (let [v (nth (get-params vt) n 0)] 95 | (if (zero? v) 96 | default 97 | v))) 98 | 99 | ;; terminal control functions 100 | 101 | (defn execute-bs [vt] 102 | (update vt :screen screen/move-cursor-left)) 103 | 104 | (defn execute-ht [vt] 105 | (update vt :screen screen/move-cursor-to-next-tab 1)) 106 | 107 | (defn execute-cr [vt] 108 | (update vt :screen screen/move-cursor-to-col! 0)) 109 | 110 | (defn execute-lf [vt] 111 | (update vt :screen screen/line-feed)) 112 | 113 | (defn execute-so [vt] 114 | (update vt :screen screen/set-special-charset)) 115 | 116 | (defn execute-si [vt] 117 | (update vt :screen screen/set-default-charset)) 118 | 119 | (defn execute-nel [vt] 120 | (update vt :screen screen/new-line)) 121 | 122 | (defn execute-hts [vt] 123 | (update vt :screen screen/set-horizontal-tab)) 124 | 125 | (defn execute-ri [vt] 126 | (update vt :screen screen/reverse-index)) 127 | 128 | (defn execute-decaln [vt] 129 | (update vt :screen screen/test-pattern)) 130 | 131 | (defn execute-sc [vt] 132 | (update vt :screen screen/save-cursor)) 133 | 134 | (defn execute-rc [vt] 135 | (update vt :screen screen/restore-cursor)) 136 | 137 | (defn execute-ris [vt] 138 | (make-vt (-> vt :screen screen/width) (-> vt :screen screen/height))) 139 | 140 | (defn execute-ich [vt] 141 | (let [n (get-param vt 0 1)] 142 | (update vt :screen screen/insert-characters n))) 143 | 144 | (defn execute-cuu [vt] 145 | (let [n (get-param vt 0 1)] 146 | (update vt :screen screen/cursor-up n))) 147 | 148 | (defn execute-cud [vt] 149 | (let [n (get-param vt 0 1)] 150 | (update vt :screen screen/cursor-down n))) 151 | 152 | (defn execute-cuf [vt] 153 | (let [n (get-param vt 0 1)] 154 | (update vt :screen screen/cursor-forward n))) 155 | 156 | (defn execute-cub [vt] 157 | (let [n (get-param vt 0 1)] 158 | (update vt :screen screen/cursor-backward n))) 159 | 160 | (defn execute-cnl [vt] 161 | (let [n (get-param vt 0 1)] 162 | (update vt :screen #(-> % 163 | (screen/cursor-down n) 164 | (screen/move-cursor-to-col! 0))))) 165 | 166 | (defn execute-cpl [vt] 167 | (let [n (get-param vt 0 1)] 168 | (update vt :screen #(-> % 169 | (screen/cursor-up n) 170 | (screen/move-cursor-to-col! 0))))) 171 | 172 | (defn execute-cha [vt] 173 | (let [x (dec (get-param vt 0 1))] 174 | (update vt :screen screen/move-cursor-to-col x))) 175 | 176 | (defn execute-cup [vt] 177 | (let [y (dec (get-param vt 0 1)) 178 | x (dec (get-param vt 1 1))] 179 | (update vt :screen screen/move-cursor x y))) 180 | 181 | (defn execute-cht [vt] 182 | (let [n (get-param vt 0 1)] 183 | (update vt :screen screen/move-cursor-to-next-tab n))) 184 | 185 | (defn execute-ed [vt] 186 | (let [n (get-param vt 0 0)] 187 | (update vt :screen (case n 188 | 0 screen/clear-to-end-of-screen 189 | 1 screen/clear-to-beginning-of-screen 190 | 2 screen/clear-screen 191 | identity)))) 192 | 193 | (defn execute-el [vt] 194 | (let [n (get-param vt 0 0)] 195 | (update vt :screen (case n 196 | 0 screen/clear-to-end-of-line 197 | 1 screen/clear-to-beginning-of-line 198 | 2 screen/clear-line 199 | identity)))) 200 | 201 | (defn execute-su [vt] 202 | (let [n (get-param vt 0 1)] 203 | (update vt :screen screen/scroll-up n))) 204 | 205 | (defn execute-sd [vt] 206 | (let [n (get-param vt 0 1)] 207 | (update vt :screen screen/scroll-down n))) 208 | 209 | (defn execute-il [vt] 210 | (let [n (get-param vt 0 1)] 211 | (update vt :screen screen/insert-lines n))) 212 | 213 | (defn execute-dl [vt] 214 | (let [n (get-param vt 0 1)] 215 | (update vt :screen screen/delete-lines n))) 216 | 217 | (defn execute-dch [vt] 218 | (let [n (get-param vt 0 1)] 219 | (update vt :screen screen/delete-characters n))) 220 | 221 | (defn execute-ctc [vt] 222 | (let [n (get-param vt 0 0)] 223 | (case n 224 | 0 (update vt :screen screen/set-horizontal-tab) 225 | 2 (update vt :screen screen/clear-horizontal-tab) 226 | 5 (update vt :screen screen/clear-all-horizontal-tabs) 227 | vt))) 228 | 229 | (defn execute-ech [vt] 230 | (let [n (get-param vt 0 1)] 231 | (update vt :screen screen/erase-characters n))) 232 | 233 | (defn execute-cbt [vt] 234 | (let [n (get-param vt 0 1)] 235 | (update vt :screen screen/move-cursor-to-prev-tab n))) 236 | 237 | (defn execute-tbc [vt] 238 | (let [n (get-param vt 0 0)] 239 | (case n 240 | 0 (update vt :screen screen/clear-horizontal-tab) 241 | 3 (update vt :screen screen/clear-all-horizontal-tabs) 242 | vt))) 243 | 244 | (defn execute-sm [vt] 245 | (let [intermediate (get-intermediate vt 0)] 246 | (reduce #(set-mode %1 intermediate %2) vt (get-params vt)))) 247 | 248 | (defn execute-rm [vt] 249 | (let [intermediate (get-intermediate vt 0)] 250 | (reduce #(reset-mode %1 intermediate %2) vt (get-params vt)))) 251 | 252 | (defn execute-sgr* [screen params] 253 | (loop [screen screen 254 | params params] 255 | (if (seq params) 256 | (let [x (first params)] 257 | (case x 258 | 0 (recur (screen/reset-char-attrs screen) (rest params)) 259 | 1 (recur (screen/set-attr screen :bold true) (rest params)) 260 | 3 (recur (screen/set-attr screen :italic true) (rest params)) 261 | 4 (recur (screen/set-attr screen :underline true) (rest params)) 262 | 5 (recur (screen/set-attr screen :blink true) (rest params)) 263 | 7 (recur (screen/set-attr screen :inverse true) (rest params)) 264 | 9 (recur (screen/set-attr screen :strikethrough true) (rest params)) 265 | 21 (recur (screen/unset-attr screen :bold) (rest params)) 266 | 22 (recur (screen/unset-attr screen :bold) (rest params)) 267 | 23 (recur (screen/unset-attr screen :italic) (rest params)) 268 | 24 (recur (screen/unset-attr screen :underline) (rest params)) 269 | 25 (recur (screen/unset-attr screen :blink) (rest params)) 270 | 27 (recur (screen/unset-attr screen :inverse) (rest params)) 271 | (30 31 32 33 34 35 36 37) (recur (screen/set-attr screen :fg (- x 30)) (rest params)) 272 | 38 (case (second params) 273 | 2 (let [[r g b] (take 3 (drop 2 params))] 274 | (if b ; all r, g and b are not nil 275 | (recur (screen/set-attr screen :fg [r g b]) (drop 5 params)) 276 | (recur screen (drop 2 params)))) 277 | 5 (if-let [fg (first (drop 2 params))] 278 | (recur (screen/set-attr screen :fg fg) (drop 3 params)) 279 | (recur screen (drop 2 params))) 280 | (recur screen (rest params))) 281 | 39 (recur (screen/unset-attr screen :fg) (rest params)) 282 | (40 41 42 43 44 45 46 47) (recur (screen/set-attr screen :bg (- x 40)) (rest params)) 283 | 48 (case (second params) 284 | 2 (let [[r g b] (take 3 (drop 2 params))] 285 | (if b ; all r, g and b are not nil 286 | (recur (screen/set-attr screen :bg [r g b]) (drop 5 params)) 287 | (recur screen (drop 2 params)))) 288 | 5 (if-let [bg (first (drop 2 params))] 289 | (recur (screen/set-attr screen :bg bg) (drop 3 params)) 290 | (recur screen (drop 2 params))) 291 | (recur screen (rest params))) 292 | 49 (recur (screen/unset-attr screen :bg) (rest params)) 293 | (90 91 92 93 94 95 96 97) (recur (screen/set-attr screen :fg (- x 82)) (rest params)) 294 | (100 101 102 103 104 105 106 107) (recur (screen/set-attr screen :bg (- x 92)) (rest params)) 295 | (recur screen (rest params)))) 296 | screen))) 297 | 298 | (defn execute-sgr [vt] 299 | (let [params (or (seq (get-params vt)) [0])] 300 | (update vt :screen execute-sgr* params))) 301 | 302 | (defn execute-vpa [vt] 303 | (let [n (dec (get-param vt 0 1))] 304 | (update vt :screen screen/move-cursor-to-row-within-margins n))) 305 | 306 | (defn execute-decstr [vt] 307 | (if (= (get-intermediate vt 0) 0x21) 308 | (update vt :screen screen/soft-reset) 309 | vt)) 310 | 311 | (defn execute-decstbm [vt] 312 | (let [top (dec (get-param vt 0 1)) 313 | bottom (some-> vt (get-param 1 nil) dec)] 314 | (update vt :screen #(-> % 315 | (screen/set-margins top bottom) 316 | screen/move-cursor-to-home)))) 317 | 318 | ;; parser actions 319 | 320 | (defn ignore [vt input] 321 | vt) 322 | 323 | (defn print [vt input] 324 | (update vt :screen screen/print input)) 325 | 326 | (defn execute [vt input] 327 | (if-let [action (case input 328 | 0x08 execute-bs 329 | 0x09 execute-ht 330 | 0x0a execute-lf 331 | 0x0b execute-lf 332 | 0x0c execute-lf 333 | 0x0d execute-cr 334 | 0x0e execute-so 335 | 0x0f execute-si 336 | 0x84 execute-lf 337 | 0x85 execute-nel 338 | 0x88 execute-hts 339 | 0x8d execute-ri 340 | nil)] 341 | (action vt) 342 | vt)) 343 | 344 | (defn clear [vt input] 345 | (assoc vt :parser-intermediates [] :parser-params [])) 346 | 347 | (defn collect [vt input] 348 | (assoc vt :parser-intermediates (conj (:parser-intermediates vt) input))) 349 | 350 | (defn param [vt input] 351 | (assoc vt :parser-params (conj (:parser-params vt) input))) 352 | 353 | (defn esc-dispatch [vt input] 354 | (match [(get-intermediate vt 0) input] 355 | [nil (_ :guard #(<= 0x40 % 0x5f))] (execute vt (+ input 0x40)) 356 | [nil 0x37] (execute-sc vt) 357 | [nil 0x38] (execute-rc vt) 358 | [nil 0x63] (execute-ris vt) 359 | [0x23 0x38] (execute-decaln vt) 360 | [0x28 0x30] (execute-so vt) 361 | [0x28 _] (execute-si vt) 362 | :else vt)) 363 | 364 | (defn csi-dispatch [vt input] 365 | (if-let [action (case input 366 | 0x40 execute-ich 367 | 0x41 execute-cuu 368 | 0x42 execute-cud 369 | 0x43 execute-cuf 370 | 0x44 execute-cub 371 | 0x45 execute-cnl 372 | 0x46 execute-cpl 373 | 0x47 execute-cha 374 | 0x48 execute-cup 375 | 0x49 execute-cht 376 | 0x4a execute-ed 377 | 0x4b execute-el 378 | 0x4c execute-il 379 | 0x4d execute-dl 380 | 0x50 execute-dch 381 | 0x53 execute-su 382 | 0x54 execute-sd 383 | 0x57 execute-ctc 384 | 0x58 execute-ech 385 | 0x5a execute-cbt 386 | 0x60 execute-cha 387 | 0x61 execute-cuf 388 | 0x64 execute-vpa 389 | 0x65 execute-cuu 390 | 0x66 execute-cup 391 | 0x67 execute-tbc 392 | 0x68 execute-sm 393 | 0x6c execute-rm 394 | 0x6d execute-sgr 395 | 0x70 execute-decstr 396 | 0x72 execute-decstbm 397 | nil)] 398 | (action vt) 399 | vt)) 400 | 401 | (defn hook [vt input] 402 | vt) 403 | 404 | (defn put [vt input] 405 | vt) 406 | 407 | (defn unhook [vt input] 408 | vt) 409 | 410 | (defn osc-start [vt input] 411 | vt) 412 | 413 | (defn osc-put [vt input] 414 | vt) 415 | 416 | (defn osc-end [vt input] 417 | vt) 418 | 419 | ;; end actions 420 | 421 | (def action-mapping 422 | {:execute execute 423 | :print print 424 | :clear clear 425 | :collect collect 426 | :esc-dispatch esc-dispatch 427 | :ignore ignore 428 | :csi-dispatch csi-dispatch 429 | :param param 430 | :hook hook 431 | :put put 432 | :unhook unhook 433 | :osc-start osc-start 434 | :osc-put osc-put 435 | :osc-end osc-end}) 436 | 437 | (defn execute-actions [vt actions input] 438 | (loop [vt vt 439 | actions actions] 440 | (if (seq actions) 441 | (recur ((action-mapping (first actions)) vt input) (next actions)) 442 | vt))) 443 | 444 | (defn feed [vt inputs] 445 | (loop [vt vt 446 | parser-state (:parser-state vt) 447 | inputs inputs] 448 | (if-let [input (first inputs)] 449 | (let [[new-parser-state actions] (parser/parse parser-state input)] 450 | (recur (execute-actions vt actions input) new-parser-state (rest inputs))) 451 | (assoc vt :parser-state parser-state)))) 452 | 453 | (defn feed-one [vt input] 454 | (feed vt [input])) 455 | 456 | (defn feed-str [vt str] 457 | (let [codes #?(:clj (mapv #(.codePointAt str %) (range (count str))) 458 | :cljs (mapv #(.codePointAt % 0) str))] 459 | (feed vt codes))) 460 | 461 | (defn dump-color [base c] 462 | (match c 463 | [r g b] (str (+ base 8) ";2;" r ";" g ";" b) 464 | (_ :guard #(< % 8)) (str (+ base c)) 465 | (_ :guard #(< % 16)) (str (+ base 52 c)) 466 | :else (str (+ base 8) ";5;" c))) 467 | 468 | (def dump-fg (partial dump-color 30)) 469 | (def dump-bg (partial dump-color 40)) 470 | 471 | (defn dump-sgr [{:keys [fg bg bold italic underline blink inverse strikethrough]}] 472 | (str 473 | (cond-> "\u001b[0" 474 | fg (str ";" (dump-fg fg)) 475 | bg (str ";" (dump-bg bg)) 476 | bold (str ";1") 477 | italic (str ";3") 478 | underline (str ";4") 479 | blink (str ";5") 480 | inverse (str ";7") 481 | strikethrough (str ";9")) 482 | "m")) 483 | 484 | (defn dump-fragment [[text attrs]] 485 | (str (dump-sgr attrs) text)) 486 | 487 | (defn dump-line [line] 488 | (str/replace (str/join (map dump-fragment line)) #"\u001b\[0m\u0020+$" "")) 489 | 490 | (defn dump [vt] 491 | (str/join "\r\n" (map dump-line (-> vt :screen screen/lines)))) 492 | -------------------------------------------------------------------------------- /src/asciinema/vt/screen.cljc: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt.screen 2 | (:refer-clojure :exclude [print]) 3 | (:require [schema.core :as s #?@(:cljs [:include-macros true])])) 4 | 5 | (def Tabs #?(:clj clojure.lang.PersistentTreeSet :cljs cljs.core/PersistentTreeSet)) 6 | 7 | (def Charset (s/pred ifn?)) 8 | 9 | (def Cursor {:x s/Num 10 | :y s/Num 11 | :visible s/Bool}) 12 | 13 | (def CodePoint s/Num) 14 | 15 | (def Color (s/if vector? 16 | [(s/one s/Num "r") (s/one s/Num "g") (s/one s/Num "b")] 17 | s/Num)) 18 | 19 | (def CharAttrs {(s/optional-key :fg) Color 20 | (s/optional-key :bg) Color 21 | (s/optional-key :bold) s/Bool 22 | (s/optional-key :italic) s/Bool 23 | (s/optional-key :underline) s/Bool 24 | (s/optional-key :strikethrough) s/Bool 25 | (s/optional-key :blink) s/Bool 26 | (s/optional-key :inverse) s/Bool}) 27 | 28 | (def SavedCursor {:cursor {:x s/Num :y s/Num} 29 | :char-attrs CharAttrs 30 | :origin-mode s/Bool 31 | :auto-wrap-mode s/Bool}) 32 | 33 | (def Cell [(s/one CodePoint "unicode codepoint") (s/one CharAttrs "text attributes")]) 34 | 35 | (def CellLine [Cell]) 36 | 37 | (s/defrecord Screen 38 | [width :- s/Num 39 | height :- s/Num 40 | top-margin :- s/Num 41 | bottom-margin :- s/Num 42 | tabs :- Tabs 43 | cursor :- Cursor 44 | char-attrs :- CharAttrs 45 | charset-fn :- Charset 46 | insert-mode :- s/Bool 47 | auto-wrap-mode :- s/Bool 48 | new-line-mode :- s/Bool 49 | next-print-wraps :- s/Bool 50 | origin-mode :- s/Bool 51 | buffer :- s/Keyword 52 | lines :- [CellLine] 53 | saved :- SavedCursor 54 | other-buffer-lines :- (s/maybe [CellLine]) 55 | other-buffer-saved :- SavedCursor]) 56 | 57 | ;; field accessors 58 | 59 | (def width :width) 60 | (def height :height) 61 | (def char-attrs :char-attrs) 62 | (def next-print-wraps? :next-print-wraps) 63 | (def origin-mode? :origin-mode) 64 | (def auto-wrap-mode? :auto-wrap-mode) 65 | (def insert-mode? :insert-mode) 66 | (def new-line-mode? :new-line-mode) 67 | 68 | (def space 0x20) 69 | 70 | (def normal-char-attrs {}) 71 | 72 | (s/defn cell :- Cell 73 | [ch :- CodePoint 74 | char-attrs :- CharAttrs] 75 | (vector ch char-attrs)) 76 | 77 | (s/defn blank-cell :- Cell 78 | [char-attrs] 79 | (cell space char-attrs)) 80 | 81 | (s/defn blank-line :- CellLine 82 | ([width] (blank-line width normal-char-attrs)) 83 | ([width char-attrs] 84 | (vec (repeat width (blank-cell char-attrs))))) 85 | 86 | (s/defn blank-buffer :- [CellLine] 87 | ([width height] (blank-buffer width height normal-char-attrs)) 88 | ([width height char-attrs] 89 | (let [line (blank-line width char-attrs)] 90 | (vec (repeat height line))))) 91 | 92 | (s/defn default-tabs :- Tabs 93 | [width] 94 | (apply sorted-set (range 8 width 8))) 95 | 96 | (def initial-cursor {:x 0 97 | :y 0 98 | :visible true}) 99 | 100 | (def initial-saved-cursor {:cursor {:x 0 :y 0} 101 | :char-attrs normal-char-attrs 102 | :origin-mode false 103 | :auto-wrap-mode true}) 104 | 105 | (def default-charset identity) 106 | 107 | (def special-charset {96 9830, 97 9618, 98 9225, 99 9228, 108 | 100 9229, 101 9226, 102 176, 103 177, 109 | 104 9252, 105 9227, 106 9496, 107 9488, 110 | 108 9484, 109 9492, 110 9532, 111 9146, 111 | 112 9147, 113 9472, 114 9148, 115 9149, 112 | 116 9500, 117 9508, 118 9524, 119 9516, 113 | 120 9474, 121 8804, 122 8805, 123 960, 114 | 124 8800, 125 163, 126 8901}) 115 | 116 | (s/defn blank-screen :- Screen 117 | [width :- s/Num 118 | height :- s/Num] 119 | (map->Screen {:width width 120 | :height height 121 | :top-margin 0 122 | :bottom-margin (dec height) 123 | :tabs (default-tabs width) 124 | :cursor initial-cursor 125 | :char-attrs normal-char-attrs 126 | :charset-fn default-charset 127 | :insert-mode false 128 | :auto-wrap-mode true 129 | :new-line-mode false 130 | :next-print-wraps false 131 | :origin-mode false 132 | :buffer :primary 133 | :lines (blank-buffer width height) 134 | :saved initial-saved-cursor 135 | :other-buffer-lines nil 136 | :other-buffer-saved initial-saved-cursor})) 137 | 138 | ;; modes 139 | 140 | (defn enable-insert-mode [screen] 141 | (assoc screen :insert-mode true)) 142 | 143 | (defn disable-insert-mode [screen] 144 | (assoc screen :insert-mode false)) 145 | 146 | (defn enable-new-line-mode [screen] 147 | (assoc screen :new-line-mode true)) 148 | 149 | (defn disable-new-line-mode [screen] 150 | (assoc screen :new-line-mode false)) 151 | 152 | (defn enable-origin-mode [screen] 153 | (assoc screen :origin-mode true)) 154 | 155 | (defn disable-origin-mode [screen] 156 | (assoc screen :origin-mode false)) 157 | 158 | (defn enable-auto-wrap-mode [screen] 159 | (assoc screen :auto-wrap-mode true)) 160 | 161 | (defn disable-auto-wrap-mode [screen] 162 | (assoc screen :auto-wrap-mode false)) 163 | 164 | ;; char attrs 165 | 166 | (defn reset-char-attrs [screen] 167 | (assoc screen :char-attrs normal-char-attrs)) 168 | 169 | (defn set-attr [screen attr-name value] 170 | (assoc-in screen [:char-attrs attr-name] value)) 171 | 172 | (defn unset-attr [screen attr-name] 173 | (update screen :char-attrs dissoc attr-name)) 174 | 175 | ;; scrolling 176 | 177 | (defn- scroll-up-lines [lines n filler] 178 | (let [n (min n (count lines))] 179 | (concat 180 | (drop n lines) 181 | (repeat n filler)))) 182 | 183 | (defn scroll-up 184 | ([screen] (scroll-up screen 1)) 185 | ([{:keys [width top-margin bottom-margin char-attrs] :as screen} n] 186 | (let [filler (blank-line width char-attrs)] 187 | (update screen :lines (fn [lines] 188 | (vec (concat 189 | (take top-margin lines) 190 | (scroll-up-lines (subvec lines top-margin (inc bottom-margin)) n filler) 191 | (drop (inc bottom-margin) lines)))))))) 192 | 193 | (defn- scroll-down-lines [lines n filler] 194 | (let [height (count lines) 195 | n (min n height)] 196 | (concat 197 | (repeat n filler) 198 | (take (- height n) lines)))) 199 | 200 | (defn scroll-down 201 | ([screen] (scroll-down screen 1)) 202 | ([{:keys [width top-margin bottom-margin char-attrs] :as screen} n] 203 | (let [filler (blank-line width char-attrs)] 204 | (update screen :lines (fn [lines] 205 | (vec (concat 206 | (take top-margin lines) 207 | (scroll-down-lines (subvec lines top-margin (inc bottom-margin)) n filler) 208 | (drop (inc bottom-margin) lines)))))))) 209 | 210 | ;; cursor 211 | 212 | (defn cursor [screen] 213 | (:cursor screen)) 214 | 215 | (defn saved [screen] 216 | (:saved screen)) 217 | 218 | (defn show-cursor [screen] 219 | (assoc-in screen [:cursor :visible] true)) 220 | 221 | (defn hide-cursor [screen] 222 | (assoc-in screen [:cursor :visible] false)) 223 | 224 | (defn move-cursor-to-col! [screen x] 225 | (-> screen 226 | (assoc-in [:cursor :x] x) 227 | (assoc :next-print-wraps false))) 228 | 229 | (defn move-cursor-to-col [{width :width :as screen} x] 230 | (move-cursor-to-col! screen (-> x (max 0) (min (dec width))))) 231 | 232 | (defn move-cursor-to-row! [{:keys [width] {:keys [x]} :cursor :as screen} y] 233 | (-> screen 234 | (assoc-in [:cursor :x] (min x (dec width))) 235 | (assoc-in [:cursor :y] y) 236 | (assoc :next-print-wraps false))) 237 | 238 | (defn top-margin [{:keys [origin-mode top-margin] :as screen}] 239 | (if origin-mode top-margin 0)) 240 | 241 | (defn bottom-margin [{:keys [origin-mode bottom-margin height] :as screen}] 242 | (if origin-mode bottom-margin (dec height))) 243 | 244 | (defn adjust-to-range [value min-value max-value] 245 | (min max-value (max value min-value))) 246 | 247 | (defn- adjust-y-to-margins [screen y] 248 | (let [top (top-margin screen) 249 | bottom (bottom-margin screen)] 250 | (adjust-to-range (+ top y) top bottom))) 251 | 252 | (defn move-cursor-to-row-within-margins [screen y] 253 | (move-cursor-to-row! screen (adjust-y-to-margins screen y))) 254 | 255 | (defn move-cursor-to-home [screen] 256 | (-> screen 257 | (move-cursor-to-col! 0) 258 | (move-cursor-to-row! (top-margin screen)))) 259 | 260 | (defn move-cursor [screen x y] 261 | (-> screen 262 | (move-cursor-to-col x) 263 | (move-cursor-to-row-within-margins y))) 264 | 265 | (defn- move-cursor-down-with-scroll [{:keys [bottom-margin height] {y :y} :cursor :as screen}] 266 | (let [last-row (dec height)] 267 | (cond (= y bottom-margin) (scroll-up screen) 268 | (< y last-row) (move-cursor-to-row! screen (inc y)) 269 | :else screen))) 270 | 271 | (defn move-cursor-left [{{x :x} :cursor :as screen}] 272 | (move-cursor-to-col screen (dec x))) 273 | 274 | (defn cursor-up [{:keys [top-margin] {:keys [y]} :cursor :as screen} n] 275 | (let [new-y (if (< y top-margin) 276 | (max 0 (- y n)) 277 | (max top-margin (- y n)))] 278 | (move-cursor-to-row! screen new-y))) 279 | 280 | (defn cursor-down [{{y :y} :cursor :keys [bottom-margin height] :as screen} n] 281 | (let [new-y (if (> y bottom-margin) 282 | (min (dec height) (+ y n)) 283 | (min bottom-margin (+ y n)))] 284 | (move-cursor-to-row! screen new-y))) 285 | 286 | (defn cursor-forward [{{x :x} :cursor :as screen} n] 287 | (move-cursor-to-col screen (+ x n))) 288 | 289 | (defn cursor-backward [{{x :x} :cursor :as screen} n] 290 | (move-cursor-to-col screen (- x n))) 291 | 292 | (defn line-feed [{:keys [new-line-mode] :as screen}] 293 | (let [screen (move-cursor-down-with-scroll screen)] 294 | (if new-line-mode 295 | (move-cursor-to-col! screen 0) 296 | screen))) 297 | 298 | (defn new-line [screen] 299 | (-> screen 300 | move-cursor-down-with-scroll 301 | (move-cursor-to-col! 0))) 302 | 303 | (defn reverse-index [{:keys [top-margin] {y :y} :cursor :as screen}] 304 | (cond (= y top-margin) (scroll-down screen) 305 | (> y 0) (move-cursor-to-row! screen (dec y)) 306 | :else screen)) 307 | 308 | (defn save-cursor [{{:keys [x y]} :cursor :keys [width char-attrs origin-mode auto-wrap-mode] :as screen}] 309 | (let [x (min x (dec width))] 310 | (assoc screen :saved {:cursor {:x x :y y} 311 | :char-attrs char-attrs 312 | :origin-mode origin-mode 313 | :auto-wrap-mode auto-wrap-mode}))) 314 | 315 | (defn restore-cursor [{{:keys [cursor char-attrs origin-mode auto-wrap-mode]} :saved :as screen}] 316 | (-> screen 317 | (assoc :char-attrs char-attrs 318 | :next-print-wraps false 319 | :origin-mode origin-mode 320 | :auto-wrap-mode auto-wrap-mode) 321 | (update :cursor merge cursor))) 322 | 323 | (defn reset-saved-cursor [screen] 324 | (assoc screen :saved initial-saved-cursor)) 325 | 326 | ;; margins 327 | 328 | (defn set-margins [{:keys [height] :as screen} top bottom] 329 | (let [bottom (or bottom (dec height))] 330 | (if (< -1 top bottom height) 331 | (assoc screen :top-margin top :bottom-margin bottom) 332 | screen))) 333 | 334 | (defn reset-margins [{:keys [height] :as screen}] 335 | (assoc screen :top-margin 0 :bottom-margin (dec height))) 336 | 337 | ;; buffers 338 | 339 | (defn switch-to-alternate-buffer [{:keys [buffer width height char-attrs] :as screen}] 340 | (if (= buffer :primary) 341 | (assoc screen 342 | :buffer :alternate 343 | :other-buffer-lines (:lines screen) 344 | :other-buffer-saved (:saved screen) 345 | :lines (blank-buffer width height char-attrs) 346 | :saved (:other-buffer-saved screen)) 347 | screen)) 348 | 349 | (defn switch-to-primary-buffer [{:keys [buffer] :as screen}] 350 | (if (= buffer :alternate) 351 | (assoc screen 352 | :buffer :primary 353 | :other-buffer-lines nil 354 | :other-buffer-saved (:saved screen) 355 | :lines (:other-buffer-lines screen) 356 | :saved (:other-buffer-saved screen)) 357 | screen)) 358 | 359 | ;; tabs 360 | 361 | (defn set-horizontal-tab [{{:keys [x]} :cursor :keys [width] :as screen}] 362 | (if (< 0 x width) 363 | (update screen :tabs conj x) 364 | screen)) 365 | 366 | (defn clear-horizontal-tab [{{:keys [x]} :cursor :as screen}] 367 | (update screen :tabs disj x)) 368 | 369 | (defn clear-all-horizontal-tabs [screen] 370 | (update screen :tabs empty)) 371 | 372 | (defn move-cursor-to-next-tab [{{:keys [x]} :cursor :keys [tabs width] :as screen} n] 373 | (let [n (dec n) 374 | right-margin (dec width) 375 | next-tabs (drop-while #(>= x %) tabs) 376 | new-x (nth next-tabs n right-margin)] 377 | (move-cursor-to-col screen new-x))) 378 | 379 | (defn move-cursor-to-prev-tab [{{:keys [x]} :cursor :keys [tabs width] :as screen} n] 380 | (let [n (dec n) 381 | prev-tabs (take-while #(> x %) tabs) 382 | new-x (nth (reverse prev-tabs) n 0)] 383 | (move-cursor-to-col screen new-x))) 384 | 385 | ;; charsets 386 | 387 | (defn set-default-charset [screen] 388 | (assoc screen :charset-fn default-charset)) 389 | 390 | (defn set-special-charset [screen] 391 | (assoc screen :charset-fn special-charset)) 392 | 393 | ;; printing 394 | 395 | (defn- replace-char [line x cell] 396 | (assoc line x cell)) 397 | 398 | (defn- insert-char [line x cell] 399 | (vec (concat 400 | (take x line) 401 | [cell] 402 | (take (- (count line) x 1) (drop x line))))) 403 | 404 | (defn- wrap [{{:keys [y]} :cursor :keys [height] :as screen}] 405 | (let [screen (move-cursor-to-col! screen 0)] 406 | (if (= height (inc y)) 407 | (scroll-up screen) 408 | (move-cursor-to-row! screen (inc y))))) 409 | 410 | (defn- do-print [{:keys [width height char-attrs auto-wrap-mode insert-mode charset-fn] {:keys [x y]} :cursor :as screen} input] 411 | (let [input (if (< 95 input 127) (charset-fn input) input) 412 | cell (cell input char-attrs)] 413 | (if (= width (inc x)) 414 | (if auto-wrap-mode 415 | (-> screen 416 | (assoc-in [:lines y x] cell) 417 | (move-cursor-to-col! (inc x)) 418 | (assoc :next-print-wraps true)) 419 | (-> screen 420 | (assoc-in [:lines y x] cell))) 421 | (let [f (if insert-mode insert-char replace-char)] 422 | (-> screen 423 | (update-in [:lines y] f x cell) 424 | (move-cursor-to-col! (inc x))))))) 425 | 426 | (defn print [{:keys [auto-wrap-mode next-print-wraps] :as screen} input] 427 | (if (and auto-wrap-mode next-print-wraps) 428 | (do-print (wrap screen) input) 429 | (do-print screen input))) 430 | 431 | (defn test-pattern [{:keys [width height] :as screen}] 432 | (assoc screen :lines (vec (repeat height (vec (repeat width [0x45 normal-char-attrs])))))) 433 | 434 | ;; clearing/erasing 435 | 436 | (defn clear-line [{{y :y} :cursor :keys [width char-attrs] :as screen}] 437 | (assoc-in screen [:lines y] (blank-line width char-attrs))) 438 | 439 | (defn- clear-line-right [line x char-attrs] 440 | (vec (concat (take x line) 441 | (repeat (- (count line) x) (blank-cell char-attrs))))) 442 | 443 | (defn- clear-line-left [line x char-attrs] 444 | (vec (concat (repeat (inc x) (blank-cell char-attrs)) 445 | (drop (inc x) line)))) 446 | 447 | (defn clear-to-end-of-line [{{x :x y :y} :cursor :keys [width char-attrs] :as screen}] 448 | (let [x (min x (dec width))] 449 | (update-in screen [:lines y] clear-line-right x char-attrs))) 450 | 451 | (defn clear-to-beginning-of-line [{{x :x y :y} :cursor :keys [width char-attrs] :as screen}] 452 | (let [x (min x (dec width))] 453 | (update-in screen [:lines y] clear-line-left x char-attrs))) 454 | 455 | (defn clear-screen [{:keys [width height char-attrs] :as screen}] 456 | (assoc screen :lines (blank-buffer width height char-attrs))) 457 | 458 | (defn clear-to-end-of-screen [{{:keys [x y]} :cursor :keys [width height char-attrs] :as screen}] 459 | (update screen :lines (fn [lines] 460 | (let [top-lines (take y lines) 461 | curr-line (clear-line-right (nth lines y) x char-attrs) 462 | bottom-lines (repeat (- height y 1) (blank-line width char-attrs))] 463 | (vec (concat top-lines [curr-line] bottom-lines)))))) 464 | 465 | (defn clear-to-beginning-of-screen [{{:keys [x y]} :cursor :keys [width height char-attrs] :as screen}] 466 | (let [x (min x (dec width))] 467 | (update screen :lines (fn [lines] 468 | (let [top-lines (repeat y (blank-line width char-attrs)) 469 | curr-line (clear-line-left (nth lines y) x char-attrs) 470 | bottom-lines (drop (inc y) lines)] 471 | (vec (concat top-lines [curr-line] bottom-lines))))))) 472 | 473 | (defn erase-characters [{{:keys [x y]} :cursor :keys [width char-attrs] :as screen} n] 474 | (let [n (min n (- width x))] 475 | (update-in screen [:lines y] (fn [line] 476 | (vec (concat 477 | (take x line) 478 | (repeat n (blank-cell char-attrs)) 479 | (drop (+ x n) line))))))) 480 | 481 | ;; inserting 482 | 483 | (defn insert-characters [{{:keys [x y]} :cursor :keys [width char-attrs] :as screen} n] 484 | (update-in screen [:lines y] (fn [line] 485 | (vec (take width (concat (take x line) 486 | (repeat n [space char-attrs]) 487 | (drop x line))))))) 488 | 489 | (defn insert-lines [{:keys [bottom-margin width height char-attrs] {y :y} :cursor :as screen} n] 490 | (let [filler (blank-line width char-attrs)] 491 | (update screen :lines (fn [lines] 492 | (vec (if (<= y bottom-margin) 493 | (concat 494 | (take y lines) 495 | (scroll-down-lines (subvec lines y (inc bottom-margin)) n filler) 496 | (drop (inc bottom-margin) lines)) 497 | (concat 498 | (take y lines) 499 | (scroll-down-lines (drop y lines) n filler)))))))) 500 | 501 | ;; deleting 502 | 503 | (defn delete-lines [{:keys [bottom-margin width height char-attrs] {y :y} :cursor :as screen} n] 504 | (let [filler (blank-line width char-attrs)] 505 | (update screen :lines (fn [lines] 506 | (vec (if (<= y bottom-margin) 507 | (concat 508 | (take y lines) 509 | (scroll-up-lines (subvec lines y (inc bottom-margin)) n filler) 510 | (drop (inc bottom-margin) lines)) 511 | (concat 512 | (take y lines) 513 | (scroll-up-lines (drop y lines) n filler)))))))) 514 | 515 | (defn delete-characters [{{:keys [x y]} :cursor :keys [width char-attrs] :as screen} n] 516 | (let [screen (if (>= x width) (move-cursor-to-col screen (dec width)) screen) 517 | x (get-in screen [:cursor :x]) 518 | n (min n (- width x))] 519 | (update-in screen [:lines y] (fn [line] 520 | (vec (concat 521 | (take x line) 522 | (drop (+ x n) line) 523 | (repeat n (blank-cell char-attrs)))))))) 524 | 525 | ;; lines 526 | 527 | (s/defn chars->string :- s/Str 528 | [chars :- [CodePoint]] 529 | #?(:clj (String. (int-array chars) 0 (count chars)) 530 | :cljs (apply js/String.fromCodePoint chars))) 531 | 532 | (def Fragment [(s/one s/Str "text") (s/one CharAttrs "text attributes")]) 533 | 534 | (def FragmentLine [Fragment]) 535 | 536 | (s/defn compact-line :- FragmentLine 537 | "Joins together all neighbouring cells having the same color attributes, 538 | converting unicode codepoints to strings." 539 | [line :- CellLine] 540 | (let [[cell & cells] line] 541 | (loop [segments [] 542 | chars [(first cell)] 543 | attrs (last cell) 544 | cells cells] 545 | (if-let [[char new-attrs] (first cells)] 546 | (if (= new-attrs attrs) 547 | (recur segments (conj chars char) attrs (rest cells)) 548 | (recur (conj segments [(chars->string chars) attrs]) [char] new-attrs (rest cells))) 549 | (conj segments [(chars->string chars) attrs]))))) 550 | 551 | (defn compact-lines [lines] 552 | (mapv compact-line lines)) 553 | 554 | (defn lines [screen] 555 | (-> screen :lines compact-lines)) 556 | 557 | ;; resetting 558 | 559 | (defn soft-reset [screen] 560 | (-> screen 561 | show-cursor 562 | reset-margins 563 | disable-insert-mode 564 | disable-origin-mode 565 | reset-char-attrs 566 | reset-saved-cursor)) 567 | -------------------------------------------------------------------------------- /test/asciinema/vt_test.cljc: -------------------------------------------------------------------------------- 1 | (ns asciinema.vt-test 2 | #?(:cljs (:require-macros [cljs.test :refer [is are deftest testing]] 3 | [clojure.test.check.clojure-test :refer [defspec]] 4 | [asciinema.vt.test-macros :refer [property-tests-multiplier expect-lines expect-first-line expect-tabs expect-cursor]])) 5 | (:require #?(:clj [clojure.test :refer [is are deftest testing use-fixtures]] 6 | :cljs [cljs.test :refer-macros [use-fixtures]]) 7 | [clojure.test.check :as tc] 8 | [clojure.test.check.generators :as gen] 9 | [clojure.test.check.properties :as prop #?@(:cljs [:include-macros true])] 10 | #?(:clj [clojure.test.check.clojure-test :refer [defspec]]) 11 | [schema.test] 12 | #?(:clj [asciinema.vt.test-macros :refer [property-tests-multiplier expect-lines expect-first-line expect-tabs expect-cursor]]) 13 | [asciinema.vt :as vt :refer [make-vt feed feed-one feed-str get-params dump-sgr dump]] 14 | [asciinema.vt.screen :as screen])) 15 | 16 | (use-fixtures :once schema.test/validate-schemas) 17 | 18 | (def vt-80x24 (make-vt 80 24)) 19 | 20 | (deftest make-vt-test 21 | (let [vt (make-vt 80 24)] 22 | (is (= (-> vt :parser-intermediates) [])) 23 | (is (= (-> vt :parser-params) [])) 24 | (is (= (-> vt :screen :tabs) #{8 16 24 32 40 48 56 64 72})) 25 | (is (= (-> vt :screen :char-attrs) screen/normal-char-attrs)) 26 | (is (= (-> vt :screen :saved) screen/initial-saved-cursor)) 27 | (is (= (-> vt :screen :insert-mode) false)) 28 | (is (= (-> vt :screen :auto-wrap-mode) true)) 29 | (is (= (-> vt :screen :new-line-mode) false)) 30 | (is (= (-> vt :screen :top-margin) 0)) 31 | (is (= (-> vt :screen :bottom-margin) 23)) 32 | (is (= (-> vt :screen :origin-mode) false))) 33 | (let [vt (make-vt 20 5)] 34 | (is (= (-> vt :screen :tabs) #{8 16})))) 35 | 36 | (defn feed-esc [vt str] 37 | (let [codes (mapv #(#?(:clj .codePointAt :cljs .charCodeAt) str %) (range (count str)))] 38 | (feed vt (list* 0x1b codes)))) 39 | 40 | (defn feed-csi [vt & strs] 41 | (feed-esc vt (apply str (list* "[" strs)))) 42 | 43 | (defn move-cursor [vt x y] 44 | (feed-csi vt (str (inc y) ";" (inc x) "H"))) 45 | 46 | (defn set-fg [vt fg] 47 | (feed-csi vt (str "3" fg "m"))) 48 | 49 | (defn set-bg [vt bg] 50 | (feed-csi vt (str "4" bg "m"))) 51 | 52 | (defn set-bold [vt] 53 | (feed-csi vt "1m")) 54 | 55 | (defn hide-cursor [vt] 56 | (update vt :screen screen/hide-cursor)) 57 | 58 | (deftest print-test 59 | (let [vt (-> (make-vt 4 3) 60 | (set-fg 1))] 61 | 62 | (testing "printing within single line" 63 | (let [vt (feed-str vt "ABC")] 64 | (expect-lines vt [[["ABC" {:fg 1}] [" " {}]] 65 | [[" " {}]] 66 | [[" " {}]]]) 67 | (expect-cursor vt 3 0 true))) 68 | 69 | (testing "printing non-ASCII characters" 70 | (let [vt (feed-str vt "ABCżÓłĆ")] 71 | (expect-lines vt [[["ABCż" {:fg 1}]] 72 | [["ÓłĆ" {:fg 1}] [" " {}]] 73 | [[" " {}]]]) 74 | (expect-cursor vt 3 1 true))) 75 | 76 | (testing "printing ASCII art using special drawing character set" 77 | (let [vt (-> vt 78 | (feed-esc "(0") ; use drawing character set 79 | (feed-str "ab{|") 80 | (feed-esc "(B") ; back to ASCII 81 | (feed-str "ab") 82 | (feed-one 0x0e) ; use drawing character set 83 | (feed-str "ab{|") 84 | (feed-one 0x0f) ; back to ASCII 85 | (feed-str "ab"))] 86 | (expect-lines vt [[["▒␉π≠" {:fg 1}]] 87 | [["ab▒␉" {:fg 1}]] 88 | [["π≠ab" {:fg 1}]]]))) 89 | 90 | (testing "printing in insert mode" 91 | (let [vt (-> vt 92 | (feed-str "ABC") 93 | (move-cursor 1 0) 94 | (feed-csi "4h") ; enable insert mode 95 | (set-fg 2) 96 | (feed-str "HI"))] 97 | (expect-lines vt [[["A" {:fg 1}] ["HI" {:fg 2}] ["B" {:fg 1}]] 98 | [[" " {}]] 99 | [[" " {}]]]) 100 | (expect-cursor vt 3 0 true))) 101 | 102 | (testing "printing on the right edge of the line" 103 | (let [vt (feed-str vt "ABCD")] 104 | (expect-lines vt [[["ABCD" {:fg 1}]] 105 | [[" " {}]] 106 | [[" " {}]]]) 107 | (expect-cursor vt 4 0 true) 108 | (let [vt (feed-str vt "EF")] 109 | (expect-lines vt [[["ABCD" {:fg 1}]] 110 | [["EF" {:fg 1}] [" " {}]] 111 | [[" " {}]]]) 112 | (expect-cursor vt 2 1 true)) 113 | (let [vt (-> vt 114 | (feed-csi "1;4H") ; move to the current position (in place) 115 | (feed-str "EF"))] ; next-print-wraps should have been reset above 116 | (expect-lines vt [[["ABCE" {:fg 1}]] 117 | [["F" {:fg 1}] [" " {}]] 118 | [[" " {}]]]) 119 | (expect-cursor vt 1 1 true)))) 120 | 121 | (testing "printing on the right edge of the line (auto-wrap off)" 122 | (let [vt (-> vt 123 | (feed-csi "?7l") ; reset auto-wrap 124 | (feed-str "ABCDEF"))] 125 | (expect-lines vt [[["ABCF" {:fg 1}]] 126 | [[" " {}]] 127 | [[" " {}]]]) 128 | (expect-cursor vt 3 0 true))) 129 | 130 | (testing "printing on the bottom right edge of the screen" 131 | (let [vt (feed-str vt "AAAABBBBCCCC")] 132 | (expect-lines vt [[["AAAA" {:fg 1}]] 133 | [["BBBB" {:fg 1}]] 134 | [["CCCC" {:fg 1}]]]) 135 | (expect-cursor vt 4 2 true) 136 | (let [vt (feed-str vt "DD")] 137 | (expect-lines vt [[["BBBB" {:fg 1}]] 138 | [["CCCC" {:fg 1}]] 139 | [["DD " {:fg 1}]]]) 140 | (expect-cursor vt 2 2 true)))) 141 | 142 | (testing "printing on the bottom right edge of the screen (auto-wrap off)" 143 | (let [vt (-> vt 144 | (feed-str "AAAABBBBCC") 145 | (feed-csi "?7l") ; reset auto-wrap 146 | (feed-str "DDEFGH"))] 147 | (expect-lines vt [[["AAAA" {:fg 1}]] 148 | [["BBBB" {:fg 1}]] 149 | [["CCDH" {:fg 1}]]]) 150 | (expect-cursor vt 3 2 true))))) 151 | 152 | (defn test-lf [f] 153 | (let [vt (-> (make-vt 4 7) 154 | (feed-str "AAAABBBBCCCCDDDDEEEEFFFFG") 155 | (set-bg 3))] 156 | (let [vt (-> vt (move-cursor 0 0) f)] 157 | (expect-lines vt [[["AAAA" {}]] 158 | [["BBBB" {}]] 159 | [["CCCC" {}]] 160 | [["DDDD" {}]] 161 | [["EEEE" {}]] 162 | [["FFFF" {}]] 163 | [["G " {}]]]) 164 | (expect-cursor vt 0 1)) 165 | (let [vt (-> vt (move-cursor 1 1) f)] 166 | (expect-lines vt [[["AAAA" {}]] 167 | [["BBBB" {}]] 168 | [["CCCC" {}]] 169 | [["DDDD" {}]] 170 | [["EEEE" {}]] 171 | [["FFFF" {}]] 172 | [["G " {}]]]) 173 | (expect-cursor vt 1 2)) 174 | (let [vt (-> vt (move-cursor 2 6) f)] 175 | (expect-lines vt [[["BBBB" {}]] 176 | [["CCCC" {}]] 177 | [["DDDD" {}]] 178 | [["EEEE" {}]] 179 | [["FFFF" {}]] 180 | [["G " {}]] 181 | [[" " {:bg 3}]]]) 182 | (expect-cursor vt 2 6)) 183 | (let [vt (feed-csi vt "3;5r")] ; set scroll region 3-5 184 | (let [vt (-> vt (move-cursor 2 1) f)] 185 | (expect-lines vt [[["AAAA" {}]] 186 | [["BBBB" {}]] 187 | [["CCCC" {}]] 188 | [["DDDD" {}]] 189 | [["EEEE" {}]] 190 | [["FFFF" {}]] 191 | [["G " {}]]]) 192 | (expect-cursor vt 2 2)) 193 | (let [vt (-> vt (move-cursor 2 3) f)] 194 | (expect-lines vt [[["AAAA" {}]] 195 | [["BBBB" {}]] 196 | [["CCCC" {}]] 197 | [["DDDD" {}]] 198 | [["EEEE" {}]] 199 | [["FFFF" {}]] 200 | [["G " {}]]]) 201 | (expect-cursor vt 2 4)) 202 | (let [vt (-> vt (move-cursor 2 4) f)] 203 | (expect-lines vt [[["AAAA" {}]] 204 | [["BBBB" {}]] 205 | [["DDDD" {}]] 206 | [["EEEE" {}]] 207 | [[" " {:bg 3}]] 208 | [["FFFF" {}]] 209 | [["G " {}]]]) 210 | (expect-cursor vt 2 4)) 211 | (let [vt (-> vt (move-cursor 2 5) f)] 212 | (expect-lines vt [[["AAAA" {}]] 213 | [["BBBB" {}]] 214 | [["CCCC" {}]] 215 | [["DDDD" {}]] 216 | [["EEEE" {}]] 217 | [["FFFF" {}]] 218 | [["G " {}]]]) 219 | (expect-cursor vt 2 6)) 220 | (let [vt (-> vt (move-cursor 2 6) f)] 221 | (expect-lines vt [[["AAAA" {}]] 222 | [["BBBB" {}]] 223 | [["CCCC" {}]] 224 | [["DDDD" {}]] 225 | [["EEEE" {}]] 226 | [["FFFF" {}]] 227 | [["G " {}]]]) 228 | (expect-cursor vt 2 6)) 229 | (let [vt (feed-csi vt "20h") ; set new-line mode 230 | vt (-> vt (move-cursor 2 1) f)] 231 | (expect-cursor vt 0 2))))) 232 | 233 | (defn test-nel [f] 234 | (let [vt (-> (make-vt 4 7) 235 | (feed-str "AAAABBBBCCCCDDDDEEEEFFFFG") 236 | (set-bg 3))] 237 | (let [vt (-> vt (move-cursor 0 0) f)] 238 | (expect-lines vt [[["AAAA" {}]] 239 | [["BBBB" {}]] 240 | [["CCCC" {}]] 241 | [["DDDD" {}]] 242 | [["EEEE" {}]] 243 | [["FFFF" {}]] 244 | [["G " {}]]]) 245 | (expect-cursor vt 0 1)) 246 | (let [vt (-> vt (move-cursor 1 1) f)] 247 | (expect-lines vt [[["AAAA" {}]] 248 | [["BBBB" {}]] 249 | [["CCCC" {}]] 250 | [["DDDD" {}]] 251 | [["EEEE" {}]] 252 | [["FFFF" {}]] 253 | [["G " {}]]]) 254 | (expect-cursor vt 0 2)) 255 | (let [vt (-> vt (move-cursor 2 6) f)] 256 | (expect-lines vt [[["BBBB" {}]] 257 | [["CCCC" {}]] 258 | [["DDDD" {}]] 259 | [["EEEE" {}]] 260 | [["FFFF" {}]] 261 | [["G " {}]] 262 | [[" " {:bg 3}]]]) 263 | (expect-cursor vt 0 6)) 264 | (let [vt (feed-csi vt "3;5r")] ; set scroll region 3-5 265 | (let [vt (-> vt (move-cursor 2 1) f)] 266 | (expect-lines vt [[["AAAA" {}]] 267 | [["BBBB" {}]] 268 | [["CCCC" {}]] 269 | [["DDDD" {}]] 270 | [["EEEE" {}]] 271 | [["FFFF" {}]] 272 | [["G " {}]]]) 273 | (expect-cursor vt 0 2)) 274 | (let [vt (-> vt (move-cursor 2 3) f)] 275 | (expect-lines vt [[["AAAA" {}]] 276 | [["BBBB" {}]] 277 | [["CCCC" {}]] 278 | [["DDDD" {}]] 279 | [["EEEE" {}]] 280 | [["FFFF" {}]] 281 | [["G " {}]]]) 282 | (expect-cursor vt 0 4)) 283 | (let [vt (-> vt (move-cursor 2 4) f)] 284 | (expect-lines vt [[["AAAA" {}]] 285 | [["BBBB" {}]] 286 | [["DDDD" {}]] 287 | [["EEEE" {}]] 288 | [[" " {:bg 3}]] 289 | [["FFFF" {}]] 290 | [["G " {}]]]) 291 | (expect-cursor vt 0 4)) 292 | (let [vt (-> vt (move-cursor 2 5) f)] 293 | (expect-lines vt [[["AAAA" {}]] 294 | [["BBBB" {}]] 295 | [["CCCC" {}]] 296 | [["DDDD" {}]] 297 | [["EEEE" {}]] 298 | [["FFFF" {}]] 299 | [["G " {}]]]) 300 | (expect-cursor vt 0 6)) 301 | (let [vt (-> vt (move-cursor 2 6) f)] 302 | (expect-lines vt [[["AAAA" {}]] 303 | [["BBBB" {}]] 304 | [["CCCC" {}]] 305 | [["DDDD" {}]] 306 | [["EEEE" {}]] 307 | [["FFFF" {}]] 308 | [["G " {}]]]) 309 | (expect-cursor vt 0 6))))) 310 | 311 | (defn test-hts [f] 312 | (let [vt (make-vt 20 3)] 313 | (expect-tabs (-> vt (move-cursor 0 0) f) #{8 16}) 314 | (expect-tabs (-> vt (move-cursor 1 0) f) #{1 8 16}) 315 | (expect-tabs (-> vt (move-cursor 11 0) f) #{8 11 16}) 316 | (expect-tabs (-> vt (move-cursor 19 0) f) #{8 16 19}))) 317 | 318 | (defn test-ri [f] 319 | (let [vt (-> (make-vt 4 7) 320 | (feed-str "AAAABBBBCCCCDDDDEEEEFFFFG") 321 | (set-bg 3))] 322 | (let [vt (-> vt (move-cursor 0 6) f)] 323 | (expect-lines vt [[["AAAA" {}]] 324 | [["BBBB" {}]] 325 | [["CCCC" {}]] 326 | [["DDDD" {}]] 327 | [["EEEE" {}]] 328 | [["FFFF" {}]] 329 | [["G " {}]]]) 330 | (expect-cursor vt 0 5)) 331 | (let [vt (-> vt (move-cursor 1 5) f)] 332 | (expect-lines vt [[["AAAA" {}]] 333 | [["BBBB" {}]] 334 | [["CCCC" {}]] 335 | [["DDDD" {}]] 336 | [["EEEE" {}]] 337 | [["FFFF" {}]] 338 | [["G " {}]]]) 339 | (expect-cursor vt 1 4)) 340 | (let [vt (-> vt (move-cursor 2 0) f)] 341 | (expect-lines vt [[[" " {:bg 3}]] 342 | [["AAAA" {}]] 343 | [["BBBB" {}]] 344 | [["CCCC" {}]] 345 | [["DDDD" {}]] 346 | [["EEEE" {}]] 347 | [["FFFF" {}]]]) 348 | (expect-cursor vt 2 0)) 349 | (let [vt (feed-csi vt "3;5r")] ; set scroll region 3-5 350 | (let [vt (-> vt (move-cursor 2 5) f)] 351 | (expect-lines vt [[["AAAA" {}]] 352 | [["BBBB" {}]] 353 | [["CCCC" {}]] 354 | [["DDDD" {}]] 355 | [["EEEE" {}]] 356 | [["FFFF" {}]] 357 | [["G " {}]]]) 358 | (expect-cursor vt 2 4)) 359 | (let [vt (-> vt (move-cursor 2 3) f)] 360 | (expect-lines vt [[["AAAA" {}]] 361 | [["BBBB" {}]] 362 | [["CCCC" {}]] 363 | [["DDDD" {}]] 364 | [["EEEE" {}]] 365 | [["FFFF" {}]] 366 | [["G " {}]]]) 367 | (expect-cursor vt 2 2)) 368 | (let [vt (-> vt (move-cursor 2 2) f)] 369 | (expect-lines vt [[["AAAA" {}]] 370 | [["BBBB" {}]] 371 | [[" " {:bg 3}]] 372 | [["CCCC" {}]] 373 | [["DDDD" {}]] 374 | [["FFFF" {}]] 375 | [["G " {}]]]) 376 | (expect-cursor vt 2 2)) 377 | (let [vt (-> vt (move-cursor 2 1) f)] 378 | (expect-lines vt [[["AAAA" {}]] 379 | [["BBBB" {}]] 380 | [["CCCC" {}]] 381 | [["DDDD" {}]] 382 | [["EEEE" {}]] 383 | [["FFFF" {}]] 384 | [["G " {}]]]) 385 | (expect-cursor vt 2 0)) 386 | (let [vt (-> vt (move-cursor 2 0) f)] 387 | (expect-lines vt [[["AAAA" {}]] 388 | [["BBBB" {}]] 389 | [["CCCC" {}]] 390 | [["DDDD" {}]] 391 | [["EEEE" {}]] 392 | [["FFFF" {}]] 393 | [["G " {}]]]) 394 | (expect-cursor vt 2 0))))) 395 | 396 | (deftest control-char-test 397 | (let [vt (make-vt 4 3)] 398 | (testing "0x00 (NUL)" 399 | (is (= vt (feed-one vt 0x00)))) 400 | 401 | (testing "0x01 (SOH)" 402 | (is (= vt (feed-one vt 0x01)))) 403 | 404 | (testing "0x02 (STX)" 405 | (is (= vt (feed-one vt 0x02)))) 406 | 407 | (testing "0x03 (ETX)" 408 | (is (= vt (feed-one vt 0x03)))) 409 | 410 | (testing "0x04 (EOT)" 411 | (is (= vt (feed-one vt 0x04)))) 412 | 413 | (testing "0x05 (ENQ)" 414 | (is (= vt (feed-one vt 0x05)))) 415 | 416 | (testing "0x06 (ACK)" 417 | (is (= vt (feed-one vt 0x06)))) 418 | 419 | (testing "0x07 (BEL)" 420 | (is (= vt (feed-one vt 0x07)))) 421 | 422 | (testing "0x08 (BS)" 423 | (let [vt (-> vt (move-cursor 0 0) (feed-one 0x08))] 424 | (expect-cursor vt 0 0)) 425 | (let [vt (-> vt (move-cursor 2 0) (feed-one 0x08))] 426 | (expect-cursor vt 1 0)) 427 | (let [vt (-> vt (move-cursor 0 2) (feed-one 0x08))] 428 | (expect-cursor vt 0 2))) 429 | 430 | (testing "0x09 (HT)" 431 | (let [vt (make-vt 20 3)] 432 | (let [vt (-> vt (move-cursor 0 0) (feed-one 0x09))] 433 | (expect-cursor vt 8 0)) 434 | (let [vt (-> vt (move-cursor 2 0) (feed-one 0x09))] 435 | (expect-cursor vt 8 0)) 436 | (let [vt (-> vt (move-cursor 8 1) (feed-one 0x09))] 437 | (expect-cursor vt 16 1)) 438 | (let [vt (-> vt (move-cursor 9 1) (feed-one 0x09))] 439 | (expect-cursor vt 16 1)) 440 | (let [vt (-> vt (move-cursor 16 1) (feed-one 0x09))] 441 | (expect-cursor vt 19 1)) 442 | (let [vt (-> vt (move-cursor 19 1) (feed-one 0x09))] 443 | (expect-cursor vt 19 1)))) 444 | 445 | (testing "0x0b (VT), 0x0c (FF), 0x84 (IND)" 446 | (doseq [ch [0x0a 0x0b 0x0c 0x84]] 447 | (test-lf #(feed-one % ch)))) 448 | 449 | (testing "0x0d (CR)" 450 | (let [vt (-> vt (move-cursor 0 1) (feed-one 0x0d))] 451 | (expect-cursor vt 0 1)) 452 | (let [vt (-> vt (move-cursor 2 1) (feed-one 0x0d))] 453 | (expect-cursor vt 0 1))) 454 | 455 | (testing "0x85 (NEL)" 456 | (doseq [ch [0x85]] 457 | (test-nel #(feed-one % ch)))) 458 | 459 | (testing "0x88 (HTS)" 460 | (test-hts #(feed-one % 0x88))) 461 | 462 | (testing "0x8d (RI)" 463 | (test-ri #(feed-one % 0x8d))))) 464 | 465 | (deftest esc-sequence-test 466 | (testing "ESC D (IND)" 467 | (test-lf #(feed-esc % "D"))) 468 | 469 | (testing "ESC E (NEL)" 470 | (test-nel #(feed-esc % "E"))) 471 | 472 | (testing "ESC H (HTS)" 473 | (test-hts #(feed-esc % "H"))) 474 | 475 | (testing "ESC M (RI)" 476 | (test-ri #(feed-esc % "M"))) 477 | 478 | (testing "ESC #8 (DECALN)" 479 | (let [vt (-> (make-vt 4 3) 480 | (move-cursor 2 1) 481 | (feed-esc "#8"))] 482 | (expect-lines vt [[["EEEE" {}]] 483 | [["EEEE" {}]] 484 | [["EEEE" {}]]]) 485 | (expect-cursor vt 2 1))) 486 | 487 | (testing "ESC 7 (SC), CSI ?1048h" 488 | (let [vt (-> (make-vt 80 24) 489 | (move-cursor 2 1) 490 | (set-fg 1) 491 | (feed-csi "?6h") ; set origin mode 492 | (feed-csi "?7l") ; reset auto-wrap mode 493 | (move-cursor 4 5))] 494 | (doseq [f [#(feed-esc % "7") #(feed-csi % "?1048h")]] 495 | (let [saved (-> vt f :screen screen/saved)] 496 | (is (= saved {:cursor {:x 4 :y 5} 497 | :char-attrs {:fg 1} 498 | :origin-mode true 499 | :auto-wrap-mode false})))))) 500 | 501 | (testing "ESC 8 (RC), CSI ?1048l" 502 | (doseq [f [#(feed-esc % "8") #(feed-csi % "?1048l")]] 503 | (let [vt (-> vt-80x24 504 | (move-cursor 79 10) 505 | (feed-str " ") ; print on the edge 506 | f)] ; restore cursor 507 | (is (not (-> vt :screen screen/next-print-wraps?)))) 508 | (let [vt (-> vt-80x24 509 | (set-fg 1) 510 | (feed-csi "?6h") ; set origin mode 511 | (feed-csi "?7l") ; reset auto-wrap mode 512 | (move-cursor 4 5))] 513 | (let [vt (f vt)] ; restore cursor, there was no save (SC) so far 514 | (expect-cursor vt 0 0) 515 | (is (= (-> vt :screen screen/char-attrs) screen/normal-char-attrs)) 516 | (is (not (-> vt :screen screen/origin-mode?))) 517 | (is (-> vt :screen screen/auto-wrap-mode?))) 518 | (let [vt (-> vt 519 | (feed-esc "7") ; save cursor 520 | (feed-csi "?6l") ; reset origin mode 521 | (feed-csi "?7h") ; set auto-wrap mode 522 | (feed-csi "m") ; reset char attrs 523 | (feed-csi "42m") ; set bg=2 524 | f)] ; restore cursor 525 | (expect-cursor vt 4 5) 526 | (is (= (-> vt :screen screen/char-attrs) {:fg 1})) 527 | (is (-> vt :screen screen/origin-mode?)) 528 | (is (not (-> vt :screen screen/auto-wrap-mode?))))))) 529 | 530 | (testing "ESC c (RIS)" 531 | (let [initial-vt (make-vt 4 3) 532 | new-vt (-> initial-vt 533 | (feed-str "AB") 534 | (feed-esc "H") ; set tab 535 | (feed-esc "c"))] ; reset 536 | (is (= initial-vt new-vt))))) 537 | 538 | (deftest control-sequence-test 539 | (testing "CSI @ (ICH)" 540 | (let [vt (-> (make-vt 5 3) 541 | (feed-str "ABCD") 542 | (set-bg 3) 543 | (move-cursor 1 0))] 544 | (let [vt (feed-csi vt "@")] 545 | (expect-first-line vt [["A" {}] [" " {:bg 3}] ["BCD" {}]]) 546 | (expect-cursor vt 1 0)) 547 | (let [vt (feed-csi vt "2@")] 548 | (expect-first-line vt [["A" {}] [" " {:bg 3}] ["BC" {}]]) 549 | (expect-cursor vt 1 0)))) 550 | 551 | (testing "CSI A (CUU), CSI e (VPR)" 552 | (let [vt (make-vt 5 10)] 553 | (doseq [ch ["A" "e"]] 554 | (let [vt (-> vt 555 | (move-cursor 1 0) 556 | (feed-csi ch))] 557 | (expect-cursor vt 1 0)) 558 | (let [vt (-> vt 559 | (move-cursor 1 2) 560 | (feed-csi ch))] 561 | (expect-cursor vt 1 1)) 562 | (let [vt (-> vt 563 | (move-cursor 1 2) 564 | (feed-csi "4" ch))] 565 | (expect-cursor vt 1 0)) 566 | (let [vt (feed-csi vt "4;8r")] ; set scroll region 567 | (let [vt (-> vt 568 | (move-cursor 1 2) 569 | (feed-csi ch))] 570 | (expect-cursor vt 1 1)) 571 | (let [vt (-> vt 572 | (move-cursor 1 6) 573 | (feed-csi "5" ch))] 574 | (expect-cursor vt 1 3)) 575 | (let [vt (-> vt 576 | (move-cursor 1 9) 577 | (feed-csi "9" ch))] 578 | (expect-cursor vt 1 3)))))) 579 | 580 | (testing "CSI B (CUD)" 581 | (let [vt (make-vt 5 10)] 582 | (let [vt (-> vt 583 | (move-cursor 1 0) 584 | (feed-csi "B"))] 585 | (expect-cursor vt 1 1)) 586 | (let [vt (-> vt 587 | (move-cursor 1 9) 588 | (feed-csi "B"))] 589 | (expect-cursor vt 1 9)) 590 | (let [vt (-> vt 591 | (move-cursor 1 7) 592 | (feed-csi "4B"))] 593 | (expect-cursor vt 1 9)) 594 | (let [vt (feed-csi vt "4;8r")] ; set scroll region 595 | (let [vt (-> vt 596 | (move-cursor 1 1) 597 | (feed-csi "20B"))] 598 | (expect-cursor vt 1 7)) 599 | (let [vt (-> vt 600 | (move-cursor 1 6) 601 | (feed-csi "5B"))] 602 | (expect-cursor vt 1 7)) 603 | (let [vt (-> vt 604 | (move-cursor 1 8) 605 | (feed-csi "B"))] 606 | (expect-cursor vt 1 9))))) 607 | 608 | (testing "CSI C (CUF), CSI a (HPR)" 609 | (let [vt (make-vt 5 3)] 610 | (doseq [ch ["C" "a"]] 611 | (let [vt (-> vt 612 | (move-cursor 1 0) 613 | (feed-csi ch))] 614 | (expect-cursor vt 2 0)) 615 | (let [vt (-> vt 616 | (move-cursor 4 0) 617 | (feed-csi ch))] 618 | (expect-cursor vt 4 0)) 619 | (let [vt (-> vt 620 | (move-cursor 2 1) 621 | (feed-csi "4" ch))] 622 | (expect-cursor vt 4 1))))) 623 | 624 | (testing "CSI D (CUB)" 625 | (let [vt (make-vt 5 3)] 626 | (let [vt (-> vt 627 | (move-cursor 3 0) 628 | (feed-csi "D"))] 629 | (expect-cursor vt 2 0)) 630 | (let [vt (-> vt 631 | (move-cursor 0 1) 632 | (feed-csi "D"))] 633 | (expect-cursor vt 0 1)) 634 | (let [vt (-> vt 635 | (move-cursor 2 1) 636 | (feed-csi "4D"))] 637 | (expect-cursor vt 0 1)))) 638 | 639 | (testing "CSI E (CNL)" 640 | (let [vt (make-vt 5 3)] 641 | (let [vt (-> vt 642 | (move-cursor 1 0) 643 | (feed-csi "E"))] 644 | (expect-cursor vt 0 1)) 645 | (let [vt (-> vt 646 | (move-cursor 1 2) 647 | (feed-csi "E"))] 648 | (expect-cursor vt 0 2)) 649 | (let [vt (-> vt 650 | (move-cursor 1 1) 651 | (feed-csi "4E"))] 652 | (expect-cursor vt 0 2)))) 653 | 654 | (testing "CSI F (CPL)" 655 | (let [vt (make-vt 5 3)] 656 | (let [vt (-> vt 657 | (move-cursor 1 0) 658 | (feed-csi "F"))] 659 | (expect-cursor vt 0 0)) 660 | (let [vt (-> vt 661 | (move-cursor 1 2) 662 | (feed-csi "F"))] 663 | (expect-cursor vt 0 1)) 664 | (let [vt (-> vt 665 | (move-cursor 1 2) 666 | (feed-csi "4F"))] 667 | (expect-cursor vt 0 0)))) 668 | 669 | (testing "CSI G (CHA), CSI ` (HPA)" 670 | (let [vt (-> (make-vt 5 3) 671 | (move-cursor 1 1))] 672 | (doseq [ch ["G" "`"]] 673 | (let [vt (feed-csi vt ch)] 674 | (expect-cursor vt 0 1)) 675 | (let [vt (feed-csi vt "3" ch)] 676 | (expect-cursor vt 2 1)) 677 | (let [vt (feed-csi vt "8" ch)] 678 | (expect-cursor vt 4 1))))) 679 | 680 | (testing "CSI H (CUP), CSI f (HVP)" 681 | (let [vt (-> (make-vt 20 10) 682 | (move-cursor 1 1))] 683 | (doseq [ch ["H" "f"]] 684 | (let [vt (feed-csi vt ch)] 685 | (expect-cursor vt 0 0)) 686 | (let [vt (feed-csi vt "3" ch)] 687 | (expect-cursor vt 0 2)) 688 | (let [vt (feed-csi vt ";3" ch)] 689 | (expect-cursor vt 2 0)) 690 | (let [vt (feed-csi vt "3;4" ch)] 691 | (expect-cursor vt 3 2)) 692 | (let [vt (feed-csi vt "15;25" ch)] 693 | (expect-cursor vt 19 9)) 694 | (let [vt (feed-csi vt "4;6r")] ; set scroll region 695 | (let [vt (feed-csi vt "3;8" ch)] 696 | (expect-cursor vt 7 2)) 697 | (let [vt (feed-csi vt "5;8" ch)] 698 | (expect-cursor vt 7 4)) 699 | (let [vt (feed-csi vt "15;25" ch)] 700 | (expect-cursor vt 19 9)) 701 | (let [vt (feed-csi vt "?6h")] ; set origin mode 702 | (let [vt (feed-csi vt "2;7" ch)] 703 | (expect-cursor vt 6 4)) 704 | (let [vt (feed-csi vt "15;25" ch)] 705 | (expect-cursor vt 19 5))))))) 706 | 707 | (testing "CSI I (CHT)" 708 | (let [vt (-> (make-vt 80 3) (move-cursor 20 0))] 709 | (let [vt (feed-csi vt "I")] 710 | (expect-cursor vt 24 0)) 711 | (let [vt (feed-csi vt "3I")] 712 | (expect-cursor vt 40 0)))) 713 | 714 | (testing "CSI J (ED)" 715 | (let [vt (-> (make-vt 4 3) 716 | (feed-str "ABCDEFGHIJ") 717 | (set-bg 3) 718 | (move-cursor 1 1))] 719 | (let [vt (feed-csi vt "J")] 720 | (expect-lines vt [[["ABCD" {}]] 721 | [["E" {}] [" " {:bg 3}]] 722 | [[" " {:bg 3}]]]) 723 | (expect-cursor vt 1 1)) 724 | (let [vt (feed-csi vt "1J")] 725 | (expect-lines vt [[[" " {:bg 3}]] 726 | [[" " {:bg 3}] ["GH" {}]] 727 | [["IJ " {}]]]) 728 | (expect-cursor vt 1 1)) 729 | (let [vt (feed-csi vt "2J")] 730 | (expect-lines vt [[[" " {:bg 3}]] 731 | [[" " {:bg 3}]] 732 | [[" " {:bg 3}]]]) 733 | (expect-cursor vt 1 1)))) 734 | 735 | (testing "CSI K (EL)" 736 | (let [vt (-> (make-vt 6 2) 737 | (feed-str "ABCDEF") 738 | (set-bg 3) 739 | (move-cursor 3 0))] 740 | (let [vt (feed-csi vt "K")] 741 | (expect-first-line vt [["ABC" {}] [" " {:bg 3}]]) 742 | (expect-cursor vt 3 0)) 743 | (let [vt (feed-csi vt "1K")] 744 | (expect-first-line vt [[" " {:bg 3}] ["EF" {}]]) 745 | (expect-cursor vt 3 0)) 746 | (let [vt (feed-csi vt "2K")] 747 | (expect-first-line vt [[" " {:bg 3}]]) 748 | (expect-cursor vt 3 0)))) 749 | 750 | (testing "CSI L (IL)" 751 | (let [vt (-> (make-vt 4 4) 752 | (feed-str "ABCDEFGHIJKLMN") 753 | (set-bg 3) 754 | (move-cursor 2 1))] 755 | (let [vt (feed-csi vt "L")] 756 | (expect-lines vt [[["ABCD" {}]] 757 | [[" " {:bg 3}]] 758 | [["EFGH" {}]] 759 | [["IJKL" {}]]]) 760 | (expect-cursor vt 2 1)) 761 | (let [vt (feed-csi vt "2L")] 762 | (expect-lines vt [[["ABCD" {}]] 763 | [[" " {:bg 3}]] 764 | [[" " {:bg 3}]] 765 | [["EFGH" {}]]]) 766 | (expect-cursor vt 2 1)) 767 | (let [vt (feed-csi vt "10L")] 768 | (expect-lines vt [[["ABCD" {}]] 769 | [[" " {:bg 3}]] 770 | [[" " {:bg 3}]] 771 | [[" " {:bg 3}]]]) 772 | (expect-cursor vt 2 1)) 773 | (let [vt (-> vt 774 | (feed-csi "2;3r") ; set scroll region 775 | (move-cursor 2 0))] 776 | (let [vt (feed-csi vt "2L")] 777 | (expect-lines vt [[[" " {:bg 3}]] 778 | [[" " {:bg 3}]] 779 | [["ABCD" {}]] 780 | [["MN " {}]]]) 781 | (expect-cursor vt 2 0)) 782 | (let [vt (feed-csi vt "10L")] 783 | (expect-lines vt [[[" " {:bg 3}]] 784 | [[" " {:bg 3}]] 785 | [[" " {:bg 3}]] 786 | [["MN " {}]]]) 787 | (expect-cursor vt 2 0))))) 788 | 789 | (testing "CSI M (DL)" 790 | (let [vt (-> (make-vt 4 4) 791 | (feed-str "ABCDEFGHIJKLM") 792 | (move-cursor 2 1))] 793 | (let [vt (feed-csi vt "M")] 794 | (expect-lines vt [[["ABCD" {}]] 795 | [["IJKL" {}]] 796 | [["M " {}]] 797 | [[" " {}]]]) 798 | (expect-cursor vt 2 1)) 799 | (let [vt (feed-csi vt "2M")] 800 | (expect-lines vt [[["ABCD" {}]] 801 | [["M " {}]] 802 | [[" " {}]] 803 | [[" " {}]]]) 804 | (expect-cursor vt 2 1)) 805 | (let [vt (feed-csi vt "10M")] 806 | (expect-lines vt [[["ABCD" {}]] 807 | [[" " {}]] 808 | [[" " {}]] 809 | [[" " {}]]]) 810 | (expect-cursor vt 2 1)) 811 | (let [vt (-> vt 812 | (feed-csi "2;3r") ; set scroll region 813 | (move-cursor 2 0))] 814 | (let [vt (feed-csi vt "2M")] 815 | (expect-lines vt [[["IJKL" {}]] 816 | [[" " {}]] 817 | [[" " {}]] 818 | [["M " {}]]]) 819 | (expect-cursor vt 2 0)) 820 | (let [vt (feed-csi vt "20M")] 821 | (expect-lines vt [[[" " {}]] 822 | [[" " {}]] 823 | [[" " {}]] 824 | [["M " {}]]]) 825 | (expect-cursor vt 2 0))))) 826 | 827 | (testing "CSI P (DCH)" 828 | (let [vt (-> (make-vt 7 1) 829 | (feed-str "ABCDEF") 830 | (move-cursor 2 0))] 831 | (let [vt (feed-csi vt "P")] 832 | (expect-first-line vt [["ABDEF " {}]]) 833 | (expect-cursor vt 2 0)) 834 | (let [vt (feed-csi vt "2P")] 835 | (expect-first-line vt [["ABEF " {}]]) 836 | (expect-cursor vt 2 0)) 837 | (let [vt (feed-csi vt "10P")] 838 | (expect-first-line vt [["AB " {}]]) 839 | (expect-cursor vt 2 0)))) 840 | 841 | (testing "CSI S (SU)" 842 | (let [vt (-> (make-vt 4 5) 843 | (feed-str "ABCDEFGHIJKLMNOPQR") 844 | (set-bg 3) 845 | (move-cursor 2 1))] 846 | (let [vt (feed-csi vt "S")] 847 | (expect-lines vt [[["EFGH" {}]] 848 | [["IJKL" {}]] 849 | [["MNOP" {}]] 850 | [["QR " {}]] 851 | [[" " {:bg 3}]]]) 852 | (expect-cursor vt 2 1)) 853 | (let [vt (feed-csi vt "2S")] 854 | (expect-lines vt [[["IJKL" {}]] 855 | [["MNOP" {}]] 856 | [["QR " {}]] 857 | [[" " {:bg 3}]] 858 | [[" " {:bg 3}]]]) 859 | (expect-cursor vt 2 1)) 860 | (let [vt (feed-csi vt "10S")] 861 | (expect-lines vt [[[" " {:bg 3}]] 862 | [[" " {:bg 3}]] 863 | [[" " {:bg 3}]] 864 | [[" " {:bg 3}]] 865 | [[" " {:bg 3}]]]) 866 | (expect-cursor vt 2 1)) 867 | (let [vt (-> vt 868 | (feed-csi "2;4r") 869 | (move-cursor 2 0)) 870 | vt (feed-csi vt "2S")] 871 | (expect-lines vt [[["ABCD" {}]] 872 | [["MNOP" {}]] 873 | [[" " {:bg 3}]] 874 | [[" " {:bg 3}]] 875 | [["QR " {}]]]) 876 | (expect-cursor vt 2 0)))) 877 | 878 | (testing "CSI T (SD)" 879 | (let [vt (-> (make-vt 4 5) 880 | (feed-str "ABCDEFGHIJKLMNOPQR") 881 | (set-bg 3) 882 | (move-cursor 2 1))] 883 | (let [vt (feed-csi vt "T")] 884 | (expect-lines vt [[[" " {:bg 3}]] 885 | [["ABCD" {}]] 886 | [["EFGH" {}]] 887 | [["IJKL" {}]] 888 | [["MNOP" {}]]]) 889 | (expect-cursor vt 2 1)) 890 | (let [vt (feed-csi vt "2T")] 891 | (expect-lines vt [[[" " {:bg 3}]] 892 | [[" " {:bg 3}]] 893 | [["ABCD" {}]] 894 | [["EFGH" {}]] 895 | [["IJKL" {}]]]) 896 | (expect-cursor vt 2 1)) 897 | (let [vt (feed-csi vt "10T")] 898 | (expect-lines vt [[[" " {:bg 3}]] 899 | [[" " {:bg 3}]] 900 | [[" " {:bg 3}]] 901 | [[" " {:bg 3}]] 902 | [[" " {:bg 3}]]]) 903 | (expect-cursor vt 2 1)) 904 | (let [vt (-> vt 905 | (feed-csi "2;4r") 906 | (move-cursor 2 0)) 907 | vt (feed-csi vt "2T")] 908 | (expect-lines vt [[["ABCD" {}]] 909 | [[" " {:bg 3}]] 910 | [[" " {:bg 3}]] 911 | [["EFGH" {}]] 912 | [["QR " {}]]]) 913 | (expect-cursor vt 2 0)))) 914 | 915 | (testing "CSI W (CTC)" 916 | (let [vt (-> (make-vt 30 24))] 917 | (let [vt (-> vt (move-cursor 5 0) (feed-csi "W"))] 918 | (expect-tabs vt #{5 8 16 24})) 919 | (let [vt (-> vt (move-cursor 5 0) (feed-csi "0W"))] 920 | (expect-tabs vt #{5 8 16 24})) 921 | (let [vt (-> vt (move-cursor 16 0) (feed-csi "2W"))] 922 | (expect-tabs vt #{8 24})) 923 | (let [vt (-> vt (feed-csi "5W"))] 924 | (expect-tabs vt #{})))) 925 | 926 | (testing "CSI X (ECH)" 927 | (let [vt (-> (make-vt 7 1) 928 | (feed-str "ABCDEF") 929 | (set-bg 3) 930 | (move-cursor 2 0))] 931 | (let [vt (feed-csi vt "X")] 932 | (expect-first-line vt [["AB" {}] [" " {:bg 3}] ["DEF " {}]]) 933 | (expect-cursor vt 2 0)) 934 | (let [vt (feed-csi vt "2X")] 935 | (expect-first-line vt [["AB" {}] [" " {:bg 3}] ["EF " {}]]) 936 | (expect-cursor vt 2 0)) 937 | (let [vt (feed-csi vt "100X")] 938 | (expect-first-line vt [["AB" {}] [" " {:bg 3}] ]) 939 | (expect-cursor vt 2 0)))) 940 | 941 | (testing "CSI Z" 942 | (let [vt (make-vt 20 3)] 943 | (let [vt (-> vt (move-cursor 0 0) (feed-csi "Z"))] 944 | (expect-cursor vt 0 0)) 945 | (let [vt (-> vt (move-cursor 2 0) (feed-csi "2Z"))] 946 | (expect-cursor vt 0 0)) 947 | (let [vt (-> vt (move-cursor 8 1) (feed-csi "Z"))] 948 | (expect-cursor vt 0 1)) 949 | (let [vt (-> vt (move-cursor 9 1) (feed-csi "Z"))] 950 | (expect-cursor vt 8 1)) 951 | (let [vt (-> vt (move-cursor 18 1) (feed-csi "2Z"))] 952 | (expect-cursor vt 8 1)))) 953 | 954 | (testing "CSI d (VPA)" 955 | (let [vt (-> (make-vt 80 24) 956 | (move-cursor 15 1))] 957 | (let [vt (feed-csi vt "d")] 958 | (expect-cursor vt 15 0)) 959 | (let [vt (feed-csi vt "5d")] 960 | (expect-cursor vt 15 4)) 961 | (let [vt (feed-csi vt "10;15r")] ; set scroll region 962 | (let [vt (feed-csi vt "5d")] 963 | (expect-cursor vt 0 4)) 964 | (let [vt (feed-csi vt "?6h")] ; set origin mode 965 | (let [vt (feed-csi vt "3d")] 966 | (expect-cursor vt 0 11)) 967 | (let [vt (feed-csi vt "8d")] 968 | (expect-cursor vt 0 14)))))) 969 | 970 | (testing "CSI g (TBC)" 971 | (let [vt (-> (make-vt 45 24) 972 | (move-cursor 24 0))] 973 | (let [vt (feed-csi vt "g")] 974 | (expect-tabs vt #{8 16 32 40})) 975 | (let [vt (feed-csi vt "3g")] 976 | (expect-tabs vt #{})))) 977 | 978 | (testing "CSI 4h (SM)" 979 | (let [vt (-> (make-vt 80 24) 980 | (feed-csi "4h"))] 981 | (is (-> vt :screen screen/insert-mode?)))) 982 | 983 | (testing "CSI 20h (SM)" 984 | (let [vt (-> (make-vt 80 24) 985 | (feed-csi "20h"))] 986 | (is (-> vt :screen screen/new-line-mode?)))) 987 | 988 | (testing "CSI ?6h (DECSM)" ; set origin mode 989 | (let [vt (-> (make-vt 80 24) 990 | (feed-csi "3;5r") ; set scroll region 991 | (move-cursor 1 1) 992 | (feed-csi "?6h"))] 993 | (is (-> vt :screen screen/origin-mode?)) 994 | (expect-cursor vt 0 2))) 995 | 996 | (testing "CSI ?7h (DECSM)" ; set auto-wrap mode 997 | (let [vt (-> (make-vt 80 24) 998 | (feed-csi "?7h"))] 999 | (is (-> vt :screen screen/auto-wrap-mode?)))) 1000 | 1001 | (testing "CSI ?25h (DECSM)" ; show cursor 1002 | (let [vt (-> (make-vt 80 24) 1003 | hide-cursor 1004 | (feed-csi "?25h"))] ; show cursor 1005 | (expect-cursor vt 0 0 true))) 1006 | 1007 | (testing "CSI ?47h, CSI ?1047h (DECSM)" ; switch to alternate buffer 1008 | (let [vt (make-vt 4 3)] 1009 | (doseq [cseq ["?47h" "?1047h"]] 1010 | (testing "when in primary buffer" 1011 | (let [vt (-> vt 1012 | (feed-str "ABC\n\rDE") 1013 | (set-bg 2) 1014 | (feed-csi cseq))] 1015 | (expect-cursor vt 2 1) 1016 | (expect-lines vt [[[" " {:bg 2}]] 1017 | [[" " {:bg 2}]] 1018 | [[" " {:bg 2}]]]))) 1019 | (testing "when in alternate buffer" 1020 | (let [vt (-> vt 1021 | (feed-csi cseq) 1022 | (feed-str "ABC\n\rDE") 1023 | (feed-csi cseq))] 1024 | (expect-cursor vt 2 1) 1025 | (expect-lines vt [[["ABC " {}]] 1026 | [["DE " {}]] 1027 | [[" " {}]]])))))) 1028 | 1029 | (testing "CSI ?1049h (DECSM)" ; save cursor and switch to alternate buffer 1030 | (let [vt (make-vt 4 3)] 1031 | (testing "when in primary buffer" 1032 | (let [vt (-> vt 1033 | (feed-str "ABC\n\rDE") 1034 | (set-bg 2) 1035 | (feed-csi "?1049h"))] 1036 | (expect-cursor vt 2 1) 1037 | (expect-lines vt [[[" " {:bg 2}]] 1038 | [[" " {:bg 2}]] 1039 | [[" " {:bg 2}]]]))) 1040 | (testing "when in alternate buffer" 1041 | (let [vt (-> vt 1042 | (feed-csi "?1049h") 1043 | (feed-str "ABC\n\rDE") 1044 | (feed-csi "?1049h"))] 1045 | (expect-cursor vt 2 1) 1046 | (expect-lines vt [[["ABC " {}]] 1047 | [["DE " {}]] 1048 | [[" " {}]]]))))) 1049 | 1050 | (testing "CSI ?h (DECSM)" ; set multiple modes 1051 | (let [vt (-> (make-vt 80 24) 1052 | (feed-csi "?6;7;25h"))] 1053 | (is (-> vt :screen screen/origin-mode?)) 1054 | (is (-> vt :screen screen/auto-wrap-mode?)) 1055 | (is (-> vt :screen screen/cursor :visible)))) 1056 | 1057 | (testing "CSI 4l (RM)" 1058 | (let [vt (-> (make-vt 80 24) 1059 | (feed-csi "4l"))] 1060 | (is (not (-> vt :screen screen/insert-mode?))))) 1061 | 1062 | (testing "CSI 20l (RM)" 1063 | (let [vt (-> (make-vt 80 24) 1064 | (feed-csi "20l"))] 1065 | (is (not (-> vt :screen screen/new-line-mode?))))) 1066 | 1067 | (testing "CSI ?6l (DECRM)" ; reset origin mode 1068 | (let [vt (-> (make-vt 20 10) 1069 | (feed-csi "3;5r") ; set scroll region 1070 | (feed-csi "?6h") ; set origin mode 1071 | (move-cursor 1 1) 1072 | (feed-csi "?6l"))] 1073 | (is (not (-> vt :screen screen/origin-mode?))) 1074 | (expect-cursor vt 0 0))) 1075 | 1076 | (testing "CSI ?7l (DECRM)" 1077 | (let [vt (-> (make-vt 80 24) 1078 | (feed-csi "?7l"))] 1079 | (is (not (-> vt :screen screen/auto-wrap-mode?))))) 1080 | 1081 | (testing "CSI ?25l (DECRM)" ; hide cursor 1082 | (let [vt (-> (make-vt 80 24) 1083 | (feed-csi "?25l"))] 1084 | (expect-cursor vt 0 0 false))) 1085 | 1086 | (testing "CSI ?47l, ?1047l (DECRM)" ; switch back to primary buffer 1087 | (let [vt (make-vt 4 3)] 1088 | (doseq [cseq ["?1047l"]] 1089 | (testing "when in primary buffer" 1090 | (let [vt (-> vt 1091 | (feed-str "ABC\n\rDE") 1092 | (feed-csi cseq))] 1093 | (expect-cursor vt 2 1) 1094 | (expect-lines vt [[["ABC " {}]] 1095 | [["DE " {}]] 1096 | [[" " {}]]]))) 1097 | (testing "when in alternate buffer" 1098 | (let [vt (-> vt 1099 | (feed-str "ABC\n\rDE") 1100 | (set-bg 2) 1101 | (feed-csi "?1047h") ; set alternate buffer 1102 | (feed-str "\n\rX") 1103 | (feed-csi cseq))] 1104 | (expect-cursor vt 1 2) 1105 | (expect-lines vt [[["ABC " {}]] 1106 | [["DE " {}]] 1107 | [[" " {}]]])))))) 1108 | 1109 | (testing "CSI ?1049l (DECRM)" ; switch back to primary buffer and restore cursor 1110 | (let [vt (make-vt 4 3)] 1111 | (testing "when in primary buffer" 1112 | (let [vt (-> vt 1113 | (feed-str "ABC\n\rDE") 1114 | (feed-csi "?1049l"))] 1115 | (expect-cursor vt 0 0) 1116 | (expect-lines vt [[["ABC " {}]] 1117 | [["DE " {}]] 1118 | [[" " {}]]]))) 1119 | (testing "when in alternate buffer" 1120 | (let [vt (-> vt 1121 | (feed-str "ABC\n\rDE") 1122 | (set-bg 2) 1123 | (feed-csi "?1049h") 1124 | (feed-str "\n\rXYZ") 1125 | (feed-esc "7") 1126 | (feed-csi "?1049l"))] 1127 | (expect-cursor vt 2 1) 1128 | (expect-lines vt [[["ABC " {}]] 1129 | [["DE " {}]] 1130 | [[" " {}]]]))))) 1131 | 1132 | (testing "CSI ?l (DECRM)" ; reset multiple modes 1133 | (let [vt (make-vt 80 24)] 1134 | (testing "resetting multiple modes" 1135 | (let [vt (feed-csi vt "?6;7;25l")] 1136 | (is (not (-> vt :screen screen/origin-mode?))) 1137 | (is (not (-> vt :screen screen/auto-wrap-mode?))) 1138 | (is (not (-> vt :screen screen/cursor :visible))))))) 1139 | 1140 | (testing "CSI m (SGR)" 1141 | (let [vt (make-vt 21 1) 1142 | all-on-params "1;3;4;5;7;9;31;42m" 1143 | all-on-attrs {:bold true :italic true :underline true :blink true 1144 | :inverse true :strikethrough true :fg 1 :bg 2} 1145 | compare-attrs #(= (-> %1 (feed-csi %2) (feed-str "A") :screen screen/lines ffirst last) %3)] 1146 | (are [input-str expected-attrs] (compare-attrs vt input-str expected-attrs) 1147 | "1m" {:bold true} 1148 | "3m" {:italic true} 1149 | "4m" {:underline true} 1150 | "5m" {:blink true} 1151 | "7m" {:inverse true} 1152 | "9m" {:strikethrough true} 1153 | "32m" {:fg 2} 1154 | "43m" {:bg 3} 1155 | "93m" {:fg 11} 1156 | "104m" {:bg 12} 1157 | "1;38;5;88;48;5;99;5m" {:fg 88 :bg 99 :bold true :blink true} 1158 | "1;38;2;1;101;201;48;2;2;102;202;5m" {:fg [1 101 201] :bg [2 102 202] :bold true :blink true} 1159 | all-on-params all-on-attrs) 1160 | (let [vt (feed-csi vt all-on-params)] 1161 | (are [input-str expected-attrs] (compare-attrs vt input-str expected-attrs) 1162 | "m" screen/normal-char-attrs ; implicit 0 param 1163 | "0m" screen/normal-char-attrs ; explicit 0 param 1164 | "21m" (dissoc all-on-attrs :bold) 1165 | "22m" (dissoc all-on-attrs :bold) 1166 | "23m" (dissoc all-on-attrs :italic) 1167 | "24m" (dissoc all-on-attrs :underline) 1168 | "25m" (dissoc all-on-attrs :blink) 1169 | "27m" (dissoc all-on-attrs :inverse) 1170 | "39m" (dissoc all-on-attrs :fg) 1171 | "49m" (dissoc all-on-attrs :bg))))) 1172 | 1173 | (testing "CSI !p (DECSTR)" 1174 | (let [vt (-> (make-vt 4 4) 1175 | (feed-str "ABCDEFGHI") 1176 | (feed-csi "2;3r") ; set scroll region 1177 | (feed-csi "?6h") ; set origin mode 1178 | (feed-csi "4h") ; set insert mode 1179 | (feed-csi "?25l") ; hide cursor 1180 | (move-cursor 2 1) ; this will be relative to top margin 1181 | (set-fg 1) 1182 | (feed-esc "7") ; save cursor 1183 | (feed-csi "!p"))] ; soft reset 1184 | (expect-lines vt [[["ABCD" {}]] 1185 | [["EFGH" {}]] 1186 | [["I " {}]] 1187 | [[" " {}]]]) 1188 | (expect-cursor vt 2 2 true) 1189 | (is (= (-> vt :screen screen/char-attrs) screen/normal-char-attrs)) 1190 | (is (not (-> vt :screen screen/insert-mode?))) 1191 | (is (not (-> vt :screen screen/origin-mode?))) 1192 | (is (= (-> vt :screen screen/top-margin) 0)) 1193 | (is (= (-> vt :screen screen/bottom-margin) 3)) 1194 | (is (= (-> vt :screen screen/saved) screen/initial-saved-cursor)))) 1195 | 1196 | (testing "CSI r (DECSTBM)" 1197 | (let [vt (make-vt 80 24)] 1198 | (let [vt (feed-csi vt "r")] 1199 | (is (= (-> vt :screen screen/top-margin) 0)) 1200 | (is (= (-> vt :screen screen/bottom-margin) 23)) 1201 | (expect-cursor vt 0 0)) 1202 | (let [vt (-> vt 1203 | (move-cursor 20 10) 1204 | (feed-csi "5;15r"))] 1205 | (is (= (-> vt :screen screen/top-margin) 0)) 1206 | (is (= (-> vt :screen screen/bottom-margin) 23)) 1207 | (expect-cursor vt 0 0)) 1208 | (let [vt (-> vt 1209 | (feed-csi "?6h") ; set origin mode 1210 | (move-cursor 20 10) 1211 | (feed-csi "5;15r"))] ; set scroll region 1212 | (is (= (-> vt :screen screen/top-margin) 4)) 1213 | (is (= (-> vt :screen screen/bottom-margin) 14)) 1214 | (expect-cursor vt 0 4))))) 1215 | 1216 | (deftest get-params-test 1217 | (let [vt (-> (make-vt 4 3) (assoc-in [:parser-params] []))] 1218 | (is (= (get-params vt) []))) 1219 | (let [vt (-> (make-vt 4 3) (assoc-in [:parser-params] [0x33]))] 1220 | (is (= (get-params vt) [3]))) 1221 | (let [vt (-> (make-vt 4 3) (assoc-in [:parser-params] [0x3b 0x3b 0x31 0x32 0x3b 0x3b 0x32 0x33 0x3b 0x31 0x3b]))] 1222 | (is (= (get-params vt) [0 0 12 0 23 1])))) 1223 | 1224 | (deftest restore-cursor-on-the-edge 1225 | (let [vt (feed (make-vt 10 2) [32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 27, 55, 27, 56, 32])] 1226 | (expect-cursor vt 10 0) 1227 | (expect-first-line vt [[" " {}]]))) 1228 | 1229 | #?(:cljs 1230 | (deftest feed-str-unicode-handling 1231 | (let [vt (feed-str (make-vt 10 1) "\ud83c\udf7a <- beer")] 1232 | (expect-first-line vt [["🍺 <- beer" {}]])))) ; U+1F37A: BEER MUG 1233 | 1234 | (def gen-unicode-rubbish (gen/vector (gen/choose 0 0x10ffff) 1 20)) 1235 | 1236 | (def gen-color (gen/one-of [(gen/return nil) 1237 | (gen/choose 0 15) 1238 | (gen/choose 16 231) 1239 | (gen/tuple (gen/choose 0 255) (gen/choose 0 255) (gen/choose 0 255))])) 1240 | 1241 | (def gen-ctl-seq (gen/let [char (gen/elements (reduce into #{} [(range 0x00 0x18) 1242 | [0x19] 1243 | (range 0x1c 0x20)]))] 1244 | [char])) 1245 | 1246 | (def gen-intermediate (gen/elements (range 0x20 0x30))) 1247 | 1248 | (def gen-finalizer (gen/elements (reduce into #{} [(range 0x30 0x50) 1249 | (range 0x51 0x58) 1250 | [0x59] 1251 | [0x5a] 1252 | [0x5c] 1253 | (range 0x60 0x7f)]))) 1254 | 1255 | (def gen-esc-seq (gen/let [intermediates (gen/vector gen-intermediate 0 2) 1256 | finalizer gen-finalizer] 1257 | (apply concat [[0x1b] intermediates [finalizer]]))) 1258 | 1259 | (def gen-param (gen/elements (range 0x30 0x3a))) 1260 | 1261 | (def gen-params (gen/vector (gen/one-of [gen-param 1262 | gen-param 1263 | (gen/return 0x3b)]) 0 5)) 1264 | 1265 | (def gen-csi-seq (gen/let [params gen-params 1266 | finalizer (gen/elements (range 0x40 0x7f))] 1267 | (apply concat [[0x1b 0x5b] params [finalizer]]))) 1268 | 1269 | (def gen-sgr-seq (gen/let [params gen-params] 1270 | (apply concat [[0x1b 0x5b] params [0x6d]]))) 1271 | 1272 | (def gen-ascii-char (gen/choose 0x20 0x7f)) 1273 | 1274 | (def gen-char (gen/one-of [gen-ascii-char 1275 | gen-ascii-char 1276 | gen-ascii-char 1277 | gen-ascii-char 1278 | gen-ascii-char 1279 | (gen/choose 0x80 0xd7ff) 1280 | ; skip Unicode surrogates and private use area 1281 | (gen/choose 0xf900 0xffff)])) 1282 | 1283 | (def gen-text (gen/vector gen-char 1 10)) 1284 | 1285 | (def gen-input (gen/one-of [gen-ctl-seq 1286 | gen-esc-seq 1287 | gen-csi-seq 1288 | gen-sgr-seq 1289 | gen-text])) 1290 | 1291 | (defspec test-parser-state-for-random-input 1292 | {:num-tests (* 10 (property-tests-multiplier))} 1293 | (prop/for-all [rubbish gen-unicode-rubbish] 1294 | (let [vt (-> (make-vt 80 24) (feed rubbish))] 1295 | (keyword? (-> vt :parser-state))))) 1296 | 1297 | (defspec test-cursor-position-for-random-input 1298 | {:num-tests (* 100 (property-tests-multiplier))} 1299 | (prop/for-all [x (gen/choose 0 19) 1300 | y (gen/choose 0 9) 1301 | input gen-input] 1302 | (let [vt (-> (make-vt 20 10) 1303 | (move-cursor x y) 1304 | (feed input)) 1305 | {:keys [x y]} (-> vt :screen screen/cursor)] 1306 | (and (or (< -1 x 20) (and (= x 20) (-> vt :screen screen/next-print-wraps?))) 1307 | (< -1 y 10))))) 1308 | 1309 | (defspec test-row-and-column-count-for-random-input 1310 | {:num-tests (* 100 (property-tests-multiplier))} 1311 | (prop/for-all [x (gen/choose 0 19) 1312 | y (gen/choose 0 9) 1313 | input gen-input] 1314 | (let [vt (-> (make-vt 20 10) 1315 | (move-cursor x y) 1316 | (feed input)) 1317 | lines (-> vt :screen :lines)] 1318 | (and (= 10 (count lines)) 1319 | (every? #(= 20 (count %)) lines))))) 1320 | 1321 | (defspec test-no-wrapping-after-moved-from-right-margin 1322 | {:num-tests (* 100 (property-tests-multiplier))} 1323 | (prop/for-all [y (gen/choose 0 9) 1324 | input gen-input] 1325 | (let [vt (-> (make-vt 20 10) 1326 | (move-cursor 19 y) 1327 | (feed input)) 1328 | new-x (-> vt :screen screen/cursor :x) 1329 | next-print-wraps (-> vt :screen screen/next-print-wraps?)] 1330 | (not (and next-print-wraps (< new-x 20)))))) 1331 | 1332 | (defspec test-dump-sgr 1333 | {:num-tests (* 100 (property-tests-multiplier))} 1334 | (prop/for-all [fg gen-color 1335 | bg gen-color 1336 | bold gen/boolean 1337 | italic gen/boolean 1338 | underline gen/boolean 1339 | blink gen/boolean 1340 | inverse gen/boolean 1341 | strikethrough gen/boolean] 1342 | (let [attrs (cond-> {} 1343 | fg (assoc :fg fg) 1344 | bg (assoc :bg bg) 1345 | bold (assoc :bold bold) 1346 | italic (assoc :italic italic) 1347 | underline (assoc :underline underline) 1348 | blink (assoc :blink blink) 1349 | inverse (assoc :inverse inverse) 1350 | strikethrough (assoc :strikethrough strikethrough)) 1351 | sgr (dump-sgr attrs) 1352 | new-vt (feed-str vt-80x24 sgr) 1353 | new-attrs (-> new-vt :screen screen/char-attrs)] 1354 | (= attrs new-attrs)))) 1355 | 1356 | (defspec test-dump 1357 | {:num-tests (* 100 (property-tests-multiplier))} 1358 | (prop/for-all [input (gen/vector gen-input 5 100)] 1359 | (let [blank-vt (make-vt 10 5) 1360 | vt (reduce feed blank-vt input) 1361 | text (dump vt) 1362 | new-vt (feed-str blank-vt text)] 1363 | (= (-> vt :screen screen/lines) (-> new-vt :screen screen/lines))))) 1364 | --------------------------------------------------------------------------------