(* ------------------------------------------------------------------------ :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) :History. v1.1m [Frank Lömker] 21-Feb-92 Umsetzung nach Modula :Copyright. (c) 1985-1990 by MKSoft Development :Language. Modula-2 :Translator. M2Amiga V4.0d :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... *) (*-----------------------------------------------------------------------*) IMPLEMENTATION MODULE RenderInfo; (*$ LargeVars:=FALSE StackParms:=FALSE StackChk:=FALSE NilChk:=FALSE RangeChk:=FALSE OverflowChk:=FALSE ReturnChk:=FALSE EntryClear:=FALSE *) FROM ExecL IMPORT Forbid,Permit; FROM GraphicsL IMPORT OpenFont,CloseFont,GetRGB4; FROM GraphicsD IMPORT TextAttr,FontStyleSet,FontFlagSet,FontFlags; FROM IntuitionL IMPORT LockPubScreen,UnlockPubScreen,GetScreenData, intuitionVersion; FROM IntuitionD IMPORT ScreenPtr,Screen,ScreenFlagSet,ScreenFlags; FROM SYSTEM IMPORT ADR,SHIFT,BITSET,CAST; FROM Arts IMPORT Assert; FROM Heap IMPORT Allocate,Deallocate; 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 := CAST( INTEGER, CAST(BITSET,rgb0) * {0..3} )- CAST( INTEGER, CAST(BITSET,rgb1) * {0..3} ); level := tmp*tmp*BlueScale; tmp := CAST( INTEGER, CAST( BITSET,INTEGER(SHIFT( rgb0, -4)) ) * {0..3} )- CAST( INTEGER, CAST( BITSET,INTEGER(SHIFT( rgb1, -4)) ) * {0..3} ); INC(level, tmp*tmp*GreenScale); tmp := CAST( INTEGER, CAST( BITSET,INTEGER(SHIFT( rgb0, -8)) ) * {0..3} )- CAST( INTEGER, CAST( BITSET,INTEGER(SHIFT( 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: ScreenPtr); VAR numcolors: INTEGER; loop: INTEGER; loop1: INTEGER; backpen: INTEGER; tmp: INTEGER; colors: ARRAY [0..MaxColors-1] OF INTEGER; colorlevels: ARRAY [0..MaxColors-1] OF INTEGER; pens: ARRAY [0..MaxColors-1] OF INTEGER; screen: 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 intuitionVersion >= 37 THEN ri.screen := LockPubScreen(NIL); TheScreen := ri.screen; ELSE TheScreen := ADR(screen); IF GetScreenData(TheScreen, SIZE(Screen), ScreenFlagSet{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!* **) Forbid; IF TheScreen^.font # NIL THEN ri.theFont := OpenFont(TheScreen^.font); IF ri.theFont = NIL THEN WITH ri.textAttr DO name:=ADR(fontnam); ySize:=8; style:=FontStyleSet{}; flags:=FontFlagSet{romFont}; END; ri.theFont := OpenFont(ADR(ri.textAttr)); END; (* IF *) END; (* IF *) 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 WITH ri.textAttr DO name:=ADR(fontnam); ySize:=8; style:=FontStyleSet{}; flags:=FontFlagSet{romFont}; END; END; (* IF *) ri.fontSize := ri.textAttr.ySize; numcolors := SHIFT(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 Forbid; loop := 0; WHILE loop < numcolors DO colors[loop] := GetRGB4(TheScreen^.viewPort.colorMap, loop); colorlevels[loop] := ColorLevel(colors[loop]); pens[loop] := loop; INC(loop); END; (* WHILE *) 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 := SHORTINT(pens[loop]); DEC(loop); UNTIL ri.highlight # 0; (* and Shadow... *) loop := 0; REPEAT ri.shadow := SHORTINT(pens[loop]); INC(loop); UNTIL ri.shadow # 0; (* The BackGround pen... *) IF pens[loop] # 0 THEN INC(loop) END; backpen := loop; ri.backPen := SHORTINT(pens[backpen]); loop1 := 0; loop := 0; WHILE loop < numcolors DO tmp := ColorDifference(colors[loop], colors[backpen]); IF tmp > loop1 THEN loop1 := tmp; ri.textPen := SHORTINT(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 CloseFont(ri^.theFont); ri^.theFont:=NIL; END; IF (ri^.screen # NIL) AND (intuitionVersion >= 37) THEN UnlockPubScreen(NIL, ri^.screen); ri^.screen:=NIL; END; Deallocate(ri); END; (* IF *) END CleanUpRenderInfo; (*-----------------------------------------------------------------------*) (* Use this screen for the render information. *) (*-----------------------------------------------------------------------*) PROCEDURE GetRenderInfo (TheScreen: ScreenPtr): RenderInfoPtr; VAR ri: RenderInfoPtr; BEGIN Allocate(ri,SIZE(ri^)); Assert (ri#NIL,ADR("Zu wenig Speicher !")); NewFillInRenderInfo(ri^, TheScreen); RETURN ri; END GetRenderInfo; END RenderInfo.