GajuDesk/src/gd_sophia_editor.erl

-module(gd_sophia_editor).
-vsn("0.7.0").
-export([new/1, update/2,
         get_text/1, set_text/2]).

-include("$zx_include/zx_logger.hrl").
-include_lib("wx/include/wx.hrl").


%%% Formatting Constants

%% Style labels
-define(DEFAULT,    0).
-define(KEYWORD,    1).
-define(IDENTIFIER, 2).
-define(COMMENT,    3).
-define(STRING,     4).
-define(NUMBER,     5).
-define(OPERATOR,   6).



%% Color palette

% Intensities:
-define(H, 255). % High
-define(M, 192). % Medium
-define(L, 128). % Low
-define(X,  32). % X-Low
-define(Z,   0). % Zilch


% RGB values
%                        R   G   B
-define(black,         {?Z, ?Z, ?Z}).
-define(light_red,     {?H, ?Z, ?Z}).
-define(light_green,   {?Z, ?H, ?Z}).
-define(light_blue,    {?Z, ?Z, ?H}).
-define(yellow,        {?H, ?H, ?Z}).
-define(light_magenta, {?H, ?Z, ?H}).
-define(light_cyan,    {?Z, ?H, ?H}).
-define(high_white,    {?H, ?H, ?H}).
-define(red,           {?L, ?Z, ?Z}).
-define(green,         {?Z, ?L, ?Z}).
-define(blue,          {?Z, ?Z, ?L}).
-define(brown,         {?L, ?L, ?Z}).
-define(magenta,       {?L, ?Z, ?L}).
-define(cyan,          {?Z, ?L, ?L}).
-define(not_black,     {?X, ?X, ?X}).
-define(grey,          {?L, ?L, ?L}).
-define(white,         {?M, ?M, ?M}).

styles() ->
    [?DEFAULT,
     ?KEYWORD,
     ?IDENTIFIER,
     ?COMMENT,
     ?STRING,
     ?NUMBER,
     ?OPERATOR].

palette(light) ->
    #{?DEFAULT    => ?black,
      ?KEYWORD    => ?blue,
      ?IDENTIFIER => ?cyan,
      ?COMMENT    => ?grey,
      ?STRING     => ?red,
      ?NUMBER     => ?magenta,
      ?OPERATOR   => ?brown,
      bg          => ?high_white};
palette(dark) ->
    #{?DEFAULT    => ?white,
      ?KEYWORD    => ?light_cyan,
      ?IDENTIFIER => ?green,
      ?COMMENT    => ?grey,
      ?STRING     => ?light_red,
      ?NUMBER     => ?light_magenta,
      ?OPERATOR   => ?yellow,
      bg          => ?not_black}.

color_mode() ->
    {R, G, B, _} = wxSystemSettings:getColour(?wxSYS_COLOUR_WINDOW),
    case (lists:sum([R, G, B]) div 3) > 128 of
        true  -> light;
        false -> dark
    end.


new(Parent) ->
    STC = wxStyledTextCtrl:new(Parent),
    ok = wxStyledTextCtrl:setLexer(STC, ?wxSTC_LEX_CONTAINER),
    FontSize = 13,
    Mono = wxFont:new(FontSize,
                      ?wxFONTFAMILY_TELETYPE,
                      ?wxFONTSTYLE_NORMAL,
                      ?wxFONTWEIGHT_NORMAL,
                      [{face, "Monospace"}]),
    SetMonospace = fun(Style) -> wxStyledTextCtrl:styleSetFont(STC, Style, Mono) end,
    ok = lists:foreach(SetMonospace, styles()),
    ok = wxStyledTextCtrl:styleSetFont(STC, ?wxSTC_STYLE_DEFAULT, Mono),
    ok = set_colors(STC),
    STC.

get_text(STC) ->
    wxStyledTextCtrl:getText(STC).

set_text(STC, Text) ->
    ok = wxStyledTextCtrl:setText(STC, Text),
    %% Force Scintilla to request styling for the entire text
    wxStyledTextCtrl:colourise(STC, 0, -1).


set_colors(STC) ->
    ok = wxStyledTextCtrl:styleClearAll(STC),
    Palette = #{bg := BGC} = palette(color_mode()),
    Colorize =
        fun(Style) ->
            Color = maps:get(Style, Palette),
            ok = wxStyledTextCtrl:styleSetForeground(STC, Style, Color),
            ok = wxStyledTextCtrl:styleSetBackground(STC, Style, BGC)
        end,
    ok = wxStyledTextCtrl:styleSetBackground(STC, ?wxSTC_STYLE_DEFAULT, BGC),
    lists:foreach(Colorize, styles()).


update(_Event, STC) ->
    Text = wxStyledTextCtrl:getText(STC),
    case so_scan:scan(Text) of
        {ok, Tokens} ->
            ok = wxStyledTextCtrl:startStyling(STC, 0),
            apply_styles(STC, Tokens);
        {error, _Reason} ->
            ok
    end.


apply_styles(STC, Tokens) ->
    lists:foreach(fun(Token) -> style_token(STC, Token) end, Tokens).


% FIXME: 'qid' is not properly handled. If there are multi-dot qids, they will break
style_token(STC, Token) ->
    {Type, Value} = type_and_value(Token),
    {StartOffset, LengthOffset} = offset(Type),
    {Line, Col} = element(2, Token),
    Length = byte_size(to_binary(Value)) + LengthOffset,
    Style = classify_style(Type, Value),
    Start = wxStyledTextCtrl:positionFromLine(STC, Line - 1) + Col + StartOffset,
    wxStyledTextCtrl:startStyling(STC, Start),
    wxStyledTextCtrl:setStyling(STC, Length, Style).

offset(string) -> { 0, 0};
offset(qid)    -> {-1, 1};
offset(_)      -> {-1, 0}.

to_binary(S) when is_list(S) ->
    unicode:characters_to_binary(S);
to_binary(S) when is_binary(S) ->
    S;
to_binary(I) when is_integer(I) ->
    integer_to_binary(I).


classify_style(Type, Value) ->
    case Type of
        symbol ->
            case lists:member(Value, keywords()) of
                true  -> ?KEYWORD;
                false -> ?OPERATOR
            end;
        id     -> ?IDENTIFIER;
        qid    -> ?IDENTIFIER;
        con    -> ?IDENTIFIER;
        qcon   -> ?IDENTIFIER;
        tvar   -> ?IDENTIFIER;
        string -> ?STRING;
        char   -> ?STRING;
        int    -> ?NUMBER;
        hex    -> ?NUMBER;
        bytes  -> ?NUMBER;
        skip   -> ?COMMENT;
        _      -> ?DEFAULT
    end.


type_and_value({Type, _Line, Value}) -> {Type, Value};
type_and_value({Type, _})            -> {Type, atom_to_list(Type)}.


keywords() ->
    ["contract", "include", "let", "switch", "type", "record", "datatype", "if",
     "elif", "else", "function", "stateful", "payable", "true", "false", "mod",
     "public", "entrypoint", "private", "indexed", "namespace", "interface",
     "main", "using", "as", "for", "hiding", "band", "bor", "bxor", "bnot"].