hotseat Squava (a tiny LablGtk2 demo)

(* GEANY lablgtk2+vanilla project *)
(* F8 : ocamlopt.opt -o "%e" -w s -I +lablgtk2 lablgtk.cmxa "%f" *)
(* F5 : "./%e" *)

let window =
    GMain.init ();
    let wnd = GWindow.window ~resizable:true ~title:"Squava board game" ()
    in  wnd#connect#destroy GMain.quit; wnd

let vbox1 =
    GPack.vbox ~packing:window#add ()

let button id tooltip =
    let but = GButton.tool_button ~stock:id () in
    but#misc#set_tooltip_markup tooltip;
    but

let restart =
    button `NEW "<b>Start</b> a new game"

let about =
    button `ABOUT "<b>About</b> Squava"

let quit =
    button `QUIT "<b>Quit</b> the application"

let toolbar =
    let bar = GButton.toolbar
        ~orientation:`HORIZONTAL ~style:`ICONS ~packing:vbox1#pack ()
    in
    bar#set_icon_size `LARGE_TOOLBAR;
    bar#insert restart;
    bar#insert (GButton.separator_tool_item ());
    bar#insert about;
    bar#insert (GButton.separator_tool_item ());
    bar#insert quit;
    bar

let center =
    GBin.alignment ~xalign:0.5 ~yalign:0.5 ~xscale:0. ~yscale:0. ~packing:vbox1#add ()

let pixbuf =
    GdkPixbuf.from_file "./squava.png"
let pixmap,_ =
    GdkPixbuf.create_pixmap pixbuf
let sqr_size1 = GdkPixbuf.get_width pixbuf / 5
let sqr_size = sqr_size1 - 1
let asize = sqr_size1 * 5
let asize1 = asize + 1

let area =
    GMisc.drawing_area ~width:asize1 ~height:asize1 ~packing:center#add ()
let drawing =
    new GDraw.drawable (area#misc#realize (); area#misc#window)

let statusbar =
    GMisc.statusbar ~has_resize_grip:true ~packing:vbox1#pack ()

let dialog = GWindow.about_dialog
    ~authors:
    ["Game design by Cameron Browne & N\xC3\xA9stor Romeral Andr\xC3\xA9s";
    "GTK2 application by SpiceGuid (<[email protected]>)"]
    ~copyright:"Copyright \xC2\xA9 2026 SpiceGuid"
    ~license:"LGPL-2.1-or-later\nWITH OCaml-LGPL-linking-exception"
    ~version:"1.1"
    ~website:"https://boardgamegeek.com/boardgame/112745/squava"
    ~website_label:"Board Game Geek : Squava"
    ~parent:window
    ~destroy_with_parent:true ()

let put_pixmap i src =
    if src >= 0 then
    let x = (i mod 5) * sqr_size1 + 1
    and y = (i / 5) * sqr_size1 + 1
    and xsrc = (src mod 5) * sqr_size1 + 1
    and ysrc = (src / 5) * sqr_size1 + 1
    in drawing#put_pixmap ~x ~y ~xsrc ~ysrc ~width:sqr_size ~height:sqr_size pixmap

let str_restart = "Click Start to begin a new game."
let str_free_position = "Please click a free position."
let str_white_turn = "It's White player turn."
let str_red_turn = "It's Red player turn."
let str_white_winner = "White player is the winner."
let str_red_winner = "Red player is the winner."
let str_white_loser = "White player is the loser."
let str_red_loser = "Red player is the loser."

let status_context = statusbar#new_context ~name:""

let winner_moves =
    [|
    31457280; 15728640; 983040; 491520; 30720; 15360; 960; 480; 30; 15;
    17318400; 541200; 8659200; 270600; 4329600; 135300; 2164800; 67650;
    1082400; 33825; 17043520; 266305; 1118464; 69904; 8521760; 532610; 2236928;
    34952 |]

let loser_moves =
    [|
    29360128; 14680064; 7340032; 917504; 458752; 229376; 28672; 14336; 7168;
    896; 448; 224; 28; 14; 7; 17317888; 541184; 16912; 8658944; 270592; 8456;
    4329472; 135296; 4228; 2164736; 67648; 2114; 1082368; 33824; 1057; 4472832;
    4260864; 1092; 16644; 2236416; 139776; 8521728; 133152; 2184; 34944;
    532608; 8322; 17043456; 266304; 4161; 1118208; 69888; 4368 |]

let has_mask mask n =
    mask land n = n

let mouse m =
    let mx = int_of_float (GdkEvent.Button.x m)
    and my = int_of_float (GdkEvent.Button.y m)
    in  (mx - 1) / sqr_size1 + ((my - 1) / sqr_size1) * 5

let main =
    let ctrl =
        object (self)
            val mutable pressed = (-1)
            val mutable released = (-1)
            val mutable white_mask = 0
            val mutable red_mask = 0
            val mutable moves = 0
            val board = Array.make 25 (-1)
            method clicked =
                board.(pressed) <- moves;
                status_context#pop ();
                if moves land 1 = 1 then begin
                    red_mask <- 1 lsl pressed + red_mask;
                    if Array.exists (has_mask red_mask) winner_moves then
                        (status_context#push str_red_winner; moves <- 24)
                    else if Array.exists (has_mask red_mask) loser_moves then
                        (status_context#push str_red_loser; moves <- 24)
                    else begin
                        status_context#push str_white_turn; ()
                    end
                end else begin
                    white_mask <- 1 lsl pressed + white_mask;
                    if Array.exists (has_mask white_mask) winner_moves then
                        (status_context#push str_white_winner; moves <- 24)
                    else if Array.exists (has_mask white_mask) loser_moves then
                        (status_context#push str_white_loser; moves <- 24)
                    else begin
                        status_context#push str_red_turn; ()
                    end
                end;
                area#misc#draw None;
                pressed <- (-1); released <- (-1);
                moves <- moves + 1;
            method restart () =
                pressed <- (-1); released <- (-1);
                white_mask <- 0; red_mask <- 0;
                moves <- 0; Array.fill board 0 25 (-1);
                area#misc#draw None;
                status_context#pop ();
                status_context#push str_white_turn;
                ()
            method button_press m =
                if GdkEvent.Button.button m = 1 then begin
                    pressed <- mouse m;
                    if moves = 25 then status_context#flash str_restart;
                end;
                false
            method button_release m =
                if GdkEvent.Button.button m = 1 then begin
                    released <- mouse m;
                    if pressed >=0 && released = pressed && moves < 25 then
                        if board.(pressed) >= 0 then
                            status_context#flash str_free_position
                        else
                            self#clicked;
                end;
                false
            method expose _ =
                drawing#set_foreground `WHITE;
                drawing#rectangle ~x:0 ~y:0 ~width:asize1 ~height:asize1 ~filled:true ();
                drawing#set_foreground `BLACK;
                let y = ref 0 in
                while !y <= asize do
                    drawing#line ~x:0 ~y:!y ~x:asize1 ~y:!y;
                    y := !y + sqr_size1;
                done;
                let x = ref 0 in
                while !x <= asize do
                    drawing#line ~x:!x ~y:0 ~x:!x ~y:asize1;
                    x := !x + sqr_size1;
                done;
                Array.iteri put_pixmap board;
                false
        end
    in
    about#connect#clicked (fun () -> dialog#run (); dialog#misc#hide ());
    area#event#connect#expose ~callback:ctrl#expose;
    area#event#add [`BUTTON_PRESS;`BUTTON_RELEASE];
    area#event#connect#button_press ~callback:ctrl#button_press;
    area#event#connect#button_release ~callback:ctrl#button_release;
    restart#connect#clicked ~callback:ctrl#restart;
    quit#connect#clicked GMain.Main.quit;
    status_context#push str_restart;
    window#show ();
    GMain.main ()