TUI Dialect - A dialect to print ASCII sequences

I post here an interesting guide: Author: Ingo Hohmann


With REBOL 2.1 and on we got the ability to use ASCII sequences in REBOL's 'print statements, to control cursor behaviour. A really big step, because now we could do nifty things like:

print "^[[J^[[10;10HHello World!"


Which would, actually, clear the screen, put the cursor at position 10, 10 on the screen, and print "Hello World!". That's nice enough for REBOL to print, but not for me to write, or even understand later. So, what could be done to make writing those strings easier?

First Steps

A first idea could be to save the control sequences to some word, thus having:

cls: "^(1B)[J"


Now the above could be written as:
print rejoin [ cls "^[[10;10HHello World!"]


Which is better readable than our first version, but has two disadvantages:

• words for the ascii strings clutter the global namespace
• we can't do positioning strings like that, because the position has to be added into the ASCII sequence.

Next take:

we'll create a single function, with refinements for every ASCII command, like this:

cursor1: func [
    "Positions the cursor"
    /clear "clears the screen"
    /pos "sets cursor to position row, col"
    posi [pair! ]
    /local ret
] [
    pre: copy "^(1B)["
    any [
        all [
            clear ret: join pre "J"
        ]
        all [
            pos ret: join pre rejoin [
                posi/x ";" posi/y "H"
            ]
        ]
    ]
    ret
]


Now we can write our little "Hello World" message this way:
print rejoin [cursor1/clear cursor1/pos 10x10 "Hello World!" ]



What I didn't like about it, that was the "/" notation used, so I decided to settle to write a dialect to position the cursor.
A Cursor Positioning Dialect

Creating a dialect means, to create a now mini language, that can be used in a specialized environment within REBOL. This means, dialects are organized as blocks, which are not treated by the normal REBOL interpreter, but by an interpreter written in REBOL.

O.K. first what we'll gain:

print cursor2 [clear pos 10x10 "Hello World!" ]


This will print exactly the same as the string we started with, but it is much easier to understand, and change later, should the need arise.

Have I got you interested? Well, of course, because otherwise you wouldn't have proceded until here...

How to do it

First we'll need a function, that accepts a block:

cursor2: func [
    {Cursor positioning dialect (iho)}
    commands [
        block!
    ]
] [
]


Now we have to get this function interpret the block, this is best done with REBOLs block-parse ability:

cursor2: func [
    {Cursor positioning dialect (iho)}
    commands [
        block!
    ]
] [
    parse commands rules
]


And now all we need to do is fill in the rules ;-)

Let's proceed slowly, we have seen above, that we want to use specific words, to trigger output of the respective ASCII commands, let's give it a try:


rules: [
    any [
        'clear | 'at
    ]
]


Using this rule, our function will correctly parse a block containing any sequence of the words 'clear 'at:

cursor2: func [
    {Cursor positioning dialect (iho)}
    commands [
        block!
    ]
    /local rules
] [
    rules: [
        any [
            'clear | 'at
        ]
    ]
    parse commands rules
]


>> cursor2 [ clear at at clear at ]
== true

Nice, isn't it? But we need to be able to give the 'at command the actual coordinates to put the cursor, and, well, I'd like to be able to insert Text-strings right between the commands, so we need to parse looking for data-types: (While I'm only changing the rules block, I'll not print the whole function again ...)

rules: [
    any [
        'clear |
        'at set arg pair! |
        set arg string!
    ]
]

Now our dialect block can contain elements like

just the word 'clear
the word 'at, followed by a pair, this pair! will be saved into arg
strings

Let's give it a try again:

>> Cursor2 [ clear at 10x10 "Hi World!" ]
== true

Yup, so far it works, but now we want it to make some real output.

rules: [
    any [
        'clear (append string "^(1B)[J") |
        'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
        set arg string! (append string arg)
    ]
]


Now, the part in parens is normal REBOL code, that gets executed, whenever the the part before it matches, now let's update our function with some things we need, and give it a try.

cursor2: func [
    {Cursor positioning dialect (iho)}
    commands [
        block!
    ]
    /local rules string arg
] [
    string: copy "" ; Don't forget 'copy here ...
    rules: [
        any [
            'clear (append string "^(1B)[J") |
            'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
            set arg string! (append string arg)
        ]
    ]
    parse commands rules
    string
]


>> print Cursor2 [ clear at 10x10 "Hi World!" ]

Aaaahhhhh, it worked like a charm, here. Now, what have we done since the last time we looked at the function? We made some new words local, initialized an empty string, that holds the return value, and the last thing, we return this value. Great.

Now you could go ahead, read the REBOL documentation, and fill in words for other ASCII commands, but wait, I want to do some little fine-tuning, first.

Think about it, wouldn't it be nice, if we could include arbitrary REBOL Code within the dialect? Maybe like you want include a row of dashes, of computed length.

Let's add a command to repeat a given string:

rules: [
    any [
        'clear (append string "^(1B)[J") |
        'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
        set cnt integer! set arg string! (append string head insert/dup copy "" arg cnt) |
        set arg string! (append string arg)
    ]
]


Let's try:

>> print cursor2 [ clear 10 "-" ]

It works, but where's the promised REBOL Code support? Just a wee little moment of patience. Here it is, the 'command function. All we actually have to do is run the dialect block through compose first, like this:

cursor2: func [
    {Cursor positioning dialect (iho)}
    commands [
        block!
    ]
    /local rules string arg
] [
    string: copy ""
    commands: compose commands ; NEW LINE HERE
    rules: [
        any [
            'clear (append string "^(1B)[J") |
            'at set arg pair! (append string rejoin ["^(1B)[" arg/x ";" arg/y "H"]) |
            set cnt integer! set arg string! (
append string head insert/dup copy "" arg cnt
) |
            set arg string! (append string arg)
        ]
    ]
    parse commands rules
    string
]


>> x: 10x10
== 10x10
>> print cursor2 [ clear at (x) "Hello World!" at 11x10 (length? "Hello World!") "-" ]

What I am still missing, I want to know about the screen size, for some computation, can we add this, too? Sure.

To get the screen-size, we first have to print the ASCII command, and then read the data from the console port, and understand it, of course. Here's what I want to add to our dialect function:

; Don't forget to add 'screen-size to our functions locals
screen-size: (
; for Rebol Version 1.3
; c: open/binary [scheme: 'console]
; for later versions (changes in port handling)
c: open/binary/no-wait [scheme: 'console]
prin "^(1B)[7n"
arg: next next to-string copy c
close c
arg: parse/all arg ";R"
forall arg [change arg to-integer first arg]
arg: to-pair head arg
)


So, we're setting screen-size to what the whole parent expression evaluates to. That's,

• open port to the console
• print the ASCII command for "get screen dimension"
• get the return value (copy c)
• convert it to a string - this will be something like "^[[48;110R" - 48 lines, 110 columns wide
• skip the first two characters, and assign to arg
• close the port
• split the string, removing ";" and "R" - [ "48" "110" ]
• change those values into integers!
• and make a pair! from that block

Now we have the screen-dimensions as a block in 'screen-size, let's try it out:
>> print cursor2 [ clear (screen-size/y) "-" ]
** Script Error: screen-size has no value.
** Where: screen-size/y

That's not exactly what we wanted, is it? The problem here is, 'compose runs the code in the dialect in the global context, where screen-size isn't defined, because it's only local to cursor2. So we have to manually 'bind it to this functions context, to be able to access the value, it's done like this:

Change the line


commands: compose commands


to


commands: compose bind commands 'screen-size


This tells REBOL, whenever you find a word you don't understand while working on our command string, try to find it where you can find 'screen-size right now.
Time for a final version

This text is already much longer than I planned it, so maybe we should just have a look at the final version.

I included some more words in the dialect, and a limited error handling, but you'll see ...

cursor2: func [
    {Cursor positioning dialect (iho)} [
        catch
    ]
    commands [
        block!
    ]
    /local screen-size string arg cnt cmd c err
] [
    ; get the size of the screen
    screen-size: (
; for Rebol Version 1.3
; c: open/binary [scheme: 'console]
; for later versions (changes in port handling)
c: open/binary/no-wait [scheme: 'console]
prin "^(1B)[7n"
arg: next next to-string copy c
close c
arg: parse/all arg ";R"
forall arg [change arg to-integer first arg]
arg: to-pair head arg
)

    ; some setup
    string: copy ""

    ; I added this little func, so I don't have to write the start
    ; of all the commands over and over
    cmd: func [
        s
    ] [
        join "^(1B)[" s
    ]

    ; compose, so that () in the dialect gets reduced
    ; and catch any error within, then throw it again ...
    if error? set/any 'err try [
        commands: compose bind commands 'screen-size
    ] [
        throw err
    ]

    ; ready to parse the dialect now (I included the rules block directly)
    arg: parse commands [
        any [
            'direct set arg string! (append string arg) |
            'home (append string cmd "H") |
            'kill (append string cmd "K") |
            'clear (append string cmd "J") |
            'up set arg integer! (append string cmd [arg "A"]) |
            'down set arg integer! (append string cmd [arg "B"]) |
            'right set arg integer! (append string cmd [arg "C"]) |
            'left set arg integer! (append string cmd [arg "D"]) |
            'at set arg pair! (append string cmd [arg/x ";" arg/y "H" ]) |
            'del set arg integer! (append string cmd [arg "P"]) |
            'space set arg integer! (append string cmd [arg "@"]) |
            'move set arg pair! (append string cmd [arg/x ";" arg/y "H" ]) |
            set cnt integer! set arg string! (
append string head insert/dup copy "" arg cnt
) |
            set arg string! (append string arg)
        ]
        end
    ]

    ; ahh, maybe the user made an error when writing commands in
    ; the dialect? throw an error, then
    if not arg [
        throw make error! "Unable to parse block"
    ]

    ;return string to be printed
    string
]


Maybe you wondered about the [catch] in the functions header (or maybe you didn't even notice), what does it do? Instead of trying to describe it, I'll show you the error messages of two cursor2 runs, once with, and once without catch:

Without [catch]

>> print cursor2 [ clear (screen-size/y) "-" x ]
** Throw Error: ** User Error: Unable to parse block.
** Where: throw make error! "Unable to parse block"

With [catch] included

>> print cursor2 [ clear (screen-size/y) "-" x ]
** User Error: Unable to parse block.
** Where: cursor2 [clear (screen-size/y) "-" x]

You see, without [catch] the call of 'throw is displayed as originator of the error, whereas including [catch] displays the call of the dialect as source of the error. I think the latter is much more understandable to the user.

Final thoughts

Creating a dialect is like creating a new language, so you have to be careful about what words you use, and about the grammar.

For example, I started out with 'pos for positioning the cursor, but settled for 'at at last. Because I got into trouble. Is 'pos used to get or set the position? If it sets the position, and I have get-pos for getting, why is there no set-pos? So, better use 'at and 'where, in my opinion.

Some rules: words should be,

• easy to remember
• hard to misunderstand
• short (?)

For the repeat string command, I haven't actually included a command, I wan't able to decide what to use

'repeat integer! string! (repeat 3 ".")
'repeat string! integer! (repeat "." 3)
'repeat string! 'x integer! (repeat "." x 3)
.
.
.

So I thought this is short, and understandable, and not likely to be misunderstood/misused.

And last, I return the string instead of printing it directly, this way you are free to save the string returned for later use, without the need to run the dialect again.