diff -r d56585b0e8c0 -r f1223fbd4e15 Image.st --- 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!