author | Claus Gittinger <cg@exept.de> |
Sat, 11 Nov 1995 17:05:49 +0100 | |
changeset 114 | e577a2f332d0 |
parent 111 | 23f66f18a3cb |
child 158 | 16f2237474fe |
permissions | -rw-r--r-- |
77 | 1 |
" |
2 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
3 |
All Rights Reserved |
|
4 |
||
5 |
This software is furnished under a license and may be used |
|
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
12 |
||
13 |
'From Smalltalk/X, Version:2.10.5 on 14-apr-1995 at 11:13:06 am'! |
|
14 |
||
15 |
Object subclass:#Icon |
|
16 |
instanceVariableNames:'image mask' |
|
17 |
classVariableNames:'KnownIcons' |
|
18 |
poolDictionaries:'' |
|
19 |
category:'Graphics-Support' |
|
20 |
! |
|
21 |
||
22 |
!Icon class methodsFor:'documentation'! |
|
23 |
||
24 |
version |
|
114
e577a2f332d0
uff - version methods changed to return stings
Claus Gittinger <cg@exept.de>
parents:
111
diff
changeset
|
25 |
^ '$Header: /cvs/stx/stx/libview2/Icon.st,v 1.5 1995-11-11 16:04:33 cg Exp $' |
77 | 26 |
! |
27 |
||
28 |
documentation |
|
29 |
" |
|
111 | 30 |
ST-80 Compatibility mimicri for Icon. |
31 |
Implements the #constantNamed: message which is used by some ST-80 PD |
|
77 | 32 |
classes and returns corresponding ST/X icons. |
111 | 33 |
|
34 |
If you like the original ST-80 icons, install the xbm files in the bitmap |
|
77 | 35 |
directory under a name foo.xbm, where foo corresponds to the icons |
36 |
name symbol (i.e. for Icon constantNamed:#foo, a 'foo.xbm' file is required). |
|
111 | 37 |
You can grab those icons from manchester or from the PrimeTime Freeware CD. |
38 |
A copy of the PTF-CD is also in goodies/bitmaps/st80bitmaps. |
|
39 |
Then, change the replacementName method to return an empty array. |
|
40 |
||
105 | 41 |
Caveat: |
42 |
masks are not yet implemented |
|
77 | 43 |
" |
44 |
! |
|
45 |
||
46 |
copyright |
|
47 |
" |
|
48 |
COPYRIGHT (c) 1995 by Claus Gittinger |
|
49 |
All Rights Reserved |
|
50 |
||
51 |
This software is furnished under a license and may be used |
|
52 |
only in accordance with the terms of that license and with the |
|
53 |
inclusion of the above copyright notice. This software may not |
|
54 |
be provided or otherwise made available to, or used by, any |
|
55 |
other person. No title to or ownership of the software is |
|
56 |
hereby transferred. |
|
57 |
" |
|
58 |
! ! |
|
59 |
||
60 |
!Icon class methodsFor:'initialization'! |
|
61 |
||
62 |
replacementNames |
|
105 | 63 |
"return an ST-80 constant name to ST/X file name translation." |
77 | 64 |
|
65 |
^ #( |
|
66 |
#(file FBrowser) |
|
67 |
#(debugger Debugger) |
|
68 |
#(systembrowser SBrowser) |
|
69 |
#(classbrowser SBrowser) |
|
70 |
#(categoryBrowser SBrowser) |
|
71 |
#(hierarchyBrowser SBrowser) |
|
72 |
#(methodBrowser SBrowser) |
|
73 |
#(launcher SmalltalkX) |
|
74 |
#(workspace SmalltalkX) |
|
75 |
#(transcript SmalltalkX) |
|
76 |
#(inspector Inspector) |
|
77 |
#(default SmalltalkX) |
|
78 |
) |
|
79 |
! |
|
80 |
||
81 |
replacementNameFor:aName |
|
82 |
"return a replacement ST/X name for an ST80 icon name." |
|
83 |
||
84 |
self replacementNames do:[:aPair | |
|
85 |
(aPair at:1) == aName ifTrue:[^ aPair at:2]. |
|
86 |
]. |
|
87 |
^ nil |
|
88 |
! |
|
89 |
||
90 |
initialize |
|
91 |
KnownIcons := IdentityDictionary new |
|
92 |
||
93 |
" |
|
94 |
Icon initialize |
|
95 |
" |
|
96 |
! ! |
|
97 |
||
98 |
!Icon class methodsFor:'instance creation'! |
|
99 |
||
100 |
constantNamed:aName put:anIcon |
|
105 | 101 |
KnownIcons at:aName put:anIcon |
77 | 102 |
! |
103 |
||
104 |
constantNamed:aName |
|
105 |
|icon nm| |
|
106 |
||
107 |
icon := KnownIcons at:aName ifAbsent:[]. |
|
108 |
icon isNil ifTrue:[ |
|
109 |
nm := self replacementNameFor:aName. |
|
110 |
nm notNil ifTrue:[ |
|
111 |
icon := Image fromFile:('bitmaps/' , nm , '.xbm'). |
|
112 |
]. |
|
113 |
icon isNil ifTrue:[ |
|
84 | 114 |
icon := Image fromFile:('bitmaps/' , aName , '.xbm'). |
77 | 115 |
icon isNil ifTrue:[ |
116 |
('ICON: no icon named ' , aName) errorPrintNL. |
|
117 |
^ nil |
|
118 |
]. |
|
105 | 119 |
icon := icon on:Screen default. |
77 | 120 |
]. |
121 |
KnownIcons at:aName put:icon. |
|
122 |
]. |
|
123 |
^ icon |
|
124 |
||
125 |
" |
|
126 |
Icon constantNamed:#file |
|
127 |
Icon constantNamed:#debugger |
|
128 |
Icon constantNamed:#systembrowser |
|
84 | 129 |
Icon constantNamed:#SBrowser |
105 | 130 |
Icon constantNamed:#SBrowser |
77 | 131 |
" |
132 |
! ! |
|
133 |
||
134 |
Icon initialize! |