1:- module(qml,
    2          [ qml_run/1,            % qml_run(+Ui)
    3            qml_run/2,            % qml_run(+Ui, :OnFrame)
    4            qml_run/4,            % qml_run(+Ui, :OnFrame, +State0, +Save0)
    5            qml_get/4,           % qml_get(+Key, -Value) //
    6            qml_get/5,           % qml_get(+Key, -Value, +Default) //
    7            qml_get_save/4,      % qml_get_save(+Key, -Value) //
    8            qml_event/5,         % qml_event(+Tag, +Type, -Event) //
    9            qml_button/3,        % qml_button(?Button) //
   10            qml_contour/2        % qml_contour(+Box, +Point)
   11            ]).   12
   13:- use_module(library(sdl)).   14:- use_module(library(clpBNR)).   15
   16:- meta_predicate qml_run(+, 0).   17:- meta_predicate qml_run(+, 0, +, +).   18
   19%%! \section{Entry points}
   20%%
   21%% A UI is a dict tree whose tags name element types (window, column,
   22%% rectangle, image, button, ...). Each frame:
   23%%
   24%%   1. events are polled into the current state,
   25%%   2. the user-supplied `OnFrame` phrase runs (it may read the previous
   26%%      frame's saved values via qml_get_save/2 and the current events via
   27%%      qml_event/3, binding the reactive variables shared with the UI),
   28%%   3. the render command list is replayed unless it is unchanged.
   29%
   30% qml_run(+Ui) runs a static UI (no per-frame logic).
   31qml_run(Ui) :-
   32   qml_run(Ui, qml_noop, state{}, state{render: []-[]}).
   33
   34% qml_run(+Ui, :OnFrame) runs a UI with per-frame logic but no persistent
   35% state beyond what OnFrame threads itself.
   36qml_run(Ui, OnFrame) :-
   37   qml_run(Ui, OnFrame, state{}, state{render: []-[]}).
   38
   39% qml_run(+Ui, :OnFrame, +State0, +Save0) is the full entry point.
   40%
   41% State0 holds the reactive variables (shared with Ui and OnFrame); it is
   42% the "current frame" container. Save0 holds their concrete initial values
   43% (plus render: []-[]); it is the "previous frame" container that OnFrame
   44% reads through qml_get_save/2. The framework injects onFrame, render,
   45% events and next keys into State0 before running.
   46qml_run(Ui, OnFrame, State0, Save0) :-
   47   put_dict([onFrame: OnFrame, render: R-R, events: [], next: []], State0, State),
   48   put_dict([render: []-[]], Save0, Save),
   49   phrase(setup(Ui), [State, Save], _).
   50
   51%%! \section{State access for OnFrame handlers}
   52%%
   53%% These let an OnFrame phrase read the previous frame's saved values and
   54%% the current frame's events / state without depending on framework
   55%% internals.
   56
   57qml_get(Key, Value) -->
   58   get(Key, Value).
   59qml_get(Key, Value, Default) -->
   60   get(Key, Value, Default).
   61qml_get_save(Key, Value) -->
   62   get_save(Key, Value).
   63qml_event(Tag, Type, Event) -->
   64   get_event(Tag, Type, Event).
   65
   66%%! \section{Built-in button behavior}
   67%%
   68%% qml_button(?Button) is an OnFrame phrase that maintains the `pressed`
   69%% property of a button dict: a left-click inside the button's rectangle
   70%% sets pressed = true, a left-button release sets it back to false.
   71
   72qml_button(Button) -->
   73   get_save(pressed, SavePressed),
   74   qml_button_(SavePressed, Button).
   75qml_button_(true, Button) -->
   76   (  get_event(mousebutton, mousebuttonup, Event),
   77      { Event.button = left }
   78   -> { Button.pressed = false }
   79   ;  { Button.pressed = true }
   80   ).
   81qml_button_(false, Button) -->
   82   (  get_event(mousebutton, mousebuttondown, Event),
   83      { Event.button = left }
   84   -> {  when(
   85             (ground(Button.x),
   86              ground(Button.y),
   87              ground(Button.w),
   88              ground(Button.h)), (
   89             (  qml_contour(Button, Event)
   90             -> Button.pressed = true
   91             ;  Button.pressed = false
   92             )
   93          )) }
   94   ;  { Button.pressed = false }
   95   ).
   96
   97% qml_contour(+Box, +Point) holds when Point lies inside Box (a dict with
   98% x, y, w, h) — the point-in-rectangle test used by qml_button/1.
   99qml_contour(Box, Point) :-
  100   {
  101      Box.x =< Point.x,
  102      Point.x =< Box.x + Box.w,
  103      Box.y =< Point.y,
  104      Point.y =< Box.y + Box.h
  105   }.
  106
  107%%! \section{Framework internals}
  108%
  109% The predicates below implement the DCG state threading, the element
  110% dispatch, the render loop and the built-in elements. They are not part
  111% of the public API but are needed by qml_run/1,2,4.
  112
  113qml_noop --> [].
  114
  115% DCG state primitives. The threaded list is, during setup, a single
  116% state dict [State]; during render it expands to three positions
  117% [Copy, State, Save] (see copy_state//0 / save_state//0).
  118
  119put(Key, Value), [Out] -->
  120   [In],
  121   { put_dict(Key, In, Value, Out) }.
  122get(Key, Value), [In] -->
  123   [In],
  124   { get_dict(Key, In, Value) }.
  125get_save(Key, Value), [Copy, X, Save] -->
  126   [Copy, X, Save],
  127   { get_dict(Key, Save, Value) }.
  128get(Key, Value, Default), [In] -->
  129   [In],
  130   { Value = In.get(Key, Default) }.
  131update(Key, Value, NewValue), [Out] -->
  132   [In],
  133   { get_dict(Key, In, Value, Out, NewValue) }.
  134
  135copy_state, [Copy, X] -->
  136   [X],
  137   { copy_term(X, Copy) }.
  138save_state, [X, Save] -->
  139   [Save, X, _].
  140
  141setup_call_cleanup(Setup, Goal, Cleanup, In, Out) :-
  142   setup_call_cleanup(
  143      Setup,
  144      phrase(Goal, In, Out),
  145      Cleanup).
  146
  147setup(Ui) -->
  148   setup_call_cleanup(
  149      sdl_init([everything]),
  150      call_tag(setup, Ui),
  151      sdl_quit).
  152
  153% call_tag(+Method, +Dict) dispatches on the dict tag: a dict tagged
  154% `rectangle` is handled by rectangle(Method, Dict). This is the QML
  155% "element type resolves to its implementation" step.
  156call_tag(Method, Dict) -->
  157   { is_dict(Dict, Tag) },
  158   call(Tag, Method, Dict).
  159
  160%%! \subsection{Setup traversal}
  161
  162setup_childs(Childs) -->
  163   get(next, Next, []),
  164   {
  165      (  is_dict(Childs)
  166      -> append([Childs], Next, ChildsNext)
  167      ;  append(Childs, Next, ChildsNext)
  168      )
  169   },
  170   put(next, ChildsNext),
  171   setup_next.
  172
  173setup_next -->
  174   get(next, Nexts),
  175   setup_next(Nexts).
  176
  177setup_next([]) -->
  178   render.
  179setup_next([Next | Nexts]) -->
  180   put(next, Nexts),
  181   call_tag(setup, Next).
  182
  183%%! \subsection{Render command list and events}
  184
  185add_render(Goal) -->
  186   update(render, R-[Goal | Rs], R-Rs).
  187add_event(Event) -->
  188   update(events, In, [Event | In]).
  189get_event(Tag, Type, Event) -->
  190   get(events, Events),
  191   {  member(Event, Events),
  192      is_dict(Event, Tag),
  193      get_dict(type, Event, Type),
  194      !
  195   }.
  196
  197%%! \subsection{Built-in elements}
  198
  199% window(setup, _) creates the SDL window/renderer, stores the renderer
  200% in the state, then sets up its children.
  201window(setup, Ui) -->
  202   setup_call_cleanup(
  203      sdl_createwindow(Window, Ui.title, Ui.w, Ui.h, [vulkan, resizable]),
  204      setup_call_cleanup(
  205         sdl_createrenderer(Renderer, Window, null),
  206         (  put(renderer, Renderer),
  207            setup_childs(Ui.get(childs, []))
  208         ),
  209         sdl_destroyrenderer(Renderer)),
  210      sdl_destroywindow(Window)).
  211
  212image(setup, Image) -->
  213   get(renderer, Renderer),
  214   setup_call_cleanup(
  215      setup_call_cleanup(
  216         img_load(Surface, Image.source),
  217         sdl_createtexturefromsurface(Texture, Renderer, Surface),
  218         sdl_destroysurface(Surface)
  219      ),
  220      (  { Rect = rect(Image.x, Image.y, Image.w, Image.h) },
  221         add_render(sdl_rendertexture(Renderer, Texture, null, Rect)),
  222         setup_childs(Image.get(childs, []))
  223      ),
  224      sdl_destroytexture(Texture)
  225   ).
  226
  227rectangle(render, rgba(R, G, B, A), Rect, Fill, Renderer) :-
  228   sdl_setrenderdrawcolor(Renderer, R, G, B, A),
  229   (  Fill
  230   -> sdl_renderfillrect(Renderer, Rect)
  231   ;  sdl_renderrect(Renderer, Rect)
  232   ).
  233
  234rectangle(setup, Rect) -->
  235   get(renderer, Renderer),
  236   {
  237      RectC = rect(Rect.x, Rect.y, Rect.w, Rect.h),
  238      Color = Rect.color,
  239      Fill = Rect.get(fill, false)
  240   },
  241   add_render(rectangle(render, Color, RectC, Fill, Renderer)),
  242   setup_childs(Rect.get(childs, [])).
  243
  244% column(setup, _) is the QML Column layout: children are stacked
  245% vertically, each child's y is reactively bound to the running height.
  246column(setup, Column) -->
  247   {
  248      Y = Column.y,
  249      Childs = Column.childs,
  250      foldl([Child, TopY, BottomY]>>(
  251         get_dict(y, Child, TopY),
  252         get_dict(h, Child, H),
  253         { BottomY == TopY + H }), Childs, Y, _)
  254   },
  255   setup_childs(Childs).
  256
  257% button(setup, _) renders a button; it is filled when pressed.
  258button(setup, Button) -->
  259   get(renderer, Renderer),
  260   {
  261      RectC = rect(Button.x, Button.y, Button.w, Button.h),
  262      Color = Button.color,
  263      Fill = Button.pressed
  264   },
  265   add_render(rectangle(render, Color, RectC, Fill, Renderer)),
  266   setup_childs(Button.get(childs, [])).
  267
  268%%! \subsection{Render loop}
  269
  270render -->
  271   { get_time(Start) },
  272   copy_state,
  273   events,
  274   get(onFrame, MakeFrame),
  275   MakeFrame,
  276   get(renderer, Renderer),
  277   get(render, R-[]),
  278   get_save(render, RSave-[]),
  279   {
  280      (  R == RSave
  281      -> true
  282      ;  sdl_setrenderdrawcolor(Renderer, 0, 0, 0, 255),
  283         sdl_renderclear(Renderer),
  284         maplist(call, R),
  285         sdl_renderpresent(Renderer)
  286      )
  287   },
  288   (  get_event(quit, _, _)
  289   -> []
  290   ;  {  get_time(End),
  291         Sleep is 1/60 - (End - Start),
  292         sleep(Sleep)
  293      },
  294      save_state,
  295      render
  296   ).
  297
  298events -->
  299   (  { sdl_pollevent(Event) }
  300   -> add_event(Event),
  301      events
  302   ;  []
  303   )