home *** CD-ROM | disk | FTP | other *** search
- (*************************************************************************
-
- $RCSfile: CloneScreen.mod $
- Description: A port of clonescreen.c
-
- Clone an existing public screen.
-
- Requires: AmigaOS 2.04+ (Kickstart 37+)
-
- Created by: fjc (Frank Copeland)
- $Revision: 1.3 $
- $Author: fjc $
- $Date: 1994/08/08 16:55:25 $
-
- Log entries are at the end of the file.
-
- *************************************************************************)
-
- MODULE CloneScreen;
-
- (*
- ** $C= CaseChk $I= IndexChk $L= LongAdr $N= NilChk
- ** $P- PortableCode $R= RangeChk $S= StackChk $T= TypeChk
- ** $V= OvflChk $Z= ZeroVars
- *)
-
- IMPORT
- SYS := SYSTEM,
- E := Exec,
- U := Utility,
- D := Dos,
- G := Graphics,
- I := Intuition,
- Str := Strings;
-
- CONST
- VersionTag = "\0$VER: CloneScreen 1.0 (10.6.94)\r\n";
-
- pubScreenName = "Workbench";
-
- (*------------------------------------*)
- (*$D-*)
- PROCEDURE cloneScreen (pubScreenName : ARRAY OF CHAR);
-
- VAR
- myScreen : I.ScreenPtr;
- screenModeID : LONGINT;
- pubScrFontName : E.STRPTR;
- fontName : E.STRPTR;
- fontNameSize : LONGINT;
- pubScreenFont : G.TextAttr;
- openedFont : G.TextFontPtr;
- pubScreen : I.ScreenPtr;
- screenDrawInfo : I.DrawInfoPtr;
-
- BEGIN (* cloneScreen *)
- pubScreen := I.base.LockPubScreen (pubScreenName);
- IF pubScreen # NIL THEN
- (*
- ** Get the DrawInfo structure from the locked screen
- ** This returns pen, depth and font info.
- *)
- screenDrawInfo := I.base.GetScreenDrawInfo (pubScreen);
- IF screenDrawInfo # NIL THEN
- screenModeID := G.base.GetVPModeID (SYS.ADR (pubScreen.viewPort));
- IF screenModeID # G.invalidID THEN
- (*
- ** Get a copy of the font
- ** The name of the font must be copied as the public screen may
- ** go away at any time after we unlock it.
- ** Allocate enough memory to copy the font name, create a
- ** TextAttr that matches the font, and open the font.
- *)
- pubScrFontName := screenDrawInfo.font.name;
- fontNameSize := 1 + Str.Length (pubScrFontName^);
- (* Program will halt if allocation fails *)
- SYS.NEW (fontName, fontNameSize);
- COPY (pubScrFontName^, fontName^);
- pubScreenFont.name := fontName;
- pubScreenFont.ySize := screenDrawInfo.font.ySize;
- pubScreenFont.style := screenDrawInfo.font.style;
- pubScreenFont.flags := screenDrawInfo.font.flags;
- openedFont := G.base.OpenFont (pubScreenFont);
- IF openedFont # NIL THEN
- (*
- ** screenModeID may now be used in a call to
- ** OpenScreenTags () with the tag saDisplayID
- *)
- myScreen := I.base.OpenScreenTagsA ( NIL,
- I.saWidth, LONG (pubScreen.width),
- I.saHeight, LONG (pubScreen.height),
- I.saDepth, LONG (screenDrawInfo.depth),
- I.saOverscan, I.oscanText,
- I.saAutoScroll, E.LTRUE,
- I.saPens, screenDrawInfo.pens,
- I.saFont, SYS.ADR (pubScreenFont),
- I.saDisplayID, screenModeID,
- I.saTitle, SYS.ADR ("Cloned screen"),
- U.tagEnd );
- IF myScreen # NIL THEN
- (*
- ** Free the drawinfo an public screen as we don't
- ** need them any more. We now have our own screen.
- *)
- I.base.FreeScreenDrawInfo (pubScreen, screenDrawInfo);
- screenDrawInfo := NIL;
- I.base.UnlockPubScreen (pubScreenName, pubScreen);
- pubScreen := NIL;
-
- D.base.Delay (300); (* should be rest_of_program *)
-
- I.base.OldCloseScreen (myScreen)
- END;
- G.base.CloseFont (openedFont)
- END
- END
- END
- END
- END cloneScreen;
-
- BEGIN (* CloneScreen *)
- IF I.base.version >= 37 THEN
- IF G.base.version >= 37 THEN
- cloneScreen (pubScreenName)
- END
- END
- END CloneScreen.
-
- (*************************************************************************
-
- $Log: CloneScreen.mod $
- Revision 1.3 1994/08/08 16:55:25 fjc
- Release 1.4
-
- Revision 1.2 1994/07/03 15:13:11 fjc
- - Incorporated changes in 3.1 Interfaces
-
- Revision 1.1 1994/06/14 00:58:29 fjc
- - Updated for release
-
- *************************************************************************)
-
-