(* ------------------------------------------------------------------------ :Program. RenderInfo :Contents. get rendering information for certain screen :Author. Kai Bolay [kai] :Address. Hoffmannstraße 168 :Address. D-W7250 Leonberg 1 :Address. Federal Republic of Germany :History. v1.0 [kai] 20-Feb-91 (ported to Oberon) :History. v1.1 [kai] 17-Aug-91 (enhanced, + Screen locking) :Copyright. (c) 1985-1990 by MKSoft Development :Language. Oberon :Translator. AMIGA OBERON v2.07e :Remark. Taken from Atlanta-DevCon-Disk #3 ------------------------------------------------------------------------ *) (* * MKSoft Development Amiga ToolKit V1.0 * * Copyright (c) 1985,86,87,88,89,90 by MKSoft Development * * Ported to Oberon 1991 by Kai Bolay * * * ************************************************************************ * * * DISCLAIMER * * * * THIS SOFTWARE IS PROVIDED "AS IS". * * NO REPRESENTATIONS OR WARRANTIES ARE MADE WITH RESPECT TO THE * * ACCURACY, RELIABILITY, PERFORMANCE, CURRENTNESS, OR OPERATION * * OF THIS SOFTWARE, AND ALL USE IS AT YOUR OWN RISK. * * NEITHER COMMODORE NOR THE AUTHORS ASSUME ANY RESPONSIBILITY OR * * LIABILITY WHATSOEVER WITH RESPECT TO YOUR USE OF THIS SOFTWARE. * * * ************************************************************************ *) (*-----------------------------------------------------------------------*) (* This file contains the definition of the rendering information *) (* for elements on the screen. This information is used to generate *) (* the correct pen colors for items on the screen... *) (*-----------------------------------------------------------------------*) MODULE RenderInfo; IMPORT e: Exec, g: Graphics, I: Intuition, y: SYSTEM; TYPE RenderInfoPtr* = POINTER TO RenderInfo; RenderInfo* = STRUCT (* -- Pen Colors ------------------------------- *) highlight*: SHORTINT; (* Standard Highlight *) shadow*: SHORTINT; (* Standard Shadow *) textPen*: SHORTINT; (* Requester Text Pen *) backPen*: SHORTINT; (* Requester Back Fill *) (* -- Window Borders --------------------------- *) windowTop*: SHORTINT; (* Top border of window *) windowLeft*: SHORTINT; (* Left border *) windowRight*: SHORTINT; (* Right border *) windowBottom*: SHORTINT; (* Bottom border *) windowTitle*: SHORTINT; (* Window title size (includes border) *) (* -- Internal --------------------------------- *) junkPad: SHORTINT; (* -- Screen Dimensions ------------------------ *) screenWidth*: INTEGER; (* Width of the screen *) screenHeight*: INTEGER; (* Height of the screen *) (* -- Font Information ------------------------- *) fontSize*: INTEGER; (* Font size for string gadgets *) theFont*: g.TextFontPtr; (* Font TextFont *) textAttr*: g.TextAttr; (* Font TextAttr *) (* -- Internal --------------------------------- *) screen: I.ScreenPtr; END; (* STRUCT *) CONST fontnam = "topaz.font"; (* The "default" font we might need... *) MaxColors = 16; (* Define the maximum colors to look at. *) (* This is my way of making this work *) (* "everywhere" including HAM *) BlueScale = 2; (* These define the amount of Red, Green *) GreenScale = 6; (* and Blue scaling used to help take *) RedScale = 3; (* into account the different visual *) (* impact of those colors on the screen. *) (*-----------------------------------------------------------------------*) (* This returns the color difference hamming value... *) (*-----------------------------------------------------------------------*) PROCEDURE ColorDifference(rgb0, rgb1: INTEGER): INTEGER; VAR level, tmp: INTEGER; BEGIN tmp := y.VAL(INTEGER, y.VAL(SET, rgb0) * {0..3})- y.VAL(INTEGER, y.VAL(SET, rgb1) * {0..3}); level := tmp*tmp*BlueScale; tmp := y.VAL(INTEGER, y.LSH(y.VAL(SET, rgb0), -4) * {0..3})- y.VAL(INTEGER, y.LSH(y.VAL(SET, rgb1), -4) * {0..3}); INC(level, tmp*tmp*GreenScale); tmp := y.VAL(INTEGER, y.LSH(y.VAL(SET, rgb0), -8) * {0..3})- y.VAL(INTEGER, y.LSH(y.VAL(SET, rgb1), -8) * {0..3}); INC(level, tmp*tmp*RedScale); RETURN level; END ColorDifference; (*-----------------------------------------------------------------------*) (* Calculate a rough brightness hamming value... *) (*-----------------------------------------------------------------------*) PROCEDURE ColorLevel(rgb: INTEGER): INTEGER; BEGIN RETURN ColorDifference(rgb,0); END ColorLevel; (*-----------------------------------------------------------------------*) (* For new programs, this also opens fonts... *) (*-----------------------------------------------------------------------*) PROCEDURE NewFillInRenderInfo(VAR ri: RenderInfo; TheScreen: I.ScreenPtr); VAR numcolors: INTEGER; loop: INTEGER; loop1: INTEGER; backpen: INTEGER; tmp: INTEGER; colors: ARRAY MaxColors OF INTEGER; colorlevels: ARRAY MaxColors OF INTEGER; pens: ARRAY MaxColors OF INTEGER; screen: I.Screen; BEGIN (** ** If no screen was passed we will used the old (1.2 compatible) ** or the new (2.0) way of getting at the screen... **) ri.screen := NIL; IF TheScreen = NIL THEN IF I.int.libNode.version >= 37 THEN ri.screen := I.LockPubScreen(NIL); TheScreen := ri.screen; ELSE TheScreen := y.ADR(screen); IF I.GetScreenData(TheScreen^, y.SIZE(I.Screen), SET{I.wbenchScreen}, NIL) THEN END; END; END; (* IF *) ri.windowTop := TheScreen^.wBorTop; ri.windowLeft := TheScreen^.wBorLeft; ri.windowRight := TheScreen^.wBorRight; ri.windowBottom := TheScreen^.wBorBottom; ri.windowTitle := TheScreen^.barHeight-TheScreen^.barVBorder+ TheScreen^.wBorTop; ri.screenWidth := TheScreen^.width; ri.screenHeight := TheScreen^.height; (** ** If we can't open the font given for the screen we need ** to fall-back to Topaz... *YUCK!* **) e.Forbid; IF TheScreen^.font # NIL THEN ri.theFont := g.OpenFont(TheScreen^.font^); IF ri.theFont = NIL THEN ri.textAttr := g.TextAttr(y.ADR(fontnam), 8, SHORTSET{}, SHORTSET{g.romFont}); ri.theFont := g.OpenFont(ri.textAttr); END; (* IF *) END; (* IF *) e.Permit; IF ri.theFont # NIL THEN ri.textAttr.name := ri.theFont^.message.node.name; ri.textAttr.ySize := ri.theFont^.ySize; ri.textAttr.style := ri.theFont^.style; ri.textAttr.flags := ri.theFont^.flags; ELSE ri.textAttr := g.TextAttr(y.ADR(fontnam), 8, SHORTSET{}, SHORTSET{g.romFont}); END; (* IF *) ri.fontSize := ri.textAttr.ySize; numcolors := y.LSH(1, TheScreen^.rastPort.bitMap^.depth); IF numcolors > MaxColors THEN numcolors := MaxColors END; IF numcolors < 3 THEN (* Some silly person is running with 2 colors... *) ri.backPen := 0; ri.highlight := 1; ri.shadow := 1; ri.textPen := 1; ELSE e.Forbid; loop := 0; WHILE loop < numcolors DO colors[loop] := g.GetRGB4(TheScreen^.viewPort.colorMap, loop); colorlevels[loop] := ColorLevel(colors[loop]); pens[loop] := loop; INC(loop); END; (* WHILE *) e.Permit; (* Sort darkest to brightest... *) loop := 0; WHILE loop < numcolors-1 DO loop1 := loop+1; WHILE loop1 < numcolors DO IF colorlevels[loop] > colorlevels[loop1] THEN tmp := colorlevels[loop]; colorlevels[loop] := colorlevels[loop1]; colorlevels[loop1] := tmp; tmp := colors[loop]; colors[loop] := colors[loop1]; colors[loop1] := tmp; tmp := pens[loop]; pens[loop] := pens[loop1]; pens[loop1] := tmp; END; (* IF *) INC (loop1); END; (* WHILE *) INC (loop); END; (* WHILE *) (* Now, pick the pens... HightLight... *) loop := numcolors-1; REPEAT ri.highlight := SHORT(pens[loop]); DEC(loop); UNTIL ri.highlight # 0; (* and Shadow... *) loop := 0; REPEAT ri.shadow := SHORT(pens[loop]); INC(loop); UNTIL ri.shadow # 0; (* The BackGround pen... *) IF pens[loop] # 0 THEN INC(loop) END; backpen := loop; ri.backPen := SHORT(pens[backpen]); loop1 := 0; loop := 0; WHILE loop < numcolors DO tmp := ColorDifference(colors[loop], colors[backpen]); IF tmp > loop1 THEN loop1 := tmp; ri.textPen := SHORT(pens[loop]); END; (* IF *) INC (loop); END; (* WHILE *) END; (* IF *) END NewFillInRenderInfo; (*-----------------------------------------------------------------------*) (* Close the font, unlock screen and free the memory... *) (*-----------------------------------------------------------------------*) PROCEDURE CleanUpRenderInfo* (VAR ri: RenderInfoPtr); BEGIN IF ri # NIL THEN IF ri^.theFont # NIL THEN g.CloseFont(ri^.theFont) END; IF ri^.screen # NIL THEN I.UnlockPubScreen(NIL, ri^.screen) END; DISPOSE(ri); END; (* IF *) END CleanUpRenderInfo; (*-----------------------------------------------------------------------*) (* Use this screen for the render information. *) (*-----------------------------------------------------------------------*) PROCEDURE GetRenderInfo* (TheScreen: I.ScreenPtr): RenderInfoPtr; VAR ri: RenderInfoPtr; BEGIN NEW(ri); IF ri = NIL THEN HALT(20) END; NewFillInRenderInfo(ri^, TheScreen); RETURN ri; END GetRenderInfo; END RenderInfo.