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.