FreeOberon/Programs/Gui.Mod

MODULE Gui;
IMPORT G := Graph, Strings, Out;

TYPE
  Caption* = POINTER TO CaptionDesc;
  CaptionDesc* = RECORD
    s*: ARRAY 100 OF CHAR
  END;

  DrawHandler* = PROCEDURE (W: Widget; x, y: INTEGER);
  MouseDownHandler* = PROCEDURE (W: Widget; x, y, btn: INTEGER);

  Widget* = POINTER TO WidgetDesc;
  WidgetDesc* = RECORD
    x*, y*, w*, h*: INTEGER;
    body*: Widget;
    text*: Caption;
    bmp*: G.Bitmap;
    parent*: Widget;
    prev*, next*: Widget;
    draw*: DrawHandler;
    (* Event Handlers *)
    onMouseDown*: MouseDownHandler
  END;

  Window* = POINTER TO WindowDesc;
  WindowDesc* = RECORD(WidgetDesc)
    win*: G.Window
  END;

VAR
  Done*: BOOLEAN;
  exitRunLoop: BOOLEAN; (* See procedure Run *)
  font: G.Font;

  newWindowSettings: SET;
  ZZZ: INTEGER;

  globalWin: Window; (* !FIXME *)

(* Widget *)

PROCEDURE SetOnMouseDown*(W: Widget; handler: MouseDownHandler);
BEGIN
  W.onMouseDown := handler
END SetOnMouseDown;

PROCEDURE InitWidget*(w: Widget);
BEGIN
  w.x := 0; w.y := 0; w.w := 24; w.h := 24;
  w.draw := NIL;
  w.onMouseDown := NIL;

  (* Замок *)
  NEW(w.body); w.body.prev := w.body; w.body.next := w.body
END InitWidget;

PROCEDURE SetText*(w: Widget; s: ARRAY OF CHAR);
BEGIN
  IF w.text = NIL THEN NEW(w.text) END;
  Strings.Copy(s, w.text.s)
END SetText;

PROCEDURE Place*(where, what: Widget; x, y: INTEGER);
BEGIN
  what.x := x; what.y := y;

  (* Добавление в кольцо с замком *)
  what.prev := where.body.prev;
  what.next := where.body;
  where.body.prev.next := what;
  where.body.prev := what
END Place;

(* Window *)

PROCEDURE NewWindowSettings*(settings: SET);
BEGIN
  newWindowSettings := settings
END NewWindowSettings;

PROCEDURE DrawWidget(W: Widget; x, y: INTEGER);
BEGIN
  W.draw(W, x + W.x, y + W.y)
END DrawWidget;

PROCEDURE DrawBody*(W: Widget; x, y: INTEGER);
VAR p: Widget;
BEGIN
  p := W.body.next;
  WHILE p # W.body DO
    DrawWidget(p, x, y);
    p := p.next
  END
END DrawBody;

PROCEDURE DrawWindow*(W: Widget; x, y: INTEGER);
VAR c: G.Color;
  w, h: INTEGER;
BEGIN
  G.MakeCol(c, ZZZ * 40 MOD 256, 120, 120);
  G.ClearToColor(c);
  G.MakeCol(c, 0, 0, ZZZ * 20 MOD 256);
  G.GetScreenSize(w, h);
  G.Rect(5, 5, w - 6, h - 6, c);

  DrawBody(W, x, y)
END DrawWindow;

PROCEDURE InitWindow*(win: Window; w, h: INTEGER);
BEGIN
  InitWidget(win);
  win.win := G.NewWindow(-1, -1, w, h,
    'Window', newWindowSettings);
  win.x := 0; win.y := 0;
  win.w := win.win.w; win.h := win.win.h;
  win.draw := DrawWindow
END InitWindow;

PROCEDURE NewWindow*(w, h: INTEGER): Window;
VAR win: Window;
BEGIN
  NEW(win);
  InitWindow(win, w, h);
  globalWin := win
RETURN win END NewWindow;

(* Draw *)

PROCEDURE DrawAll;
BEGIN
  globalWin.draw(globalWin, 0, 0);
  G.Flip
END DrawAll;

(* Fonts *)

PROCEDURE GetFont*(W: Widget): G.Font;
RETURN font END GetFont;

(* General *)

PROCEDURE TriggerOnMouseDown*(W: Widget; x, y, btn: INTEGER);
BEGIN
  IF (W # NIL) & (W.onMouseDown # NIL) THEN
    W.onMouseDown(W, x, y, btn)
  END
END TriggerOnMouseDown;

PROCEDURE FindWidgetUnderMouse*(W: Widget; VAR x, y: INTEGER): Widget;
VAR p: Widget;
BEGIN
  IF W = NIL THEN p := W
  ELSIF W.body # NIL THEN
    p := W.body.prev;
    WHILE (p # W.body) &
          ~((p.x <= x) & (x < p.x + p.w) &
            (p.y <= y) & (y < p.y + p.h))
    DO p := p.prev
    END;
    IF p = W.body THEN p := W END
  ELSE p := NIL
  END
RETURN p END FindWidgetUnderMouse;

PROCEDURE HandleMouseDownEvent*(e: G.Event);
VAR W: Widget;
  x, y: INTEGER;
BEGIN
  x := e.x; y := e.y;
  W := FindWidgetUnderMouse(globalWin, x, y);
  TriggerOnMouseDown(W, x, y, e.button)
END HandleMouseDownEvent;

PROCEDURE HandleEvent(e: G.Event);
BEGIN
  IF e.type = G.mouseDown THEN
    HandleMouseDownEvent(e)
  ELSIF e.type = G.keyDown THEN
    IF e.key = G.kEsc THEN exitRunLoop := TRUE END;
    INC(ZZZ)
  ELSIF e.type = G.quit THEN
    exitRunLoop := TRUE
  END
END HandleEvent;

PROCEDURE Run*;
VAR e: G.Event;
BEGIN
  exitRunLoop := FALSE;
  REPEAT
    WHILE G.HasEvents() DO
      G.WaitEvent(e);
      HandleEvent(e)
    END;
    DrawAll
  UNTIL exitRunLoop
END Run;

PROCEDURE Init*;
BEGIN
  G.Settings(0, 0, {G.manual});
  G.Init;
  IF G.Done THEN
    font := G.LoadFont('../Data/Fonts/Main');
    IF font = NIL THEN
      Out.String('Gui: Could not load font.'); Out.Ln;
      Done := FALSE
    END
  ELSE Done := FALSE
  END
END Init;

PROCEDURE Close*;
BEGIN
  G.Close
END Close;

BEGIN
  Done := TRUE;
  ZZZ := 0
END Gui.