Image.st
changeset 401 f163a93a0987
parent 399 0b6e43843204
child 518 f76da6242336
--- a/Image.st	Sun Feb 04 20:40:49 1996 +0100
+++ b/Image.st	Mon Feb 05 01:48:12 1996 +0100
@@ -585,6 +585,10 @@
 
     display := Screen current.
     ^ self fromScreen:(0@0 corner:(display width @ display height))
+
+    "
+     Image fromScreen
+    "
 !
 
 fromScreen:aRectangle
@@ -592,20 +596,37 @@
 
     ^ self fromScreen:aRectangle on:Screen current 
 
-    "Image fromScreen:(0@0 corner:100@100)"
+    "
+     Image fromScreen:(0@0 corner:100@100)
+    "
 !
 
 fromScreen:aRectangle on:aDisplay
     "return an image of a part of the screen, which may be on
      another Display."
 
-    |depth img|
+    |depth vis img|
 
     depth := aDisplay depth.
+
+    "/
+    "/ for truecolor displays, return a Depth24Image
+    "/ (must do this for depth15 & depth16 displays, since
+    "/  Depth16Image has no way to specify r/g/b masks ...)
+    "/
+    vis := aDisplay visualType.
+    (vis == #TrueColor or:[vis == #DirectColor]) ifTrue:[
+	depth > 8 ifTrue:[
+	    depth := 24.
+	]
+    ].
+
     img := (self implementorForDepth: depth) new.
     ^ img fromScreen:aRectangle on:aDisplay
 
-    "Image fromScreen:(0@0 corner:100@100)"
+    "
+     Image fromScreen:(0@0 corner:100@100)
+    "
 !
 
 fromScreenArea
@@ -614,7 +635,9 @@
 
     ^ self fromScreen:(Rectangle fromUser)
 
-    "Image fromScreenArea"
+    "
+     Image fromScreenArea
+    "
 !
 
 fromUser
@@ -623,7 +646,9 @@
 
     ^ self fromScreenArea
 
-    "Image fromUser"
+    "
+     Image fromUser
+    "
 !
 
 fromView:aView
@@ -642,7 +667,7 @@
     ^ self fromScreen:(org extent:aView extent) on:dev
 
     "
-     Image fromView:(Launcher allInstances first topView)
+     Image fromView:(NewLauncher allInstances first topView)
      Image fromView:(SystemBrowser allInstances first topView)
     "
 ! !
@@ -3090,6 +3115,9 @@
      shR "{ Class: SmallInteger }"
      shG "{ Class: SmallInteger }"
      shB "{ Class: SmallInteger }"
+     shR2 "{ Class: SmallInteger }"
+     shG2 "{ Class: SmallInteger }"
+     shB2 "{ Class: SmallInteger }"
      r "{ Class: SmallInteger }"
      g "{ Class: SmallInteger }"
      b "{ Class: SmallInteger }"
@@ -3132,10 +3160,12 @@
 	    ((visType == #TrueColor) or:[visType == #DirectColor]) ifTrue:[
 		photometric := #rgb.
 		samplesPerPixel := 3.
-		bitsPerPixel := depth.
-		bitsPerSample := Array with:aDevice bitsRed
-				       with:aDevice bitsGreen
-				       with:aDevice bitsBlue
+"/                bitsPerPixel := depth.
+"/                bitsPerSample := Array with:aDevice bitsRed
+"/                                       with:aDevice bitsGreen
+"/                                       with:aDevice bitsBlue
+		bitsPerPixel := 24.
+		bitsPerSample := #(8 8 8).
 	    ] ifFalse:[
 		self error:'screen visual not supported'.
 		^ nil
@@ -3217,38 +3247,66 @@
 
 	bitsPerPixelIn ~~ bitsPerPixel ifTrue:[
 	    "/ for now, only 32 -> 24 is supported
-	    ((bitsPerPixelIn ~~ 32)
-	    or:[bitsPerPixel ~~ 24]) ifTrue:[
-		'unsupported depth combination' errorPrintNL.
-		^ nil
+
+	    maskR := (1 bitShift:aDevice bitsRed) - 1.
+	    maskG := (1 bitShift:aDevice bitsGreen) - 1.
+	    maskB := (1 bitShift:aDevice bitsBlue) - 1.
+	    shR := aDevice shiftRed negated.
+	    shG := aDevice shiftGreen negated.
+	    shB := aDevice shiftBlue negated.
+	    shR2 := (8 - aDevice bitsRed).
+	    shG2 := (8 - aDevice bitsGreen).
+	    shB2 := (8 - aDevice bitsBlue).
+
+	    ((bitsPerPixelIn == 32) and:[bitsPerPixel == 24]) ifTrue:[
+		"/ 'reformatting 32->24...' printNL.
+		1 to:h do:[:hi |
+		    srcIndex := srcRow.
+		    dstIndex := dstRow.
+
+		    1 to:w do:[:wi |
+			word := tmpData doubleWordAt:srcIndex MSB:true.
+			r := (word bitShift:shR) bitAnd:maskR.
+			g := (word bitShift:shG) bitAnd:maskG.
+			b := (word bitShift:shB) bitAnd:maskB.
+
+			inData at:dstIndex   put:r.
+			inData at:dstIndex+1 put:g.
+			inData at:dstIndex+2 put:b.
+			srcIndex := srcIndex + 4.
+			dstIndex := dstIndex + 3.
+		    ].
+		    dstRow := dstRow + bytesPerLine.
+		    srcRow := srcRow + bytesPerLineIn
+		]
+	    ] ifFalse:[
+		((bitsPerPixelIn == 16) and:[bitsPerPixel == 24]) ifTrue:[
+		    "/ 'reformatting 16->24...' printNL.
+		    1 to:h do:[:hi |
+			srcIndex := srcRow.
+			dstIndex := dstRow.
+
+			1 to:w do:[:wi |
+			    word := tmpData wordAt:srcIndex MSB:true.
+			    r := (word bitShift:shR) bitAnd:maskR.
+			    g := (word bitShift:shG) bitAnd:maskG.
+			    b := (word bitShift:shB) bitAnd:maskB.
+
+			    inData at:dstIndex   put:(r bitShift:shR2).
+			    inData at:dstIndex+1 put:(g bitShift:shG2).
+			    inData at:dstIndex+2 put:(b bitShift:shB2).
+			    srcIndex := srcIndex + 2.
+			    dstIndex := dstIndex + 3.
+			].
+			dstRow := dstRow + bytesPerLine.
+			srcRow := srcRow + bytesPerLineIn
+		    ]
+		] ifFalse:[
+		    ('unsupported depth combination: ' , bitsPerPixelIn printString , ' -> ' ,
+							bitsPerPixel printString) errorPrintNL.
+		    ^ nil
+		]
 	    ].
-
-	    'reformatting ...' printNL.
-	    1 to:h do:[:hi |
-		srcIndex := srcRow.
-		dstIndex := dstRow.
-		maskR := (1 bitShift:aDevice bitsRed) - 1.
-		maskG := (1 bitShift:aDevice bitsGreen) - 1.
-		maskB := (1 bitShift:aDevice bitsBlue) - 1.
-		shR := aDevice shiftRed negated.
-		shG := aDevice shiftGreen negated.
-		shB := aDevice shiftBlue negated.
-
-		1 to:w do:[:wi |
-		    word := tmpData doubleWordAt:srcIndex MSB:true.
-		    r := (word bitShift:shR) bitAnd:maskR.
-		    g := (word bitShift:shG) bitAnd:maskG.
-		    b := (word bitShift:shB) bitAnd:maskB.
-
-		    inData at:dstIndex   put:r.
-		    inData at:dstIndex+1 put:g.
-		    inData at:dstIndex+2 put:b.
-		    srcIndex := srcIndex + 4.
-		    dstIndex := dstIndex + 3.
-		].
-		dstRow := dstRow + bytesPerLine.
-		srcRow := srcRow + bytesPerLineIn
-	    ]
 	] ifFalse:[
 	    "
 	     repad in the buffer
@@ -3304,10 +3362,12 @@
      (Image new) fromScreen:((0 @ 0) corner:(100 @ 100)) on:Display
      (Image new) fromScreen:((0 @ 0) corner:(500 @ 500)) on:Display
     "
+
+    "Modified: 5.2.1996 / 01:10:48 / cg"
 ! !
 
 !Image class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.59 1996-02-04 17:13:46 cg Exp $'! !
+    ^ '$Header: /cvs/stx/stx/libview/Image.st,v 1.60 1996-02-05 00:48:12 cg Exp $'! !
 Image initialize!