Image.st
changeset 1307 f1223fbd4e15
parent 1306 d56585b0e8c0
child 1309 2a1d271ef7f8
--- a/Image.st	Sat Feb 01 14:13:37 1997 +0100
+++ b/Image.st	Sat Feb 01 15:13:29 1997 +0100
@@ -16,7 +16,7 @@
 		deviceForm monoDeviceForm fullColorDeviceForm mask'
 	classVariableNames:'Lobby DitherAlgorithm NumberOfDitherColors
 		CollectGarbageWhenRunningOutOfColors FileFormats
-		ImageNotFoundQuerySignal'
+		ImageNotFoundQuerySignal BadImageFormatQuerySignal'
 	poolDictionaries:''
 	category:'Graphics-Images'
 !
@@ -455,6 +455,20 @@
 
 !Image class methodsFor:'initialization'!
 
+addReader:aReaderClass suffix:aSuffix
+    "register an additional image reader.
+     This is provided for subclasses, to regster themself when
+     loaded (or from the startup scripts)"
+
+    FileFormats at:(aSuffix asLowercase) put:aReaderClass.
+
+    "
+     Image addReader:GIFReader suffix:'gif'
+    "
+
+    "Modified: 1.2.1997 / 14:42:54 / cg"
+!
+
 fileFormats
     "return the collection of supported file formats.
      The returned dictionary maps file-extensions to image reader classes."
@@ -512,9 +526,12 @@
 
         ImageNotFoundQuerySignal := QuerySignal new.
         ImageNotFoundQuerySignal nameClass:self message:#imageNotFoundQuerySignal.
+
+        BadImageFormatQuerySignal := QuerySignal new.
+        BadImageFormatQuerySignal nameClass:self message:#badImageFormatQuerySignal.
     ]
 
-    "Modified: 7.1.1997 / 16:05:02 / cg"
+    "Modified: 1.2.1997 / 14:40:53 / cg"
 !
 
 initializeFileFormatTable
@@ -523,15 +540,18 @@
      see the 'smalltalk.rc' startup file for a real (full) map."
 
     FileFormats := Dictionary new.
-    FileFormats at:'.xbm'  put:XBMReader.
-    FileFormats at:'.tiff' put:TIFFReader.
-    FileFormats at:'.gif'  put:GIFReader.
-"/    FileFormats at:'.img'  put:IMGReader.
-"/    FileFormats at:'.icon' put:SunRasterReader.
+
+    FileFormats at:'xbm'  put:XBMReader.
+    FileFormats at:'tiff' put:TIFFReader.
+    FileFormats at:'gif'  put:GIFReader.
+"/    FileFormats at:'img'  put:IMGReader.
+"/    FileFormats at:'icon' put:SunRasterReader.
 
     "
      Image initializeFileFormatTable
     "
+
+    "Modified: 1.2.1997 / 14:41:11 / cg"
 !
 
 update:something with:aParameter from:changedObject
@@ -867,6 +887,19 @@
 
 !Image class methodsFor:'Signal constants'!
 
+badImageFormatQuerySignal
+    "return the (query-) signal, which is raised if some
+     bitmap-image could not be loaded due to an unrecognized format.
+     If unhandled, the image-load returns nil.
+     Otherwise, it returns whatever the handler proceeds with.
+     The exception gets either the images fileName or an input stream
+     as parameter"
+
+    ^ BadImageFormatQuerySignal
+
+    "Created: 1.2.1997 / 14:40:29 / cg"
+!
+
 imageNotFoundQuerySignal
     "return the (query-) signal, which is raised if some
      bitmap-image could not be loaded from a file.
@@ -912,59 +945,63 @@
      the ImageNotFoundQuerySignal is raised, which may be handled to
      proceed with some replacement image. If unhandled, nil is returned."
 
-    |image name nm inStream suffixLen|
+    |image name fn nm inStream suffix readerClass|
 
     "
      before trying each reader, check if the file is readable
     "
-    name := aFileName.
+    name := aFileName asFilename name.
+
     inStream := Smalltalk systemFileStreamFor:name.
     inStream isNil ifTrue:[
         inStream := Smalltalk bitmapFileStreamFor:name.
         inStream isNil ifTrue:[
-            image := ImageNotFoundQuerySignal
+
+            "/ this signal is a query - if noone seems to
+            "/ care, return nil.
+            "/ However, a handler may provide a replacement.
+
+"/            ('IMAGE: ' , aFileName , ' does not exist or is not readable') infoPrintCR.
+            ^ ImageNotFoundQuerySignal
                         raiseRequestWith:aFileName
                         errorString:('IMAGE: ''' , aFileName , ''' does not exist or is not readable').
-"/            ('IMAGE: ' , aFileName , ' does not exist or is not readable') infoPrintCR.
-            ^ image
         ].
         name := 'bitmaps/' , name.
     ].
     inStream close.
 
-    "
-     get the imageReader class from the files extension
-    "
     nm := name.
-    (name endsWith:'.Z') ifTrue:[
-        suffixLen := 2
-    ] ifFalse:[
-        (name endsWith:'.gz') ifTrue:[
-            suffixLen := 3
-        ] ifFalse:[
-            suffixLen := 0
-        ]
-    ].
-    suffixLen ~~ 0 ifTrue:[
-        nm := name copyWithoutLast:suffixLen
-    ].
-
-    "
-     ask the corresponding readerclass first
-    "
-    FileFormats keysAndValuesDo:[:suffix :readerClass |
-        (nm endsWith:suffix) ifTrue:[
-            readerClass notNil ifTrue:[
-                image := readerClass fromFile:name.
-                image notNil ifTrue:[^ image].
-            ]
-        ]
+    fn := nm asFilename.
+    suffix := fn suffix.
+
+    "/
+    "/ handle compressed-suffix
+    "/
+    (#('Z' 'gz') includes:suffix) ifTrue:[
+        fn := fn withoutSuffix.
+        nm := fn name.
+        suffix := fn suffix.
+    ].
+
+    suffix isEmpty ifTrue:[
+        suffix := nm.
+    ].
+
+    "/
+    "/ get the imageReader class from the files extension
+    "/ and ask it first
+
+    readerClass := FileFormats at:(suffix asLowercase).
+    readerClass notNil ifTrue:[
+        image := readerClass fromFile:name.
+        image notNil ifTrue:[^ image].
     ].
 
     "
      no known extension - ask all readers if they know
      this format ...
      ... these look into the file, and investigate the header.
+     therefore, it takes a bit longer.
     "
     FileFormats do:[:readerClass |
         readerClass notNil ifTrue:[
@@ -974,14 +1011,16 @@
         ]
     ].
 
-    "
-     nope - unknown format
-    "
-    image := ImageNotFoundQuerySignal
+    "/ nope - unknown format
+    "/
+    "/ this signal is a query - if noone seems to
+    "/ care, return nil.
+    "/ However, a handler may provide a replacement.
+
+"/    'IMAGE: unknown image file format: ' infoPrint. aFileName infoPrintNL.
+    ^ ImageNotFoundQuerySignal
                 raiseRequestWith:aFileName
                 errorString:('IMAGE: unknown image file format: ''' , aFileName , '''').
-"/    'IMAGE: unknown image file format: ' infoPrint. aFileName infoPrintNL.
-    ^ image
 
     "
      Image fromFile:'bitmaps/dano.tiff'
@@ -1025,40 +1064,43 @@
      ]
     "
 
-    "Modified: 7.1.1997 / 16:08:37 / cg"
+    "Modified: 1.2.1997 / 15:12:51 / cg"
 !
 
 fromFile:aFileName on:aDevice
     "read an image from a file and prepare a device representation.
-     Return nil, if the file is unreadable or does not contain an
-     appropriate image."
+     Return nil (or whatever a handler returned), 
+     if the file is unreadable or does not contain an appropriate image."
 
     |img|
 
     img := self fromFile:aFileName.
     img notNil ifTrue:[
-	^ img on:aDevice
+        ^ img on:aDevice
     ].
     ^ nil
+
+    "Modified: 1.2.1997 / 14:48:07 / cg"
 !
 
 fromFile:aFileName resolution:res
     "read an image from a file and (if required) scale the image
      as appropriate (only with very high resolution displays).
-     Return nil, if the file is unreadable or does not contain an
-     appropriate image."
+     Return nil (or whatever a handler returned), 
+     if the file is unreadable or does not contain an appropriate image."
 
     ^ self fromFile:aFileName resolution:res on:nil
 
     "Created: 19.12.1996 / 14:02:13 / cg"
+    "Modified: 1.2.1997 / 14:48:16 / cg"
 !
 
 fromFile:aFileName resolution:dpi on:aDevice
     "read an image from a file and (if required) scale the image
      as appropriate (only with very high resolution displays).
      Prepare a device representation.
-     Return nil, if the file is unreadable or does not contain an
-     appropriate image."
+     Return nil (or whatever a handler returned), 
+     if the file is unreadable or does not contain an appropriate image."
 
     |img dev dpiH mag|
 
@@ -1084,13 +1126,17 @@
         ^ img on:aDevice
     ].
     ^ img
+
+    "Modified: 1.2.1997 / 14:48:20 / cg"
 !
 
 fromStream:aStream
     "read an image from a stream - this methods tries to find
      out the file format itself (by contents)
      and lets the appropriate reader read the file.
-     To do this, the stream must be positionable."
+     To do this, the stream must be positionable.
+     Return nil (or whatever a handler returned), 
+     if the stream does not contain an appropriate image."
 
     |image|
 
@@ -1108,8 +1154,11 @@
     "
      nope - unknown format
     "
-    'Image [info]: unknown image file format in stream: ' infoPrintCR.
-    ^ nil
+"/    'Image [info]: unknown image file format in stream: ' infoPrintCR.
+
+    ^ ImageNotFoundQuerySignal
+                raiseRequestWith:aStream
+                errorString:('IMAGE: unknown image file format in stream').
 
     "
      Image fromFile:'bitmaps/dano.tiff'
@@ -1130,7 +1179,33 @@
     "
 
     "Created: 13.9.1996 / 18:06:00 / cg"
-    "Modified: 10.1.1997 / 15:45:53 / cg"
+    "Modified: 1.2.1997 / 14:48:41 / cg"
+!
+
+fromStream:aStream using:aReaderClass
+    "read an image from a stream, given an imageReaderClass.
+     Use this, if you know the files format, but it has an invalid
+     extension (or non-definite header), so #fromStream: could not
+     find out the images format.
+     Return nil (or whatever a handler returned), 
+     if the stream does not contain an appropriate image."
+
+    |image|
+
+    image := aReaderClass fromStream:aStream.
+    image notNil ifTrue:[^ image].
+
+    "
+     nope - unknown format
+    "
+"/    'Image [info]: unknown image file format in stream: ' infoPrintCR.
+
+    ^ ImageNotFoundQuerySignal
+                raiseRequestWith:aStream
+                errorString:('IMAGE: unknown image file format in stream').
+
+    "Created: 1.2.1997 / 14:46:20 / cg"
+    "Modified: 1.2.1997 / 14:48:53 / cg"
 ! !
 
 !Image class methodsFor:'misc'!
@@ -1266,7 +1341,10 @@
 
     "
      Image fromScreen
-    "
+     Image fromScreen inspect
+    "
+
+    "Modified: 1.2.1997 / 14:55:12 / cg"
 !
 
 fromScreen:aRectangle
@@ -1276,7 +1354,10 @@
 
     "
      Image fromScreen:(0@0 corner:100@100)
-    "
+     (Image fromScreen:(0@0 corner:100@100)) inspect
+    "
+
+    "Modified: 1.2.1997 / 14:55:33 / cg"
 !
 
 fromScreen:aRectangle on:aDisplay
@@ -1294,9 +1375,9 @@
     "/
     vis := aDisplay visualType.
     (vis == #TrueColor or:[vis == #DirectColor]) ifTrue:[
-	depth > 8 ifTrue:[
-	    depth := 24.
-	]
+        depth > 8 ifTrue:[
+            depth := 24.
+        ]
     ].
 
     img := (self implementorForDepth: depth) new.
@@ -1305,17 +1386,32 @@
     "
      Image fromScreen:(0@0 corner:100@100)
     "
+
+    "get a snapshot of your friends screen ...
+
+     |dpy2|
+
+     dpy2 := XWorkstation new initializeFor:'idefix:0'.
+     (Image fromScreen:(dpy2 bounds) on:dpy2) inspect
+    "
+
+    "Modified: 1.2.1997 / 14:54:20 / cg"
 !
 
 fromScreenArea
     "return an image of a part of the screen; 
-     let user specify screen area."
+     let user specify screen area.
+     This is the same as #fromUser - kept for backward compatibility.
+     Use #fromUser for ST-80 compatibility."
 
     ^ self fromScreen:(Rectangle fromUser)
 
     "
      Image fromScreenArea
-    "
+     Image fromScreenArea inspect
+    "
+
+    "Modified: 1.2.1997 / 14:55:47 / cg"
 !
 
 fromUser
@@ -1326,15 +1422,19 @@
 
     "
      Image fromUser
-    "
+     Image fromUser inspect
+    "
+
+    "Modified: 1.2.1997 / 14:55:54 / cg"
 !
 
 fromView:aView
     "return an image taken from a views contents as currently
      on the screen. The returned image has the same depth and photometric
-     as the Display. Notice, that for invisible or partial covered
-     views, the returned Image is NOT correct. You may want to raise
-     the view before using this method."
+     as the Display. 
+     Notice, that for invisible or partial covered views, 
+     the returned Image is NOT correct. 
+     You may want to raise the view before using this method."
 
     |org dev|
 
@@ -1345,12 +1445,20 @@
     ^ self fromScreen:(org extent:aView extent) on:dev
 
     "
-     Image fromView:(Launcher allInstances first topView)
-     Image fromView:(SystemBrowser allInstances first topView)
-    "
-
-    "Modified: 28.5.1996 / 20:23:32 / cg"
+     Image fromView:(Launcher allInstances first window topView)
+     Image fromView:(BrowserView allInstances first topView)
+    "
+
+    "get a snapshot from whichever view is active:
+
+     |active|
+
+     active := WindowGroup activeGroup topViews first.
+     (Image fromView:active) inspect
+    "
+
     "Modified: 9.9.1996 / 22:41:01 / stefan"
+    "Modified: 1.2.1997 / 14:57:24 / cg"
 ! !
 
 !Image methodsFor:'ST-80 compatibility'!
@@ -8396,35 +8504,40 @@
      controls the format. Currently, not all formats may be supported
      (see ImageReader subclasses implementing save:onFile:)"
 
-    "
-     from the extension, get the imageReader class
-     (which should know how to write images as well)
-    "
-    FileFormats associationsDo:[:a |
-        (aFileName endsWith:(a key)) ifTrue:[
-            ^ (a value) save:self onFile:aFileName
-        ]
-    ].
-
-    "
-     no known extension - could ask user for the format here.
-     currently default to tiff format.
-    "
+    |suffix readerClass|
+
+    "/
+    "/ from the extension, get the imageReader class
+    "/ (which should know how to write images as well)
+    "/
+    suffix := aFileName asFilename suffix.
+    readerClass := FileFormats at:suffix ifAbsent:nil.
+    readerClass notNil ifTrue:[
+        ^ self saveOn:aFileName using:readerClass
+    ].
+
+    "/
+    "/ no known extension - could ask user for the format here.
+    "/ currently default to tiff format.
+    "/
     'Image [warning]: unknown extension - cannot figure out format - using tiff' errorPrintCR.
+
     ^ self saveOn:aFileName using:TIFFReader
 
-    "Modified: 10.1.1997 / 17:53:34 / cg"
+    "Modified: 1.2.1997 / 14:45:41 / cg"
 !
 
 saveOn:aFileName using:readerClass
     "save the receiver using the representation class"
 
-    readerClass save:self onFile:aFileName
+    ^ readerClass save:self onFile:aFileName
 
     "
      anImage saveOn:'myImage' using:TIFFReader
      anImage saveOn:'myImage' using:XBMReader
     "
+
+    "Modified: 1.2.1997 / 14:45:13 / cg"
 ! !
 
 !Image methodsFor:'screen capture'!
@@ -8818,6 +8931,6 @@
 !Image class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.142 1997-02-01 13:13:37 ca Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.143 1997-02-01 14:13:29 cg Exp $'
 ! !
 Image initialize!