OberonCore

(**
 * 1. https://doi.org/10.1214/aoap/1177005878
 * 2. https://groups.google.com/g/comp.lang.fortran/c/5Bi8cFoYwPE
 *)
MODULE xkiss;

TYPE XkissArState = RECORD
    x : INTEGER;
    a0, a1, c : INTEGER;
END;


PROCEDURE XkissArInit(VAR obj : XkissArState; x, a0, a1 : INTEGER);
BEGIN
    obj.x := x;
    obj.a0 := a0 MOD 67108863; (* 2^26 - 1 *)
    obj.a1 := a1 MOD 67108863; (* 2^26 - 1 *)
    obj.c  := 1;
    IF obj.x = 0  THEN obj.x  := 123456 END;
    IF obj.a0 < 0 THEN obj.a0 := 0 END;
    IF obj.a1 < 0 THEN obj.a1 := 0 END
END XkissArInit;


PROCEDURE XkissArNext(VAR obj : XkissArState) : INTEGER;
CONST
    mask26 = 03FFFFFFH;
    mask31 = 07FFFFFFFH;
VAR
    t: INTEGER;
BEGIN
    (* LFSR part *)
    obj.x := ORD(SET(obj.x) / SET(LSH(obj.x, 1)));
    obj.x := ORD(SET(obj.x) / SET(ROR(obj.x, 23)) / SET(ROR(obj.x, 5)));
    (* AWC part *)
    t := obj.a0 + obj.a1 + obj.c;
    obj.a1 := obj.a0;
    obj.c  := LSH(t, -26);
    obj.a0 := ORD(SET(t) * SET(mask26));
    (* Output function *)
    RETURN ORD(SET(mask31) * (SET(obj.x) / SET(LSH(obj.a0, 6)) /
        SET(obj.a1 * 29)))
END XkissArNext;


PROCEDURE XkissArTest() : BOOLEAN;
CONST
    uref = 0453EFE6EH;
VAR
    prng : XkissArState;
    i, u : INTEGER;
BEGIN
    u := 0;
    XkissArInit(prng, 12345678, 3, 2);
    FOR i := 1 TO 1000000 DO
        u := XkissArNext(prng)
    END;
    OUT("Output:    "); OUT(u); OUT(" ");
    OUT("Reference: "); OUT(uref); OUT(" ");
    FOR i := 1 TO 10 DO
        u := XkissArNext(prng);
        OUT(u);
        OUT(" ")
    END;
    RETURN u = uref
END XkissArTest;


BEGIN
    IF XkissArTest() THEN OUT("Passed")
    ELSE                  OUT("Failed")
    END
END xkiss.

MODULE bexmRotator;

VAR
    u : INTEGER;
BEGIN
    u := 8;
    u := ROR(u, 1);
    OUT(u)
END bexmRotator.

VAR xkbcont : ADDRESS;
    xkbkmap : ADDRESS;
    xkbstat : ADDRESS;

VAR dxcbimg : ADDRESS;
    crtpixm : ADDRESS;

    dxkbx11 : ADDRESS;
    x11sext : ADDRESS;
    x11core : ADDRESS;
    x11kmap : ADDRESS;
    x11stat : ADDRESS;

    xdevice : INTEGER;

   xcb_c_pixmap : PROCEDURE@(     c : ADDRESS;
                                  d : INTEGER;
                               data : ADDRESS;
                              width : INTEGER;
                             height : INTEGER;
                              depth : INTEGER;
                                 fg : INTEGER;
                                 bg : INTEGER;
                                gcp : ADDRESS) : INTEGER;

   xkb_x11_sext : PROCEDURE@(     c : ADDRESS;
                  major_xkb_version : INTEGER;
                  minor_xkb_version : INTEGER;
                              flags : INTEGER;
              major_xkb_version_out : ADDRESS;
              minor_xkb_version_out : ADDRESS;
                     base_event_out : ADDRESS;
                     base_error_out : ADDRESS) : INTEGER;
   xkb_x11_core : PROCEDURE@(     c : ADDRESS) : INTEGER;
   xkb_x11_kmap : PROCEDURE@(context: ADDRESS;
                                  c : ADDRESS;
                          device_id : INTEGER;
                              flags : INTEGER) : ADDRESS;
   xkb_x11_stat : PROCEDURE@(keymap : ADDRESS;
                                  c : ADDRESS;
                          device_id : INTEGER) : ADDRESS;


   PROCEDURE mycursor (x,y, w,h : INTEGER ;
                       cs : ARRAY OF SCHR ) : INTEGER;
      VAR s,m, c,  i, n,p :  INTEGER;
          src,msk : ARRAY 32 OF BSET;
   BEGIN
      (* load libxcb-image.so.0 ------------------ *)
      dxcbimg := DLL.dlopen(
                 @'libxcb-image.so.0', DLL.RTLD_LAZY);
      IF dxcbimg < 1 THEN RETURN 0                END;
      crtpixm := DLL.dlsym(dxcbimg,
               @'xcb_create_pixmap_from_bitmap_data');
      PUT(@xcb_c_pixmap, @crtpixm);
      (* ----------------------------------------- *)

      FOR i := 0 TO 31     DO
          src[i] := {}; msk[i] := {}              END;
      FOR i := 0 TO w*h -1 DO
          n := i DIV 32;
          p := i MOD 32;
          IF cs[i] = '*' THEN ICL(src[n], p)      END;
          IF cs[i] # ' ' THEN ICL(msk[n], p)  END END;

      s := xcb_c_pixmap(connect, xscreen.root, @src,
                                    w, h, 1, 0, 0,0 );
      m := xcb_c_pixmap(connect, xscreen.root, @msk,
                                    w, h, 1, 0, 0,0 );
      c := XCB.xcb_generate_id(connect);
      XCB.xcb_create_cursor(connect, c ,
          s,m, 0H,0H,0H, 0DD00H, 0FFFFH, 0FFFFH, x,y);

      XCB.xcb_flush(connect);

      XCB.xcb_free_pixmap(connect, s);
      XCB.xcb_free_pixmap(connect, m);

      dxcbimg := DLL.dlclose(dxcbimg);

      RETURN c ;
   END mycursor;


PROCEDURE StartXKB(  );
BEGIN
   (* обязательная установка локали ----------------- *)
   IF Lib.setlocale(Lib.LC_CTYPE, @(0X+0X)) > 0 THEN END;

   (* расширение xkbcommon-x11 ---------------------- *)
   dxkbx11 := DLL.dlopen(
                @'libxkbcommon-x11.so.0', DLL.RTLD_LAZY);
   IF dxkbx11 > 0 THEN
   x11sext := DLL.dlsym(dxkbx11,
                         @'xkb_x11_setup_xkb_extension');
   x11core := DLL.dlsym(dxkbx11,
                 @'xkb_x11_get_core_keyboard_device_id');
   x11kmap := DLL.dlsym(dxkbx11,
                      @'xkb_x11_keymap_new_from_device');
   x11stat := DLL.dlsym(dxkbx11,
                       @'xkb_x11_state_new_from_device');
   PUT(@xkb_x11_sext, @x11sext);
   PUT(@xkb_x11_core, @x11core);
   PUT(@xkb_x11_kmap, @x11kmap);
   PUT(@xkb_x11_stat, @x11stat);

   (* инициализация xkbcommon с xkbcommon-x11 ------- *)
   xkbcont := XKB.xkb_context_new(
                               XKB.XKB_CONTEXT_NO_FLAGS);
   xdevice := xkb_x11_sext(connect, 1,0, 0, 0,0, 0,0   );
   xdevice := xkb_x11_core(connect);
   xkbkmap := xkb_x11_kmap(xkbcont, connect,
               xdevice, XKB.XKB_KEYMAP_COMPILE_NO_FLAGS);
   xkbstat := xkb_x11_stat(xkbkmap, connect, xdevice   );

                  ELSE
   (* инициализация xkbcommon без xkbcommon-x11 ----- *)
   xkbcont := XKB.xkb_context_new(
                               XKB.XKB_CONTEXT_NO_FLAGS);
   xkbkmap := XKB.xkb_keymap_new_from_names(xkbcont, 0,
                        XKB.XKB_KEYMAP_COMPILE_NO_FLAGS);
   xkbstat := XKB.xkb_state_new(xkbkmap)             END;

   // dxkbx11 := DLL.dlclose(dxkbx11);
END StartXKB;


// пример обработки нажатия клавиши на клавиатуре

      XCB.XCB_KEY_PRESS      :
                          but := ORD(BIT(k_event.detail) * BIT(0FFH) );
                          key := {}; set := BIT(k_event.state        );

                          (* модификаторы shift, control, alt       *)
                          depress := ORD(set * BIT(
                                                XCB.XCB_MOD_MASK_SHIFT
                                            + XCB.XCB_MOD_MASK_CONTROL
                                            + XCB.XCB_MOD_MASK_1   ) );
                          (* включение CapsLock, NumLock            *)
                          xlocked := ORD(set * BIT(
                                                 XCB.XCB_MOD_MASK_LOCK
                                               + XCB.XCB_MOD_MASK_2) );
                          (* активная раскладка клавиатуры        *)
                          xlayout := LSH(ORD(set * BIT(0F000H)),  -13);

                          XKB.xkb_state_update_mask(xkbstat,
                                                    depress,
                                                    latched,
                                                    xlocked,
                                                    0, 0,
                                                    xlayout);

                          (* кодировка utf-8 ---------------------- *]
                          chr := XKB.xkb_state_key_get_utf32(
                                                       xkbstat,  but );

                          [* кодировка koi-8 ---------------------- *)
                          chr := XKB.xkb_state_key_get_one_sym(
                                                       xkbstat,  but );

                           . . .