├── .gitignore ├── .vscode ├── launch.json ├── settings.json └── tasks.json ├── CODE_OF_CONDUCT.md ├── Docs ├── DEVELOP.md ├── LessonsLearnt.md ├── MiniExpectScripts.md ├── Test.data └── implementationChart.md ├── LICENSE ├── README.md ├── Screenshots ├── DasherA-20220130.png └── DasherA-20220305.png ├── Scripts └── test.script ├── Templates ├── BROWSE_template.txt ├── MEMACS_template.txt ├── SED_template.txt └── SMI_template.txt ├── alire.toml ├── changelog ├── dashera.gpr ├── non_alire.gpr ├── share └── dashera │ ├── D410-b-12.bdf │ └── DGlogoOrange.ico └── src ├── bdf_font.adb ├── bdf_font.ads ├── cell.adb ├── cell.ads ├── crt.adb ├── crt.ads ├── dasher_codes.ads ├── dashera.adb ├── display_p.adb ├── display_p.ads ├── embedded.adb ├── embedded.ads ├── gnat.adc ├── gui.adb ├── gui.ads ├── keyboard.adb ├── keyboard.ads ├── logging.adb ├── logging.ads ├── mini_expect.adb ├── mini_expect.ads ├── redirector.adb ├── redirector.ads ├── serial.adb ├── serial.ads ├── session_logger.adb ├── session_logger.ads ├── telnet.adb ├── telnet.ads ├── terminal.adb ├── terminal.ads ├── xmodem.adb └── xmodem.ads /.gitignore: -------------------------------------------------------------------------------- 1 | /obj/* 2 | /resources 3 | dashera 4 | /obj/ 5 | /bin/ 6 | /alire/ 7 | /config/ 8 | -------------------------------------------------------------------------------- /.vscode/launch.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.2.0", 3 | "configurations": [ 4 | { 5 | "name": "(gdb) Launch", 6 | "type": "cppdbg", 7 | "request": "launch", 8 | "program": "${workspaceFolder}/bin/dashera", 9 | "args": [], 10 | "stopAtEntry": false, 11 | "cwd": "${workspaceFolder}", 12 | "environment": [], 13 | "MIMode": "gdb", 14 | "setupCommands": [ 15 | { 16 | "description": "Enable pretty-printing for gdb", 17 | "text": "-enable-pretty-printing", 18 | "ignoreFailures": true 19 | } 20 | ] 21 | } 22 | ] 23 | } -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "editor.tabSize": 3, 3 | "ada.projectFile": "dashera.gpr", 4 | "ada.enableDiagnostics": false, 5 | "cSpell.words": [ 6 | "dashera", 7 | "iftop", 8 | "stty" 9 | ] 10 | } -------------------------------------------------------------------------------- /.vscode/tasks.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "2.0.0", 3 | "tasks": [ 4 | { 5 | "type": "gprbuild", 6 | "projectFile": "${config:ada.projectFile}", 7 | "problemMatcher": [ 8 | "$ada" 9 | ], 10 | "group": { 11 | "kind": "build", 12 | "isDefault": true 13 | }, 14 | "label": "ada: Build current project" 15 | } 16 | ] 17 | } -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity 10 | and orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the 26 | overall community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards of 42 | acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies when 54 | an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail address, 56 | posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at 63 | Project Owner. 64 | All complaints will be reviewed and investigated promptly and fairly. 65 | 66 | All community leaders are obligated to respect the privacy and security of the 67 | reporter of any incident. 68 | 69 | ## Enforcement Guidelines 70 | 71 | Community leaders will follow these Community Impact Guidelines in determining 72 | the consequences for any action they deem in violation of this Code of Conduct: 73 | 74 | ### 1. Correction 75 | 76 | **Community Impact**: Use of inappropriate language or other behavior deemed 77 | unprofessional or unwelcome in the community. 78 | 79 | **Consequence**: A private, written warning from community leaders, providing 80 | clarity around the nature of the violation and an explanation of why the 81 | behavior was inappropriate. A public apology may be requested. 82 | 83 | ### 2. Warning 84 | 85 | **Community Impact**: A violation through a single incident or series 86 | of actions. 87 | 88 | **Consequence**: A warning with consequences for continued behavior. No 89 | interaction with the people involved, including unsolicited interaction with 90 | those enforcing the Code of Conduct, for a specified period of time. This 91 | includes avoiding interactions in community spaces as well as external channels 92 | like social media. Violating these terms may lead to a temporary or 93 | permanent ban. 94 | 95 | ### 3. Temporary Ban 96 | 97 | **Community Impact**: A serious violation of community standards, including 98 | sustained inappropriate behavior. 99 | 100 | **Consequence**: A temporary ban from any sort of interaction or public 101 | communication with the community for a specified period of time. No public or 102 | private interaction with the people involved, including unsolicited interaction 103 | with those enforcing the Code of Conduct, is allowed during this period. 104 | Violating these terms may lead to a permanent ban. 105 | 106 | ### 4. Permanent Ban 107 | 108 | **Community Impact**: Demonstrating a pattern of violation of community 109 | standards, including sustained inappropriate behavior, harassment of an 110 | individual, or aggression toward or disparagement of classes of individuals. 111 | 112 | **Consequence**: A permanent ban from any sort of public interaction within 113 | the community. 114 | 115 | ## Attribution 116 | 117 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 118 | version 2.0, available at 119 | https://www.contributor-covenant.org/version/2/0/code_of_conduct.html. 120 | 121 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 122 | enforcement ladder](https://github.com/mozilla/diversity). 123 | 124 | [homepage]: https://www.contributor-covenant.org 125 | 126 | For answers to common questions about this code of conduct, see the FAQ at 127 | https://www.contributor-covenant.org/faq. Translations are available at 128 | https://www.contributor-covenant.org/translations. 129 | -------------------------------------------------------------------------------- /Docs/DEVELOP.md: -------------------------------------------------------------------------------- 1 | # Developer's Notes for DasherA 2 | 3 | ## November 2021... 4 | 5 | DasherA is a rewrite of DasherG v0.10.0x in Ada using the GtkAda toolkit and only Gtk3 elements. 6 | 7 | The GUI toolkit used for DasherG (go-gtk) now seems to be unmaintained and it is probably a good time to leave Gtk2 behind. 8 | 9 | ## Objects 10 | 11 | I've wasted too much time taking a 'purist' approach to making things objects. 12 | DasherA is only ever going to be single-session, there will only ever be a single connection/terminal etc. 13 | Henceforth, try to use objects only where required, elsewhere a traditional Ada procedural approach works just fine. 14 | 15 | ## Major Packages 16 | 17 | * Cell - a single ASCII character and its Dasher attributes 18 | * Crt - handle the drawing of a Display in the application 19 | * Dashera - the main entry point 20 | * Display - holds a matrix of ASCII characters (Cells) 21 | * GUI - the bulk of the Gtk interface 22 | * Keyboard - guess what?!? 23 | * Redirector - routes data according to the current connection 24 | * Serial - handle the serial (async) connection 25 | * Telnet - handle the Telnet connection and protocol 26 | * Terminal - implements the Dasher behaviour 27 | 28 | ### Tasks 29 | 30 | * Mini_Expect.Runner_Task (transient) 31 | * ~~Redirector.Router~~ 32 | * ~~Serial.Keyboard_Sender~~ 33 | * Serial.Receiver 34 | * ~~Telnet.Keyboard_Sender~~ 35 | * Telnet.Receiver 36 | * ~~Terminal.Processor~~ 37 | * Xmodem.Receiver (transient) 38 | * Xmodem.Sender (transient) 39 | 40 | ### Embedded Resources 41 | 42 | The embedded font and icon were generated with this command, run from the top-level dir... 43 | `are --lang=Ada -o src --resource=Embedded --name-access --fileset='**/*.*' share/dashera` 44 | 45 | ## Build and Clean 46 | 47 | Dashera has moved to the [Alire](https://alire.ada.dev/) build system. 48 | 49 | [![Alire](https://img.shields.io/endpoint?url=https://alire.ada.dev/badges/dashera.json)](https://alire.ada.dev/crates/dashera.html) 50 | 51 | Once you have Alire installed you should be able to obtain the latest release of Dashera and build it with just the three commands below... 52 | ``` 53 | alr get dashera 54 | cd dashera 55 | alr build 56 | ``` 57 | N.B. If you have not built a GtkAda crate (the GUI toolkit we use) recently then Alire will automatically download and build that before building Dashera itself. This can take some time when it first happens, subsequent builds should be much faster. 58 | 59 | ### Non-Alire Build 60 | 61 | If you cannot use Alire, it should still be possible to build Dashera with gprbuild... 62 | ``` 63 | mkdir obj 64 | gprbuild -Pnon_alire 65 | ``` 66 | Ignore the warning about file name not matching project name. 67 | You may append `-Xmode=release` to the gprbuild command for an optimised build. 68 | 69 | Without Alire you will have to manually ensure that dependencies (eg. GtkAda) are installed. 70 | Eg. You may need to install the `libgtkada20-dev` package. 71 | 72 | 73 | ## Run with Fatal Warnings... 74 | `./dashera --gtk-fatal-warnings --g-fatal--warnings` 75 | 76 | ## Terminal setting on Linux host: 77 | 78 | Ensure `ncurses-term` package is installed. 79 | 80 | `export TERM=d210-dg` 81 | 82 | You may have to `stty echo` if no characters appear when you type. 83 | 84 | N.B. There are bugs in the termcap database for (all) the DASHER terminals; not many allegedly termcap (ncurses) aware programs actually handle unusual terminal types. The `htop` program does a fair job of behaving properly - even so, you will see a few glitches over time. Likewise with `iftop`. The `nano` editor seems to behave quite well - although you may need to use the function keys to save and exit. 85 | 86 | ## Serial Port Test Setup (Linux) 87 | 88 | Install and then `insmod` `tty0tty`. 89 | 90 | Then `/dev/tnt0` is connected to `/dev/tnt1`, etc. 91 | 92 | -------------------------------------------------------------------------------- /Docs/LessonsLearnt.md: -------------------------------------------------------------------------------- 1 | # Lessons Learnt Moving a Gtk Application from Go to Ada 2 | - [Lessons Learnt Moving a Gtk Application from Go to Ada](#lessons-learnt-moving-a-gtk-application-from-go-to-ada) 3 | - [Summary](#summary) 4 | - [Introduction](#introduction) 5 | - [Caveat](#caveat) 6 | - [Application Description](#application-description) 7 | - [Why Port?](#why-port) 8 | - [Result](#result) 9 | - [What was Easy?](#what-was-easy) 10 | - [Program Logic](#program-logic) 11 | - [Gtk 2 to Gtk 3](#gtk-2-to-gtk-3) 12 | - [What was Difficult?](#what-was-difficult) 13 | - [Documentation](#documentation) 14 | - [Finding Libraries](#finding-libraries) 15 | - [Examples](#examples) 16 | - [Change of Mindset](#change-of-mindset) 17 | - [Debugging tasks](#debugging-tasks) 18 | - [Traps for the Unwary](#traps-for-the-unwary) 19 | - [Rewrite, don't Translate](#rewrite-dont-translate) 20 | - [GtkAda and Tasks](#gtkada-and-tasks) 21 | - [Goroutines vs. Tasks](#goroutines-vs-tasks) 22 | - [Channels](#channels) 23 | - [Error Handling](#error-handling) 24 | - [Pleasures and Disappointments](#pleasures-and-disappointments) 25 | - [Pleasures](#pleasures) 26 | - [Disappointments](#disappointments) 27 | 28 | ## Summary 29 | 30 | ## Introduction 31 | This document describes some of my thoughts following the successful transition of a desktop terminal emulator program from Go and Gtk 2 to Ada and Gtk 3. The rewrite took place over a period of four months beginning in November 2021. 32 | 33 | ### Caveat 34 | I do not claim to be an expert in anything that follows. These days (2022) programming is a hobby for me and all the work described here was undertaken as a 'spare time' project. This is an 'opinion piece' - I am not going to back up every statement with references! 35 | 36 | ### Application Description 37 | My DASHER terminal emulators provide free, open source and modern emulations of the most commonly used types of terminal (D200 and D210) that were connected to Data General minicomputers of the 1970s through to the end of the century. 38 | 39 | Having both serial and telnet support, the emulators can be connected both to legacy hardware and modern emulations of that hardware. 40 | 41 | The first in this series of terminal emulators was written in C++ with a Qt GUI, then came a Java version, and thirdly a Go version using a rather nice Gtk 2 package (binding). 42 | 43 | ### Why Port? 44 | DasherG was first released in 2019 but by the end of 2021 it had already become difficult to build and maintain. This was mainly because the GUI toolkit used had become unmaintained leading to significant dependency difficulties. Also, Gtk 2 is nearing the end of its life. 45 | 46 | There appeared to be two options: either find a new GUI toolkit and reuse the guts of the code, or switch to a language with better GUI support. 47 | 48 | Unfortunately, Go does not have a good 'story' regarding GUI libraries. There is no officially-supported library and some of the better-known ones are either very idiosyncratic ('opinionated' in Go parlance) or immature. I did have a serious try with Fyne and although it's promising it suffers both of the aforementioned problems. 49 | 50 | It seemed that switching to a language with better GUI support would make sense, and I had some recent experience learning Ada and porting some non-GUI Go code to Ada. 51 | 52 | Also, it was clear to me that I needed a language, toolkit, and bindings which were likely to be stable for some years. Ada, Gtk 3 and GtkAda seem to fit the bill nicely. 53 | 54 | After following the evolution of Go for many years I feel that the core developers are abandoning the idea of it being a truly general purpose language and shifting their focus to being an excellent web-services/netops domain-specific language. 55 | 56 | ### Result 57 | DasherA v0.11 written in Ada is believed to be functionally equivalent to DasherG v0.10 - with some minor improvements. Performance and memory consumption of the two applications is similar. 58 | 59 | DasherA is now easy to build and maintain on modern Debian-based systems. 60 | 61 | As usual, a rewrite of the code (which had some legacy cruft left over from its previous incarnations) gave an opportunity to improve the structure of the program a little. 62 | 63 | Before starting, I guesstimated a timeframe of about six weeks for this, in fact it took four months. However, the time I have available for projects such as this varies wildly. I think this effort would have taken about four weeks if I was working on it full-time. 64 | 65 | ## What was Easy? 66 | 67 | ### Program Logic 68 | Most of the actual terminal emulation logic is contained the `terminal` sources in both DasherG and DasherA. A quick glance and `terminal.go` and `Terminal.adb` will reveal that they are strikingly similar. 69 | 70 | ### Gtk 2 to Gtk 3 71 | Although DasherG used a number of the features that changed significantly between Gtk 2 and Gtk 3, the move was made much easier due to the excellent general information available on-line. 72 | 73 | ## What was Difficult? 74 | 75 | ### Documentation 76 | The Go developers and community have done a very good job of building excellent documentation facilities and practices into the language and packages (libraries) right from its inception. 77 | 78 | Unfortunately the same cannot be said for Ada. 79 | 80 | I think there are tools somewhat akin to `godoc`, but there are _several_ of them - each using different conventions for creating and accessing any generated documentation. 81 | 82 | It was frustrating to come across some Ada packages which seemed to have very good documentation embedded in the code, but no instructions regarding how to generate that documentation in a readable form. 83 | 84 | Ada has been around for a long time; unfortunately it is not always clear to the unwary reader to what version of the language online documentation is referring. This caught me out when I read somewhere about the Ada `Character` type being either only-displayable characters, or seven-bit (I forget which). This may have been true in some old version of Ada, but nowadays the `Character` type includes all 8-bit values. I spent some time working around a restriction that does not apply, then throwing away that work. 85 | 86 | Similarly, a lot of the Gtk examples and documents on-line actually refer to Gtk 2 - not Gtk 3 (or 4!). 87 | 88 | ### Finding Libraries 89 | Allied to the above point, it was not straightforward to find the serial I/O, networking and other similar packages. There does not seem to be a generally agreed-upon central repository for such information in Ada. 90 | 91 | ### Examples 92 | It was a real struggle to find useful publicly available example code for some of the packages used in DasherA. 93 | 94 | It is salutary to compare the number of code examples on `rosettacode.org` for the two languages. At the time of writing there are 1460 Go examples and 865 Ada ones; shocking when one considers how relatively recently Go was introduced. 95 | 96 | A similar story applies to GitHub - according to their API there are 967876 Go repositories and just 4535 Ada ones as of 8th March 2022. 97 | 98 | ### Change of Mindset 99 | I would characterise Go as a simple language, and Ada as rich one. 100 | 101 | However, Go's apparent simplicity hides inevitable complexity when doing anything non-trivial with Goroutines. Contrariwise, Ada's complexity can blind one to the simplicity of such things as `protected` types and task `entry` points. 102 | 103 | Both Go and Ada seem to me to take an agnostic approach to object-oriented programming. In both languages there are occasions when you can ask yourself whether a type is really an object. When moving code over be clear about this, and stick to your decision! (There is a little work outstanding in DasherA removing some unnecessary 'objects'.) 104 | 105 | Also, see the Channels section below. 106 | 107 | ### Debugging tasks 108 | Urgh! I need to investigate this further; `gdb` seems to be quite inadequate in this regard once multiple tasks are involved (cf. the excellent `delve` debugger for Go). 109 | 110 | ## Traps for the Unwary 111 | Always ensure you are reading up-to-date, reliable documentation - if you can find it. 112 | 113 | ### Rewrite, don't Translate 114 | When faced with a lot of code to move it is tempting to try to translate between languages on a token-by-token basis. This is rarely a good idea. Take a step back, consider what each package, type or func does, then reimplement it using Ada idioms. (I got better at this as this project progressed, I should revisit some of the first code that was ported.) 115 | 116 | ### GtkAda and Tasks 117 | It turns out that any time you use ANY Glib, Gdk, or Gtk entity, you MUST either be in a callback, or be inside a `Gdk.Threads.Enter; ... Gdk.Threads.Leave;` block. This includes such innocent-seeming things as `Glib.Error`, `Gdk.Types.Keysyms`, and even `Glib.Guint`. 118 | 119 | Failure to observe the above rule leads to very strange behaviour - usually resulting in a crash. Any error messages produced may not be helpful in pointing you to the underlying cause. 120 | 121 | I think the above also applies to entities referred to during Ada *elaboration*. 122 | 123 | ### Goroutines vs. Tasks 124 | Goroutines are so lightweight and easy to use that it is common to overuse them in Go code. I believe that in GNAT Ada, tasks are implemented as O.S. threads - so they are less lightweight. 125 | 126 | When moving code from Go to Ada always consider whether a task is really needed. Using fewer Goroutines/tasks may well result in simpler code - despite the seductiveness of Go's facilities. 127 | 128 | Having written this, I can now see at least one remaining task in DasherA that should probably be rewritten as a `protected type`. 129 | 130 | It is a constant surprise to me that GNAT Ada appears to lack easy-to-use equivalents to Go's race detector and deadlock reporting. For a language that places so much emphasis on tasking, the lack of these modern tools feels like a large omission. 131 | 132 | ### Channels 133 | I wasted time recreating Go-like channels in Ada. Things became much simpler when I had the realisation that *Go's channels are in fact surprisingly analogous to Ada's task entries*. 134 | 135 | ### Error Handling 136 | I think it is widely acknowledged that error handling is a weak spot in Go. Unfortunately this can lead to habits that are hard to shake off, even when given the benefit of exceptions in Ada. Code is likely to need to be consistently restructured once you have worked out your exception handling strategy. 137 | 138 | ## Pleasures and Disappointments 139 | (These things matter to me as a hobby programmer: it is important to me that programming does not become a trial.) 140 | 141 | ### Pleasures 142 | * Easy compiler and GUI toolkit installation on Mint Linux using standard package management 143 | * Good task control in Ada 144 | * Fast build times (feels nearly as quick as Go) 145 | * Good performance - even prior to any optimisation 146 | * Language support in VS Code 147 | * Excellent (C-based) documentation and tutorials for Gtk 3 148 | * Data structures are a joy in Ada - the better-constrained types just feel 'right' 149 | * Protected types are a lot easier to deal with than mutexes in Go. 150 | 151 | ### Disappointments 152 | * Documentation... 153 | * Needing to have `/usr/lib/gcc/x86_64-linux-gnu/9/adainclude/` and `/usr/share/ada/adainclude/gtkada/` open at all times to refer to the `.ads` files in those directories 154 | * Lack of real-world GtkAda code examples 155 | * Poor Ada task debugging under `gdb` 156 | * Lack of deadlock and race condition detection (they are built-in with Go) 157 | 158 | License: Attribution-ShareAlike 4.0 International (CC BY-SA 4.0) 159 | 160 | ©2022 Steve Merrony 161 | 162 | -------------------------------------------------------------------------------- /Docs/MiniExpectScripts.md: -------------------------------------------------------------------------------- 1 | # DasherA mini-Expect Scripting 2 | 3 | DasherA supports a limited subset of the [Expect](https://en.wikipedia.org/wiki/Expect) scripting language for automating certain types of task on the system to which the terminal emulator is connected. 4 | 5 | Only the following commands are implemented... 6 | * `#` the line is treated as a comment, must be 1st character on line 7 | * `expect "literal-string"` swallow all responses from the host until "literal-string" is recieved 8 | * `send "literal-string"` send the "literal-string" to the host, `\n` is sent as a DG newline 9 | * `exit` signals the end of the script, interaction is returned to the operator (end of script has the same effect) 10 | 11 | N.B. The `spawn` command is not implemented; it is assumed that you are connected to a host before you launch the mini-Expect script. 12 | 13 | Literal strings must be enclosed in double-quotes (`"`) which are not sent to or expected from the host. 14 | 15 | Variables, timeouts, conditions, escape characters (other than `\n`), and all other Expect features not listed above are not supported. 16 | 17 | **BEWARE** - this version of Expect is infinitely patient; if you make a mistake in your script, or the host does not respond as expected DasherG will hang and need to be terminated. When writing scripts the `-tracescript` option to DasherA is your best friend! 18 | 19 | ## Sample Script 20 | The following script automates the formatting of a disk... 21 | ``` 22 | # Mini-Expect script for DasherA that formats DPF0 and runs 1 test pattern on it. 23 | # It is assumed that the host is connected and running TBOOT and we are 24 | # at the tape "file number" prompt. 25 | send "2\n" 26 | expect "NEW LINE)? " 27 | send "F\n" 28 | expect "name? " 29 | send "DPF0\n" 30 | expect "27] ? " 31 | send "\n" 32 | expect "name? " 33 | send "\n" 34 | expect "area? [Y] " 35 | send "\n" 36 | expect "23420] " 37 | send "\n" 38 | expect "[] " 39 | send "DPF0ID\n" 40 | expect "characters)? [] " 41 | send "DPF0NAME\n" 42 | expect "15 characters)? " 43 | send "+\n" 44 | expect "LINE)? " 45 | send "RE\n" 46 | expect "15 characters)? " 47 | send "\n" 48 | expect "analysis? [N] " 49 | send "Y\n" 50 | expect "number? " 51 | send "1\n" 52 | expect "number? " 53 | send "\n" 54 | expect "like to run? " 55 | send "1\n" 56 | # the analysis takes some time... 57 | expect "done): " 58 | send "\n" 59 | expect "410632] " 60 | send "\n" 61 | expect "620] " 62 | send "\n" 63 | expect "410763] " 64 | send "\n" 65 | expect "176] " 66 | send "\n" 67 | expect "174] " 68 | send "\n" 69 | exit 70 | ``` 71 | 72 | -------------------------------------------------------------------------------- /Docs/Test.data: -------------------------------------------------------------------------------- 1 | Test data for DasherA terminal emulator... (at top of screen) 2 |  - The BELL may have rung (see the user guide) 3 |  - Blinking is enabled 4 | This should blinkThis should not blink 5 | This should be dimThis should be normal 6 | This should be in reverse video if you have set D210 modeThis should be normal 7 | This should be underlinedThis should be normal 8 |  9 | 10 | This should start at position (10,10) 11 | -------------------------------------------------------------------------------- /Docs/implementationChart.md: -------------------------------------------------------------------------------- 1 | # DasherA Implementation Chart 2 | 3 | | Command | Octal | Keyboard | D200 | D210 | Notes | 4 | |--------------------------------------|-------------|----------------------------| :--: | :--: | ----------------------------------| 5 | | Bell | 007 | Ctrl-G | Y | Y | Must be allowed by your window manager | 6 | | Blink Disable | 004 | Ctrl-D | Y | Y | Disable blinking on screen | 7 | | Blink Enable | 003 | Ctrl-C | Y | Y | Enable blinking on screen | 8 | | Blink Off | 017 | Ctrl-O | Y | Y | | 9 | | Blink On | 016 | Ctrl-N | Y | Y | | 10 | | Break (CMD-Break) | - | Break Button | Y | Y | Only affects Serial operation | 11 | | Carriage Return | 015 | Ctrl-M or CR | Y | Y | No implied new line | 12 | | Cursor Down | 032 | Ctrl-Z or ↓ | Y | Y | | 13 | | Cursor Left | 031 | Ctrl-Y or ← | Y | Y | | 14 | | Cursor Right | 030 | Ctrl-X or → | Y | Y | | 15 | | Cursor Up | 027 | Ctrl-W or ↑ | Y | Y | | 16 | | Dim Off | 035 | Ctrl-} | Y | Y | | 17 | | Dim On | 034 | Ctrl-\ | Y | Y | | 18 | | Erase EOL | 013 | Ctrl-K or Erase EOL | Y | Y | Erase from Cursor to End of Line | 19 | | Erase (Unprotected) to End of Screen | 036 106 106 | Cmd-Brk FF | - | Y | Introduced in D210 | 20 | | Erase Page/Window | 014 | Ctrl-L or Erase Page | Y | Y | ~Clear Screen on a D200 | 21 | | New Line | 012 | Ctrl-J | Y | Y | ~Enter/Return | 22 | | Print Form | 001 | Ctrl-A or Shift-Local Print | N | N | TODO | 23 | | Print Screen/Window | 021 | Ctrl-Q or Local Print | N | N | TODO | 24 | | Read Model ID | 036 103 | Cmd-Brk C | Y | Y | | 25 | | Read Cursor/Window Address | 005 | Ctrl-E | Y | Y | Times out after 0.5s if host not listening | 26 | | Remote Test Enter | 036 101 | | N | N | *Will not implement in emulator* | 27 | | Remote Test Exit | 036 102 | | N | N | *Will not implement in emulator* | 28 | | Reverse Video Off | 036 105 | Cmd-Brk E | Y | Y | Inverse Chars off | 29 | | Reverse Video Off | 002 | Ctrl-B | - | Y | Introduced in D210 | 30 | | Reverse Video On | 036 104 | Cmd-Brk D | Y | Y | Inverse Chars on | 31 | | Reverse Video On | 026 | Ctrl-V | - | Y | Introduced in D210 | 32 | | Roll Disable | 023 | Ctrl-S | Y | Y | Turn on 'paged mode' | 33 | | Roll Enable | 022 | Ctrl-R | Y | Y | Turn on normal scrolling | 34 | | Underscore Off | 025 | Ctrl-U | Y | Y | | 35 | | Underscore On | 024 | Ctrl-T | Y | Y | | 36 | | Window Home | 010 | Ctrl-H | Y | Y | | 37 | | Write Window Address | 020 n n | Ctrl-P col row | Y | Y | Move cursor to addr | 38 | 39 | Also: Home (010) and Tab (011) which were not considered to be 'commands' in the DG documentation. 40 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright ©2021,2022 Stephen Merrony 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DasherA 2 | DasherA is a free terminal emulator for Data General DASHER series character-based terminals. 3 | 4 | It is written in GNU Ada using the GtkAda toolkit and should run on all common platforms targeted by those tools. Other platforms satisfying the build requirements (see below) may also work - eg. it builds and runs successfully on Raspbian GNU/Linux version 11 32-bit. 5 | 6 | ![Screenshot](./Screenshots/DasherA-20220305.png) 7 | 8 | 9 | ## Key Features 10 | 11 | * DASHER D200 & D210 Emulation 12 | * Serial interface support at 300, 1200, 2400, 9600, 19200 & 38400 baud, 7 or 8 data bits, 13 | no/odd/even parity, 1 or 2 stop bits (defaults to DG-standard: 9600, 8, n, 1) 14 | * BREAK key support for serial interface - permits use as master console 15 | * Network Interface (Telnet) support 16 | * May specify ```-host host:port``` on command line 17 | * Reverse video, blinking, dim and underlined characters 18 | * Pixel-for-pixel copy of D410 character set 19 | * 15 (plus Ctrl & Shift) DASHER Function keys, Erase Page, Erase EOL, Hold, and Break keys 20 | * C1, C2, C3 and C4 DASHER Custom keys (plus shifted versions) 21 | * Loadable function-key templates (BROWSE, SED and SMI provided as examples) 22 | * 2000-line terminal history 23 | * Session logging to file 24 | * Various terminal widths, heights and zoom-levels available 25 | * Support for mini-Expect scripts to automate some tasks [see Wiki](https://github.com/SMerrony/DasherG/wiki/DasherG-Mini-Expect-Scripts) 26 | * Paste from system Clipboard 27 | * XMODEM-CRC file send and receive with short (128) or long (1024) packets 28 | 29 | Here is the full [Implementation Chart](./Docs/implementationChart.md) for DasherA. 30 | 31 | ## Source 32 | DasherA is [hosted on GitHub](https://github.com/SMerrony/dashera). 33 | 34 | A binary version for 64-bit Debian-based systems *may* be available as part of a release. 35 | 36 | I would love to be able to provide a Windows binary, but I don't have the required 37 | facilities. If anyone could help with this, please do get in touch. 38 | 39 | ## Build 40 | 41 | ### Alire 42 | 43 | Dashera has moved to the [Alire](https://alire.ada.dev/) build system (but see below). 44 | 45 | [![Alire](https://img.shields.io/endpoint?url=https://alire.ada.dev/badges/dashera.json)](https://alire.ada.dev/crates/dashera.html) 46 | 47 | Once you have Alire installed you should be able to obtain the latest release of Dashera and build it with just the three commands below... 48 | ``` 49 | alr get dashera 50 | cd dashera 51 | alr build 52 | ``` 53 | N.B. If you have not built a GtkAda crate (the GUI toolkit we use) recently then Alire will automatically download and build that before building Dashera itself. This can take some time when it first happens, subsequent builds should be much faster. 54 | 55 | ### Non-Alire 56 | 57 | If you cannot use Alire, it should still be possible to build Dashera with gprbuild... 58 | ``` 59 | mkdir obj 60 | gprbuild -Pnon_alire -Xmode=release 61 | ``` 62 | Ignore the warning about file name not matching project name. 63 | 64 | Without Alire you will have to manually ensure that dependencies (eg. GtkAda) are installed. 65 | Eg. You may need to install the `libgtkada20-dev` package. 66 | 67 | ## Run 68 | `.bin/dashera` 69 | 70 | ``` 71 | Usage of dashera: 72 | -amber Use an amber font instead of green 73 | -debug Print debugging information on STDOUT 74 | -h or -help Print this help 75 | -host Host to connect with via Telnet 76 | -tracescript Print trace of Mini-Expect script on STDOUT 77 | -tracexmodem Show details of XMODEM file transfers on STDOUT 78 | -version Show the version number of dashera and exit 79 | -white Use a white font instead of green 80 | ``` 81 | You need the DASHER font and icon to be in the same directory as the executable (for now). 82 | 83 | ## Operational Notes 84 | * The DASHER 'CR' (carriage-return, no line-feed) is available from both the GUI 'CR' button and the 85 | numeric keypad enter key (if present). 86 | * The DASHER keyboards had a 'DEL' key but no 'Backspace', Dashera treats both keys as a DASHER Delete (backwards) 87 | * The BELL sound will only work if DasherA is started from a terminal supporting such an event, 88 | or if the windowing system permits Window Beeps. In Mint 20+, the critical setting is 89 | Accessibility => Keyboard => Event Feedback => Sound to use for window alerts. 90 | 91 | -------------------------------------------------------------------------------- /Screenshots/DasherA-20220130.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SMerrony/dashera/3d8309f0aae36124bef9ceee487213a0e5e8bccf/Screenshots/DasherA-20220130.png -------------------------------------------------------------------------------- /Screenshots/DasherA-20220305.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SMerrony/dashera/3d8309f0aae36124bef9ceee487213a0e5e8bccf/Screenshots/DasherA-20220305.png -------------------------------------------------------------------------------- /Scripts/test.script: -------------------------------------------------------------------------------- 1 | # Mini-Expect test script for DasherA 2 | 3 | send "Hello, World!\n" 4 | expect "found" 5 | exit -------------------------------------------------------------------------------- /Templates/BROWSE_template.txt: -------------------------------------------------------------------------------- 1 | BROWSE 2 | Execute 3 | 4 | Switch\Windows 5 | 6 | Command 7 | Index 8 | Col.\H/light 9 | 10 | Prev\Screen 11 | 12 | 13 | 14 | Next\Screen 15 | 16 | 17 | 18 | Intrrpt 19 | 20 | 21 | 22 | Insert 23 | Find 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | Delete 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | Cancel/\Exit 43 | 44 | 45 | Terminate 46 | 47 | 48 | 49 | 50 | Save 51 | 52 | Placemrk 53 | Instnt\Placemrk 54 | 55 | Erase 56 | 57 | 58 | Open In\Windows 59 | 60 | 61 | Display\Mode 62 | -------------------------------------------------------------------------------- /Templates/MEMACS_template.txt: -------------------------------------------------------------------------------- 1 | mEMACS 2 | Ctrl-X 3 | Prev\Para 4 | 5 | 6 | Yank 7 | End\Para 8 | 9 | 10 | Exchge\Pt&Mk 11 | 12 | 13 | 14 | One\Window 15 | 16 | 17 | 18 | Split\Window 19 | 20 | 21 | 22 | Search\Fwd 23 | Open\Line 24 | 25 | 26 | Search\Bkwd 27 | 28 | 29 | 30 | Delete\Buffer 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | Exit 43 | -------------------------------------------------------------------------------- /Templates/SED_template.txt: -------------------------------------------------------------------------------- 1 | SED 2 | Up 1\Screen 3 | Top\Of\Screen 4 | 1st\Line\Of Page 5 | 6 | Down 1\Screen 7 | Bottom\Of\Screen 8 | Last\Line\On Page 9 | 10 | Go To\Prev.\Position 11 | Middle\Of\Screen 12 | Middle\Line\On Page 13 | 14 | Position\Page\Prev. 15 | Position\Page\First 16 | Display 17 | 18 | Position\Page\Next 19 | Position\Page\Last 20 | View 21 | 22 | Modify\Current 23 | Insert\Current 24 | Append 25 | 26 | Find 27 | Backfind 28 | CLI 29 | 30 | Delete\Current 31 | Undo 32 | Bye\Yes\Continue 33 | 34 | Up 4\Lines 35 | Up 11\Lines 36 | 37 | 38 | Down 4\Lines 39 | Down 11\Lines 40 | 41 | 42 | Cut\While\Editing 43 | Paste\While\Editing 44 | -------------------------------------------------------------------------------- /Templates/SMI_template.txt: -------------------------------------------------------------------------------- 1 | SMI 2 | Execute 3 | Help 4 | 5 | 6 | 7 | 8 | 9 | 10 | Prev.\Screen 11 | 12 | 13 | 14 | Next\Screen 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | Insert\Space 27 | 28 | 29 | 30 | Delete\Char 31 | 32 | 33 | 34 | Delete 35 | Delete\Word 36 | 37 | 38 | 39 | 40 | 41 | 42 | Cancel/\Exit 43 | Back\Field 44 | -------------------------------------------------------------------------------- /alire.toml: -------------------------------------------------------------------------------- 1 | name = "dashera" 2 | description = "DASHER Terminal Emulator" 3 | version = "0.15.1" 4 | licenses = "MIT" 5 | website = "https://github.com/SMerrony/dashera" 6 | 7 | authors = ["Stephen Merrony"] 8 | maintainers = ["Stephen Merrony "] 9 | maintainers-logins = ["SMerrony"] 10 | 11 | tags = ["gtk", "terminal", "dasher", "emulator",] 12 | 13 | executables = ["dashera"] 14 | 15 | [[depends-on]] 16 | gtkada = "^23.0.0" 17 | 18 | [build-switches] 19 | development.style_checks = ["-gnaty-m"] 20 | release.style_checks = "No" -------------------------------------------------------------------------------- /changelog: -------------------------------------------------------------------------------- 1 | dashera (0.15.0) stable; urgency=low 2 | 3 | [SMerrony] 4 | * Performance: Significant improvements 5 | * Internal: Remove Router, Keyboard_Sender and Terminal.Processor tasks 6 | * Issue: Fix rare crash due to data race in Telnet/Terminal 7 | 8 | -- SMerrony Wed, 21 Dec 2022 10:00:00 +0200 9 | 10 | dashera (0.14.0) stable; urgency=low 11 | 12 | [SMerrony] 13 | * Usability: Implement key auto-repeat (Issue #8) 14 | * Usability: Make the Backspace key work the same as DEL 15 | * Usability: Increase history to 2000 lines 16 | * Issue: Remove template title labels when collapsing template 17 | 18 | -- SMerrony Sun, 04 Dec 2022 10:00:00 +0200 19 | 20 | dashera (0.13.2) stable; urgency=low 21 | 22 | [SMerrony] 23 | * Build: Remove call to Set_Monospace in Gui so GtkAda v21 still works 24 | * Build: Reintroduce non-Alire build config 25 | * Docs: Update README.md to include non-Alire build 26 | * Usability: Add more info to message when Telnet fails to connect 27 | 28 | -- SMerrony Sun, 20 Nov 2022 10:00:00 +0200 29 | 30 | dashera (0.13.1) stable; urgency=low 31 | 32 | [SMerrony] 33 | * Issue: Fix File|Send (Text) File not sending new-lines 34 | * Issue: Fix #7 (Hold not working) by sending Ctrl-S/Q 35 | * Usability: Move terminal Resize menu item back to Emulation menu 36 | * Usability: Move Load F-Key Template to View menu 37 | * Usability: Add new Hide F-Key Template menu item 38 | * Performance: Small improvements in Crt.Draw_Crt 39 | 40 | -- SMerrony Wed, 16 Nov 2022 10:00:00 +0200 41 | 42 | dashera (0.13.0) stable; urgency=low 43 | 44 | [SMerrony] 45 | * Fix issue with Edit|Paste not actually pasting into data stream 46 | * Fix issue with cursor sometimes leaving trail on screen 47 | * Add View menu 48 | * Add View|History to display terminal history, remove scrollback 49 | * Move Edit|Resize to View|Resize Terminal 50 | * Upgrade Gtkada to v.23 51 | * Embed font and icon resources in code using 'are' 52 | * Add `-amber` and `-white` options to emulate different phosphor colours 53 | 54 | -- SMerrony Fri, 11 Nov 2022 10:00:00 +0200 55 | 56 | dashera (0.12.1) stable; urgency=low 57 | 58 | [SMerrony] 59 | * Package up release 0.12.1 for Debian 60 | 61 | -- SMerrony Fri, 28 Oct 2022 10:00:00 +0200 62 | -------------------------------------------------------------------------------- /dashera.gpr: -------------------------------------------------------------------------------- 1 | with "config/dashera_config.gpr"; 2 | project Dashera is 3 | 4 | for Source_Dirs use ("src/", "config/"); 5 | for Object_Dir use "obj/" & Dashera_Config.Build_Profile; 6 | for Create_Missing_Dirs use "True"; 7 | for Exec_Dir use "bin"; 8 | for Main use ("dashera.adb"); 9 | 10 | package Compiler is 11 | for Default_Switches ("Ada") use Dashera_Config.Ada_Compiler_Switches; 12 | end Compiler; 13 | 14 | package Binder is 15 | for Switches ("Ada") use ("-Es"); -- Symbolic traceback 16 | end Binder; 17 | 18 | package Install is 19 | for Artifacts (".") use ("share"); 20 | end Install; 21 | 22 | end Dashera; 23 | -------------------------------------------------------------------------------- /non_alire.gpr: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with "gtkada"; 21 | 22 | project Dashera is 23 | type Mode_Type is ("debug", "profile", "release"); -- all possible values 24 | Mode : Mode_Type := external ("mode", "debug"); -- default 25 | 26 | for Languages use ("Ada"); 27 | for Main use ("dashera.adb"); 28 | for Source_Dirs use ("src"); 29 | for Object_Dir use "obj"; 30 | for Exec_Dir use "./"; 31 | 32 | package Compiler is 33 | case Mode is 34 | when "debug" => 35 | for Switches ("Ada") use ("-fstack-check", 36 | "-g", 37 | "-gnata", 38 | "-gnateE", 39 | "-gnatwa", 40 | "-O0" ); 41 | -- "-gnatJ", "-gnatel" 42 | when "profile" => 43 | for Switches ("Ada") use ("-g", "-pg"); 44 | when "release" => 45 | for Switches ("Ada") use ("-O3"); 46 | end case; 47 | end Compiler; 48 | 49 | package Builder is 50 | for Global_Configuration_Pragmas use "src/gnat.adc"; 51 | case Mode is 52 | when "debug" => 53 | for Switches ("ada") use ("-j4", "-g"); 54 | when "release" => 55 | for Switches ("ada") use ("-j4"); 56 | end case; 57 | end Builder; 58 | 59 | package Binder is 60 | for Switches ("Ada") use ("-Es"); 61 | end Binder; 62 | 63 | -- package Linker is 64 | -- for Leading_Switches ("Ada") use External_As_List("LDFLAGS", " "); 65 | -- end Linker; 66 | 67 | end Dashera; 68 | -------------------------------------------------------------------------------- /share/dashera/D410-b-12.bdf: -------------------------------------------------------------------------------- 1 | STARTFONT 2.1 2 | FONT -FontForge-Dasher-Medium-R-Normal--12-120-75-75-C-100-ISO8859-1 3 | SIZE 12 75 75 4 | FONTBOUNDINGBOX 8 11 0 0 5 | COMMENT "Generated by fontforge, http://fontforge.sourceforge.net" 6 | STARTPROPERTIES 31 7 | FOUNDRY "FontForge" 8 | FAMILY_NAME "Dasher" 9 | WEIGHT_NAME "Medium" 10 | SLANT "R" 11 | SETWIDTH_NAME "Normal" 12 | ADD_STYLE_NAME "" 13 | PIXEL_SIZE 12 14 | POINT_SIZE 120 15 | RESOLUTION_X 75 16 | RESOLUTION_Y 75 17 | SPACING "C" 18 | AVERAGE_WIDTH 100 19 | CHARSET_REGISTRY "ISO8859" 20 | CHARSET_ENCODING "1" 21 | FONTNAME_REGISTRY "" 22 | CHARSET_COLLECTIONS "ISOLatin1Encoding" 23 | FONT_NAME "D410" 24 | FACE_NAME "D410" 25 | FONT_VERSION "001.000" 26 | FONT_ASCENT 10 27 | FONT_DESCENT 2 28 | UNDERLINE_POSITION -1 29 | UNDERLINE_THICKNESS 1 30 | X_HEIGHT 7 31 | CAP_HEIGHT 10 32 | RAW_ASCENT 800 33 | RAW_DESCENT 200 34 | NORM_SPACE 10 35 | FIGURE_WIDTH 10 36 | AVG_LOWERCASE_WIDTH 100 37 | AVG_UPPERCASE_WIDTH 100 38 | ENDPROPERTIES 39 | CHARS 96 40 | STARTCHAR space 41 | ENCODING 32 42 | SWIDTH 833 0 43 | DWIDTH 10 0 44 | BBX 1 1 0 0 45 | BITMAP 46 | 00 47 | ENDCHAR 48 | STARTCHAR exclam 49 | ENCODING 33 50 | SWIDTH 833 0 51 | DWIDTH 10 0 52 | BBX 1 9 4 2 53 | BITMAP 54 | 80 55 | 80 56 | 80 57 | 80 58 | 80 59 | 80 60 | 00 61 | 00 62 | 80 63 | ENDCHAR 64 | STARTCHAR quotedbl 65 | ENCODING 34 66 | SWIDTH 833 0 67 | DWIDTH 10 0 68 | BBX 4 3 2 8 69 | BITMAP 70 | 90 71 | 90 72 | 90 73 | ENDCHAR 74 | STARTCHAR numbersign 75 | ENCODING 35 76 | SWIDTH 833 0 77 | DWIDTH 10 0 78 | BBX 7 9 1 2 79 | BITMAP 80 | 28 81 | 28 82 | 28 83 | FE 84 | 28 85 | FE 86 | 28 87 | 28 88 | 28 89 | ENDCHAR 90 | STARTCHAR dollar 91 | ENCODING 36 92 | SWIDTH 833 0 93 | DWIDTH 10 0 94 | BBX 7 9 1 2 95 | BITMAP 96 | 10 97 | 7E 98 | 90 99 | 90 100 | 7C 101 | 12 102 | 12 103 | FC 104 | 10 105 | ENDCHAR 106 | STARTCHAR percent 107 | ENCODING 37 108 | SWIDTH 833 0 109 | DWIDTH 10 0 110 | BBX 7 9 1 2 111 | BITMAP 112 | 40 113 | A2 114 | 44 115 | 08 116 | 10 117 | 20 118 | 44 119 | 8A 120 | 04 121 | ENDCHAR 122 | STARTCHAR ampersand 123 | ENCODING 38 124 | SWIDTH 833 0 125 | DWIDTH 10 0 126 | BBX 7 9 1 2 127 | BITMAP 128 | 70 129 | 88 130 | 88 131 | 50 132 | 20 133 | 52 134 | 8C 135 | 8C 136 | 72 137 | ENDCHAR 138 | STARTCHAR quotesingle 139 | ENCODING 39 140 | SWIDTH 833 0 141 | DWIDTH 10 0 142 | BBX 2 3 4 8 143 | BITMAP 144 | C0 145 | 40 146 | 80 147 | ENDCHAR 148 | STARTCHAR parenleft 149 | ENCODING 40 150 | SWIDTH 833 0 151 | DWIDTH 10 0 152 | BBX 3 9 3 2 153 | BITMAP 154 | 20 155 | 40 156 | 80 157 | 80 158 | 80 159 | 80 160 | 80 161 | 40 162 | 20 163 | ENDCHAR 164 | STARTCHAR parenright 165 | ENCODING 41 166 | SWIDTH 833 0 167 | DWIDTH 10 0 168 | BBX 3 9 3 2 169 | BITMAP 170 | 80 171 | 40 172 | 20 173 | 20 174 | 20 175 | 20 176 | 20 177 | 40 178 | 80 179 | ENDCHAR 180 | STARTCHAR asterisk 181 | ENCODING 42 182 | SWIDTH 833 0 183 | DWIDTH 10 0 184 | BBX 7 7 1 3 185 | BITMAP 186 | 10 187 | 92 188 | 54 189 | 38 190 | 54 191 | 92 192 | 10 193 | ENDCHAR 194 | STARTCHAR plus 195 | ENCODING 43 196 | SWIDTH 833 0 197 | DWIDTH 10 0 198 | BBX 7 7 1 3 199 | BITMAP 200 | 10 201 | 10 202 | 10 203 | FE 204 | 10 205 | 10 206 | 10 207 | ENDCHAR 208 | STARTCHAR comma 209 | ENCODING 44 210 | SWIDTH 833 0 211 | DWIDTH 10 0 212 | BBX 2 3 4 0 213 | BITMAP 214 | C0 215 | 40 216 | 80 217 | ENDCHAR 218 | STARTCHAR hyphen 219 | ENCODING 45 220 | SWIDTH 833 0 221 | DWIDTH 10 0 222 | BBX 7 1 1 6 223 | BITMAP 224 | FE 225 | ENDCHAR 226 | STARTCHAR period 227 | ENCODING 46 228 | SWIDTH 833 0 229 | DWIDTH 10 0 230 | BBX 2 1 4 2 231 | BITMAP 232 | C0 233 | ENDCHAR 234 | STARTCHAR slash 235 | ENCODING 47 236 | SWIDTH 833 0 237 | DWIDTH 10 0 238 | BBX 7 7 1 3 239 | BITMAP 240 | 02 241 | 04 242 | 08 243 | 10 244 | 20 245 | 40 246 | 80 247 | ENDCHAR 248 | STARTCHAR zero 249 | ENCODING 48 250 | SWIDTH 833 0 251 | DWIDTH 10 0 252 | BBX 7 9 1 2 253 | BITMAP 254 | 38 255 | 44 256 | 82 257 | 82 258 | 82 259 | 82 260 | 82 261 | 44 262 | 38 263 | ENDCHAR 264 | STARTCHAR one 265 | ENCODING 49 266 | SWIDTH 833 0 267 | DWIDTH 10 0 268 | BBX 5 9 2 2 269 | BITMAP 270 | 20 271 | 60 272 | A0 273 | 20 274 | 20 275 | 20 276 | 20 277 | 20 278 | F8 279 | ENDCHAR 280 | STARTCHAR two 281 | ENCODING 50 282 | SWIDTH 833 0 283 | DWIDTH 10 0 284 | BBX 7 9 1 2 285 | BITMAP 286 | 7C 287 | 82 288 | 02 289 | 04 290 | 18 291 | 60 292 | 80 293 | 80 294 | FE 295 | ENDCHAR 296 | STARTCHAR three 297 | ENCODING 51 298 | SWIDTH 833 0 299 | DWIDTH 10 0 300 | BBX 7 9 1 2 301 | BITMAP 302 | 7C 303 | 82 304 | 02 305 | 02 306 | 3C 307 | 02 308 | 02 309 | 82 310 | 7C 311 | ENDCHAR 312 | STARTCHAR four 313 | ENCODING 52 314 | SWIDTH 833 0 315 | DWIDTH 10 0 316 | BBX 7 9 1 2 317 | BITMAP 318 | 04 319 | 0C 320 | 14 321 | 24 322 | 44 323 | 84 324 | FE 325 | 04 326 | 04 327 | ENDCHAR 328 | STARTCHAR five 329 | ENCODING 53 330 | SWIDTH 833 0 331 | DWIDTH 10 0 332 | BBX 7 9 1 2 333 | BITMAP 334 | FE 335 | 80 336 | 80 337 | F8 338 | 04 339 | 02 340 | 02 341 | 84 342 | 78 343 | ENDCHAR 344 | STARTCHAR six 345 | ENCODING 54 346 | SWIDTH 833 0 347 | DWIDTH 10 0 348 | BBX 7 9 1 2 349 | BITMAP 350 | 3C 351 | 40 352 | 80 353 | 80 354 | FC 355 | 82 356 | 82 357 | 82 358 | 7C 359 | ENDCHAR 360 | STARTCHAR seven 361 | ENCODING 55 362 | SWIDTH 833 0 363 | DWIDTH 10 0 364 | BBX 7 9 1 2 365 | BITMAP 366 | FE 367 | 82 368 | 04 369 | 08 370 | 10 371 | 20 372 | 20 373 | 20 374 | 20 375 | ENDCHAR 376 | STARTCHAR eight 377 | ENCODING 56 378 | SWIDTH 833 0 379 | DWIDTH 10 0 380 | BBX 7 9 1 2 381 | BITMAP 382 | 7C 383 | 82 384 | 82 385 | 82 386 | 7C 387 | 82 388 | 82 389 | 82 390 | 7C 391 | ENDCHAR 392 | STARTCHAR nine 393 | ENCODING 57 394 | SWIDTH 833 0 395 | DWIDTH 10 0 396 | BBX 7 9 0 2 397 | BITMAP 398 | 7C 399 | 82 400 | 82 401 | 82 402 | 7E 403 | 02 404 | 02 405 | 04 406 | 78 407 | ENDCHAR 408 | STARTCHAR colon 409 | ENCODING 58 410 | SWIDTH 833 0 411 | DWIDTH 10 0 412 | BBX 2 5 4 2 413 | BITMAP 414 | C0 415 | 00 416 | 00 417 | 00 418 | C0 419 | ENDCHAR 420 | STARTCHAR semicolon 421 | ENCODING 59 422 | SWIDTH 833 0 423 | DWIDTH 10 0 424 | BBX 2 7 4 0 425 | BITMAP 426 | C0 427 | 00 428 | 00 429 | 00 430 | C0 431 | 40 432 | 80 433 | ENDCHAR 434 | STARTCHAR less 435 | ENCODING 60 436 | SWIDTH 833 0 437 | DWIDTH 10 0 438 | BBX 5 9 1 2 439 | BITMAP 440 | 08 441 | 10 442 | 20 443 | 40 444 | 80 445 | 40 446 | 20 447 | 10 448 | 08 449 | ENDCHAR 450 | STARTCHAR equal 451 | ENCODING 61 452 | SWIDTH 833 0 453 | DWIDTH 10 0 454 | BBX 7 3 1 5 455 | BITMAP 456 | FE 457 | 00 458 | FE 459 | ENDCHAR 460 | STARTCHAR greater 461 | ENCODING 62 462 | SWIDTH 833 0 463 | DWIDTH 10 0 464 | BBX 5 9 3 2 465 | BITMAP 466 | 80 467 | 40 468 | 20 469 | 10 470 | 08 471 | 10 472 | 20 473 | 40 474 | 80 475 | ENDCHAR 476 | STARTCHAR question 477 | ENCODING 63 478 | SWIDTH 833 0 479 | DWIDTH 10 0 480 | BBX 6 9 2 2 481 | BITMAP 482 | 78 483 | 84 484 | 84 485 | 08 486 | 10 487 | 10 488 | 00 489 | 00 490 | 10 491 | ENDCHAR 492 | STARTCHAR at 493 | ENCODING 64 494 | SWIDTH 833 0 495 | DWIDTH 10 0 496 | BBX 7 9 1 2 497 | BITMAP 498 | 3C 499 | 42 500 | 9A 501 | AA 502 | AA 503 | BC 504 | 80 505 | 40 506 | 3C 507 | ENDCHAR 508 | STARTCHAR A 509 | ENCODING 65 510 | SWIDTH 833 0 511 | DWIDTH 10 0 512 | BBX 7 9 1 2 513 | BITMAP 514 | 38 515 | 44 516 | 82 517 | 82 518 | 82 519 | FE 520 | 82 521 | 82 522 | 82 523 | ENDCHAR 524 | STARTCHAR B 525 | ENCODING 66 526 | SWIDTH 833 0 527 | DWIDTH 10 0 528 | BBX 7 9 1 2 529 | BITMAP 530 | FC 531 | 42 532 | 42 533 | 42 534 | 7C 535 | 42 536 | 42 537 | 42 538 | FC 539 | ENDCHAR 540 | STARTCHAR C 541 | ENCODING 67 542 | SWIDTH 833 0 543 | DWIDTH 10 0 544 | BBX 7 9 1 2 545 | BITMAP 546 | 3C 547 | 42 548 | 80 549 | 80 550 | 80 551 | 80 552 | 80 553 | 42 554 | 3C 555 | ENDCHAR 556 | STARTCHAR D 557 | ENCODING 68 558 | SWIDTH 833 0 559 | DWIDTH 10 0 560 | BBX 7 9 1 2 561 | BITMAP 562 | F8 563 | 44 564 | 42 565 | 42 566 | 42 567 | 42 568 | 42 569 | 44 570 | F8 571 | ENDCHAR 572 | STARTCHAR E 573 | ENCODING 69 574 | SWIDTH 833 0 575 | DWIDTH 10 0 576 | BBX 7 9 1 2 577 | BITMAP 578 | FE 579 | 80 580 | 80 581 | 80 582 | F8 583 | 80 584 | 80 585 | 80 586 | FE 587 | ENDCHAR 588 | STARTCHAR F 589 | ENCODING 70 590 | SWIDTH 833 0 591 | DWIDTH 10 0 592 | BBX 7 9 1 2 593 | BITMAP 594 | FE 595 | 80 596 | 80 597 | 80 598 | F8 599 | 80 600 | 80 601 | 80 602 | 80 603 | ENDCHAR 604 | STARTCHAR G 605 | ENCODING 71 606 | SWIDTH 833 0 607 | DWIDTH 10 0 608 | BBX 7 9 1 2 609 | BITMAP 610 | 3C 611 | 42 612 | 80 613 | 80 614 | 80 615 | 8E 616 | 82 617 | 42 618 | 3C 619 | ENDCHAR 620 | STARTCHAR H 621 | ENCODING 72 622 | SWIDTH 833 0 623 | DWIDTH 10 0 624 | BBX 7 9 1 2 625 | BITMAP 626 | 82 627 | 82 628 | 82 629 | 82 630 | FE 631 | 82 632 | 82 633 | 82 634 | 82 635 | ENDCHAR 636 | STARTCHAR I 637 | ENCODING 73 638 | SWIDTH 833 0 639 | DWIDTH 10 0 640 | BBX 5 9 2 2 641 | BITMAP 642 | F8 643 | 20 644 | 20 645 | 20 646 | 20 647 | 20 648 | 20 649 | 20 650 | F8 651 | ENDCHAR 652 | STARTCHAR J 653 | ENCODING 74 654 | SWIDTH 833 0 655 | DWIDTH 10 0 656 | BBX 7 9 1 2 657 | BITMAP 658 | 0E 659 | 04 660 | 04 661 | 04 662 | 04 663 | 04 664 | 84 665 | 84 666 | 78 667 | ENDCHAR 668 | STARTCHAR K 669 | ENCODING 75 670 | SWIDTH 833 0 671 | DWIDTH 10 0 672 | BBX 7 9 1 2 673 | BITMAP 674 | 82 675 | 84 676 | 88 677 | 90 678 | A0 679 | D0 680 | 88 681 | 84 682 | 82 683 | ENDCHAR 684 | STARTCHAR L 685 | ENCODING 76 686 | SWIDTH 833 0 687 | DWIDTH 10 0 688 | BBX 7 9 1 2 689 | BITMAP 690 | 80 691 | 80 692 | 80 693 | 80 694 | 80 695 | 80 696 | 80 697 | 80 698 | FE 699 | ENDCHAR 700 | STARTCHAR M 701 | ENCODING 77 702 | SWIDTH 833 0 703 | DWIDTH 10 0 704 | BBX 7 9 1 2 705 | BITMAP 706 | 82 707 | C6 708 | AA 709 | 92 710 | 92 711 | 82 712 | 82 713 | 82 714 | 82 715 | ENDCHAR 716 | STARTCHAR N 717 | ENCODING 78 718 | SWIDTH 833 0 719 | DWIDTH 10 0 720 | BBX 7 9 1 2 721 | BITMAP 722 | 82 723 | 82 724 | C2 725 | A2 726 | 92 727 | 8A 728 | 86 729 | 82 730 | 82 731 | ENDCHAR 732 | STARTCHAR O 733 | ENCODING 79 734 | SWIDTH 833 0 735 | DWIDTH 10 0 736 | BBX 7 9 1 2 737 | BITMAP 738 | 7C 739 | 82 740 | 82 741 | 82 742 | 82 743 | 82 744 | 82 745 | 82 746 | 7C 747 | ENDCHAR 748 | STARTCHAR P 749 | ENCODING 80 750 | SWIDTH 833 0 751 | DWIDTH 10 0 752 | BBX 7 9 1 2 753 | BITMAP 754 | FC 755 | 82 756 | 82 757 | 82 758 | FC 759 | 80 760 | 80 761 | 80 762 | 80 763 | ENDCHAR 764 | STARTCHAR Q 765 | ENCODING 81 766 | SWIDTH 833 0 767 | DWIDTH 10 0 768 | BBX 7 9 1 2 769 | BITMAP 770 | 38 771 | 44 772 | 82 773 | 82 774 | 82 775 | 92 776 | 8A 777 | 44 778 | 3A 779 | ENDCHAR 780 | STARTCHAR R 781 | ENCODING 82 782 | SWIDTH 833 0 783 | DWIDTH 10 0 784 | BBX 7 9 1 2 785 | BITMAP 786 | FC 787 | 82 788 | 82 789 | 82 790 | FC 791 | 90 792 | 88 793 | 84 794 | 82 795 | ENDCHAR 796 | STARTCHAR S 797 | ENCODING 83 798 | SWIDTH 833 0 799 | DWIDTH 10 0 800 | BBX 7 9 1 2 801 | BITMAP 802 | 7C 803 | 82 804 | 80 805 | 80 806 | 7C 807 | 02 808 | 02 809 | 82 810 | 7C 811 | ENDCHAR 812 | STARTCHAR T 813 | ENCODING 84 814 | SWIDTH 833 0 815 | DWIDTH 10 0 816 | BBX 7 9 1 2 817 | BITMAP 818 | FE 819 | 10 820 | 10 821 | 10 822 | 10 823 | 10 824 | 10 825 | 10 826 | 10 827 | ENDCHAR 828 | STARTCHAR U 829 | ENCODING 85 830 | SWIDTH 833 0 831 | DWIDTH 10 0 832 | BBX 7 9 1 2 833 | BITMAP 834 | 82 835 | 82 836 | 82 837 | 82 838 | 82 839 | 82 840 | 82 841 | 82 842 | 7C 843 | ENDCHAR 844 | STARTCHAR V 845 | ENCODING 86 846 | SWIDTH 833 0 847 | DWIDTH 10 0 848 | BBX 7 9 1 2 849 | BITMAP 850 | 82 851 | 82 852 | 82 853 | 44 854 | 44 855 | 28 856 | 28 857 | 10 858 | 10 859 | ENDCHAR 860 | STARTCHAR W 861 | ENCODING 87 862 | SWIDTH 833 0 863 | DWIDTH 10 0 864 | BBX 7 9 1 2 865 | BITMAP 866 | 82 867 | 82 868 | 82 869 | 82 870 | 92 871 | 92 872 | AA 873 | C6 874 | 82 875 | ENDCHAR 876 | STARTCHAR X 877 | ENCODING 88 878 | SWIDTH 833 0 879 | DWIDTH 10 0 880 | BBX 7 9 1 2 881 | BITMAP 882 | 82 883 | 82 884 | 44 885 | 28 886 | 10 887 | 28 888 | 44 889 | 82 890 | 82 891 | ENDCHAR 892 | STARTCHAR Y 893 | ENCODING 89 894 | SWIDTH 833 0 895 | DWIDTH 10 0 896 | BBX 7 9 1 2 897 | BITMAP 898 | 82 899 | 82 900 | 44 901 | 28 902 | 10 903 | 10 904 | 10 905 | 10 906 | 10 907 | ENDCHAR 908 | STARTCHAR Z 909 | ENCODING 90 910 | SWIDTH 833 0 911 | DWIDTH 10 0 912 | BBX 7 9 1 2 913 | BITMAP 914 | FE 915 | 02 916 | 04 917 | 08 918 | 10 919 | 20 920 | 40 921 | 80 922 | FE 923 | ENDCHAR 924 | STARTCHAR bracketleft 925 | ENCODING 91 926 | SWIDTH 833 0 927 | DWIDTH 10 0 928 | BBX 4 9 2 2 929 | BITMAP 930 | F0 931 | 80 932 | 80 933 | 80 934 | 80 935 | 80 936 | 80 937 | 80 938 | F0 939 | ENDCHAR 940 | STARTCHAR backslash 941 | ENCODING 92 942 | SWIDTH 833 0 943 | DWIDTH 10 0 944 | BBX 7 7 1 3 945 | BITMAP 946 | 80 947 | 40 948 | 20 949 | 10 950 | 08 951 | 04 952 | 02 953 | ENDCHAR 954 | STARTCHAR bracketright 955 | ENCODING 93 956 | SWIDTH 833 0 957 | DWIDTH 10 0 958 | BBX 4 9 3 2 959 | BITMAP 960 | F0 961 | 10 962 | 10 963 | 10 964 | 10 965 | 10 966 | 10 967 | 10 968 | F0 969 | ENDCHAR 970 | STARTCHAR asciicircum 971 | ENCODING 94 972 | SWIDTH 833 0 973 | DWIDTH 10 0 974 | BBX 5 3 2 7 975 | BITMAP 976 | 20 977 | 50 978 | 88 979 | ENDCHAR 980 | STARTCHAR underscore 981 | ENCODING 95 982 | SWIDTH 833 0 983 | DWIDTH 10 0 984 | BBX 7 1 1 2 985 | BITMAP 986 | FE 987 | ENDCHAR 988 | STARTCHAR grave 989 | ENCODING 96 990 | SWIDTH 833 0 991 | DWIDTH 10 0 992 | BBX 2 3 3 8 993 | BITMAP 994 | C0 995 | 80 996 | 40 997 | ENDCHAR 998 | STARTCHAR a 999 | ENCODING 97 1000 | SWIDTH 833 0 1001 | DWIDTH 10 0 1002 | BBX 7 6 1 2 1003 | BITMAP 1004 | 78 1005 | 04 1006 | 7C 1007 | 84 1008 | 84 1009 | 7A 1010 | ENDCHAR 1011 | STARTCHAR b 1012 | ENCODING 98 1013 | SWIDTH 833 0 1014 | DWIDTH 10 0 1015 | BBX 6 9 1 2 1016 | BITMAP 1017 | 80 1018 | 80 1019 | 80 1020 | B8 1021 | C4 1022 | 84 1023 | 84 1024 | C4 1025 | B8 1026 | ENDCHAR 1027 | STARTCHAR c 1028 | ENCODING 99 1029 | SWIDTH 833 0 1030 | DWIDTH 10 0 1031 | BBX 6 6 1 2 1032 | BITMAP 1033 | 78 1034 | 84 1035 | 80 1036 | 80 1037 | 84 1038 | 78 1039 | ENDCHAR 1040 | STARTCHAR d 1041 | ENCODING 100 1042 | SWIDTH 833 0 1043 | DWIDTH 10 0 1044 | BBX 6 9 1 2 1045 | BITMAP 1046 | 04 1047 | 04 1048 | 04 1049 | 74 1050 | 8C 1051 | 84 1052 | 84 1053 | 8C 1054 | 74 1055 | ENDCHAR 1056 | STARTCHAR e 1057 | ENCODING 101 1058 | SWIDTH 833 0 1059 | DWIDTH 10 0 1060 | BBX 6 6 1 2 1061 | BITMAP 1062 | 78 1063 | 84 1064 | FC 1065 | 80 1066 | 80 1067 | 78 1068 | ENDCHAR 1069 | STARTCHAR f 1070 | ENCODING 102 1071 | SWIDTH 833 0 1072 | DWIDTH 10 0 1073 | BBX 7 9 1 2 1074 | BITMAP 1075 | 1C 1076 | 22 1077 | 20 1078 | 20 1079 | F8 1080 | 20 1081 | 20 1082 | 20 1083 | 20 1084 | ENDCHAR 1085 | STARTCHAR g 1086 | ENCODING 103 1087 | SWIDTH 833 0 1088 | DWIDTH 10 0 1089 | BBX 6 8 1 0 1090 | BITMAP 1091 | 74 1092 | 8C 1093 | 84 1094 | 8C 1095 | 74 1096 | 04 1097 | 84 1098 | 78 1099 | ENDCHAR 1100 | STARTCHAR h 1101 | ENCODING 104 1102 | SWIDTH 833 0 1103 | DWIDTH 10 0 1104 | BBX 6 9 1 2 1105 | BITMAP 1106 | 80 1107 | 80 1108 | 80 1109 | B8 1110 | C4 1111 | 84 1112 | 84 1113 | 84 1114 | 84 1115 | ENDCHAR 1116 | STARTCHAR i 1117 | ENCODING 105 1118 | SWIDTH 833 0 1119 | DWIDTH 10 0 1120 | BBX 3 8 3 2 1121 | BITMAP 1122 | C0 1123 | 00 1124 | C0 1125 | 40 1126 | 40 1127 | 40 1128 | 40 1129 | E0 1130 | ENDCHAR 1131 | STARTCHAR j 1132 | ENCODING 106 1133 | SWIDTH 833 0 1134 | DWIDTH 10 0 1135 | BBX 5 10 1 0 1136 | BITMAP 1137 | 18 1138 | 00 1139 | 18 1140 | 08 1141 | 08 1142 | 08 1143 | 08 1144 | 08 1145 | 88 1146 | 70 1147 | ENDCHAR 1148 | STARTCHAR k 1149 | ENCODING 107 1150 | SWIDTH 833 0 1151 | DWIDTH 10 0 1152 | BBX 6 9 1 2 1153 | BITMAP 1154 | 80 1155 | 80 1156 | 80 1157 | 88 1158 | 90 1159 | A0 1160 | D0 1161 | 88 1162 | 84 1163 | ENDCHAR 1164 | STARTCHAR l 1165 | ENCODING 108 1166 | SWIDTH 833 0 1167 | DWIDTH 10 0 1168 | BBX 3 9 3 2 1169 | BITMAP 1170 | C0 1171 | 40 1172 | 40 1173 | 40 1174 | 40 1175 | 40 1176 | 40 1177 | 40 1178 | E0 1179 | ENDCHAR 1180 | STARTCHAR m 1181 | ENCODING 109 1182 | SWIDTH 833 0 1183 | DWIDTH 10 0 1184 | BBX 7 6 1 2 1185 | BITMAP 1186 | EC 1187 | 92 1188 | 92 1189 | 92 1190 | 92 1191 | 92 1192 | ENDCHAR 1193 | STARTCHAR n 1194 | ENCODING 110 1195 | SWIDTH 833 0 1196 | DWIDTH 10 0 1197 | BBX 6 6 1 2 1198 | BITMAP 1199 | B8 1200 | C4 1201 | 84 1202 | 84 1203 | 84 1204 | 84 1205 | ENDCHAR 1206 | STARTCHAR o 1207 | ENCODING 111 1208 | SWIDTH 833 0 1209 | DWIDTH 10 0 1210 | BBX 6 6 1 2 1211 | BITMAP 1212 | 78 1213 | 84 1214 | 84 1215 | 84 1216 | 84 1217 | 78 1218 | ENDCHAR 1219 | STARTCHAR p 1220 | ENCODING 112 1221 | SWIDTH 833 0 1222 | DWIDTH 10 0 1223 | BBX 6 8 1 0 1224 | BITMAP 1225 | B8 1226 | C4 1227 | 84 1228 | C4 1229 | B8 1230 | 80 1231 | 80 1232 | 80 1233 | ENDCHAR 1234 | STARTCHAR q 1235 | ENCODING 113 1236 | SWIDTH 833 0 1237 | DWIDTH 10 0 1238 | BBX 6 8 1 0 1239 | BITMAP 1240 | 74 1241 | 8C 1242 | 84 1243 | 8C 1244 | 74 1245 | 04 1246 | 04 1247 | 04 1248 | ENDCHAR 1249 | STARTCHAR r 1250 | ENCODING 114 1251 | SWIDTH 833 0 1252 | DWIDTH 10 0 1253 | BBX 6 6 1 2 1254 | BITMAP 1255 | B8 1256 | C4 1257 | 80 1258 | 80 1259 | 80 1260 | 80 1261 | ENDCHAR 1262 | STARTCHAR s 1263 | ENCODING 115 1264 | SWIDTH 833 0 1265 | DWIDTH 10 0 1266 | BBX 6 6 1 2 1267 | BITMAP 1268 | 78 1269 | 84 1270 | 60 1271 | 18 1272 | 84 1273 | 78 1274 | ENDCHAR 1275 | STARTCHAR t 1276 | ENCODING 116 1277 | SWIDTH 833 0 1278 | DWIDTH 10 0 1279 | BBX 5 8 1 2 1280 | BITMAP 1281 | 20 1282 | 20 1283 | F8 1284 | 20 1285 | 20 1286 | 20 1287 | 20 1288 | 18 1289 | ENDCHAR 1290 | STARTCHAR u 1291 | ENCODING 117 1292 | SWIDTH 833 0 1293 | DWIDTH 10 0 1294 | BBX 6 6 1 2 1295 | BITMAP 1296 | 84 1297 | 84 1298 | 84 1299 | 84 1300 | 8C 1301 | 74 1302 | ENDCHAR 1303 | STARTCHAR v 1304 | ENCODING 118 1305 | SWIDTH 833 0 1306 | DWIDTH 10 0 1307 | BBX 7 6 1 2 1308 | BITMAP 1309 | 82 1310 | 82 1311 | 82 1312 | 44 1313 | 28 1314 | 10 1315 | ENDCHAR 1316 | STARTCHAR w 1317 | ENCODING 119 1318 | SWIDTH 833 0 1319 | DWIDTH 10 0 1320 | BBX 7 6 1 2 1321 | BITMAP 1322 | 82 1323 | 82 1324 | 92 1325 | 92 1326 | 92 1327 | 6C 1328 | ENDCHAR 1329 | STARTCHAR x 1330 | ENCODING 120 1331 | SWIDTH 833 0 1332 | DWIDTH 10 0 1333 | BBX 6 6 1 2 1334 | BITMAP 1335 | 84 1336 | 48 1337 | 30 1338 | 30 1339 | 48 1340 | 84 1341 | ENDCHAR 1342 | STARTCHAR y 1343 | ENCODING 121 1344 | SWIDTH 833 0 1345 | DWIDTH 10 0 1346 | BBX 6 8 1 0 1347 | BITMAP 1348 | 84 1349 | 84 1350 | 84 1351 | 8C 1352 | 74 1353 | 04 1354 | 84 1355 | 78 1356 | ENDCHAR 1357 | STARTCHAR z 1358 | ENCODING 122 1359 | SWIDTH 833 0 1360 | DWIDTH 10 0 1361 | BBX 6 6 1 2 1362 | BITMAP 1363 | FC 1364 | 08 1365 | 10 1366 | 20 1367 | 40 1368 | FC 1369 | ENDCHAR 1370 | STARTCHAR braceleft 1371 | ENCODING 123 1372 | SWIDTH 833 0 1373 | DWIDTH 10 0 1374 | BBX 4 9 2 2 1375 | BITMAP 1376 | 30 1377 | 40 1378 | 40 1379 | 40 1380 | 80 1381 | 40 1382 | 40 1383 | 40 1384 | 30 1385 | ENDCHAR 1386 | STARTCHAR bar 1387 | ENCODING 124 1388 | SWIDTH 833 0 1389 | DWIDTH 10 0 1390 | BBX 1 9 4 2 1391 | BITMAP 1392 | 80 1393 | 80 1394 | 80 1395 | 80 1396 | 80 1397 | 80 1398 | 80 1399 | 80 1400 | 80 1401 | ENDCHAR 1402 | STARTCHAR braceright 1403 | ENCODING 125 1404 | SWIDTH 833 0 1405 | DWIDTH 10 0 1406 | BBX 4 9 3 2 1407 | BITMAP 1408 | C0 1409 | 20 1410 | 20 1411 | 20 1412 | 10 1413 | 20 1414 | 20 1415 | 20 1416 | C0 1417 | ENDCHAR 1418 | STARTCHAR asciitilde 1419 | ENCODING 126 1420 | SWIDTH 833 0 1421 | DWIDTH 10 0 1422 | BBX 7 3 1 8 1423 | BITMAP 1424 | 60 1425 | 92 1426 | 0C 1427 | ENDCHAR 1428 | STARTCHAR uni007F 1429 | ENCODING 127 1430 | SWIDTH 833 0 1431 | DWIDTH 10 0 1432 | BBX 7 9 1 2 1433 | BITMAP 1434 | AA 1435 | 54 1436 | AA 1437 | 54 1438 | AA 1439 | 54 1440 | AA 1441 | 54 1442 | AA 1443 | ENDCHAR 1444 | ENDFONT 1445 | -------------------------------------------------------------------------------- /share/dashera/DGlogoOrange.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/SMerrony/dashera/3d8309f0aae36124bef9ceee487213a0e5e8bccf/share/dashera/DGlogoOrange.ico -------------------------------------------------------------------------------- /src/bdf_font.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Streams; use Ada.Streams; 21 | with Interfaces; use Interfaces; 22 | 23 | with Embedded; 24 | with Logging; use Logging; 25 | 26 | package body BDF_Font is 27 | 28 | procedure Parse_BBX 29 | (Font_Line : String; 30 | Font_Line_Length : Positive; 31 | Pix_Width, Pix_Height : out Integer; 32 | X_Offset, Y_Offset : out Integer) 33 | is 34 | Start_Pos, End_Pos : Positive; 35 | begin 36 | Start_Pos := 5; -- "BBX n..." 37 | End_Pos := Start_Pos; 38 | while Font_Line (End_Pos) /= ' ' loop 39 | End_Pos := End_Pos + 1; 40 | end loop; 41 | Pix_Width := Integer'Value (Font_Line (Start_Pos .. End_Pos - 1)); 42 | 43 | Start_Pos := End_Pos + 1; 44 | End_Pos := Start_Pos; 45 | while Font_Line (End_Pos) /= ' ' loop 46 | End_Pos := End_Pos + 1; 47 | end loop; 48 | Pix_Height := Integer'Value (Font_Line (Start_Pos .. End_Pos - 1)); 49 | 50 | Start_Pos := End_Pos + 1; 51 | End_Pos := Start_Pos; 52 | while Font_Line (End_Pos) /= ' ' loop 53 | End_Pos := End_Pos + 1; 54 | end loop; 55 | X_Offset := Integer'Value (Font_Line (Start_Pos .. End_Pos - 1)); 56 | Start_Pos := End_Pos + 1; 57 | End_Pos := Font_Line_Length; 58 | Y_Offset := Integer'Value (Font_Line (Start_Pos .. End_Pos)); 59 | 60 | end Parse_BBX; 61 | 62 | -- protected body Font is 63 | 64 | procedure Load_Font (File_Name : String; 65 | Zoom : Zoom_T; 66 | Font_Colour : Font_Colour_T) is 67 | -- Font : aliased Decoded_Acc_T := new Decoded_T; 68 | Char_Count : Positive; 69 | Font_Emb : constant Embedded.Content_Type := Embedded.Get_Content (File_Name); 70 | Font_Blob : Stream_Element_Array (1 .. 16000); 71 | Font_Blob_Ix : Ada.Streams.Stream_Element_Offset := 1; 72 | Font_Line : String (1 .. 132); 73 | Font_Line_Length : Natural; 74 | Tmp_Pix_Buf, Tmp_Dim_Pix_Buf, Tmp_Reverse_Pix_Buf, 75 | Normal_Pix_Buf, Dim_Pix_Buf, Black_Pix_Buf : Gdk_Pixbuf; 76 | ASCII_Code : Natural; 77 | Pix_Width, Pix_Height : Integer; 78 | X_Offset, Y_Offset : Integer; 79 | X, Y : Gint; 80 | Line_Byte : Unsigned_8; 81 | 82 | procedure Get_Font_Line (Line : in out String; Last : out Natural) is 83 | Char : Character; 84 | begin 85 | Last := 1; 86 | loop 87 | Char := Character'Val (Font_Blob (Font_Blob_Ix)); 88 | Font_Blob_Ix := Font_Blob_Ix + 1; 89 | exit when Char = Character'Val (10); 90 | Line (Last) := Char; 91 | Last := Last + 1; 92 | end loop; 93 | Last := Last - 1; 94 | end Get_Font_Line; 95 | 96 | begin 97 | for Val of Font_Emb.Content.all loop 98 | Font_Blob (Font_Blob_Ix) := Val; 99 | Font_Blob_Ix := Font_Blob_Ix + 1; 100 | end loop; 101 | Font_Blob_Ix := 1; 102 | 103 | case Zoom is 104 | when Large => 105 | Decoded.Char_Width := 10; 106 | Decoded.Char_Height := 24; 107 | when Normal => 108 | Decoded.Char_Width := 10; 109 | Decoded.Char_Height := 18; 110 | when Smaller => 111 | Decoded.Char_Width := 8; 112 | Decoded.Char_Height := 12; 113 | when Tiny => 114 | Decoded.Char_Width := 7; 115 | Decoded.Char_Height := 10; 116 | end case; 117 | 118 | for C of Decoded.Font loop 119 | C.Loaded := False; 120 | end loop; 121 | 122 | loop 123 | -- Get_Font_Line (Font_Line, Font_Line_Length); 124 | Get_Font_Line (Font_Line, Font_Line_Length); 125 | -- Log (DEBUG, "" & Font_Line (1 .. Font_Line_Length)); 126 | exit when Font_Line (1 .. Font_Line_Length) = "ENDPROPERTIES"; 127 | end loop; 128 | Get_Font_Line (Font_Line, Font_Line_Length); 129 | if Font_Line (1 .. 5) /= "CHARS" then 130 | raise BDF_DECODE with "ERROR: BDF_Font - CHARS line not found"; 131 | end if; 132 | Log (INFO, "BDF Font " & Font_Line (1 .. Font_Line_Length)); 133 | 134 | Char_Count := Positive'Value (Font_Line (7 .. Font_Line_Length)); 135 | 136 | Tmp_Pix_Buf := Gdk_New (Has_Alpha => False, Width => Font_Width, Height => Font_Height); 137 | Tmp_Dim_Pix_Buf := Gdk_New (Width => Font_Width, Height => Font_Height); 138 | Tmp_Reverse_Pix_Buf := Gdk_New (Width => Font_Width, Height => Font_Height); 139 | 140 | Normal_Pix_Buf := Gdk_New (Width => 1, Height => 1); 141 | Dim_Pix_Buf := Gdk_New (Width => 1, Height => 1); 142 | Black_Pix_Buf := Gdk_New (Width => 1, Height => 1); 143 | case Font_Colour is 144 | when Green => 145 | Fill (Normal_Pix_Buf, 16#00ff00ff#); 146 | Fill (Dim_Pix_Buf, 16#008800ff#); 147 | when White => 148 | Fill (Normal_Pix_Buf, 16#ffffffff#); 149 | Fill (Dim_Pix_Buf, 16#888888ff#); 150 | when Amber => 151 | Fill (Normal_Pix_Buf, 16#ffbf00ff#); 152 | Fill (Dim_Pix_Buf, 16#885f00ff#); 153 | end case; 154 | Fill (Black_Pix_Buf, 16#000000ff#); 155 | 156 | for CC in 0 .. Char_Count - 1 loop 157 | Log (DEBUG, "Loading char No. " & Integer'Image (CC)); 158 | 159 | loop 160 | Get_Font_Line (Font_Line, Font_Line_Length); 161 | exit when Font_Line (1 .. 9) = "STARTCHAR"; 162 | end loop; 163 | 164 | Get_Font_Line (Font_Line, Font_Line_Length); 165 | if Font_Line (1 .. 8) /= "ENCODING" then 166 | raise BDF_DECODE with "ERROR: BDF_Font - ENCODING line not found"; 167 | end if; 168 | ASCII_Code := Natural'Value (Font_Line (10 .. Font_Line_Length)); 169 | Log (DEBUG, "... ASCII Code: " & ASCII_Code'Image); 170 | 171 | -- skip 2 lines 172 | Get_Font_Line (Font_Line, Font_Line_Length); 173 | Get_Font_Line (Font_Line, Font_Line_Length); 174 | 175 | Get_Font_Line (Font_Line, Font_Line_Length); 176 | Parse_BBX (Font_Line, Font_Line_Length, Pix_Width, Pix_Height, X_Offset, Y_Offset); 177 | 178 | -- skip the BITMAP line 179 | Get_Font_Line (Font_Line, Font_Line_Length); 180 | 181 | -- load the actual bitmap for this char a row at a time from the top down 182 | Fill (Tmp_Pix_Buf, 0); 183 | Fill (Tmp_Dim_Pix_Buf, 0); 184 | case Font_Colour is 185 | when Green => Fill (Tmp_Reverse_Pix_Buf, 16#00ff00ff#); 186 | when White => Fill (Tmp_Reverse_Pix_Buf, 16#ffffffff#); 187 | when Amber => Fill (Tmp_Reverse_Pix_Buf, 16#ffbf00ff#); 188 | end case; 189 | 190 | for Bitmap_Line in 0 .. Pix_Height - 1 loop 191 | Get_Font_Line (Font_Line, Font_Line_Length); 192 | Line_Byte := Unsigned_8'Value ("16#" & Font_Line (1 .. 2) & "#"); 193 | for I in 0 .. Pix_Width - 1 loop 194 | if (Line_Byte and 16#80#) /= 0 then 195 | X := Gint (X_Offset + I); 196 | Y := Gint (Bitmap_Line + 12 - Pix_Height - Y_Offset); 197 | Gdk.Pixbuf.Copy_Area (Src_Pixbuf => Normal_Pix_Buf, Src_X => 0, Src_Y => 0, Width => 1, Height => 1, 198 | Dest_Pixbuf => Tmp_Pix_Buf, Dest_X => X, Dest_Y => Y); 199 | Gdk.Pixbuf.Copy_Area (Src_Pixbuf => Dim_Pix_Buf, Src_X => 0, Src_Y => 0, Width => 1, Height => 1, 200 | Dest_Pixbuf => Tmp_Dim_Pix_Buf, Dest_X => X, Dest_Y => Y); 201 | Gdk.Pixbuf.Copy_Area (Src_Pixbuf => Black_Pix_Buf, Src_X => 0, Src_Y => 0, Width => 1, Height => 1, 202 | Dest_Pixbuf => Tmp_Reverse_Pix_Buf, Dest_X => X, Dest_Y => Y); 203 | -- Decoded.Font(ASCII_Code).Pixels (X_Offset + I, Y_Offset + Bitmap_Line) := True; 204 | end if; 205 | Line_Byte := Shift_Left (Line_Byte, 1); 206 | end loop; 207 | end loop; 208 | 209 | Decoded.Font (ASCII_Code).Pix_Buf := Gdk.Pixbuf.Scale_Simple (Src => Tmp_Pix_Buf, 210 | Dest_Width => Decoded.Char_Width, 211 | Dest_Height => Decoded.Char_Height, 212 | Inter_Type => Interp_Bilinear); 213 | Decoded.Font (ASCII_Code).Dim_Pix_Buf := Gdk.Pixbuf.Scale_Simple (Src => Tmp_Dim_Pix_Buf, 214 | Dest_Width => Decoded.Char_Width, 215 | Dest_Height => Decoded.Char_Height, 216 | Inter_Type => Interp_Bilinear); 217 | Decoded.Font (ASCII_Code).Reverse_Pix_Buf := Gdk.Pixbuf.Scale_Simple (Src => Tmp_Reverse_Pix_Buf, 218 | Dest_Width => Decoded.Char_Width, 219 | Dest_Height => Decoded.Char_Height, 220 | Inter_Type => Interp_Bilinear); 221 | Decoded.Font (ASCII_Code).Loaded := True; 222 | 223 | end loop; 224 | 225 | end Load_Font; 226 | 227 | function Get_Char_Width return Gint is 228 | (Decoded.Char_Width); 229 | 230 | function Get_Char_Height return Gint is 231 | (Decoded.Char_Height); 232 | 233 | function Is_Loaded (Ix : Natural) return Boolean is 234 | (Decoded.Font (Ix).Loaded); 235 | 236 | function Get_Dim_Pixbuf (Ix : Natural) return Gdk_Pixbuf is 237 | (Decoded.Font (Ix).Dim_Pix_Buf); 238 | 239 | function Get_Rev_Pixbuf (Ix : Natural) return Gdk_Pixbuf is 240 | (Decoded.Font (Ix).Reverse_Pix_Buf); 241 | 242 | function Get_Pixbuf (Ix : Natural) return Gdk_Pixbuf is 243 | (Decoded.Font (Ix).Pix_Buf); 244 | 245 | -- end Font; 246 | 247 | end BDF_Font; 248 | -------------------------------------------------------------------------------- /src/bdf_font.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Gdk.Pixbuf; use Gdk.Pixbuf; 21 | with Glib; use Glib; 22 | 23 | package BDF_Font is 24 | 25 | Max_Chars : constant Positive := 128; 26 | BPP : constant Positive := 8; 27 | -- raw font dimensions 28 | Font_Width : constant Gint := 10; 29 | Font_Height : constant Gint := 12; 30 | 31 | type Zoom_T is (Large, Normal, Smaller, Tiny); 32 | 33 | type Matrix is array (0 .. Font_Width - 1, 0 .. Font_Height - 1) of Boolean; 34 | 35 | type BDF_Char is record 36 | Loaded : Boolean; 37 | Pix_Buf, Dim_Pix_Buf, Reverse_Pix_Buf : Gdk_Pixbuf; 38 | Pixels : Matrix; 39 | end record; 40 | 41 | type Font_Array is array (0 .. Max_Chars - 1) of BDF_Char; 42 | 43 | type Decoded_T is record 44 | Font : Font_Array; 45 | Char_Width, Char_Height : Gint; 46 | end record; 47 | 48 | type Font_Colour_T is (Green, White, Amber); 49 | 50 | -- protected Font is 51 | procedure Load_Font (File_Name : String; 52 | Zoom : Zoom_T; 53 | Font_Colour : Font_Colour_T); 54 | 55 | function Get_Char_Width return Gint; 56 | pragma Inline (Get_Char_Width); 57 | function Get_Char_Height return Gint; 58 | pragma Inline (Get_Char_Height); 59 | function Is_Loaded (Ix : Natural) return Boolean; 60 | pragma Inline (Is_Loaded); 61 | function Get_Dim_Pixbuf (Ix : Natural) return Gdk_Pixbuf; 62 | pragma Inline (Get_Dim_Pixbuf); 63 | function Get_Rev_Pixbuf (Ix : Natural) return Gdk_Pixbuf; 64 | pragma Inline (Get_Rev_Pixbuf); 65 | function Get_Pixbuf (Ix : Natural) return Gdk_Pixbuf; 66 | pragma Inline (Get_Pixbuf); 67 | -- private 68 | Decoded : Decoded_T; 69 | -- end Font; 70 | 71 | OPEN_FAILURE, 72 | BDF_DECODE : exception; 73 | 74 | end BDF_Font; 75 | -------------------------------------------------------------------------------- /src/cell.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | package body Cell is 21 | 22 | protected body Cell_T is 23 | 24 | procedure Set (Value : Character; Blnk, Dm, Rv, Under, Prot : Boolean) is 25 | begin 26 | Char_Value := Value; 27 | Blink := Blnk; 28 | Dim := Dm; 29 | Rev := Rv; 30 | Underscore := Under; 31 | Protect := Prot; 32 | Dirty := True; 33 | end Set; 34 | 35 | procedure Get (Value : out Character; Blnk, Dm, Rv, Under, Prot : out Boolean) is 36 | begin 37 | Value := Char_Value; 38 | Blnk := Blink; 39 | Dm := Dim; 40 | Rv := Rev; 41 | Under := Underscore; 42 | Prot := Protect; 43 | end Get; 44 | 45 | function Get_Char return Character is 46 | (Char_Value); 47 | 48 | procedure Clear_To_Space is 49 | begin 50 | Char_Value := ' '; 51 | Blink := False; 52 | Dim := False; 53 | Rev := False; 54 | Underscore := False; 55 | Protect := False; 56 | Dirty := True; 57 | end Clear_To_Space; 58 | 59 | procedure Clear_If_Unprotected is 60 | begin 61 | if not Protect then 62 | Clear_To_Space; 63 | end if; 64 | end Clear_If_Unprotected; 65 | 66 | function Is_Blinking return Boolean is 67 | (Blink); 68 | 69 | function Is_Dirty return Boolean is 70 | (Dirty); 71 | 72 | procedure Clear_Dirty is 73 | begin 74 | Dirty := False; 75 | end Clear_Dirty; 76 | 77 | procedure Set_Dirty is 78 | begin 79 | Dirty := True; 80 | end Set_Dirty; 81 | 82 | end Cell_T; 83 | 84 | procedure Copy (Src : in out Cell_T; Dest : out Cell_T) is 85 | Value : Character; 86 | Blnk, Dm, Rv, Under, Prot : Boolean; 87 | begin 88 | Src.Get (Value, Blnk, Dm, Rv, Under, Prot); 89 | Dest.Set (Value, Blnk, Dm, Rv, Under, Prot); 90 | end Copy; 91 | 92 | end Cell; -------------------------------------------------------------------------------- /src/cell.ads: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | package Cell is 21 | 22 | pragma Preelaborate; 23 | 24 | protected type Cell_T is 25 | 26 | procedure Set (Value : Character; Blnk, Dm, Rv, Under, Prot : Boolean); 27 | 28 | procedure Get (Value : out Character; Blnk, Dm, Rv, Under, Prot : out Boolean); 29 | 30 | function Get_Char return Character; 31 | 32 | procedure Clear_To_Space; 33 | 34 | procedure Clear_If_Unprotected; 35 | 36 | function Is_Blinking return Boolean; 37 | pragma Inline (Is_Blinking); 38 | 39 | function Is_Dirty return Boolean; 40 | pragma Inline (Is_Dirty); 41 | 42 | procedure Clear_Dirty; 43 | pragma Inline (Clear_Dirty); 44 | 45 | procedure Set_Dirty; 46 | pragma Inline (Set_Dirty); 47 | 48 | private 49 | Char_Value : Character; 50 | Blink, Dim, Rev, Underscore, Protect : Boolean; 51 | Dirty : Boolean; 52 | 53 | end Cell_T; 54 | 55 | procedure Copy (Src : in out Cell_T; Dest : out Cell_T); 56 | 57 | end Cell; 58 | -------------------------------------------------------------------------------- /src/crt.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022,2024 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Cairo; use Cairo; 21 | 22 | with Gdk.Cairo; 23 | with Gdk.Threads; 24 | with Gdk.Window; 25 | 26 | with BDF_Font; use BDF_Font; 27 | with Display_P; use Display_P; 28 | with Logging; use Logging; 29 | 30 | package body Crt is 31 | 32 | function Blink_Timeout_CB (DA : Gtk.Drawing_Area.Gtk_Drawing_Area) return Boolean is 33 | Blinking, Any_Blinking : Boolean := False; 34 | begin 35 | Gdk.Threads.Enter; 36 | Tube.Blink_State := not Tube.Blink_State; 37 | for Line in 0 .. Display.Get_Visible_Lines - 1 loop 38 | for Col in 0 .. Display.Get_Visible_Cols - 1 loop 39 | Display.Cell_Set_Dirty_If_Blinking (Line, Col, Blinking); 40 | if Blinking then 41 | Any_Blinking := True; 42 | end if; 43 | end loop; 44 | end loop; 45 | if Any_Blinking then 46 | DA.Queue_Draw; 47 | end if; 48 | Gdk.Threads.Leave; 49 | return True; 50 | end Blink_Timeout_CB; 51 | 52 | procedure Init (Zoom : Zoom_T; Font_Colour : Font_Colour_T) is 53 | begin 54 | Log (DEBUG, "Creating Crt"); 55 | Load_Font (Font_Filename, Zoom, Font_Colour); 56 | Tube.Saved_Font_Colour := Font_Colour; 57 | Gtk.Drawing_Area.Gtk_New (Tube.DA); 58 | Tube.DA.Set_Size_Request (Get_Char_Width * Gint (Display.Get_Visible_Cols), 59 | Get_Char_Height * Gint (Display.Get_Visible_Lines)); 60 | Tube.Zoom := Zoom; 61 | 62 | -- Blink timer 63 | if Blink_TO = 0 then 64 | Blink_TO := Blink_Timeout.Timeout_Add (Blink_Period_MS, Blink_Timeout_CB'Access, Tube.DA); 65 | end if; 66 | 67 | end Init; 68 | 69 | procedure Clear_Surface is 70 | Cr : Cairo.Cairo_Context; 71 | begin 72 | Cr := Cairo.Create (surface); 73 | Cairo.Set_Source_Rgb (Cr, 0.0, 0.0, 0.0); 74 | Cairo.Paint (Cr); 75 | Cairo.Destroy (Cr); 76 | end Clear_Surface; 77 | 78 | function Configure_Event_CB 79 | (Self : access Gtk.Widget.Gtk_Widget_Record'Class; 80 | Event : Gdk.Event.Gdk_Event_Configure) 81 | return Boolean 82 | is 83 | pragma Unreferenced (Event); 84 | begin 85 | Log (DEBUG, "Entering Configure_Event_CB"); 86 | if surface /= Cairo.Null_Surface then 87 | Cairo.Surface_Destroy (surface); 88 | end if; 89 | surface := 90 | Gdk.Window.Create_Similar_Surface 91 | (Self.Get_Window, 92 | Cairo.Cairo_Content_Color, 93 | Self.Get_Allocated_Width, 94 | Self.Get_Allocated_Height); 95 | -- Initialize the surface 96 | Clear_Surface; 97 | 98 | -- We've handled the configure event, no need for further processing. 99 | return True; 100 | end Configure_Event_CB; 101 | 102 | -- Draw_Crt is called from within a Callback - so it's safe to use PixBufs etc. 103 | procedure Draw_Crt is 104 | Cr : Cairo.Cairo_Context; 105 | Char_Ix : Natural; 106 | Char_X, Char_Y, Char_UL : Gdouble; 107 | Value : Character; 108 | Blnk, Dm, Rv, Under, Prot : Boolean; 109 | Blink_Enabled : constant Boolean := Display.Is_Blink_Enabled; 110 | Blink_State : constant Boolean := Tube.Blink_State; 111 | Decoded_Height : constant Gint := Get_Char_Height; 112 | Decoded_Width : constant Gint := Get_Char_Width; 113 | use Glib; 114 | begin 115 | Cr := Cairo.Create (surface); 116 | 117 | for Line in 0 .. Display.Get_Visible_Lines - 1 loop 118 | 119 | Char_Y := Gdouble (Gint (Line) * Decoded_Height); 120 | 121 | for Col in 0 .. Display.Get_Visible_Cols - 1 loop 122 | Char_X := Gdouble (Gint (Col) * Decoded_Width); 123 | 124 | if Display.Cell_Is_Dirty (Line, Col) then 125 | 126 | Display.Get_Cell (Line, Col, Value, Blnk, Dm, Rv, Under, Prot); 127 | 128 | Char_Ix := Character'Pos (Value); 129 | -- if not Is_Loaded (Char_IX) then 130 | -- raise Unloaded_Character with "Line:" & Line'Image & " Col:" & Col'Image & " Index :" & Char_Ix'Image; 131 | -- end if; 132 | 133 | if Blnk and then Blink_Enabled and then Blink_State then 134 | Gdk.Cairo.Set_Source_Pixbuf (Cr => Cr, 135 | Pixbuf => Get_Dim_Pixbuf (32), 136 | Pixbuf_X => Char_X, Pixbuf_Y => Char_Y); 137 | elsif Dm then 138 | Gdk.Cairo.Set_Source_Pixbuf (Cr => Cr, 139 | Pixbuf => Get_Dim_Pixbuf (Char_Ix), 140 | Pixbuf_X => Char_X, Pixbuf_Y => Char_Y); 141 | elsif Rv then 142 | Gdk.Cairo.Set_Source_Pixbuf (Cr => Cr, 143 | Pixbuf => Get_Rev_Pixbuf (Char_Ix), 144 | Pixbuf_X => Char_X, Pixbuf_Y => Char_Y); 145 | else 146 | Gdk.Cairo.Set_Source_Pixbuf (Cr => Cr, 147 | Pixbuf => Get_Pixbuf (Char_Ix), 148 | Pixbuf_X => Char_X, Pixbuf_Y => Char_Y); 149 | end if; 150 | Cairo.Paint (Cr); 151 | 152 | -- Underlined? 153 | if Under then 154 | Char_UL := (Gdouble (Gint (Line + 1) * Decoded_Height)) - 1.0; 155 | case Tube.Saved_Font_Colour is 156 | when Green => Cairo.Set_Source_Rgb (Cr, 0.0, 1.0, 0.0); 157 | when Amber => Cairo.Set_Source_Rgb (Cr, 1.0, 0.749, 0.0); 158 | when White => Cairo.Set_Source_Rgb (Cr, 1.0, 1.0, 1.0); 159 | end case; 160 | Cairo.Rectangle (Cr, Char_X, Char_UL, Gdouble (Decoded_Width), 1.0); 161 | Cairo.Fill (Cr); 162 | end if; 163 | Display.Cell_Clear_Dirty (Line, Col); 164 | end if; 165 | end loop; 166 | end loop; 167 | 168 | -- Draw the cursor if it's on-screen 169 | if Display.Get_Cursor_X < Display.Get_Visible_Cols and then Display.Get_Cursor_Y < Display.Get_Visible_Lines then 170 | Display.Get_Cell (Display.Get_Cursor_Y, Display.Get_Cursor_X, Value, Blnk, Dm, Rv, Under, Prot); 171 | Char_Ix := Character'Pos (Value); 172 | if Char_Ix = 0 then 173 | Char_Ix := 32; 174 | end if; 175 | if Rv then 176 | Gdk.Cairo.Set_Source_Pixbuf (Cr => Cr, 177 | Pixbuf => Get_Pixbuf (Char_Ix), 178 | Pixbuf_X => Gdouble (Gint (Display.Get_Cursor_X) * Decoded_Width), 179 | Pixbuf_Y => Gdouble (Gint (Display.Get_Cursor_Y) * Decoded_Height)); 180 | else 181 | Gdk.Cairo.Set_Source_Pixbuf (Cr => Cr, 182 | Pixbuf => Get_Rev_Pixbuf (Char_Ix), 183 | Pixbuf_X => Gdouble (Gint (Display.Get_Cursor_X) * Decoded_Width), 184 | Pixbuf_Y => Gdouble (Gint (Display.Get_Cursor_Y) * Decoded_Height)); 185 | end if; 186 | Cairo.Paint (Cr); 187 | end if; 188 | 189 | Cairo.Destroy (Cr); 190 | Display.Clear_Dirty; 191 | end Draw_Crt; 192 | 193 | function Draw_CB 194 | (Self : access Gtk.Widget.Gtk_Widget_Record'Class; 195 | Cr : Cairo.Cairo_Context) 196 | return Boolean 197 | is 198 | pragma Unreferenced (Self); 199 | begin 200 | Draw_Crt; 201 | Cairo.Set_Source_Surface (Cr, surface, 0.0, 0.0); 202 | Cairo.Paint (Cr); 203 | return False; 204 | end Draw_CB; 205 | 206 | end Crt; -------------------------------------------------------------------------------- /src/crt.ads: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | -- Crt provides a pixel-realistic DASHER VDU look for the text display. 21 | -- It may be slower than a text-based Viewer on systems with limited resources. 22 | 23 | with Cairo; 24 | with Gdk.Event; 25 | with Glib; use Glib; 26 | with Glib.Main; use Glib.Main; 27 | with Gtk.Drawing_Area; 28 | with Gtk.Widget; 29 | 30 | with BDF_Font; 31 | 32 | package Crt is 33 | 34 | package Blink_Timeout is new Glib.Main.Generic_Sources (Gtk.Drawing_Area.Gtk_Drawing_Area); 35 | package Redraw_Timeout is new Glib.Main.Generic_Sources (Gtk.Drawing_Area.Gtk_Drawing_Area); 36 | 37 | Font_Filename : constant String := "D410-b-12.bdf"; 38 | Blink_Period_MS : constant Guint := 500; 39 | 40 | type Crt_T is record 41 | DA : Gtk.Drawing_Area.Gtk_Drawing_Area; 42 | Zoom : BDF_Font.Zoom_T; 43 | Saved_Font_Colour : BDF_Font.Font_Colour_T; 44 | Blink_State : Boolean := False; 45 | end record; 46 | 47 | Tube : Crt_T; 48 | surface : Cairo.Cairo_Surface; 49 | Blink_TO : Glib.Main.G_Source_Id; 50 | 51 | procedure Init (Zoom : BDF_Font.Zoom_T; Font_Colour : BDF_Font.Font_Colour_T); 52 | 53 | function Configure_Event_CB 54 | (Self : access Gtk.Widget.Gtk_Widget_Record'Class; 55 | Event : Gdk.Event.Gdk_Event_Configure) 56 | return Boolean; 57 | function Draw_CB 58 | (Self : access Gtk.Widget.Gtk_Widget_Record'Class; 59 | Cr : Cairo.Cairo_Context) 60 | return Boolean; 61 | 62 | procedure Draw_Crt; 63 | 64 | Unloaded_Character : exception; 65 | 66 | end Crt; -------------------------------------------------------------------------------- /src/dasher_codes.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | package Dasher_Codes is 21 | 22 | pragma Pure; 23 | 24 | Dasher_Null : constant Character := Character'Val (0); 25 | Dasher_Print_Form : constant Character := Character'Val (1); 26 | Dasher_Rev_Off : constant Character := Character'Val (2); -- from D210 onwards 27 | Dasher_Blink_Enable : constant Character := Character'Val (3); -- for the whole screen 28 | Dasher_Blink_Disable : constant Character := Character'Val (4); -- for the whole screen 29 | Dasher_Read_Window_Addr : constant Character := Character'Val (5); -- requires response... 30 | Dasher_Ack : constant Character := Character'Val (6); -- sent to host to indicatelocal print is complete 31 | Dasher_Bell : constant Character := Character'Val (7); 32 | Dasher_Home : constant Character := Character'Val (8); -- window home 33 | Dasher_Tab : constant Character := Character'Val (9); 34 | Dasher_NL : constant Character := Character'Val (10); 35 | Dasher_Erase_EOL : constant Character := Character'Val (11); 36 | Dasher_Erase_Page : constant Character := Character'Val (12); 37 | Dasher_CR : constant Character := Character'Val (13); 38 | Dasher_Blink_On : constant Character := Character'Val (14); 39 | Dasher_Blink_Off : constant Character := Character'Val (15); 40 | Dasher_Write_Window_Addr : constant Character := Character'Val (16); -- followed by col then row 41 | Dasher_Print_Screen : constant Character := Character'Val (17); 42 | Dasher_Roll_Enable : constant Character := Character'Val (18); 43 | Dasher_Roll_Disable : constant Character := Character'Val (19); 44 | Dasher_Underline : constant Character := Character'Val (20); 45 | Dasher_Normal : constant Character := Character'Val (21); -- cancels Underline 46 | Dasher_Rev_On : constant Character := Character'Val (22); -- from D210 onwards 47 | Dasher_Cursor_Up : constant Character := Character'Val (23); 48 | Dasher_Cursor_Right : constant Character := Character'Val (24); 49 | Dasher_Cursor_Left : constant Character := Character'Val (25); 50 | Dasher_Cursor_Down : constant Character := Character'Val (26); 51 | Dasher_Escape : constant Character := Character'Val (27); 52 | Dasher_Dim_On : constant Character := Character'Val (28); 53 | Dasher_Dim_Off : constant Character := Character'Val (29); 54 | Dasher_Command : constant Character := Character'Val (30); 55 | 56 | Dasher_Space : constant Character := Character'Val (32); 57 | 58 | Dasher_F15 : constant Character := Character'Val (112); 59 | Dasher_F1 : constant Character := Character'Val (113); 60 | Dasher_F2 : constant Character := Character'Val (114); 61 | Dasher_F3 : constant Character := Character'Val (115); 62 | Dasher_F4 : constant Character := Character'Val (116); 63 | Dasher_F5 : constant Character := Character'Val (117); 64 | Dasher_F6 : constant Character := Character'Val (118); 65 | Dasher_F7 : constant Character := Character'Val (119); 66 | Dasher_F8 : constant Character := Character'Val (120); 67 | Dasher_F9 : constant Character := Character'Val (121); 68 | Dasher_F10 : constant Character := Character'Val (122); 69 | Dasher_F11 : constant Character := Character'Val (123); 70 | Dasher_F12 : constant Character := Character'Val (124); 71 | Dasher_F13 : constant Character := Character'Val (125); 72 | Dasher_F14 : constant Character := Character'Val (126); 73 | 74 | Dasher_C1 : constant Character := Character'Val (92); 75 | Dasher_C2 : constant Character := Character'Val (93); 76 | Dasher_C3 : constant Character := Character'Val (94); 77 | Dasher_C4 : constant Character := Character'Val (95); 78 | Dasher_Shift_C1 : constant Character := Character'Val (88); 79 | Dasher_Shift_C2 : constant Character := Character'Val (89); 80 | Dasher_Shift_C3 : constant Character := Character'Val (90); 81 | Dasher_Shift_C4 : constant Character := Character'Val (91); 82 | 83 | Dasher_Delete : constant Character := Character'Val (127); 84 | 85 | end Dasher_Codes; -------------------------------------------------------------------------------- /src/dashera.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Command_Line; use Ada.Command_Line; 21 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 22 | with Ada.Text_IO; 23 | 24 | with GNAT.OS_Lib; 25 | 26 | with Gtk.Main; 27 | with Gtk.Window; use Gtk.Window; 28 | 29 | with BDF_Font; 30 | with GUI; 31 | with Logging; use Logging; 32 | 33 | procedure Dashera is 34 | 35 | -- GUI stuff 36 | Main_Window : Gtk_Window; 37 | 38 | -- program args etc. 39 | Arg_Ix : Natural := 1; 40 | Font_Colour : BDF_Font.Font_Colour_T := BDF_Font.Green; 41 | Host_Arg : Unbounded_String := Null_Unbounded_String; 42 | -- Text_Only : Boolean := False; 43 | Trace_Xmodem : Boolean := False; 44 | 45 | procedure Print_Help is 46 | begin 47 | Ada.Text_IO.Put_Line ("Usage of dashera:"); 48 | Ada.Text_IO.Put_Line (" -amber Use an amber font instead of green"); 49 | Ada.Text_IO.Put_Line (" -debug Print debugging information on STDOUT"); 50 | Ada.Text_IO.Put_Line (" -h or -help Print this help"); 51 | Ada.Text_IO.Put_Line (" -host Host to connect with via Telnet"); 52 | -- Ada.Text_IO.Put_Line (" -textonly Use system text widget rather than graphical display"); 53 | Ada.Text_IO.Put_Line (" -tracescript Print trace of Mini-Expect script on STDOUT"); 54 | Ada.Text_IO.Put_Line (" -tracexmodem Show details of XMODEM file transfers on STDOUT"); 55 | Ada.Text_IO.Put_Line (" -version Show the version number of dashera and exit"); 56 | Ada.Text_IO.Put_Line (" -white Use a white font instead of green"); 57 | end Print_Help; 58 | 59 | begin 60 | 61 | while Arg_Ix <= Argument_Count loop 62 | if Argument (Arg_Ix) = "-version" then 63 | Ada.Text_IO.Put_Line ("dashera version " & GUI.App_SemVer); 64 | return; 65 | elsif Argument (Arg_Ix) = "-host" then 66 | Host_Arg := To_Unbounded_String (Argument (Arg_Ix + 1)); 67 | Arg_Ix := Arg_Ix + 1; 68 | elsif Argument (Arg_Ix) = "-debug" then 69 | Set_Level (DEBUG); 70 | -- elsif Argument (Arg_Ix) = "-textonly" then 71 | -- Text_Only := True; 72 | elsif Argument (Arg_Ix) = "-tracescript" then 73 | Set_Level (TRACE); 74 | elsif Argument (Arg_Ix) = "-tracexmodem" then 75 | Trace_Xmodem := True; 76 | elsif Argument (Arg_Ix) = "-amber" then 77 | Font_Colour := BDF_Font.Amber; 78 | elsif Argument (Arg_Ix) = "-white" then 79 | Font_Colour := BDF_Font.White; 80 | elsif Argument (Arg_Ix) = "-h" or else Argument (Arg_Ix) = "-help" then 81 | Print_Help; 82 | GNAT.OS_Lib.OS_Exit (0); 83 | end if; 84 | Arg_Ix := Arg_Ix + 1; 85 | end loop; 86 | 87 | -- Gdk.Threads.G_Init; 88 | -- Gdk.Threads.Init; 89 | Gtk.Main.Init; 90 | Log (DEBUG, "Preparing to enter Main GTK event loop..."); 91 | -- Gdk.Threads.Enter; 92 | Main_Window := GUI.Create_Window (Host_Arg, Font_Colour, Trace_Xmodem); 93 | Main_Window.Show_All; 94 | Gtk.Main.Main; 95 | -- Gdk.Threads.Leave; 96 | 97 | end Dashera; -------------------------------------------------------------------------------- /src/display_p.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | package body Display_P is 21 | 22 | protected body Display is 23 | 24 | procedure Set_Dirty is begin Dirty := True; end Set_Dirty; 25 | procedure Clear_Dirty is begin Dirty := False; end Clear_Dirty; 26 | function Is_Dirty return Boolean is (Dirty); 27 | function Get_Visible_Cols return Positive is (Disp.Visible_Cols); 28 | function Get_Visible_Lines return Positive is (Disp.Visible_Lines); 29 | procedure Set_Visible_Cols (Cols : Positive) is begin Disp.Visible_Cols := Cols; end Set_Visible_Cols; 30 | procedure Set_Visible_Lines (Lines : Positive) is begin Disp.Visible_Lines := Lines; end Set_Visible_Lines; 31 | function Is_Blink_Enabled return Boolean is (Disp.Blink_Enabled); 32 | procedure Set_Blink_Enabled (Blink : Boolean) is begin Disp.Blink_Enabled := Blink; end Set_Blink_Enabled; 33 | function Get_Cursor_X return Natural is (Disp.Cursor_X); 34 | function Get_Cursor_Y return Natural is (Disp.Cursor_Y); 35 | 36 | procedure Init is 37 | begin 38 | Disp.Visible_Lines := Default_Lines; 39 | Disp.Visible_Cols := Default_Cols; 40 | for Line in 0 .. Total_Lines - 1 loop 41 | for Col in 0 .. Total_Cols - 1 loop 42 | Disp.Cells (Line, Col).Clear_To_Space; 43 | end loop; 44 | end loop; 45 | Disp.Cells (12, 39).Set (Value => 'O', Blnk => False, Dm => False, Rv => False, Under => False, Prot => False); 46 | Disp.Cells (12, 40).Set (Value => 'K', Blnk => False, Dm => False, Rv => False, Under => False, Prot => False); 47 | Disp.Blink_Enabled := True; 48 | History.First := 0; 49 | History.Last := 0; 50 | -- for C in Empty_History_Line'Range loop 51 | -- Empty_History_Line (C).Clear_To_Space; 52 | -- end loop; 53 | for Line in 0 .. History_Lines - 1 loop 54 | for Col in 0 .. Total_Cols - 1 loop 55 | History.Cells (Line, Col).Clear_To_Space; 56 | end loop; 57 | end loop; 58 | end Init; 59 | 60 | procedure Copy (Src : in out Display_T; Dest : out Display_T) is 61 | begin 62 | for Line in 0 .. Src.Visible_Lines - 1 loop 63 | for Col in 0 .. Src.Visible_Cols - 1 loop 64 | Cell.Copy (Src => Src.Cells (Line, Col), Dest => Dest.Cells (Line, Col)); 65 | end loop; 66 | end loop; 67 | Dest.Blink_Enabled := Src.Blink_Enabled; 68 | Dest.Cursor_X := Src.Cursor_X; 69 | Dest.Cursor_Y := Src.Cursor_Y; 70 | Dest.Visible_Cols := Src.Visible_Cols; 71 | Dest.Visible_Lines := Src.Visible_Lines; 72 | end Copy; 73 | 74 | procedure Clear_Cell (Line, Col : Natural) is 75 | begin 76 | Disp.Cells (Line, Col).Clear_To_Space; 77 | end Clear_Cell; 78 | 79 | procedure Clear_Unprotected_Cell (Line, Col : Natural) is 80 | begin 81 | Disp.Cells (Line, Col).Clear_If_Unprotected; 82 | end Clear_Unprotected_Cell; 83 | 84 | function Cell_Is_Dirty (Line, Col : Natural) return Boolean is 85 | (Disp.Cells (Line, Col).Is_Dirty); 86 | 87 | procedure Cell_Clear_Dirty (Line, Col : Natural) is 88 | begin 89 | Disp.Cells (Line, Col).Clear_Dirty; 90 | end Cell_Clear_Dirty; 91 | 92 | procedure Cell_Set_Dirty_If_Blinking (Line, Col : Natural; Blinking : out Boolean) is 93 | begin 94 | Blinking := Disp.Cells (Line, Col).Is_Blinking; 95 | if Blinking then 96 | Disp.Cells (Line, Col).Set_Dirty; 97 | end if; 98 | end Cell_Set_Dirty_If_Blinking; 99 | 100 | procedure Get_Cell (Line, Col : Natural; Value : out Character; Blnk, Dm, Rv, Under, Prot : out Boolean) is 101 | begin 102 | Disp.Cells (Line, Col).Get (Value => Value, Blnk => Blnk, Dm => Dm, Rv => Rv, Under => Under, Prot => Prot); 103 | end Get_Cell; 104 | 105 | procedure Set_Cell (Line, Col : Natural; Char : Character; 106 | Blink, Dim, Rev, Under, Prot : Boolean) is 107 | begin 108 | Disp.Cells (Line, Col).Set (Value => Char, Blnk => Blink, Dm => Dim, 109 | Rv => Rev, Under => Under, Prot => Prot); 110 | end Set_Cell; 111 | 112 | procedure Set_Cursor (X, Y : Natural) is 113 | begin 114 | Disp.Cells (Disp.Cursor_Y, Disp.Cursor_X).Set_Dirty; 115 | Disp.Cursor_X := X; 116 | Disp.Cursor_Y := Y; 117 | end Set_Cursor; 118 | 119 | procedure Clear_Line (Line : Integer) is 120 | begin 121 | for Col in 0 .. Total_Cols - 1 loop 122 | Disp.Cells (Line, Col).Clear_To_Space; 123 | end loop; 124 | end Clear_Line; 125 | 126 | procedure Copy_Line (Src, Dest : Integer) is 127 | begin 128 | for Col in 0 .. Total_Cols - 1 loop 129 | Cell.Copy (Src => Disp.Cells (Src, Col), Dest => Disp.Cells (Dest, Col)); 130 | end loop; 131 | end Copy_Line; 132 | 133 | procedure Copy_Line_To_History (Src : Integer) is 134 | begin 135 | History.Last := History.Last + 1; 136 | if History.Last = History_Lines then 137 | -- wrap-around 138 | History.Last := 0; 139 | end if; 140 | -- has the tail hit the head? 141 | if History.Last = History.First then 142 | History.First := History.First + 1; 143 | if History.First = History_Lines then 144 | History.First := 0; 145 | end if; 146 | end if; 147 | 148 | for C in 0 .. Total_Cols - 1 loop 149 | Cell.Copy (Src => Disp.Cells (Src, C), Dest => History.Cells (History.Last, C)); 150 | end loop; 151 | end Copy_Line_To_History; 152 | 153 | function Get_First_History_Line return Integer is 154 | (History.First); 155 | function Get_Last_History_Line return Integer is 156 | (History.Last); 157 | 158 | function Get_History_Line (Line : Integer) return String is 159 | Result : String (1 .. Disp.Visible_Cols); 160 | -- Char : Character; 161 | -- Blnk, Dm, Rv, Under, Prot : Boolean; 162 | -- Tmp_Cell : Cell.Cell_T; 163 | begin 164 | for C in 0 .. Disp.Visible_Cols - 1 loop 165 | Result (C + 1) := History.Cells (Line, C).Get_Char; 166 | -- History.Cells (L, C).Get (Value => Char, Blnk => Blnk, Dm => Dm, Rv => Rv, Under => Under, Prot => Prot); 167 | end loop; 168 | 169 | return Result; 170 | end Get_History_Line; 171 | 172 | procedure Scroll_Up (Lines : Natural) is 173 | begin 174 | for L in 1 .. Lines loop 175 | Copy_Line_To_History (0); 176 | for R in 1 .. Disp.Visible_Lines loop 177 | Copy_Line (Src => R, Dest => R - 1); 178 | Clear_Line (R); 179 | end loop; 180 | Clear_Line (Disp.Visible_Lines - 1); 181 | end loop; 182 | end Scroll_Up; 183 | 184 | end Display; 185 | 186 | end Display_P; -------------------------------------------------------------------------------- /src/display_p.ads: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Cell; 21 | 22 | package Display_P is 23 | 24 | Default_Lines : constant Natural := 24; 25 | Default_Cols : constant Natural := 80; 26 | 27 | Total_Lines : constant Natural := 96; 28 | Total_Cols : constant Natural := 208; 29 | History_Lines : constant Natural := 1000; 30 | 31 | type Cell_Array is array (0 .. Total_Lines - 1, 0 .. Total_Cols - 1) of Cell.Cell_T; 32 | type History_Array is array (0 .. History_Lines - 1, 0 .. Total_Cols - 1) of Cell.Cell_T; 33 | type History_Line is array (0 .. Total_Cols - 1) of Cell.Cell_T; 34 | 35 | type Display_T is record 36 | Cells : Cell_Array; 37 | Visible_Lines, Visible_Cols : Positive; 38 | Cursor_X, Cursor_Y : Natural; 39 | Blink_Enabled : Boolean; 40 | end record; 41 | 42 | type History_T is record 43 | Cells : History_Array; 44 | First, Last : Natural; 45 | end record; 46 | 47 | protected Display is 48 | procedure Set_Dirty; 49 | procedure Clear_Dirty; 50 | function Is_Dirty return Boolean; 51 | procedure Init; 52 | function Cell_Is_Dirty (Line, Col : Natural) return Boolean; 53 | procedure Cell_Clear_Dirty (Line, Col : Natural); 54 | procedure Cell_Set_Dirty_If_Blinking (Line, Col : Natural; Blinking : out Boolean); 55 | procedure Get_Cell (Line, Col : Natural; Value : out Character; Blnk, Dm, Rv, Under, Prot : out Boolean); 56 | procedure Clear_Cell (Line, Col : Natural); 57 | procedure Clear_Unprotected_Cell (Line, Col : Natural); 58 | procedure Clear_Line (Line : Integer); 59 | procedure Set_Cell (Line, Col : Natural; Char : Character; 60 | Blink, Dim, Rev, Under, Prot : Boolean); 61 | procedure Set_Cursor (X, Y : Natural); 62 | function Get_Cursor_X return Natural; 63 | function Get_Cursor_Y return Natural; 64 | procedure Copy (Src : in out Display_T; Dest : out Display_T); 65 | procedure Copy_Line (Src, Dest : Integer); 66 | procedure Copy_Line_To_History (Src : Integer); 67 | -- Inserts a line into the circular history buffer 68 | function Get_First_History_Line return Integer; 69 | function Get_Last_History_Line return Integer; 70 | function Get_History_Line (Line : Integer) return String; 71 | 72 | procedure Scroll_Up (Lines : Natural); 73 | 74 | function Get_Visible_Cols return Positive; 75 | function Get_Visible_Lines return Positive; 76 | procedure Set_Visible_Cols (Cols : Positive); 77 | procedure Set_Visible_Lines (Lines : Positive); 78 | function Is_Blink_Enabled return Boolean; 79 | procedure Set_Blink_Enabled (Blink : Boolean); 80 | 81 | private 82 | Disp, Saved_Disp : Display_T; 83 | History : History_T; 84 | Dirty : Boolean; 85 | end Display; 86 | 87 | end Display_P; -------------------------------------------------------------------------------- /src/embedded.ads: -------------------------------------------------------------------------------- 1 | -- Advanced Resource Embedder 1.2.0 2 | with Ada.Streams; 3 | with Interfaces.C; 4 | package Embedded is 5 | 6 | type Content_Access is access constant Ada.Streams.Stream_Element_Array; 7 | 8 | type Name_Access is access constant String; 9 | 10 | type Format_Type is (FILE_RAW, FILE_GZIP); 11 | 12 | type Content_Type is record 13 | Name : Name_Access; 14 | Content : Content_Access; 15 | Modtime : Interfaces.C.long := 0; 16 | Format : Format_Type := FILE_RAW; 17 | end record; 18 | 19 | Null_Content : constant Content_Type; 20 | 21 | -- Returns the data stream with the given name or null. 22 | function Get_Content (Name : String) return 23 | Content_Type; 24 | 25 | private 26 | 27 | Null_Content : constant Content_Type := (others => <>); 28 | 29 | end Embedded; 30 | -------------------------------------------------------------------------------- /src/gnat.adc: -------------------------------------------------------------------------------- 1 | -- pragma Profile (Ravenscar); 2 | -- pragma Profile (Jorvik); 3 | -- pragma Restrictions (No_Task_Hierarchy); 4 | -- pragma Partition_Elaboration_Policy (Sequential); 5 | pragma Detect_Blocking; 6 | -- pragma License (GPL); 7 | -- pragma Restrictions (No_Direct_Boolean_Operators); 8 | pragma Restrictions (No_Implicit_Dynamic_Code); 9 | pragma Style_Checks ("r"); -- require consistency of identifier casing 10 | pragma Style_Checks ("B"); -- Check Boolean operators 11 | pragma Style_Checks ("e"); -- Check end/exit labels. 12 | pragma Style_Checks ("I"); -- check mode IN keywords. 13 | pragma Style_Checks ("k"); -- All keywords must be in lower case 14 | pragma Style_Checks ("n"); -- Check casing of entities in Standard. 15 | pragma Style_Checks ("x"); -- Check extra parentheses. 16 | -------------------------------------------------------------------------------- /src/gui.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C) 2021,2022,2024 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 21 | 22 | with Gdk.Pixbuf; 23 | 24 | with Glib.Main; 25 | 26 | with Gtk.Adjustment; 27 | with Gtk.Box; 28 | with Gtk.Grid; 29 | with Gtk.Handlers; 30 | with Gtk.Label; 31 | with Gtk.Menu_Item; use Gtk.Menu_Item; 32 | with Gtk.Revealer; 33 | with Gtk.Widget; 34 | with Gtk.Window; use Gtk.Window; 35 | 36 | with BDF_Font; 37 | with Telnet; 38 | with Terminal; 39 | 40 | package GUI is 41 | package Handlers is new Gtk.Handlers.Callback (Widget_Type => Gtk.Widget.Gtk_Widget_Record); 42 | package SB_Timeout_P is new Glib.Main.Generic_Sources (Gtk.Box.Gtk_Box); 43 | 44 | App_SemVer : constant String := "0.15.1"; -- TODO Update Version each release! 45 | App_Title : constant String := "DasherA"; 46 | App_Comment : constant String := "A Data General DASHER terminal emulator"; 47 | App_Author : constant String := "Stephen Merrony"; 48 | App_Copyright : constant String := "Copyright (C)2022,2024 S.Merrony"; 49 | App_Icon : constant String := "DGlogoOrange.ico"; 50 | App_Website : constant String := "https://github.com/SMerrony/dashera"; 51 | 52 | History_Lines : constant Natural := 2000; 53 | 54 | Main_Window : Gtk_Window; 55 | Main_Grid : Gtk.Grid.Gtk_Grid; 56 | Icon_PB : Gdk.Pixbuf.Gdk_Pixbuf; 57 | Adj : Gtk.Adjustment.Gtk_Adjustment; 58 | 59 | -- Function keys/labels... 60 | L_FKeys_Label, R_FKeys_Label : Gtk.Label.Gtk_Label; 61 | Template_Revealer : Gtk.Revealer.Gtk_Revealer; 62 | Template_Labels : array (1 .. 4, 1 .. 17) of Gtk.Label.Gtk_Label; 63 | 64 | Telnet_Sess : Telnet.Session_Acc_T; 65 | Term : Terminal.Terminal_Acc_T; 66 | Saved_Host, 67 | Saved_Port : Unbounded_String := Null_Unbounded_String; 68 | 69 | Saved_Font_Colour : BDF_Font.Font_Colour_T; 70 | 71 | -- Menu items for which we need access... 72 | Load_Template_Item, Hide_Template_Item, 73 | Net_Connect_Item, Net_Disconnect_Item, 74 | Xmodem_Rx_Item, Xmodem_Send_Item, Xmodem_Send1k_Item, 75 | Serial_Connect_Item, Serial_Disconnect_Item : Gtk_Menu_Item; 76 | 77 | -- Status Bar items... 78 | Online_Label, Host_Label, Logging_Label, 79 | Emul_Label, Hold_Label : Gtk.Label.Gtk_Label; 80 | SB_Timeout : Glib.Main.G_Source_Id := 0; 81 | 82 | -- Flags 83 | Trace_Script_Opt, Text_Only_Opt, Trace_Xmodem_Opt : Boolean := False; 84 | 85 | function Create_Window (Host_Arg : Unbounded_String; 86 | Font_Colour : BDF_Font.Font_Colour_T; 87 | -- Text_Only : Boolean; 88 | Trace_Xmodem : Boolean) return Gtk_Window; 89 | 90 | end GUI; -------------------------------------------------------------------------------- /src/keyboard.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | -- See include/gtkada/gtkada.relocatable/gtkada/gdk-types-keysyms.ads for key symbol definitions 21 | 22 | with Dasher_Codes; use Dasher_Codes; 23 | with Redirector; 24 | 25 | package body Keyboard is 26 | 27 | procedure Handle_Key_Press (Key : Gdk_Key_Type) is 28 | begin 29 | case Key is 30 | when GDK_Control_L | GDK_Control_R => Ctrl_Pressed := True; 31 | when GDK_Shift_L | GDK_Shift_R => Shift_Pressed := True; 32 | when others => null; 33 | end case; 34 | -- is the user holding a key down? 35 | if Last_Pressed = Key then 36 | Process_Key (Key); 37 | end if; 38 | Last_Pressed := Key; 39 | end Handle_Key_Press; 40 | 41 | procedure Enqueue_Key (Ch : Character) is 42 | Str : String (1 .. 1); 43 | begin 44 | Str (1) := Ch; 45 | Redirector.Send_Data (Str); 46 | end Enqueue_Key; 47 | 48 | function Modify (C : Character) return Character is 49 | MC : Character := C; 50 | begin 51 | if C >= Dasher_C1 and then C <= Dasher_C4 then 52 | if Shift_Pressed then 53 | MC := Character'Val (Character'Pos (MC) - 4); 54 | end if; 55 | else 56 | if Shift_Pressed then 57 | MC := Character'Val (Character'Pos (MC) - 16); 58 | end if; 59 | if Ctrl_Pressed then 60 | MC := Character'Val (Character'Pos (MC) - 64); 61 | end if; 62 | end if; 63 | return MC; 64 | end Modify; 65 | 66 | procedure Enqueue_Pair (C1, C2 : Character) is 67 | Str2 : String (1 .. 2); 68 | begin 69 | Str2 (1) := C1; 70 | Str2 (2) := C2; 71 | Redirector.Send_Data (Str2); 72 | end Enqueue_Pair; 73 | 74 | procedure Handle_Key_Release (Key : Gdk_Key_Type) is 75 | begin 76 | Process_Key (Key); 77 | Last_Pressed := GDK_VoidSymbol; 78 | end Handle_Key_Release; 79 | 80 | procedure Process_Key (Key : Gdk_Key_Type) is 81 | Char : Character; 82 | begin 83 | -- Ada.Text_IO.Put_Line ("DEBUG: Handle_Key_Release got key:" & Key'Image); 84 | case Key is 85 | when GDK_Control_L | GDK_Control_R => Ctrl_Pressed := False; 86 | when GDK_Shift_L | GDK_Shift_R => Shift_Pressed := False; 87 | 88 | when GDK_Return => Enqueue_Key (Dasher_NL); -- convert PC-style Return to DG NL 89 | when GDK_KP_Enter => Enqueue_Key (Dasher_CR); -- convert PC Keypad Enter to DG CR 90 | 91 | when GDK_Tab => Enqueue_Key (Dasher_Tab); 92 | when GDK_Down => Enqueue_Key (Dasher_Cursor_Down); 93 | when GDK_Up => Enqueue_Key (Dasher_Cursor_Up); 94 | when GDK_Left => Enqueue_Key (Dasher_Cursor_Left); 95 | when GDK_Right => Enqueue_Key (Dasher_Cursor_Right); 96 | when GDK_Home => Enqueue_Key (Dasher_Home); 97 | 98 | -- The Backspace / DEL key must map to 127 which is the DASHER DEL code 99 | when GDK_BackSpace | GDK_Delete => Enqueue_Key (Dasher_Delete); 100 | 101 | when GDK_Escape => Enqueue_Key (Dasher_Escape); 102 | 103 | -- N.B. At least on Debian with $TERM set to "d210-dg", the host 104 | -- expects both bytes to arrive in the same packet... 105 | when GDK_F1 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F1)); 106 | when GDK_F2 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F2)); 107 | when GDK_F3 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F3)); 108 | when GDK_F4 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F4)); 109 | when GDK_F5 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F5)); 110 | when GDK_F6 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F6)); 111 | when GDK_F7 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F7)); 112 | when GDK_F8 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F8)); 113 | when GDK_F9 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F9)); 114 | when GDK_F10 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F10)); 115 | when GDK_F11 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F11)); 116 | when GDK_F12 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F12)); 117 | when GDK_F13 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F13)); 118 | when GDK_F14 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F14)); 119 | when GDK_F15 => Enqueue_Pair (Dasher_Command, Modify (Dasher_F15)); 120 | 121 | -- Special codes from the virtual key buttons on the GUI 122 | when GDK_3270_EraseEOF => Enqueue_Key (Dasher_Erase_Page); 123 | when GDK_3270_EraseInput => Enqueue_Key (Dasher_Erase_EOL); 124 | when GDK_F29 => Enqueue_Key (Character'Val (19)); -- Fake Ctrl-S 125 | when GDK_F30 => Enqueue_Key (Character'Val (17)); -- Fake Ctrl-Q 126 | when GDK_F31 => Enqueue_Pair (Dasher_Command, Modify (Dasher_C1)); 127 | when GDK_F32 => Enqueue_Pair (Dasher_Command, Modify (Dasher_C2)); 128 | when GDK_F33 => Enqueue_Pair (Dasher_Command, Modify (Dasher_C3)); 129 | when GDK_F34 => Enqueue_Pair (Dasher_Command, Modify (Dasher_C4)); 130 | 131 | when others => 132 | if Key < 256 then 133 | Char := Character'Val (Key); 134 | if Ctrl_Pressed then 135 | Char := Character'Val (Character'Pos (Char) mod 32); 136 | end if; 137 | Enqueue_Key (Char); 138 | end if; 139 | end case; 140 | end Process_Key; 141 | end Keyboard; -------------------------------------------------------------------------------- /src/keyboard.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | -- See include/gtkada/gtkada.relocatable/gtkada/gdk-types-keysyms.ads for key symbol definitions 21 | 22 | with Gdk.Types; use Gdk.Types; 23 | with Gdk.Types.Keysyms; use Gdk.Types.Keysyms; 24 | 25 | package Keyboard is 26 | 27 | Ctrl_Pressed, Shift_Pressed : Boolean := False; 28 | Last_Pressed : Gdk_Key_Type := GDK_VoidSymbol; 29 | 30 | procedure Handle_Key_Press (Key : Gdk_Key_Type); 31 | -- Handle the pressing (or holding-down) of a key 32 | 33 | procedure Handle_Key_Release (Key : Gdk_Key_Type); 34 | -- Handle the release of a key (and cancel any repeating) 35 | 36 | procedure Process_Key (Key : Gdk_Key_Type); 37 | -- Process_Key maps PC-style keys to DASHER ones and enqueues the characters(s). 38 | 39 | end Keyboard; -------------------------------------------------------------------------------- /src/logging.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2022 Steve Merrony 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Text_IO; use Ada.Text_IO; 21 | 22 | package body Logging is 23 | 24 | procedure Set_Level (Level : Level_T) is 25 | begin 26 | Current_Level := Level; 27 | end Set_Level; 28 | 29 | procedure Log (Level : Level_T; Message : String) is 30 | begin 31 | if Level >= Current_Level then 32 | Put_Line (Level'Image & ": " & Message); 33 | end if; 34 | end Log; 35 | 36 | end Logging; -------------------------------------------------------------------------------- /src/logging.ads: -------------------------------------------------------------------------------- 1 | -- Copyright ©2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | package Logging is 21 | 22 | type Level_T is (DEBUG, TRACE, INFO, WARNING, ERROR); 23 | 24 | procedure Set_Level (Level : Level_T); 25 | procedure Log (Level : Level_T; Message : String); 26 | 27 | private 28 | 29 | Current_Level : Level_T := INFO; 30 | 31 | end Logging; -------------------------------------------------------------------------------- /src/mini_expect.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Strings; use Ada.Strings; 21 | with Ada.Strings.Fixed; use Ada.Strings.Fixed; 22 | 23 | with Dasher_Codes; use Dasher_Codes; 24 | with Logging; use Logging; 25 | with Redirector; 26 | 27 | package body Mini_Expect is 28 | 29 | -- protected body Runner is 30 | 31 | procedure Prepare (Filename : String) is 32 | begin 33 | if Expecting then 34 | raise Already_Expecting with "Cannot run mini-Expect script while another is still active"; 35 | end if; 36 | Open (File => Expect_File, Mode => In_File, Name => Filename); 37 | Log (TRACE, "mini-Expect script opened: " & Filename); 38 | Runner_Task := new Runner_T; 39 | end Prepare; 40 | 41 | function Convert_Line (Script_Line : String) return String is 42 | -- Remove leading and trailing double-quotes, convert \n to Dasher NL 43 | Src_Start : constant Positive := Index (Script_Line, """", Forward) + 1; 44 | Src_End : constant Positive := Index (Script_Line, """", Backward); 45 | Result : String (1 .. Src_End - Src_Start); 46 | In_Ix : Positive := Src_Start; 47 | Out_Ix : Positive := 1; 48 | Changed : Boolean := False; 49 | begin 50 | Log (TRACE, "Convert_Line called with: " & Script_Line); 51 | Log (TRACE, "... Src_Start set to" & Src_Start'Image & ", Src_End set to" & Src_End'Image); 52 | Log (TRACE, "... Max result length set to" & Result'Length'Image); 53 | while In_Ix < Src_End loop 54 | Changed := False; 55 | if In_Ix < Src_End then 56 | if Script_Line (In_Ix) = '\' then 57 | if Script_Line (In_Ix + 1) = 'n' then 58 | Result (Out_Ix) := Dasher_NL; 59 | In_Ix := In_Ix + 2; -- skip over a character 60 | Out_Ix := Out_Ix + 1; 61 | Changed := True; 62 | end if; 63 | end if; 64 | end if; 65 | if not Changed then 66 | Result (Out_Ix) := Script_Line (In_Ix); 67 | In_Ix := In_Ix + 1; 68 | Out_Ix := Out_Ix + 1; 69 | end if; 70 | end loop; 71 | Log (TRACE, "Convert_Line returning: " & Result (1 .. Out_Ix - 1)); 72 | return Result (1 .. Out_Ix - 1); 73 | end Convert_Line; 74 | 75 | procedure Handle_Char (Ch : Character; Done : out Boolean) is 76 | begin 77 | if Ch = Dasher_NL or else Ch = Dasher_CR then 78 | -- Reset the search on every new line 79 | Host_Str := Null_Unbounded_String; 80 | else 81 | Host_Str := Host_Str & Ch; 82 | Log (TRACE, "... so far we have: " & To_String (Host_Str)); 83 | if Length (Host_Str) >= Length (Search_Str) then 84 | Log (TRACE, "... Handle_Char comparing '" & To_String (Tail (Host_Str, Length (Search_Str))) 85 | & "' with '" & To_String (Search_Str)); 86 | if Tail (Host_Str, Length (Search_Str)) = Search_Str then 87 | Expecting := False; 88 | Log (TRACE, "... MATCHED!"); 89 | end if; 90 | end if; 91 | end if; 92 | Done := not Expecting; 93 | end Handle_Char; 94 | 95 | task body Runner_T is 96 | Expect_Line : String (1 .. 132); 97 | Expect_Line_Length : Natural; 98 | begin 99 | Expecting := False; 100 | 101 | while not End_Of_File (Expect_File) loop 102 | Get_Line (Expect_File, Expect_Line, Expect_Line_Length); 103 | Log (TRACE, "Expect script line: " & Expect_Line (1 .. Expect_Line_Length)); 104 | if Expect_Line_Length = 0 then 105 | -- empty line 106 | Log (TRACE, "... Skipping empty line"); 107 | 108 | elsif Expect_Line (1) = '#' then 109 | -- comment line 110 | Log (TRACE, "... Skipping comment line"); 111 | 112 | elsif Expect_Line (1 .. 6) = "expect" then 113 | -- expect string from host command, no timeout 114 | Expecting := True; 115 | Log (TRACE, "... Processing 'expect' command"); 116 | -- delay 0.2; 117 | Search_Str := To_Unbounded_String (Convert_Line (Expect_Line (8 .. Expect_Line_Length))); 118 | Log (TRACE, "... the search sting is '" & To_String (Search_Str) & "'"); 119 | Host_Str := Null_Unbounded_String; 120 | while Expecting loop 121 | Log (TRACE, "Mini_Expect waiting for match"); 122 | delay 0.1; 123 | end loop; 124 | Log (TRACE, "... found Expect string: " & To_String (Search_Str)); 125 | delay 0.2; 126 | 127 | elsif Expect_Line (1 .. 4) = "send" then 128 | -- send line to host command 129 | Log (TRACE, "... Processing 'send' command"); 130 | declare 131 | Converted : constant String := Convert_Line (Expect_Line (6 .. Expect_Line_Length)); 132 | begin 133 | Redirector.Send_Data (Converted); 134 | end; 135 | 136 | elsif Expect_Line (1 .. 4) = "exit" then 137 | -- exit script command 138 | exit; 139 | 140 | else 141 | Log (WARNING, "Cannot parse mini-Expect command - aborting script"); 142 | exit; 143 | end if; 144 | end loop; 145 | Close (Expect_File); 146 | Log (TRACE, "Mini-Expect script ***completed***"); 147 | 148 | end Runner_T; 149 | 150 | end Mini_Expect; -------------------------------------------------------------------------------- /src/mini_expect.ads: -------------------------------------------------------------------------------- 1 | -- Copyright ©2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 21 | with Ada.Text_IO; use Ada.Text_IO; 22 | 23 | package Mini_Expect is 24 | 25 | task type Runner_T; 26 | type Runner_Acc is access Runner_T; 27 | 28 | procedure Prepare (Filename : String); 29 | -- Try to open a DasherA mini-Expect script. 30 | -- Could also sanity-check it in the future... 31 | 32 | procedure Handle_Char (Ch : Character; Done : out Boolean); 33 | 34 | Expect_File : File_Type; 35 | Runner_Task : Runner_Acc; 36 | Expecting : Boolean; 37 | Search_Str, 38 | Host_Str : Unbounded_String; 39 | 40 | Already_Expecting : exception; 41 | 42 | end Mini_Expect; -------------------------------------------------------------------------------- /src/redirector.adb: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Serial; 21 | with Telnet; 22 | with Terminal; 23 | with Xmodem; 24 | 25 | package body Redirector is 26 | 27 | procedure Set_Destination (Dest : Connection_T) is 28 | begin 29 | Destination := Dest; 30 | end Set_Destination; 31 | 32 | function Get_Destination return Connection_T is 33 | (Destination); 34 | 35 | procedure Set_Handler (Handlr : Handler_T) is 36 | begin 37 | Handler := Handlr; 38 | end Set_Handler; 39 | 40 | procedure Handle_Data (C : Character) is 41 | begin 42 | case Handler is 43 | when Visual => Terminal.Process ("" & C); 44 | when Xmodem_Rx => Xmodem.Receiver_Task.Accept_Data (C); 45 | when Xmodem_Tx => Xmodem.Sender_Task.Accept_Data (C); 46 | end case; 47 | end Handle_Data; 48 | 49 | procedure Send_Data (Data : String) is 50 | begin 51 | case Destination is 52 | when Local => Terminal.Process (Data); 53 | when Async => Serial.Send (Data); 54 | when Network => Telnet.Send (Data); 55 | end case; 56 | exception 57 | when Telnet.Disconnected => 58 | Destination := Local; 59 | Handler := Visual; 60 | end Send_Data; 61 | 62 | end Redirector; -------------------------------------------------------------------------------- /src/redirector.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | package Redirector is 21 | 22 | type Connection_T is (Local, Async, Network); 23 | type Handler_T is (Visual, Xmodem_Rx, Xmodem_Tx); 24 | 25 | procedure Set_Destination (Dest : Connection_T); 26 | function Get_Destination return Connection_T; 27 | procedure Set_Handler (Handlr : Handler_T); 28 | procedure Handle_Data (C : Character); 29 | -- Handle_Data deals with data to be processed in the emulator 30 | 31 | procedure Send_Data (Data : String); 32 | -- Send_Data forwards data to be processed remotely 33 | 34 | private 35 | Destination : Connection_T := Local; 36 | Handler : Handler_T := Visual; 37 | 38 | end Redirector; -------------------------------------------------------------------------------- /src/serial.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2022 Steve Merrony 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | -- Note the serial break does not seem to be provided by GNAT.Serial_Communications 21 | -- It is claimed that... 22 | -- 23 | -- Sending break can be achieved by: 24 | -- 25 | -- * lowering the bit-rate 26 | -- * sending 0x00 which will seem as break. 27 | -- * change bit-rate back. 28 | -- 29 | -- During the break, it won't be possible to receive data since the bit-rate is not correct. 30 | 31 | with Ada.Exceptions; use Ada.Exceptions; 32 | with Ada.IO_Exceptions; 33 | with Ada.Streams; use Ada.Streams; 34 | 35 | with Logging; use Logging; 36 | with Redirector; 37 | 38 | package body Serial is 39 | 40 | procedure Open (Port_Str : String; 41 | Rate : Data_Rate; 42 | Bits : Data_Bits; 43 | Parity : Parity_Check; 44 | Stop_Bits : Stop_Bits_Number) is 45 | begin 46 | GNAT.Serial_Communications.Open (Port, Port_Name (Port_Str)); 47 | GNAT.Serial_Communications.Set (Port, Rate, Bits, Stop_Bits, Parity); 48 | -- Save the user-specified settings so we can reset after sending a Break 49 | User_Rate := Rate; 50 | User_Bits := Bits; 51 | User_Parity := Parity; 52 | User_Stop_Bits := Stop_Bits; 53 | Log (DEBUG, "Serial port opened and set-up"); 54 | Port_US := To_Unbounded_String (Port_Str); 55 | Receiver_Task := new Receiver; 56 | Receiver_Task.Start; 57 | Redirector.Set_Destination (Redirector.Async); 58 | Log (DEBUG, "Serial port open complete"); 59 | end Open; 60 | 61 | procedure Close is 62 | begin 63 | Close (Port); 64 | Redirector.Set_Destination (Redirector.Local); 65 | end Close; 66 | 67 | task body Receiver is 68 | B : Character; 69 | begin 70 | accept Start do 71 | Log (DEBUG, "Serial Receiver Started"); 72 | end Start; 73 | loop 74 | begin 75 | Character'Read (Port'Access, B); 76 | Redirector.Handle_Data (B); 77 | exception 78 | when Ada.IO_Exceptions.End_Error => 79 | null; 80 | end; 81 | end loop; 82 | exception 83 | when Error : others => 84 | Log (WARNING, Exception_Information (Error)); 85 | Log (INFO, "Serial Receiver loop exited"); 86 | Close; 87 | end Receiver; 88 | 89 | procedure Send (Data : String) is 90 | SEA : Stream_Element_Array (1 .. Data'Length); 91 | begin 92 | for I in 1 .. Data'Length loop 93 | SEA (Stream_Element_Offset (I)) := Stream_Element (Character'Pos (Data (I))); 94 | end loop; 95 | Write (Port, SEA); 96 | end Send; 97 | 98 | procedure Send_Break is 99 | SEA : Stream_Element_Array (1 .. 1); 100 | begin 101 | -- Set a very slow data rate 102 | GNAT.Serial_Communications.Set (Port, B110, CS8, Two, None); 103 | SEA (1) := 0; -- all zeroes 104 | Write (Port, SEA); 105 | -- Reset port to user settings 106 | GNAT.Serial_Communications.Set (Port, User_Rate, User_Bits, User_Stop_Bits, User_Parity); 107 | end Send_Break; 108 | 109 | end Serial; -------------------------------------------------------------------------------- /src/serial.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 21 | 22 | with GNAT.Serial_Communications; use GNAT.Serial_Communications; 23 | 24 | package Serial is 25 | 26 | task type Receiver is 27 | entry Start; 28 | end Receiver; 29 | type Receiver_Acc is access Receiver; 30 | 31 | Receiver_Task : Receiver_Acc; 32 | 33 | Port_US : Unbounded_String; 34 | 35 | procedure Open (Port_Str : String; 36 | Rate : Data_Rate; 37 | Bits : Data_Bits; 38 | Parity : Parity_Check; 39 | Stop_Bits : Stop_Bits_Number); 40 | 41 | procedure Send (Data : String); 42 | procedure Send_Break; 43 | 44 | procedure Close; 45 | 46 | private 47 | 48 | Port : aliased Serial_Port; 49 | 50 | User_Rate : Data_Rate; 51 | User_Bits : Data_Bits; 52 | User_Parity : Parity_Check; 53 | User_Stop_Bits : Stop_Bits_Number; 54 | 55 | end Serial; -------------------------------------------------------------------------------- /src/session_logger.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Logging; use Logging; 21 | 22 | package body Session_Logger is 23 | 24 | function Start_Logging (Filename : String) return Boolean is 25 | begin 26 | Create (Log_File, Out_File, Filename); 27 | Logging := True; 28 | return True; 29 | exception 30 | when others => 31 | Log (WARNING, "Could not open file for logging - " & Filename); 32 | return False; 33 | end Start_Logging; 34 | 35 | procedure Stop_Logging is 36 | begin 37 | Logging := False; 38 | Close (Log_File); 39 | end Stop_Logging; 40 | 41 | procedure Log_Char (Char : Character) is 42 | begin 43 | Put (Log_File, Char); 44 | end Log_Char; 45 | 46 | end Session_Logger; 47 | -------------------------------------------------------------------------------- /src/session_logger.ads: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Text_IO; use Ada.Text_IO; 21 | 22 | package Session_Logger is 23 | 24 | Logging : Boolean := False; 25 | Log_File : File_Type; 26 | 27 | function Start_Logging (Filename : String) return Boolean; 28 | procedure Stop_Logging; 29 | procedure Log_Char (Char : Character); 30 | 31 | end Session_Logger; 32 | -------------------------------------------------------------------------------- /src/telnet.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022,2024 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Exceptions; 21 | with Ada.Streams; use Ada.Streams; 22 | 23 | with Glib.Main; 24 | 25 | with Logging; use Logging; 26 | with Redirector; 27 | with Terminal; 28 | 29 | package body Telnet is 30 | 31 | function New_Connection (Host_Str : String; Port_Num : Integer) return Session_Acc_T is 32 | Sess : aliased constant Session_Acc_T := new Session_T; 33 | Address : GNAT.Sockets.Sock_Addr_Type; 34 | begin 35 | -- Exceptions should be handled by caller 36 | GNAT.Sockets.Create_Socket (Sess.Conn); 37 | Log (DEBUG, "Telnet - Host: " & Host_Str & ", Port: " & Port_Num'Image); 38 | Address.Addr := GNAT.Sockets.Addresses (GNAT.Sockets.Get_Host_By_Name (Host_Str), 1); 39 | Address.Port := GNAT.Sockets.Port_Type (Port_Num); 40 | GNAT.Sockets.Connect_Socket (Sess.Conn, Address); 41 | Log (DEBUG, "Telnet - Socket connected"); 42 | -- GNAT.Sockets.Set_Socket_Option (Socket => Sess.Conn, Option => (No_Delay, True)); 43 | Sess.Host_Str := To_Unbounded_String (Host_Str); 44 | Sess.Port_Num := Port_Num; 45 | Receiver_Task := new Receiver; 46 | Receiver_Task.Start (Sess); 47 | Session := Sess; 48 | return Sess; 49 | end New_Connection; 50 | 51 | procedure Send (Str : String) is 52 | SEA : Ada.Streams.Stream_Element_Array (1 .. Str'Length); 53 | Dummy_Bytes_Sent : Ada.Streams.Stream_Element_Offset; 54 | begin 55 | -- Log (DEBUG, "Telnet.Send called with No. bytes: " & Str'Length'Image); 56 | for I in 1 .. Str'Length loop 57 | SEA (Ada.Streams.Stream_Element_Offset (I)) := Ada.Streams.Stream_Element (Character'Pos (Str (I))); 58 | end loop; 59 | GNAT.Sockets.Send_Socket (Socket => Session.Conn, 60 | Item => SEA, 61 | Last => Dummy_Bytes_Sent 62 | -- Flags => Send_End_Of_Record 63 | ); 64 | -- Log (DEBUG, "Telnet.Send sent No. Bytes: " & Bytes_Sent'Image); 65 | exception 66 | when E : others => 67 | Log (WARNING, "Telnet.Send has Failed (disconnected?)"); 68 | Log (WARNING, Ada.Exceptions.Exception_Information (E)); 69 | raise Disconnected; 70 | end Send; 71 | 72 | procedure Close_Connection (Sess : in out Session_T) is 73 | begin 74 | GNAT.Sockets.Shutdown_Socket (Sess.Conn); 75 | -- Keyboard_Sender_Task.Stop; 76 | Redirector.Set_Destination (Redirector.Local); 77 | exception 78 | when Socket_Error => 79 | Log (WARNING, "Error closing socket (already disconnected?)"); 80 | end Close_Connection; 81 | 82 | task body Receiver is 83 | Session : Session_Acc_T; 84 | Rx_Block : Ada.Streams.Stream_Element_Array (1 .. 2048); 85 | Fwd_US : Unbounded_String; 86 | Unused_SI : Glib.Main.G_Source_Id; 87 | Offset : Ada.Streams.Stream_Element_Count; 88 | One_Byte : Character; 89 | Three_Bytes : String (1 .. 3); 90 | In_Telnet_Cmd, Got_DO, Got_WILL : Boolean := False; 91 | begin 92 | accept Start (Sess : Session_Acc_T) do 93 | Session := Sess; 94 | Log (DEBUG, "Telnet Receiver Started"); 95 | end Start; 96 | loop 97 | -- Log (DEBUG, "Telnet Receive waiting for data..."); 98 | GNAT.Sockets.Receive_Socket (Session.Conn, Rx_Block, Offset); 99 | -- Log (DEBUG, "...Telnet Receiver got data from host - No. Bytes:" & Offset'Image); 100 | if Offset = 0 then 101 | Log (WARNING, "Telnet Receiver Stopping due to empty message from host"); 102 | goto Halt; 103 | end if; 104 | Fwd_US := Null_Unbounded_String; 105 | for I in 1 .. Offset loop 106 | One_Byte := Character'Val (Rx_Block (I)); 107 | -- Log (DEBUG, "...Telnet Receiver handling byte: " & One_Byte'Image); 108 | if One_Byte = Cmd_IAC then 109 | if In_Telnet_Cmd then 110 | -- special case - the host really wants to send a 255 - let it through 111 | Log (DEBUG, "Telnet - Passing through IAC character"); 112 | In_Telnet_Cmd := False; 113 | else 114 | In_Telnet_Cmd := True; 115 | Log (DEBUG, "Telnet - got IAC command indicator"); 116 | goto continue; 117 | end if; 118 | end if; 119 | 120 | if In_Telnet_Cmd then 121 | case One_Byte is 122 | when Cmd_DO => 123 | Got_DO := True; 124 | Log (DEBUG, "Telnet - Got DO request"); 125 | goto continue; 126 | when Cmd_WILL => 127 | Got_WILL := True; 128 | Log (DEBUG, "Telnet - Got WILL request"); 129 | goto continue; 130 | when Cmd_AO | Cmd_AYT | Cmd_BRK | Cmd_DM | Cmd_DONT | 131 | Cmd_EC | Cmd_EL | Cmd_IP | Cmd_NOP | Cmd_SB | Cmd_SE => 132 | Log (DEBUG, "Telnet - Ignoring Telnet instruction:" & One_Byte'Image); 133 | goto continue; 134 | when others => 135 | null; 136 | end case; 137 | end if; 138 | 139 | if Got_DO then 140 | -- whatever the host ask us to do we will refuse 141 | Three_Bytes (1) := Cmd_IAC; 142 | Three_Bytes (2) := Cmd_WONT; 143 | Three_Bytes (3) := One_Byte; 144 | Send (Three_Bytes); 145 | Log (DEBUG, "Telnet - Denying DO request for: " & One_Byte'Image); 146 | Got_DO := False; 147 | In_Telnet_Cmd := False; 148 | -- TESTING -- 149 | Three_Bytes (2) := Cmd_GA; 150 | Send (Three_Bytes); 151 | goto continue; 152 | end if; 153 | 154 | if Got_WILL then 155 | -- whatever the host offers to do we will refuse 156 | Three_Bytes (1) := Cmd_IAC; 157 | Three_Bytes (2) := Cmd_DONT; 158 | Three_Bytes (3) := One_Byte; 159 | Send (Three_Bytes); 160 | Log (DEBUG, "Telnet - Denying WILL request for: " & One_Byte'Image); 161 | Got_WILL := False; 162 | In_Telnet_Cmd := False; 163 | goto continue; 164 | end if; 165 | 166 | Append (Fwd_US, One_Byte); 167 | 168 | <> 169 | 170 | end loop; -- for I in 1 .. Offset 171 | 172 | -- wait for any pending data to be processed 173 | while Data_Pending loop 174 | delay 0.01; 175 | end loop; 176 | -- (re) lock the data block 177 | Data_Pending := True; 178 | -- copy the data for retrieval via Get_Data_Block 179 | Data_Block := Fwd_US; 180 | -- queue up a process request directly in Terminal 181 | -- (this is ok as Xmodem does not work via telnet) 182 | Unused_SI := Glib.Main.Idle_Add (Terminal.Process_CB'Access); 183 | 184 | end loop; -- forever 185 | <> 186 | Log (DEBUG, "Telnet Receiver loop exited"); 187 | Session.Close_Connection; 188 | end Receiver; 189 | 190 | function Get_Data_Block return String is 191 | begin 192 | return To_String (Data_Block); 193 | end Get_Data_Block; 194 | 195 | procedure Unlock_Data_Block is 196 | begin 197 | Data_Pending := False; 198 | end Unlock_Data_Block; 199 | 200 | end Telnet; -------------------------------------------------------------------------------- /src/telnet.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 21 | 22 | with GNAT.Sockets; use GNAT.Sockets; 23 | 24 | package Telnet is 25 | 26 | Cmd_SE : constant Character := Character'Val (240); 27 | Cmd_NOP : constant Character := Character'Val (241); 28 | Cmd_DM : constant Character := Character'Val (242); 29 | Cmd_BRK : constant Character := Character'Val (243); 30 | Cmd_IP : constant Character := Character'Val (244); 31 | Cmd_AO : constant Character := Character'Val (245); 32 | Cmd_AYT : constant Character := Character'Val (246); 33 | Cmd_EC : constant Character := Character'Val (247); 34 | Cmd_EL : constant Character := Character'Val (248); 35 | Cmd_GA : constant Character := Character'Val (249); 36 | Cmd_SB : constant Character := Character'Val (250); 37 | Cmd_WILL : constant Character := Character'Val (251); 38 | Cmd_WONT : constant Character := Character'Val (252); 39 | Cmd_DO : constant Character := Character'Val (253); 40 | Cmd_DONT : constant Character := Character'Val (254); 41 | Cmd_IAC : constant Character := Character'Val (255); 42 | 43 | type Message is new String; 44 | 45 | type Session_T is tagged record 46 | Conn : GNAT.Sockets.Socket_Type; 47 | Host_Str : Unbounded_String; -- The host as specified by our user 48 | Port_Num : Integer; -- The port as specified by our user 49 | end record; 50 | 51 | type Session_Acc_T is access all Session_T; 52 | 53 | Session : Session_Acc_T; 54 | 55 | function New_Connection (Host_Str : String; Port_Num : Integer) return Session_Acc_T; 56 | -- Attempt to initiate a new TCPIP/Telnet connection to the specified Host and Port. 57 | -- Data from the remote host will be directed to the supplied Terminal. 58 | -- To send data, call the Send procedure 59 | 60 | procedure Send (Str : String); 61 | function Get_Data_Block return String; 62 | procedure Unlock_Data_Block; 63 | 64 | procedure Close_Connection (Sess : in out Session_T); 65 | 66 | task type Receiver is 67 | entry Start (Sess : Session_Acc_T); 68 | end Receiver; 69 | type Receiver_Acc is access Receiver; 70 | 71 | Receiver_Task : Receiver_Acc; 72 | Data_Pending : Boolean := False; 73 | Data_Block : Unbounded_String; 74 | 75 | Disconnected : exception; 76 | 77 | end Telnet; -------------------------------------------------------------------------------- /src/terminal.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2021,2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Characters.Latin_1; 21 | with Ada.Strings.Fixed; 22 | 23 | with Gdk.Main; 24 | with Glib.Main; 25 | 26 | with BDF_Font; 27 | with Crt; 28 | with Dasher_Codes; use Dasher_Codes; 29 | with Display_P; use Display_P; 30 | with Logging; use Logging; 31 | with Session_Logger; 32 | with Mini_Expect; 33 | with Redirector; 34 | with Telnet; 35 | -- with Viewer; 36 | 37 | package body Terminal is 38 | 39 | function Create (Emul : Emulation_T; Text_Only : Boolean) return Terminal_Acc_T is 40 | Term : aliased constant Terminal_Acc_T := new Terminal_T; 41 | begin 42 | Term.Emulation := Emul; 43 | Term.Text_Only := Text_Only; 44 | Term.Cursor_X := 0; 45 | Term.Cursor_Y := 0; 46 | Term.In_Command := False; 47 | Term.In_Extended_Command := False; 48 | Term.Getting_X_Addr := False; 49 | Term.Getting_Y_Addr := False; 50 | Term.Roll_Enabled := True; 51 | Term.Protection_Enabled := True; 52 | Term.Skip_Byte := False; 53 | Term.Holding := False; 54 | Term.Expecting := False; 55 | Term.Raw_Mode := False; 56 | Term.Blinking := False; 57 | Term.Dimmed := False; 58 | Term.Reversed := False; 59 | Term.Underscored := False; 60 | Term.Protectd := False; 61 | Term.Updated := True; 62 | 63 | T := Term; 64 | 65 | return Term; 66 | end Create; 67 | 68 | procedure Self_Test is 69 | HRule1 : constant String := "123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012245"; 70 | HRule2 : constant String := " 1 2 3 4 5 6 7 8 9 10 11 12 13 "; 71 | Chars : constant String := "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789!""$%^&*"; 72 | NLine : constant String := "3 Normal : "; 73 | DLine : constant String := "4 Dim : "; 74 | BLine : constant String := "5 Blink : "; 75 | RLine : constant String := "6 Reverse: "; 76 | ULine : constant String := "7 Under : "; 77 | NL, Op : String (1 .. 1); 78 | begin 79 | NL (1) := Dasher_NL; 80 | 81 | Op (1) := Dasher_Erase_Page; 82 | Process (Op); 83 | 84 | Process (HRule1 (1 .. Display.Get_Visible_Cols)); 85 | Process (HRule2 (1 .. Display.Get_Visible_Cols)); 86 | 87 | Process (NLine); 88 | Process (Chars); 89 | Process (NL); 90 | 91 | Process (DLine); 92 | Op (1) := Dasher_Dim_On; 93 | Process (Op); 94 | Process (Chars); 95 | Op (1) := Dasher_Dim_Off; 96 | Process (Op); 97 | Process (NL); 98 | 99 | Process (BLine); 100 | Op (1) := Dasher_Blink_On; 101 | Process (Op); 102 | Process (Chars); 103 | Op (1) := Dasher_Blink_Off; 104 | Process (Op); 105 | Process (NL); 106 | 107 | Process (RLine); 108 | Op (1) := Dasher_Rev_On; 109 | Process (Op); 110 | Process (Chars); 111 | Op (1) := Dasher_Rev_Off; 112 | Process (Op); 113 | Process (NL); 114 | 115 | Process (ULine); 116 | Op (1) := Dasher_Underline; 117 | Process (Op); 118 | Process (Chars); 119 | Op (1) := Dasher_Normal; 120 | Process (Op); 121 | Process (NL); 122 | 123 | for L in 8 .. Display.Get_Visible_Lines loop 124 | if L > 8 then 125 | Process (NL); 126 | end if; 127 | Process (Ada.Strings.Fixed.Trim (L'Image, Ada.Strings.Left)); 128 | end loop; 129 | 130 | end Self_Test; 131 | 132 | procedure Set_Cursor (T : in out Terminal_T; X, Y : Natural) is 133 | begin 134 | T.Cursor_X := X; 135 | T.Cursor_Y := Y; 136 | end Set_Cursor; 137 | 138 | function Beep return Boolean is 139 | begin 140 | Gdk.Main.Beep; 141 | return False; 142 | end Beep; 143 | 144 | procedure Send_Model_ID (T : Terminal_T) is 145 | Response : String (1 .. 6); 146 | begin 147 | Response (1) := Character'Val (8#036#); -- Header 1 148 | Response (1) := Character'Val (8#157#); -- Header 2 149 | Response (3) := Character'Val (8#043#); -- Model Report Follows 150 | case T.Emulation is 151 | when D200 => 152 | Response (4) := Character'Val (8#041#); -- D100/D200 153 | Response (5) := Character'Val (2#01011010#); -- see p.2-7 of D100/D200 User Manual (="Z") 154 | Response (6) := Character'Val (8#003#); -- Firmware Code 155 | when D210 => 156 | Response (4) := Character'Val (8#050#); -- D210 157 | Response (5) := Character'Val (2#01010001#); -- See p.3-9 of D210/D211 User Manual 158 | Response (6) := Character'Val (8#132#); -- Firmware Code 159 | end case; 160 | Redirector.Send_Data (Response); 161 | end Send_Model_ID; 162 | 163 | -- Process is to be called with a String whenever there is any data for 164 | -- the terminal to display or otherwise handle. 165 | procedure Process (Str : String) is 166 | B : Character; 167 | B_Int : Integer; 168 | C : Character; 169 | Unused_SI : Glib.Main.G_Source_Id; 170 | begin 171 | 172 | for Ix in Str'Range loop 173 | B := Str (Ix); 174 | B_Int := Character'Pos (B); 175 | 176 | -- Ada.Text_IO.Put_Line ("DEBUG: Terminal.Process got: " & B'Image); 177 | 178 | T.Skip_Byte := False; 179 | 180 | if T.Getting_X_Addr then -- host is setting cursor address 181 | T.New_X_Addr := Natural (B_Int mod 127); 182 | if T.New_X_Addr = 127 then 183 | -- special case - x stays the same - see D410 User Manual p.3-25 184 | T.New_X_Addr := T.Cursor_X; 185 | elsif T.New_X_Addr >= Display.Get_Visible_Cols then 186 | T.New_X_Addr := T.New_X_Addr - Display.Get_Visible_Cols; 187 | end if; 188 | T.Getting_X_Addr := False; 189 | T.Getting_Y_Addr := True; 190 | goto Redraw_Tube; 191 | end if; 192 | 193 | if T.Getting_Y_Addr then 194 | T.New_Y_Addr := Natural (B_Int mod 127); 195 | if T.New_Y_Addr = 127 then 196 | T.New_Y_Addr := T.Cursor_Y; 197 | elsif T.New_Y_Addr >= Display.Get_Visible_Lines then 198 | -- see end of p.3-24 in D410 User Manual 199 | if T.Roll_Enabled then 200 | Display.Scroll_Up (T.New_Y_Addr - (Display.Get_Visible_Lines - 1)); 201 | end if; 202 | T.New_Y_Addr := T.New_Y_Addr - Display.Get_Visible_Lines; 203 | end if; 204 | T.Set_Cursor (T.New_X_Addr, T.New_Y_Addr); 205 | T.Getting_Y_Addr := False; 206 | goto Redraw_Tube; 207 | end if; 208 | 209 | -- Log it if required 210 | if Session_Logger.Logging then 211 | Session_Logger.Log_Char (Character'Val (B_Int)); 212 | end if; 213 | 214 | -- short DASHER commands 215 | if T.In_Command then 216 | case B is 217 | when 'C' => 218 | T.Send_Model_ID; 219 | when 'D' => 220 | T.Reversed := True; 221 | when 'E' => 222 | T.Reversed := False; 223 | when 'F' => 224 | T.In_Extended_Command := True; 225 | when others => 226 | Log (WARNING, "Unrecognised Break-CMD code:" & B_Int'Image); 227 | end case; 228 | T.In_Command := False; 229 | goto Redraw_Tube; 230 | end if; 231 | 232 | -- D210 Command(s) 233 | if T.In_Extended_Command then 234 | case B is 235 | when 'F' => -- erase unprotected to end of screen 236 | -- clear to end of current line 237 | for Col in T.Cursor_X .. (Display.Get_Visible_Cols - 1) loop 238 | Display.Clear_Unprotected_Cell (Line => T.Cursor_Y, Col => Col); 239 | end loop; 240 | -- clear all lines below 241 | for Line in (T.Cursor_Y + 1) .. (Display.Get_Visible_Lines - 1) loop 242 | for Col in 0 .. (Display.Get_Visible_Cols - 1) loop 243 | Display.Clear_Unprotected_Cell (Line => T.Cursor_Y, Col => Col); 244 | end loop; 245 | end loop; 246 | when others => 247 | Log (WARNING, "Unrecognised Break-CMD F code:" & B_Int'Image); 248 | end case; 249 | T.In_Extended_Command := False; 250 | goto Redraw_Tube; 251 | end if; 252 | 253 | case B is 254 | when Dasher_Null => 255 | T.Skip_Byte := True; 256 | when Dasher_Bell => 257 | declare 258 | Dummy_ID : Glib.Main.G_Source_Id; 259 | begin 260 | Dummy_ID := Glib.Main.Idle_Add (Beep'Access); 261 | end; 262 | Log (INFO, "*** BEEP! ***" & Ada.Characters.Latin_1.BEL); -- on running terminal... 263 | T.Skip_Byte := True; 264 | when Dasher_Blink_On => 265 | T.Blinking := True; 266 | T.Skip_Byte := True; 267 | when Dasher_Blink_Off => 268 | T.Blinking := False; 269 | T.Skip_Byte := True; 270 | when Dasher_Blink_Enable => 271 | Display.Set_Blink_Enabled (True); -- Modifies Display 272 | T.Skip_Byte := True; 273 | when Dasher_Blink_Disable => 274 | Display.Set_Blink_Enabled (False); -- Modifies Display 275 | T.Skip_Byte := True; 276 | when Dasher_Command => 277 | T.In_Command := True; -- next char will form (part of) a command 278 | T.Skip_Byte := True; 279 | when Dasher_Cursor_Down => 280 | if T.Cursor_Y < Display.Get_Visible_Lines - 1 then 281 | T.Cursor_Y := T.Cursor_Y + 1; 282 | else 283 | T.Cursor_Y := 0; 284 | end if; 285 | T.Skip_Byte := True; 286 | when Dasher_Cursor_Left => 287 | if T.Cursor_X > 0 then 288 | T.Cursor_X := T.Cursor_X - 1; 289 | else 290 | T.Cursor_X := Display.Get_Visible_Cols - 1; 291 | if T.Cursor_Y > 0 then 292 | T.Cursor_Y := T.Cursor_Y - 1; 293 | else 294 | T.Cursor_Y := Display.Get_Visible_Lines - 1; 295 | end if; 296 | end if; 297 | T.Skip_Byte := True; 298 | when Dasher_Cursor_Right => 299 | if T.Cursor_X < Display.Get_Visible_Cols - 1 then 300 | T.Cursor_X := T.Cursor_X + 1; 301 | else 302 | T.Cursor_X := 0; 303 | if T.Cursor_Y < Display.Get_Visible_Lines - 1 then 304 | T.Cursor_Y := T.Cursor_Y + 1; 305 | else 306 | T.Cursor_Y := 0; 307 | end if; 308 | end if; 309 | T.Skip_Byte := True; 310 | when Dasher_Cursor_Up => 311 | if T.Cursor_Y > 0 then 312 | T.Cursor_Y := T.Cursor_Y - 1; 313 | else 314 | T.Cursor_Y := Display.Get_Visible_Lines - 1; 315 | end if; 316 | T.Skip_Byte := True; 317 | when Dasher_Dim_On => 318 | T.Dimmed := True; 319 | T.Skip_Byte := True; 320 | when Dasher_Dim_Off => 321 | T.Dimmed := False; 322 | T.Skip_Byte := True; 323 | when Dasher_Erase_EOL => 324 | for Col in T.Cursor_X .. Display.Get_Visible_Cols - 1 loop 325 | Display.Clear_Cell (T.Cursor_Y, Col); 326 | end loop; 327 | T.Skip_Byte := True; 328 | when Dasher_Erase_Page => 329 | Display.Scroll_Up (Display.Get_Visible_Lines); 330 | T.Set_Cursor (0, 0); 331 | T.Skip_Byte := True; 332 | when Dasher_Home => 333 | T.Set_Cursor (0, 0); 334 | T.Skip_Byte := True; 335 | when Dasher_Read_Window_Addr => -- REQUIRES RESPONSE - see D410 User Manual p.3-18 336 | declare 337 | B3_Arr : String (1 .. 3); 338 | begin 339 | B3_Arr (1) := Character'Val (31); 340 | B3_Arr (2) := Character'Val (T.Cursor_X); 341 | B3_Arr (3) := Character'Val (T.Cursor_Y); 342 | Redirector.Send_Data (B3_Arr); 343 | -- select 344 | -- Redirector.Send_Data (B3_Arr); 345 | -- or 346 | -- delay 0.5; -- FIXME this was to prevent hang if other end not waiting 347 | -- end select; 348 | end; 349 | T.Skip_Byte := True; 350 | when Dasher_Rev_On => 351 | if T.Emulation /= D200 then -- only for D210 and later models 352 | T.Reversed := True; 353 | T.Skip_Byte := True; 354 | end if; 355 | when Dasher_Rev_Off => 356 | if T.Emulation /= D200 then 357 | T.Reversed := False; 358 | T.Skip_Byte := True; 359 | end if; 360 | when Dasher_Roll_Disable => 361 | T.Roll_Enabled := False; 362 | T.Skip_Byte := True; 363 | when Dasher_Roll_Enable => 364 | T.Roll_Enabled := True; 365 | T.Skip_Byte := True; 366 | when Dasher_Underline => 367 | T.Underscored := True; 368 | T.Skip_Byte := True; 369 | when Dasher_Normal => 370 | T.Underscored := False; 371 | T.Skip_Byte := True; 372 | -- TAB handling removed, according to the docs it is handled at the host end, not locally 373 | -- ... and re-added because I don't think it can ever cause a problem... 374 | when Dasher_Tab => 375 | T.Cursor_X := T.Cursor_X + 1; -- always at least 1 column 376 | while (T.Cursor_X + 1) mod 8 /= 0 loop 377 | if T.Cursor_X >= Display.Get_Visible_Cols - 1 then 378 | T.Cursor_X := 0; -- ??? What about Cursor_Y ??? 379 | else 380 | T.Cursor_X := T.Cursor_X + 1; 381 | end if; 382 | end loop; 383 | T.Skip_Byte := True; 384 | when Dasher_Write_Window_Addr => 385 | T.Getting_X_Addr := True; 386 | T.Skip_Byte := True; 387 | when others => 388 | null; 389 | end case; 390 | 391 | if T.Skip_Byte then 392 | goto Redraw_Tube; 393 | end if; 394 | 395 | -- wrap due to hitting margin or new line? 396 | if T.Cursor_X = Display.Get_Visible_Cols or else B = Dasher_NL then 397 | -- hit bottom of screen? 398 | if T.Cursor_Y = Display.Get_Visible_Lines - 1 then 399 | if T.Roll_Enabled then 400 | Display.Scroll_Up (1); 401 | else 402 | T.Cursor_Y := 0; 403 | Display.Clear_Line (T.Cursor_Y); 404 | end if; 405 | else 406 | T.Cursor_Y := T.Cursor_Y + 1; 407 | if not T.Roll_Enabled then 408 | Display.Clear_Line (T.Cursor_Y); 409 | end if; 410 | end if; 411 | T.Cursor_X := 0; 412 | end if; 413 | 414 | -- CR or NL? 415 | if B = Dasher_CR or else B = Dasher_NL then 416 | T.Cursor_X := 0; 417 | -- TODO handle Expect case 418 | goto Redraw_Tube; 419 | end if; 420 | 421 | -- if Mini_Expect.Runner.Is_Expecting then 422 | if Mini_Expect.Expecting then 423 | -- Mini_Expect.Runner_Task.Expect (B); 424 | declare 425 | Finished : Boolean; 426 | begin 427 | Mini_Expect.Handle_Char (B, Finished); 428 | -- if not Finished then 429 | -- Mini_Expect.Runner.Execute; 430 | -- end if; 431 | end; 432 | end if; 433 | 434 | -- Finally! Put the character in the displayable matrix 435 | C := Character'Val (127); -- the 'unknown character' character 436 | if B_Int < 128 and then BDF_Font.Is_Loaded (B_Int) then 437 | C := B; 438 | end if; 439 | 440 | Display.Set_Cell (Line => T.Cursor_Y, Col => T.Cursor_X, Char => C, Blink => T.Blinking, Dim => T.Dimmed, 441 | Rev => T.Reversed, Under => T.Underscored, Prot => T.Protectd); 442 | 443 | T.Cursor_X := T.Cursor_X + 1; 444 | 445 | <> 446 | Display.Set_Cursor (T.Cursor_X, T.Cursor_Y); 447 | Display.Set_Dirty; 448 | -- if T.Text_Only then 449 | -- Unused_SI := Glib.Main.Idle_Add (Viewer.Update_CB'Access); 450 | -- -- Viewer.Update; 451 | -- else 452 | Crt.Tube.DA.Queue_Draw; 453 | -- end if; 454 | end loop; 455 | end Process; 456 | 457 | function Process_CB return Boolean is 458 | Data : constant String := Telnet.Get_Data_Block; 459 | begin 460 | Telnet.Unlock_Data_Block; 461 | Process (Data); 462 | return False; 463 | end Process_CB; 464 | 465 | end Terminal; 466 | -------------------------------------------------------------------------------- /src/terminal.ads: -------------------------------------------------------------------------------- 1 | -- Copyright (C)2021,2022 Steve Merrony 2 | 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | package Terminal is 21 | 22 | type Emulation_T is (D200, D210); 23 | 24 | type Terminal_T is tagged record 25 | Emulation : Emulation_T; 26 | Cursor_X, Cursor_Y : Natural; 27 | In_Command, In_Extended_Command : Boolean; 28 | Getting_X_Addr, Getting_Y_Addr : Boolean; 29 | New_X_Addr, New_Y_Addr : Natural; 30 | Roll_Enabled, Protection_Enabled : Boolean; 31 | Holding : Boolean; 32 | Skip_Byte : Boolean; 33 | Expecting : Boolean; 34 | Raw_Mode : Boolean; -- in rawMode all host data is passed straight through to rawChan 35 | Blinking, Dimmed, Reversed, Underscored, Protectd : Boolean; 36 | Updated : Boolean; 37 | Text_Only : Boolean; 38 | end record; 39 | 40 | type Terminal_Acc_T is access all Terminal_T; 41 | 42 | T : Terminal_Acc_T; 43 | 44 | -- procedure Init (Termin : Terminal_Acc_T); 45 | procedure Process (Str : String); 46 | -- Process does the bulk of the actual terminal Emulation 47 | 48 | function Process_CB return Boolean; 49 | -- Process_CB is just a callback wrapper for Process 50 | 51 | function Create (Emul : Emulation_T; Text_Only : Boolean) return Terminal_Acc_T; 52 | procedure Self_Test; 53 | 54 | end Terminal; 55 | -------------------------------------------------------------------------------- /src/xmodem.adb: -------------------------------------------------------------------------------- 1 | -- Copyright ©2022,2024 Steve Merrony 2 | -- 3 | -- This file is a part of DasherA. 4 | -- 5 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 6 | -- of this software and associated documentation files (the "Software"), to deal 7 | -- in the Software without restriction, including without limitation the rights 8 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | -- copies of the Software, and to permit persons to whom the Software is 10 | -- furnished to do so, subject to the following conditions: 11 | -- The above copyright notice and this permission notice shall be included in 12 | -- all copies or substantial portions of the Software. 13 | -- 14 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 15 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 16 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 17 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 18 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 19 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 20 | -- THE SOFTWARE. 21 | 22 | with Ada.Directories; 23 | 24 | with Logging; use Logging; 25 | with Redirector; use Redirector; 26 | 27 | package body Xmodem is 28 | 29 | function CRC_16 (Data : Vector) return Unsigned_16 is 30 | CRC : Unsigned_16 := 0; 31 | Part : Unsigned_16; 32 | begin 33 | for C of Data loop 34 | Part := Unsigned_16 (Char_To_U8 (C)); 35 | CRC := CRC xor Shift_Left (Part, 8); 36 | for I in 0 .. 7 loop 37 | if (CRC and 16#8000#) > 0 then 38 | CRC := Shift_Left (CRC, 1) xor 16#1021#; 39 | else 40 | CRC := Shift_Left (CRC, 1); 41 | end if; 42 | end loop; 43 | end loop; 44 | return CRC; 45 | end CRC_16; 46 | 47 | function CRC_16_Fixed_Len (Data : Vector; FL : Positive) return Unsigned_16 is 48 | CRC : Unsigned_16 := 0; 49 | begin 50 | -- the data part... 51 | CRC := CRC_16 (Data); 52 | 53 | -- the padding to the fixed length... 54 | for C in 0 .. (FL - Positive (Data.Length) - 1) loop 55 | CRC := CRC xor 16#0400#; 56 | for I in 0 .. 7 loop 57 | if (CRC and 16#8000#) > 0 then 58 | CRC := Shift_Left (CRC, 1) xor 16#1021#; 59 | else 60 | CRC := Shift_Left (CRC, 1); 61 | end if; 62 | end loop; 63 | end loop; 64 | 65 | return CRC; 66 | end CRC_16_Fixed_Len; 67 | 68 | procedure Send_Block (Data : in out Vector; Block_Num : Natural; Block_Size : Packet_Size) is 69 | Start_Bytes : String (1 .. 3); 70 | Block_Pos : constant Unsigned_8 := Unsigned_8 (Block_Num mod 256); 71 | Block_Inv : constant Unsigned_8 := not Block_Pos; 72 | CRC : Unsigned_16; 73 | CRC_Str : String (1 .. 2); 74 | Padding_String : String (1 .. 1); 75 | begin 76 | if Block_Size = Short then 77 | Start_Bytes (1) := ASCII.SOH; 78 | else 79 | Start_Bytes (1) := ASCII.STX; 80 | end if; 81 | Start_Bytes (2) := Character'Val (Block_Pos); 82 | Start_Bytes (3) := Character'Val (Block_Inv); 83 | if Tracing then 84 | Log (DEBUG, "X-Modem sending start byte and block number: " & Block_Pos'Image); 85 | Log (DEBUG, "X-Modem ... Actual data length: " & Data.Length'Image); 86 | end if; 87 | Redirector.Send_Data (Start_Bytes); 88 | 89 | -- Send the actual data 90 | for C of Data loop 91 | Redirector.Send_Data ("" & C); 92 | end loop; 93 | 94 | -- Pad out block 95 | if Data.Length < Block_Size'Enum_Rep then 96 | if Tracing then 97 | Log (DEBUG, "X-Modem ... Padding packet to full size"); 98 | end if; 99 | Padding_String (1) := ASCII.EOT; 100 | for Ix in Data.Length + 1 .. Block_Size'Enum_Rep loop 101 | Redirector.Send_Data (Padding_String); 102 | Data.Append (ASCII.EOT); 103 | end loop; 104 | if Tracing then 105 | Log (DEBUG, "X-Modem ... Packet size now: " & Data.Length'Image); 106 | end if; 107 | end if; 108 | 109 | CRC := CRC_16 (Data); 110 | CRC_Str (1) := Byte_To_Char (Unsigned_8 (Shift_Right (CRC and 16#ff00#, 8))); 111 | CRC_Str (2) := Byte_To_Char (Unsigned_8 (CRC and 16#00ff#)); 112 | if Tracing then 113 | Log (DEBUG, "X-Modem checksum: " & CRC'Image & ", sending: " & CRC_Str); 114 | end if; 115 | Redirector.Send_Data (CRC_Str); 116 | 117 | end Send_Block; 118 | 119 | procedure Receive (Filename : String; Trace_Flag : Boolean) is 120 | RX_File : File_Type; 121 | RX_Stream : Stream_Access; 122 | begin 123 | Tracing := Trace_Flag; 124 | if Ada.Directories.Exists (Filename) then 125 | raise Already_Exists; 126 | end if; 127 | Create (RX_File, Name => Filename); 128 | RX_Stream := Stream (RX_File); 129 | Log (INFO, "Xmodem Created file: " & Filename); 130 | Redirector.Set_Handler (Handlr => Xmodem_Rx); 131 | Receiver_Task := new Receiver; 132 | Receiver_Task.Start (RX_Stream); 133 | loop 134 | select 135 | Receiver_Task.Done; 136 | Log (INFO, "Xmodem Receive is complete"); 137 | Close (RX_File); 138 | Redirector.Set_Handler (Handlr => Visual); 139 | exit; 140 | or 141 | delay 1.0; 142 | if Tracing then 143 | Log (DEBUG, "Xmodem waiting for Receive to complete"); 144 | end if; 145 | end select; 146 | end loop; 147 | end Receive; 148 | 149 | task body Receiver is 150 | Finished : Boolean; 151 | Packet_Size : Natural; 152 | Packet_Count, Inverse_Packet_Count : Unsigned_8; 153 | Rxd_CRC, Calcd_CRC : Unsigned_16; 154 | Write_Stream : Stream_Access; 155 | File_Blob, Packet : Vector; 156 | Pkt_Hdr : Character; 157 | Purged : Boolean; 158 | begin 159 | accept Start (RX_Stream : Stream_Access) do 160 | Write_Stream := RX_Stream; 161 | Finished := False; 162 | File_Blob.Clear; 163 | Packet.Clear; 164 | end Start; 165 | if Tracing then 166 | Log (DEBUG, "Xmodem Sending POLL"); 167 | end if; 168 | Redirector.Send_Data ("" & 'C'); -- POLL 169 | while not Finished loop -- per packet 170 | Packet.Clear; 171 | 172 | if Tracing then 173 | Log (DEBUG, "Xmodem Ready for Packet Header"); 174 | end if; 175 | accept Accept_Data (Char : Character) do 176 | Pkt_Hdr := Char; 177 | end Accept_Data; 178 | 179 | case Pkt_Hdr is 180 | when ASCII.EOT | ASCII.SUB => 181 | if Tracing then 182 | Log (DEBUG, "Xmodem Got EOT (End of Transmission)"); 183 | end if; 184 | Redirector.Send_Data ("" & ASCII.ACK); 185 | if Tracing then 186 | Log (DEBUG, "Xmodem Sent final ACK"); 187 | end if; 188 | Finished := True; 189 | when ASCII.SOH => 190 | if Tracing then 191 | Log (DEBUG, "Xmodem Got SOH (Short packets indicator)"); 192 | end if; 193 | Packet_Size := 128; -- short packets 194 | when ASCII.STX => 195 | if Tracing then 196 | Log (DEBUG, "Xmodem Got STX (Long packets indicator)"); 197 | end if; 198 | Packet_Size := 1024; -- long packets 199 | when ASCII.CAN => 200 | raise Sender_Cancelled; 201 | when others => 202 | raise Protocol_Error; 203 | end case; 204 | 205 | if Finished then 206 | Redirector.Set_Handler (Handlr => Visual); 207 | -- final packet may have trailing EOFs 208 | while File_Blob (File_Blob.Last_Index) = ASCII.SUB loop 209 | File_Blob.Delete (File_Blob.Last_Index); 210 | end loop; 211 | for C of File_Blob loop 212 | Character'Write (Write_Stream, C); 213 | end loop; 214 | accept Done; 215 | 216 | else 217 | 218 | accept Accept_Data (Char : Character) do 219 | Packet_Count := Char_To_U8 (Char); 220 | end Accept_Data; 221 | if Tracing then 222 | Log (DEBUG, "Xmodem Got Packet Count " & Packet_Count'Image); 223 | end if; 224 | 225 | accept Accept_Data (Char : Character) do 226 | Inverse_Packet_Count := Char_To_U8 (Char); 227 | end Accept_Data; 228 | if Tracing then 229 | Log (DEBUG, "Xmodem Got Inverse Packet Count " & Inverse_Packet_Count'Image); 230 | end if; 231 | 232 | if (not Packet_Count) /= Inverse_Packet_Count then 233 | if Tracing then 234 | Log (DEBUG, "Xmodem Packet counts not right - sending NAK"); 235 | end if; 236 | Purged := False; 237 | while not Purged loop 238 | select 239 | accept Accept_Data (Char : Character) do 240 | pragma Unreferenced (Char); 241 | end Accept_Data; 242 | or 243 | delay 1.0; 244 | Purged := True; 245 | end select; 246 | end loop; 247 | Redirector.Send_Data ("" & ASCII.NAK); 248 | goto Next_Packet; 249 | end if; 250 | 251 | for B in 1 .. Packet_Size loop 252 | accept Accept_Data (Char : Character) do 253 | Packet.Append (Char); 254 | end Accept_Data; 255 | end loop; 256 | 257 | if Tracing then 258 | Log (DEBUG, "Xmodem - Packet received"); 259 | end if; 260 | 261 | accept Accept_Data (Char : Character) do 262 | Rxd_CRC := Unsigned_16 (Char_To_U8 (Char)); 263 | end Accept_Data; 264 | Rxd_CRC := Shift_Left (Rxd_CRC, 8); 265 | accept Accept_Data (Char : Character) do 266 | Rxd_CRC := Rxd_CRC + Unsigned_16 (Char_To_U8 (Char)); 267 | end Accept_Data; 268 | if Tracing then 269 | Log (DEBUG, "Xmodem Received CRC is " & Rxd_CRC'Image); 270 | end if; 271 | 272 | Calcd_CRC := CRC_16 (Packet); 273 | if Tracing then 274 | Log (DEBUG, "Xmodem Calculated CRC is " & Calcd_CRC'Image); 275 | end if; 276 | 277 | if Rxd_CRC = Calcd_CRC then 278 | if Tracing then 279 | Log (DEBUG, "Xmodem CRCs OK - sending ACK"); 280 | end if; 281 | Redirector.Send_Data ("" & ASCII.ACK); 282 | for C of Packet loop 283 | File_Blob.Append (C); 284 | end loop; 285 | else 286 | Log (WARNING, "Xmodem sending NAK due to CRC error"); 287 | Purged := False; 288 | while not Purged loop 289 | select 290 | accept Accept_Data (Char : Character) do 291 | pragma Unreferenced (Char); 292 | end Accept_Data; 293 | or 294 | delay 1.0; 295 | Purged := True; 296 | end select; 297 | end loop; 298 | Redirector.Send_Data ("" & ASCII.NAK); 299 | 300 | end if; 301 | 302 | end if; 303 | 304 | <> 305 | end loop; 306 | end Receiver; 307 | 308 | task body Sender is 309 | Packet_Sz : Packet_Size; 310 | Packet_Length : Positive; 311 | Read_Stream : Stream_Access; 312 | This_Block_No : Natural; 313 | Retries : Natural; 314 | Block : Vector; 315 | Ix : Natural; 316 | Sent_OK : Boolean; 317 | Finished : Boolean; 318 | begin 319 | accept Start (TX_Stream : Stream_Access; Pkt_Len : Packet_Size) do 320 | Read_Stream := TX_Stream; 321 | Packet_Sz := Pkt_Len; 322 | Packet_Length := Pkt_Len'Enum_Rep; 323 | Finished := False; 324 | Retries := 1; 325 | end Start; 326 | if Tracing then 327 | Log (INFO, "Xmodem Sender waiting for POLL"); 328 | end if; 329 | select 330 | accept Accept_Data (Char : Character) do 331 | if Char /= 'C' then 332 | Retries := Retries + 1; 333 | if Retries > 8 then 334 | raise Protocol_Error with "Did not get POLL character"; 335 | end if; 336 | if Tracing then 337 | Log (INFO, "Xmodem Sender did not get POLL - retrying"); 338 | end if; 339 | else 340 | Retries := 0; 341 | end if; 342 | end Accept_Data; 343 | while Retries /= 0 loop 344 | accept Accept_Data (Char : Character) do 345 | if Char /= 'C' then 346 | Retries := Retries + 1; 347 | if Retries > 8 then 348 | raise Protocol_Error with "Did not get POLL character"; 349 | end if; 350 | if Tracing then 351 | Log (INFO, "Xmodem Sender did not get POLL - retrying"); 352 | end if; 353 | else 354 | Retries := 0; 355 | end if; 356 | end Accept_Data; 357 | end loop; 358 | 359 | if Tracing then 360 | Log (DEBUG, "Xmodem Sender got POLLed"); 361 | end if; 362 | This_Block_No := 1; -- 1st block is #1, not 0 363 | 364 | while not Finished loop 365 | Block.Clear; 366 | Ix := 0; 367 | -- Read a packet's worth of data from the file 368 | while Ix < Packet_Length and then not Finished loop 369 | declare 370 | One_Char : Character; 371 | begin 372 | Character'Read (Read_Stream, One_Char); 373 | Block.Append (One_Char); 374 | Ix := Ix + 1; 375 | exception 376 | when End_Error => 377 | Finished := True; 378 | end; 379 | end loop; 380 | 381 | Retries := 0; 382 | Sent_OK := False; 383 | -- attempt to send the packet up to 9 times 384 | while not Sent_OK and then Retries < 9 loop 385 | Send_Block (Data => Block, Block_Num => This_Block_No, Block_Size => Packet_Sz); 386 | select 387 | accept Accept_Data (Char : Character) do 388 | case Char is 389 | when ASCII.ACK => 390 | This_Block_No := This_Block_No + 1; 391 | if Tracing then 392 | Log (DEBUG, "Xmodem Sent block ACKed"); 393 | end if; 394 | Sent_OK := True; 395 | if This_Block_No = 256 then 396 | This_Block_No := 0; 397 | end if; 398 | when ASCII.NAK => 399 | if Tracing then 400 | Log (DEBUG, "Xmodem Sent block NAKed"); 401 | end if; 402 | Sent_OK := False; 403 | Retries := Retries + 1; 404 | when others => 405 | raise Protocol_Error with "unexpected response to data packet"; 406 | end case; 407 | end Accept_Data; 408 | or 409 | delay 5.0; 410 | raise Timeout with "exceeded timeout waiting for ACK"; 411 | end select; 412 | end loop; -- retries 413 | if not Sent_OK then 414 | raise Too_Many_Retries; 415 | end if; 416 | end loop; 417 | Redirector.Send_Data ("" & ASCII.EOT); 418 | accept Done; 419 | or 420 | delay 30.0; 421 | raise Timeout with "exceeded timeout waiting for POLL"; 422 | end select; 423 | 424 | end Sender; 425 | 426 | procedure Send (Filename : String; Pkt_Len : Packet_Size; Trace_Flag : Boolean) is 427 | TX_File : File_Type; 428 | TX_Stream : Stream_Access; 429 | begin 430 | Tracing := Trace_Flag; 431 | if not Ada.Directories.Exists (Filename) then 432 | raise File_Does_Not_Exist; 433 | end if; 434 | Open (File => TX_File, Mode => In_File, Name => Filename); 435 | Redirector.Set_Handler (Handlr => Xmodem_Tx); 436 | Sender_Task := new Sender; 437 | TX_Stream := Stream (TX_File); 438 | Sender_Task.Start (TX_Stream => TX_Stream, Pkt_Len => Pkt_Len); 439 | loop 440 | select 441 | Sender_Task.Done; 442 | Log (INFO, "Xmodem Transmit is complete"); 443 | Close (TX_File); 444 | Redirector.Set_Handler (Handlr => Visual); 445 | exit; 446 | or 447 | delay 1.0; 448 | if Tracing then 449 | Log (DEBUG, "Xmodem waiting for Transmission to complete"); 450 | end if; 451 | end select; 452 | end loop; 453 | exception 454 | when others => 455 | raise File_Access_Error; 456 | end Send; 457 | 458 | end Xmodem; -------------------------------------------------------------------------------- /src/xmodem.ads: -------------------------------------------------------------------------------- 1 | -- Copyright ©2022 Steve Merrony 2 | -- 3 | -- Permission is hereby granted, free of charge, to any person obtaining a copy 4 | -- of this software and associated documentation files (the "Software"), to deal 5 | -- in the Software without restriction, including without limitation the rights 6 | -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | -- copies of the Software, and to permit persons to whom the Software is 8 | -- furnished to do so, subject to the following conditions: 9 | -- The above copyright notice and this permission notice shall be included in 10 | -- all copies or substantial portions of the Software. 11 | -- 12 | -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 13 | -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 14 | -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 16 | -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 17 | -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 18 | -- THE SOFTWARE. 19 | 20 | with Ada.Containers; use Ada.Containers; 21 | with Ada.Containers.Vectors; 22 | with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; 23 | with Ada.Unchecked_Conversion; 24 | 25 | with Interfaces; use Interfaces; 26 | 27 | package Xmodem is 28 | 29 | type Packet_Size is (Short, Long); 30 | for Packet_Size use (Short => 128, Long => 1024); 31 | 32 | package Char_Vectors is new Ada.Containers.Vectors (Index_Type => Natural, Element_Type => Character); 33 | use Char_Vectors; 34 | 35 | task type Receiver is 36 | entry Start (RX_Stream : Stream_Access); 37 | entry Accept_Data (Char : Character); 38 | entry Done; 39 | -- entry Stop; 40 | end Receiver; 41 | type Receiver_Acc is access Receiver; 42 | 43 | Receiver_Task : Receiver_Acc; 44 | 45 | procedure Receive (Filename : String; Trace_Flag : Boolean); 46 | 47 | task type Sender is 48 | entry Start (TX_Stream : Stream_Access; Pkt_Len : Packet_Size); 49 | entry Accept_Data (Char : Character); 50 | entry Done; 51 | end Sender; 52 | type Sender_Acc is access Sender; 53 | 54 | Sender_Task : Sender_Acc; 55 | 56 | procedure Send (Filename : String; Pkt_Len : Packet_Size; Trace_Flag : Boolean); 57 | 58 | Already_Exists, 59 | File_Does_Not_Exist, 60 | File_Access_Error, 61 | Protocol_Error, 62 | Sender_Cancelled, 63 | Timeout, 64 | Too_Many_Retries : exception; 65 | 66 | private 67 | 68 | function Char_To_U8 is new Ada.Unchecked_Conversion (Character, Unsigned_8); 69 | function Byte_To_Char is new Ada.Unchecked_Conversion (Unsigned_8, Character); 70 | 71 | function CRC_16 (Data : Vector) return Unsigned_16; 72 | -- Calculate the CRC-16 value of the provided block of data 73 | 74 | function CRC_16_Fixed_Len (Data : Vector; FL : Positive) return Unsigned_16; 75 | -- Calculate the CRC-16 Constant for the provided block of data 76 | 77 | procedure Send_Block (Data : in out Vector; Block_Num : Natural; Block_Size : Packet_Size); 78 | 79 | Tracing : Boolean; 80 | 81 | end Xmodem; --------------------------------------------------------------------------------