home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / examples / libraries / intuition / clonescreen.mod < prev    next >
Encoding:
Text File  |  1994-08-08  |  4.3 KB  |  143 lines

  1. (*************************************************************************
  2.  
  3.      $RCSfile: CloneScreen.mod $
  4.   Description: A port of clonescreen.c
  5.  
  6.                Clone an existing public screen.
  7.  
  8.      Requires: AmigaOS 2.04+ (Kickstart 37+)
  9.  
  10.    Created by: fjc (Frank Copeland)
  11.     $Revision: 1.3 $
  12.       $Author: fjc $
  13.         $Date: 1994/08/08 16:55:25 $
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. MODULE CloneScreen;
  20.  
  21. (*
  22. ** $C= CaseChk       $I= IndexChk  $L= LongAdr   $N= NilChk
  23. ** $P- PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  24. ** $V= OvflChk       $Z= ZeroVars
  25. *)
  26.  
  27. IMPORT
  28.   SYS := SYSTEM,
  29.   E := Exec,
  30.   U := Utility,
  31.   D := Dos,
  32.   G := Graphics,
  33.   I := Intuition,
  34.   Str := Strings;
  35.  
  36. CONST
  37.   VersionTag = "\0$VER: CloneScreen 1.0 (10.6.94)\r\n";
  38.  
  39.   pubScreenName = "Workbench";
  40.  
  41. (*------------------------------------*)
  42. (*$D-*)
  43. PROCEDURE cloneScreen (pubScreenName : ARRAY OF CHAR);
  44.  
  45.   VAR
  46.     myScreen : I.ScreenPtr;
  47.     screenModeID : LONGINT;
  48.     pubScrFontName : E.STRPTR;
  49.     fontName : E.STRPTR;
  50.     fontNameSize : LONGINT;
  51.     pubScreenFont : G.TextAttr;
  52.     openedFont : G.TextFontPtr;
  53.     pubScreen : I.ScreenPtr;
  54.     screenDrawInfo : I.DrawInfoPtr;
  55.  
  56. BEGIN (* cloneScreen *)
  57.   pubScreen := I.base.LockPubScreen (pubScreenName);
  58.   IF pubScreen # NIL THEN
  59.     (*
  60.     ** Get the DrawInfo structure from the locked screen
  61.     ** This returns pen, depth and font info.
  62.     *)
  63.     screenDrawInfo := I.base.GetScreenDrawInfo (pubScreen);
  64.     IF screenDrawInfo # NIL THEN
  65.       screenModeID := G.base.GetVPModeID (SYS.ADR (pubScreen.viewPort));
  66.       IF screenModeID # G.invalidID THEN
  67.         (*
  68.         ** Get a copy of the font
  69.         ** The name of the font must be copied as the public screen may
  70.         ** go away at any time after we unlock it.
  71.         ** Allocate enough memory to copy the font name, create a
  72.         ** TextAttr that matches the font, and open the font.
  73.         *)
  74.         pubScrFontName := screenDrawInfo.font.name;
  75.         fontNameSize := 1 + Str.Length (pubScrFontName^);
  76.         (* Program will halt if allocation fails *)
  77.         SYS.NEW (fontName, fontNameSize);
  78.         COPY (pubScrFontName^, fontName^);
  79.         pubScreenFont.name := fontName;
  80.         pubScreenFont.ySize := screenDrawInfo.font.ySize;
  81.         pubScreenFont.style := screenDrawInfo.font.style;
  82.         pubScreenFont.flags := screenDrawInfo.font.flags;
  83.         openedFont := G.base.OpenFont (pubScreenFont);
  84.         IF openedFont # NIL THEN
  85.           (*
  86.           ** screenModeID may now be used in a call to
  87.           ** OpenScreenTags () with the tag saDisplayID
  88.           *)
  89.           myScreen := I.base.OpenScreenTagsA ( NIL,
  90.               I.saWidth,      LONG (pubScreen.width),
  91.               I.saHeight,     LONG (pubScreen.height),
  92.               I.saDepth,      LONG (screenDrawInfo.depth),
  93.               I.saOverscan,   I.oscanText,
  94.               I.saAutoScroll, E.LTRUE,
  95.               I.saPens,       screenDrawInfo.pens,
  96.               I.saFont,       SYS.ADR (pubScreenFont),
  97.               I.saDisplayID,  screenModeID,
  98.               I.saTitle,      SYS.ADR ("Cloned screen"),
  99.               U.tagEnd );
  100.           IF myScreen # NIL THEN
  101.             (*
  102.             ** Free the drawinfo an public screen as we don't
  103.             ** need them any more. We now have our own screen.
  104.             *)
  105.             I.base.FreeScreenDrawInfo (pubScreen, screenDrawInfo);
  106.             screenDrawInfo := NIL;
  107.             I.base.UnlockPubScreen (pubScreenName, pubScreen);
  108.             pubScreen := NIL;
  109.  
  110.             D.base.Delay (300); (* should be rest_of_program *)
  111.  
  112.             I.base.OldCloseScreen (myScreen)
  113.           END;
  114.           G.base.CloseFont (openedFont)
  115.         END
  116.       END
  117.     END
  118.   END
  119. END cloneScreen;
  120.  
  121. BEGIN (* CloneScreen *)
  122.   IF I.base.version >= 37 THEN
  123.     IF G.base.version >= 37 THEN
  124.       cloneScreen (pubScreenName)
  125.     END
  126.   END
  127. END CloneScreen.
  128.  
  129. (*************************************************************************
  130.  
  131.   $Log: CloneScreen.mod $
  132.   Revision 1.3  1994/08/08  16:55:25  fjc
  133.   Release 1.4
  134.  
  135.   Revision 1.2  1994/07/03  15:13:11  fjc
  136.   - Incorporated changes in 3.1 Interfaces
  137.  
  138.   Revision 1.1  1994/06/14  00:58:29  fjc
  139.   - Updated for release
  140.  
  141. *************************************************************************)
  142.  
  143.