Tigr-m2/modula2/examples/flags/flags.mod

MODULE flags;

(* Compilation : 
    gm2 -fiso -I../.. ../../tigr.o ../../helper.o flags.mod -o flags -s -lGLU -lGL -lX11
*)

FROM tigr IMPORT TigrPtr,tigrWindow,tigrFree,tigrClosed, tigrClear, tigrUpdate, TPixelType,
                tigrLine, TK_ESCAPE, tigrKeyDown, tigrReadChar, tfont, tigrPrint,tigrFill,
                tigrCircle, tigrRect, tigrFillCircle,  tigrTime, tigrError, tigrClip, 
                tigrFillRect, tigrTextWidth, tigrTextHeight, tigrLoadImage, tigrReadFile,
                tigrBitmap, TIGR_2X, tigrSetPostFX, tigrMouse,tigrBlit, tigrBlitAlpha,
                 tigrEncodeUTF8, TK_RIGHT,tigrKeyHeld, TK_SPACE, TK_LEFT, TIGR_AUTO,
                 TIGR_RETINA, TIGR_FULLSCREEN, TIGR_3X, TIGR_4X, TIGR_NOCURSOR;

FROM helper IMPORT tigrRGB, tigrRGBA;
FROM InOut IMPORT Write, WriteLn, WriteCard,WriteString;
FROM NumberIO IMPORT CardToStr;
FROM Strings IMPORT Concat;
FROM SYSTEM IMPORT ADR, CAST;


TYPE 
    ToggleType = RECORD
                    text    : ARRAY[0..100] OF CHAR;
                    checked : CARDINAL;
                    value   : CARDINAL;
                    key     : CARDINAL;
                    color   : TPixelType;
                END;
    TogglePtr   = POINTER TO ToggleType;

VAR 
    Toggle              : ToggleType;
    lineColor           : TPixelType;
    flags               : CARDINAL; 
    initialW            : CARDINAL; 
    initialH            : CARDINAL;
    win                 : TigrPtr;
    white,yellow,black  : TPixelType;
    toggles             : ARRAY[0..6] OF ToggleType;

    PROCEDURE makeDemoWindow(w,h : CARDINAL; flags: CARDINAL): TigrPtr;

    BEGIN
        RETURN tigrWindow(w, h, "Flag tester", flags);
    END makeDemoWindow;


    PROCEDURE drawDemoWindow(win : TigrPtr);

        VAR
            winw, winh : ARRAY[0..5] OF CHAR;
            resultStr  : ARRAY[0..11] OF CHAR;

    BEGIN 
        lineColor := tigrRGB(100, 100, 100);
        tigrLine(win, 0, 0, win^.w - 1, win^.h - 1, lineColor);
        tigrLine(win, 0, win^.h - 1, win^.w - 1, 0, lineColor);
        tigrRect(win, 0, 0, win^.w, win^.h, tigrRGB(200, 10, 10));
        CardToStr(win^.w, 5, winw);
        CardToStr(win^.h, 5,winh);
        Concat(winw, winh, resultStr);
        tigrPrint(win, tfont, 5, 5, tigrRGB(20, 200, 0), resultStr);
    END drawDemoWindow;

    PROCEDURE drawToggle(bmp: TigrPtr; toggle: TogglePtr; x, y: CARDINAL; stride: CARDINAL);

        VAR
            height, width : CARDINAL;
            yOffset, xOffset : CARDINAL;
            lineColor : TPixelType;

    BEGIN
        height  := tigrTextHeight(tfont, toggle^.text);
        width   := tigrTextWidth(tfont, toggle^.text);
        yOffset := stride / 2;
        xOffset := width / 2; 
        
        tigrPrint(bmp, tfont, x + xOffset, y + yOffset, toggle^.color, toggle^.text);
   
        IF toggle^.checked > 0 THEN
            yOffset := yOffset + height
        ELSE
            yOffset := yOffset / 3
        END;
        lineColor := toggle^.color;
        lineColor.a := 240;
        tigrLine(bmp, x + xOffset, y + yOffset, x + xOffset + width, y + yOffset, lineColor);
    END drawToggle;


        VAR
            numToggles,
            stepY, 
            toggleY, 
            toggleX : CARDINAL; 
            newFlags : CARDINAL;
            i : CARDINAL;
            toggle : TogglePtr;
            w,h : CARDINAL;
            modeFlags, modeChange : CARDINAL;

BEGIN
    flags := 0;
    initialW := 400;
    initialH := 400;

    win := makeDemoWindow(initialW, initialH, flags);
    white := tigrRGB(255, 255, 255);
    yellow := tigrRGB(255, 255, 0);
    black := tigrRGB(0, 0, 0);

    WITH toggles[0] DO
        text := "(A)UTO"; 
        checked := 1;
        value := TIGR_AUTO;
        key :=  ORD('A'); 
        color :=  white;
    END;
    (* { "(R)ETINA", 0, TIGR_RETINA, 'R', white }, *)
    WITH toggles[1] DO
        text := "(R)ETINA"; 
        checked := 0;
        value := TIGR_RETINA;
        key :=  ORD('R'); 
        color :=  white;
    END;
    (* { "(F)ULLSCREEN", 0, TIGR_FULLSCREEN, 'F', white }, *)
     WITH toggles[2] DO
        text := "(F)ULLSCREEN"; 
        checked := 0;
        value := TIGR_FULLSCREEN;
        key :=  ORD('F'); 
        color :=  white;
    END;
    (*  { "(2)X", 0, TIGR_2X, '2', yellow }, *)
        WITH toggles[3] DO
        text := "(2)X"; 
        checked := 0;
        value := TIGR_2X;
        key :=  ORD('2'); 
        color :=  yellow;
    END;
    (* { "(3)X", 0, TIGR_3X, '3', yellow }, *)
    WITH toggles[4] DO
        text := "(3)X"; 
        checked := 0;
        value := TIGR_3X;
        key :=  ORD('3'); 
        color :=  yellow;
    END;
    (*  { "(4)X", 0, TIGR_4X, '4', yellow }, *)
     
    WITH toggles[5] DO
        text := "(4)X"; 
        checked := 0;
        value := TIGR_4X;
        key :=  ORD('4'); 
        color :=  yellow;
    END;
    (*  { "(N)OCURSOR", 0, TIGR_NOCURSOR, 'N', white } *)
    WITH toggles[6] DO
        text := "(N)OCURSOR"; 
        checked := 0;
        value := TIGR_NOCURSOR;
        key :=  ORD('N'); 
        color :=  white;
    END;

    WHILE (NOT (tigrClosed(win) > 0)) AND (NOT (tigrKeyDown(win, TK_ESCAPE) > 0)) DO 
        tigrClear(win, black);

        drawDemoWindow(win);

        numToggles := 7;
        stepY := win^.h / numToggles;
        toggleY := 0;
        toggleX := win^.w / 2;

        newFlags := 0;
        FOR i := 0 TO numToggles - 1 DO
                toggleY := toggleY + stepY;
                toggle := CAST(TogglePtr, ADR(toggles[i]));
                IF (tigrKeyDown(win, toggle^.key) > 0) THEN
                    toggle^.checked := 1 - toggle^.checked;
                END;
                newFlags := newFlags + toggle^.checked * toggle^.value;
                drawToggle(win, toggle, toggleX, toggleY, stepY);
        END;

        IF (flags # newFlags) THEN
                modeFlags := TIGR_AUTO + TIGR_RETINA;
                IF (VAL(CARDINAL, CAST(BITSET, flags) * CAST(BITSET, modeFlags))
                    # VAL(CARDINAL, CAST(BITSET, newFlags) * CAST(BITSET, modeFlags))) THEN
                    modeChange := 1;
                ELSE
                    modeChange := 0;
                END;
                flags := newFlags;

                IF modeChange > 0 THEN
                    w := initialW;
                    h := initialH
                ELSE
                    w :=  win^.w;
                    h :=  win^.h
                END;
                tigrFree(win);
                win := makeDemoWindow(w, h, flags);
        END;
        tigrUpdate(win);
    END;
    tigrFree(win);
END flags.