## ansi-term-dev.pkg
## All rights reserved.
# Compiled by:
#
src/lib/prettyprint/big/devices/prettyprint-devices.sublib# A pretty-printing device for text output to ANSI terminals.
# This device supports the standard ANSI output attributes.
### "We should give society not what
### it asks for, but what it needs."
###
### -- E.J. Dijkstra
stipulate
package fil = file__premicrothread; # file__premicrothread is from
src/lib/std/src/posix/file--premicrothread.pkg package ns = number_string; # number_string is from
src/lib/std/src/number-string.pkg package wnx = winix__premicrothread; # winix__premicrothread is from
src/lib/std/winix--premicrothread.pkgherein
package ansi_terminal_device: (weak)
api {
include Prettyprint_Device # Prettyprint_Device is from
src/lib/prettyprint/big/src/prettyprint-device.api where
Style == List( ansi_terminal::Style );
# Create an output device; if the underlying stream is connected to a TTY,
# then styled output is enabled, otherwise it will be disabled.
open_device
:
{ dst: fil::Output_Stream,
wid: Int
}
->
Device;
# enable/disable/query styled output.
#
# styleMode (dev, NULL) -- query current mode
# styleMode (dev, THE TRUE) -- enable styled output
# styleMode (dev, THE FALSE) -- disable styled output
#
# This function returns the previous state of the device.
# NOTE: this function raises FAIL if called while a style is active.
style_mode: ((Device, Null_Or( Bool )) ) -> Bool;
}
{
package a = ansi_terminal; # ansi_terminal is from
src/lib/src/ansi-term.pkg State
=
{ fg: Null_Or( a::Color ), # NULL is default color for terminal
bg: Null_Or( a::Color ), # NULL is default color for terminal
bold: Bool,
blink: Bool,
ul: Bool,
reverse: Bool,
invis: Bool
};
init_state
=
{ fg => NULL,
bg => NULL,
bold => FALSE,
blink => FALSE,
ul => FALSE,
reverse => FALSE,
invis => FALSE
};
# Compute the commands to transition from one state to another
fun transition (s1: State, s2: State)
=
{ fun needs_color_reset proj
=
case (proj s1, proj s2)
(THE _, NULL) => TRUE;
_ => FALSE;
esac;
fun needs_reset proj
=
case (proj s1, proj s2)
(TRUE, FALSE) => TRUE;
_ => FALSE;
esac;
# Does the state transition require resetting the attributes first?
reset = needs_color_reset .fg
or needs_color_reset .bg
or needs_reset .bold
or needs_reset .blink
or needs_reset .ul
or needs_reset .reverse
or needs_reset .invis;
# Compute the commands to set the foreground color
mv =
case (reset, s1.fg, s2.fg)
(FALSE, THE c1, THE c2)
=>
if (c1 == c2 ) []; else [a::FG c2];fi;
(_, _, THE c) => [a::FG c];
(_, _, NULL) => [];
esac;
# Compute the commands to set the background color
mv =
case (reset, s1.bg, s2.bg)
(FALSE, THE c1, THE c2)
=>
if (c1 == c2 ) mv; else a::FG c2 ! mv;fi;
(_, _, THE c) => a::BG c ! mv;
(_, _, NULL) => mv;
esac;
# Compute the commands to set the other display attributes
fun add (proj, cmd, mv)
=
if ((reset or not (proj s1)) and proj s2)
cmd ! mv;
else mv; fi;
mv = add (.bold, a::BF, mv);
mv = add (.blink, a::BLINK, mv);
mv = add (.ul, a::UL, mv);
mv = add (.reverse, a::REV, mv);
mv = add (.invis, a::INVIS, mv);
case (reset, mv)
(FALSE, []) => "";
(TRUE, []) => a::to_string [];
(TRUE, mv) => a::to_string [] + a::to_string mv;
(FALSE, mv) => a::to_string mv;
esac;
};
# Apply a command to a state
fun update_state1 (cmd, { fg, bg, bold, blink, ul, reverse, invis } )
=
case cmd
a::FG c => { fg=>THE c, bg, bold, blink, ul, reverse, invis };
a::BG c => { fg, bg=>THE c, bold, blink, ul, reverse, invis };
a::BF => { fg, bg, bold=>TRUE, blink, ul, reverse, invis };
a::BLINK => { fg, bg, bold, blink=>TRUE, ul, reverse, invis };
a::UL => { fg, bg, bold, blink, ul=>TRUE, reverse, invis };
a::REV => { fg, bg, bold, blink, ul, reverse=>TRUE, invis };
a::INVIS => { fg, bg, bold, blink, ul, reverse, invis=>TRUE };
esac;
# Apply a sequence of commands to a state
fun update_state ( [], st) => st;
update_state (cmd ! r, st) => update_state (r, update_state1 (cmd, st));
end;
Style
=
List( a::Style );
Device
=
DEV {
mode: Ref( Bool ),
dst: fil::Output_Stream,
wid: Int,
stk: Ref( List( State ) )
};
fun top [] => init_state;
top (st ! r) => st;
end;
fun same_style (s1: Style, s2)
=
s1 == s2;
fun push_style (DEV { mode, dst, wid, stk }, sty)
=
if *mode
#
cur_st = top *stk;
new_st = update_state (sty, cur_st);
fil::write (dst, transition (cur_st, new_st));
stk := new_st ! *stk;
fi;
fun pop_style (DEV { mode, dst, wid, stk } )
=
if *mode
#
case *stk
#
[] => ();
cur_st ! r
=>
{ new_st = top r;
#
fil::write (dst, transition (cur_st, new_st));
stk := r;
};
esac;
fi;
fun default_style _
=
[];
fun is_tty out_s # Return TRUE iff an output_stream is a TTY.
=
{ (fil::pur::get_writer (fil::get_outstream out_s))
->
(winix_base_text_file_io_driver_for_posix__premicrothread::FILEWRITER { io_descriptor, ... }, _);
case io_descriptor
#
THE iod => (wnx::io::iod_to_iodkind iod == wnx::io::CHAR_DEVICE);
_ => FALSE;
esac;
};
fun open_device { dst, wid }
=
DEV {
dst,
wid,
mode => REF (is_tty dst),
stk => REF []
};
fun depth _ # Maximum printing depth (in terms of boxes)
=
NULL;
fun line_width (DEV { wid, ... } ) # The width of the device.
=
THE wid;
fun text_width _ # The suggested maximum width of text on a line.
=
NULL;
fun space (DEV { dst, ... }, n) # Write some number of spaces to the device.
=
fil::write (dst, ns::pad_left ' ' n "");
# Write a new-line to the device
fun newline (DEV { dst, ... } )
=
fil::write_one (dst, '\n');
# Write a string/character in the current style to the device:
fun string (DEV { dst, ... }, s) = fil::write (dst, s);
fun char (DEV { dst, ... }, c) = fil::write_one (dst, c);
fun flush (DEV { dst, ... } ) # If the device is buffered, then flush any buffered output.
=
fil::flush dst;
# Enable styled output by passing TRUE to this function.
# Rturn the previous state of the device:
fun style_mode (DEV { stk => REF(_ ! _), ... }, _)
=>
raise exception FAIL "attempt to change mode inside scope of style";
style_mode (DEV { mode, ... }, NULL)
=>
*mode;
style_mode (DEV { mode as REF m, ... }, THE flag)
=>
{ mode := flag;
m;
};
end;
};
end;