home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / examples / libraries / workbench / appicon.mod < prev    next >
Encoding:
Text File  |  1994-08-08  |  4.4 KB  |  138 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: AppIcon.mod $
  4.   Description: A port of appicon.c from the RKM:Libraries
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.3 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/08 16:59:51 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This example program is part of Oberon-A.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. MODULE AppIcon;
  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.   i   := Icon,
  32.   wb  := Workbench,
  33.   IO  := StdIO;
  34.  
  35. CONST
  36.   VersionTag = "\0$VER: AppIcon 1.0 (18.6.94)\r\n";
  37.  
  38. VAR
  39.   dobj    : wb.DiskObjectPtr;
  40.   myport  : e.MsgPortPtr;
  41.   appicon : wb.AppIconPtr;
  42.   appmsg  : wb.AppMessagePtr;
  43.  
  44.   dropcount : LONGINT;
  45.   x         : LONGINT;
  46.   success   : BOOLEAN;
  47.  
  48.  
  49. BEGIN (* AppIcon *)
  50.   IF e.base.version >= 37 THEN
  51.     dobj := NIL; myport := NIL; appicon := NIL; appmsg := NIL;
  52.     dropcount := 0; x := 0; success := FALSE;
  53.     i.OpenLib (FALSE);
  54.     IF i.base.version >= 37 THEN
  55.       wb.OpenLib (FALSE);
  56.       IF wb.base.version >= 37 THEN
  57.         (* This is the easy way to get some icon imagery *)
  58.         (* Real applications should use custom imagery   *)
  59.         dobj := i.base.GetDefDiskObject (wb.disk);
  60.         IF dobj # NIL THEN
  61.           (* The type must be set to 0 for an appIcon *)
  62.           dobj.type := 0;
  63.  
  64.           (* The CreateMsgPort() function is on Exec version 37+ *)
  65.           myport := e.base.CreateMsgPort();
  66.           IF myport # NIL THEN
  67.             (* Put the AppIcon up on the Workbench window *)
  68.             appicon := wb.base.AddAppIcon
  69.               ( 0, 0, "TestAppIcon", myport, NIL, dobj, u.tagEnd );
  70.             IF appicon # NIL THEN
  71.               (* For the sake of this example, we allow the AppIcon *)
  72.               (* to be activated only five times.                   *)
  73.               IO.WriteStr ("Drop files on the Workbench AppIcon\n");
  74.               IO.WriteStr ("Example exits after 5 drops\n");
  75.  
  76.               WHILE dropcount < 5 DO
  77.                 e.base.WaitPort (myport);
  78.  
  79.                 (* Might be more than one message at the port... *)
  80.                 LOOP
  81.                   appmsg :=
  82.                     SYS.VAL (wb.AppMessagePtr, e.base.GetMsg (myport));
  83.                   IF appmsg = NIL THEN EXIT END;
  84.                   IF appmsg.numArgs = 0 THEN
  85.                     (* If numArgs is 0 the AppIcon was activated directly *)
  86.                     IO.WriteStr ("User activated the AppIcon.\n");
  87.                     IO.WriteStr
  88.                       ("A Help window for the user would be good here\n")
  89.                   ELSIF appmsg.numArgs > 0 THEN
  90.                     (* If numArgs is >0 the AppIcon was activated by *)
  91.                     (* having one or more Icons dropped on top of it *)
  92.                     IO.WriteF1
  93.                       ( "User dropped %ld icons on the AppIcon.\n",
  94.                         appmsg.numArgs );
  95.                     FOR x := 0 TO appmsg.numArgs - 1 DO
  96.                       IO.WriteF2
  97.                         ( "#%ld name ='%s'\n",
  98.                           x+1, appmsg.argList[x].name )
  99.                     END
  100.                   END;
  101.                   (* Let Workbench know we're done with the message *)
  102.                   e.base.ReplyMsg (appmsg)
  103.                 END;
  104.                 INC (dropcount)
  105.               END;
  106.               success := wb.base.RemoveAppIcon (appicon)
  107.             END;
  108.             (* Clear away any messages that arrived at the last moment *)
  109.             LOOP
  110.               appmsg :=
  111.                 SYS.VAL (wb.AppMessagePtr, e.base.GetMsg (myport));
  112.               IF appmsg = NIL THEN EXIT END;
  113.               e.base.ReplyMsg (appmsg)
  114.             END;
  115.             e.base.DeleteMsgPort (myport)
  116.           END;
  117.           i.base.FreeDiskObject (dobj)
  118.         END
  119.       END
  120.     END
  121.   END
  122. END AppIcon.
  123.  
  124. (*************************************************************************
  125.  
  126.   $Log: AppIcon.mod $
  127.   Revision 1.3  1994/08/08  16:59:51  fjc
  128.   Release 1.4
  129.  
  130.   Revision 1.2  1994/07/03  15:17:44  fjc
  131.   - Incorporated changes in 3.1 Interfaces
  132.  
  133.   Revision 1.1  1994/06/18  22:59:44  fjc
  134.   Initial revision
  135.  
  136. *************************************************************************)
  137.  
  138.