home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / RkrmSrc / Workbench / iconexample.e < prev    next >
Encoding:
Text File  |  1996-08-29  |  7.4 KB  |  186 lines
  1. -> iconexample.e - Workbench icon startup, creation, and parsing example
  2.  
  3. MODULE 'icon',
  4.        'dos/dos',
  5.        'intuition/intuition',
  6.        'workbench/startup',
  7.        'workbench/workbench'
  8.  
  9. ENUM ERR_NONE, ERR_LIB, ERR_OPEN, ERR_WRITE, ERR_MAKE
  10.  
  11. RAISE ERR_LIB   IF OpenLibrary()=NIL,
  12.       ERR_OPEN  IF Open()=NIL,
  13.       ERR_WRITE IF Write()=-1
  14.  
  15. DEF projIcon:diskobject
  16.  
  17. PROC main() HANDLE
  18.   DEF wbenchMsg:PTR TO wbstartup, wbarg:PTR TO wbarg, file=NIL, i, olddir,
  19.       projname, deftoolname, iconImageData, iconGadget, toolTypes
  20.   projname:='RAM:Example_Project'
  21.   deftoolname:='iconexample'
  22.   toolTypes:=['FILETYPE=text', 'FLAGS=BOLD|ITALICS', NIL]
  23.                  -> Plane 0
  24.   iconImageData:=[$0000,$0000,$0000,$1000,$0000,$0000,$0000,$3000,
  25.                   $0FFF,$FFFC,$0000,$3000,$0800,$0004,$0000,$3000,
  26.                   $0800,$07FF,$FFC0,$3000,$08A8,$A400,$00A0,$3000,
  27.                   $0800,$0400,$0090,$3000,$08AA,$A400,$0088,$3000,
  28.                   $0800,$042A,$A0FC,$3000,$082A,$A400,$0002,$3000,
  29.                   $0800,$0400,$0002,$3000,$0800,$A42A,$A0A2,$3000,
  30.                   $0800,$0400,$0002,$3000,$0950,$A42A,$8AA2,$3000,
  31.                   $0800,$0400,$0002,$3000,$082A,$A400,$0002,$3000,
  32.                   $0800,$042A,$2AA2,$3000,$0FFF,$FC00,$0002,$3000,
  33.                   $0000,$0400,$0002,$3000,$0000,$07FF,$FFFE,$3000,
  34.                   $0000,$0000,$0000,$3000,$7FFF,$FFFF,$FFFF,$F000,
  35.                  -> Plane 1
  36.                  $FFFF,$FFFF,$FFFF,$E000,$D555,$5555,$5555,$4000,
  37.           $D000,$0001,$5555,$4000,$D7FF,$FFF9,$5555,$4000,
  38.           $D7FF,$F800,$0015,$4000,$D757,$5BFF,$FF55,$4000,
  39.           $D7FF,$FBFF,$FF65,$4000,$D755,$5BFF,$FF75,$4000,
  40.           $D7FF,$FBD5,$5F01,$4000,$D7D5,$5BFF,$FFFD,$4000,
  41.           $D7FF,$FBFF,$FFFD,$4000,$D7FF,$5BD5,$5F5D,$4000,
  42.           $D7FF,$FBFF,$FFFD,$4000,$D6AF,$5BD5,$755D,$4000,
  43.           $D7FF,$FBFF,$FFFD,$4000,$D7D5,$5BFF,$FFFD,$4000,
  44.           $D7FF,$FBD5,$D55D,$4000,$D000,$03FF,$FFFD,$4000,
  45.           $D555,$53FF,$FFFD,$4000,$D555,$5000,$0001,$4000,
  46.           $D555,$5555,$5555,$4000,$8000,$0000,$0000,$0000]:INT
  47.   -> E-Note: C version uses obsolete gadget flags
  48.   iconGadget:=[NIL,                        -> Next Gadget Pointer
  49.                97, 12, 52, 23,             -> Left, Top, Width, Height
  50.                GFLG_GADGIMAGE OR GFLG_GADGHBOX,  -> Flags
  51.                GACT_IMMEDIATE OR GACT_RELVERIFY, -> Activation Flags
  52.                GTYP_BOOLGADGET,            -> Gadget Type
  53.                 [0, 0,           -> Top Corner
  54.                  52, 22, 2,      -> Width, Height, Depth
  55.                  iconImageData,  -> Image Data
  56.                  3, 0,           -> PlanePick, PlaneOnOff
  57.                  NIL]:image,     -> Next Image
  58.                NIL,                        -> Select Image
  59.                NIL,                        -> Gadget Text
  60.                NIL,                        -> Mutual Exclude
  61.                NIL,                        -> Special Info
  62.                0,                          -> Gadget ID
  63.                NIL]:gadget                 -> User Data
  64.   -> E-Note: a list can't be used for a diskobject because of the nested gadget
  65.   projIcon.magic:=WB_DISKMAGIC
  66.   projIcon.version:=WB_DISKVERSION
  67.   CopyMem(iconGadget, projIcon.gadget, SIZEOF gadget)
  68.   projIcon.type:=WBPROJECT
  69.   projIcon.defaulttool:=deftoolname
  70.   projIcon.tooltypes:=toolTypes
  71.   projIcon.currentx:=NO_ICON_POSITION
  72.   projIcon.currenty:=NO_ICON_POSITION
  73.   projIcon.drawerdata:=NIL
  74.   projIcon.toolwindow:=NIL
  75.   projIcon.stacksize:=4000
  76.  
  77.   -> Open icon.library
  78.   iconbase:=OpenLibrary('icon.library',33)
  79.  
  80.   -> If started from CLI, this example will create a small text file
  81.   -> RAM:Example_Project, and create an icon for the file which points
  82.   -> to this program as its default tool.
  83.   IF wbmessage=NIL
  84.     -> Make a sample project (data) file
  85.     file:=Open(projname, NEWFILE)
  86.     Write(file, 'Have a nice day\n', STRLEN)
  87.  
  88.     -> Now save/update icon for this data file
  89.     makeIcon(projname, toolTypes, deftoolname)
  90.     WriteF('\s data file and icon saved.\n', projname)
  91.     WriteF('Use Workbench menu Icon Information to examine the icon.\n')
  92.     WriteF('Then copy this example (iconexample) to RAM:\n')
  93.     WriteF('and double-click the \s project icon\n', projname)
  94.   ELSE -> Else we are from WB - ie. we were either started by a tool icon,
  95.        -> or as in this case, by being the default tool of a project icon.
  96.     -> E-Note: WriteF opens its own window if necessary
  97.     wbenchMsg:=wbmessage
  98.  
  99.     -> First arg is our executable (tool).  Any additional args are projects
  100.     -> or icons passed to us via either extend select or default tool method.
  101.     wbarg:=wbenchMsg.arglist
  102.     FOR i:=0 TO wbenchMsg.numargs-1
  103.       -> If there's a directory lock for this wbarg, CD there
  104.       olddir:=-1
  105.       IF wbarg.lock AND (wbarg.name[]<>0) THEN olddir:=CurrentDir(wbarg.lock)
  106.  
  107.       showToolTypes(wbarg)
  108.  
  109.       IF (i>0) AND (wbarg.name[]<>0)
  110.         WriteF('In Main. We could open the \s file here\n', wbarg.name)
  111.       ENDIF
  112.       IF olddir<>-1 THEN CurrentDir(olddir)  -> CD back where we were
  113.       wbarg++
  114.     ENDFOR
  115.     Delay(500)
  116.     WriteF('\nPress RETURN to close window\n')
  117.   ENDIF
  118. EXCEPT DO
  119.   IF file THEN Close(file)
  120.   SELECT exception
  121.   CASE ERR_LIB;   WriteF('Can''t open icon.library\n')
  122.   CASE ERR_OPEN;  WriteF('Can''t open file "\s"\n', projname)
  123.   CASE ERR_WRITE; WriteF('Error writing data file\n')
  124.   CASE ERR_MAKE;  WriteF('Error writing icon\n')
  125.   ENDSELECT
  126.   RETURN IF exception=ERR_NONE THEN RETURN_OK ELSE RETURN_FAIL
  127. ENDPROC
  128.  
  129. PROC makeIcon(name, newtooltypes, newdeftool)
  130.   DEF dobj:PTR TO diskobject, oldtooltypes, olddeftool, success=FALSE
  131.   IF dobj:=GetDiskObject(name)
  132.     -> If file already has an icon, we will save off any fields we need to
  133.     -> update, update those fields, put the object, restore the old field
  134.     -> pointers and then free the object.  This will preserve any custom
  135.     -> imagery the user has, and the user's current placement of the icon.
  136.     -> If your application does not know where the user currently keeps your
  137.     -> application, you should not update his dobj.defaulttool.
  138.     oldtooltypes:=dobj.tooltypes
  139.     olddeftool:=dobj.defaulttool
  140.  
  141.     dobj.tooltypes:=newtooltypes
  142.     dobj.defaulttool:=newdeftool
  143.  
  144.     success:=PutDiskObject(name, dobj)
  145.  
  146.     -> We must restore the original pointers before freeing
  147.     dobj.tooltypes:=oldtooltypes
  148.     dobj.defaulttool:=olddeftool
  149.     FreeDiskObject(dobj)
  150.   ENDIF
  151.   -> Else, put our default icon
  152.   IF success=FALSE THEN success:=PutDiskObject(name, projIcon)
  153.   IF success=FALSE THEN Raise(ERR_MAKE)
  154. ENDPROC
  155.  
  156. PROC showToolTypes(wbarg:PTR TO wbarg)
  157.   DEF dobj:PTR TO diskobject, toolarray, s, success=FALSE
  158.   WriteF('\nWBArg Lock=$\h, Name=\s ($\h)\n',
  159.          wbarg.lock, wbarg.name, wbarg.name[])
  160.  
  161.   IF (wbarg.name[]<>0) AND (dobj:=GetDiskObject(wbarg.name))
  162.     WriteF('  We have read the DiskObject (icon) for this arg\n')
  163.     toolarray:=dobj.tooltypes
  164.  
  165.     IF s:=FindToolType(toolarray, 'FILETYPE')
  166.       WriteF('    Found tooltype FILETYPE with value \s\n', s)
  167.     ENDIF
  168.     IF s:=FindToolType(toolarray, 'FLAGS')
  169.       WriteF('    Found tooltype FLAGS with value \s\n', s)
  170.       IF MatchToolValue(s, 'BOLD')
  171.         WriteF('      BOLD flag requested\n')
  172.       ENDIF
  173.       IF MatchToolValue(s, 'ITALICS')
  174.         WriteF('      ITALICS flag requested\n')
  175.       ENDIF
  176.     ENDIF
  177.     -> Free the diskobject we got
  178.     FreeDiskObject(dobj)
  179.     success:=TRUE
  180.   ELSEIF wbarg.name[]=0
  181.     WriteF('  Must be a disk or drawer icon\n')
  182.   ELSE
  183.     WriteF('  Can''t find any DiskObject (icon) for this WBArg\n')
  184.   ENDIF
  185. ENDPROC success
  186.