"
 COPYRIGHT (c) 2006 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libview2' }"

PrinterContext subclass:#WinPrinterContext
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Printing'
!

!WinPrinterContext class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2006 by eXept Software AG
              All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    I am the mediator between the smalltalk printing protocol 
    (which is the same as the graphics drawing protocol) and the
    windows printer.
    When youopena printer, you will typically talk to me, and I will
    forward the graphics commands to my printer.

    [author:]
        Felix Madrid (fm@exept.de)
"
! !

!WinPrinterContext class methodsFor:'instance creation'!

fromPrinterInfo: aPrinterInfo
    | aPrinter hDC|     

    hDC := aPrinterInfo createDC.
    hDC = 0 ifTrue: [ ^self error: 'Error while opening printer.' ].

    aPrinter := self new.
    aPrinter printerInfo: aPrinterInfo.
    aPrinter setDevice:(WinPrinter on: aPrinterInfo) id:nil gcId:hDC.
    aPrinter initExtent.
    ^aPrinter

    "Created: / 03-08-2006 / 12:53:52 / fm"
    "Modified: / 04-08-2006 / 12:55:01 / fm"
    "Modified: / 16-04-2007 / 12:36:26 / cg"
! !

!WinPrinterContext class methodsFor:'accessing'!

getPrinterInformation:printerNameString 
    " Answer the printer information for the printer named printerNameString.  If no name is specified,
      answer the information for the default printer."
    
    |h|

    h := OperatingSystem openPrinter:printerNameString.
    ^ OperatingSystem 
        getDocumentProperties:nil
        hPrinter:h
        pDeviceName:printerNameString.

    "Created: / 27-07-2006 / 10:22:32 / fm"
    "Modified: / 01-08-2006 / 16:01:44 / fm"
    "Modified: / 10-10-2006 / 18:57:45 / cg"
!

named: aName
    "Answer a new instance of Printer which represents
     the printer named aName as specified in the host
     Control Panel."

    aName isNil ifTrue: [ ^self default ].
    ^self new printerInfoWithName: aName

    "Created: / 27-07-2006 / 17:51:27 / fm"
    "Modified: / 02-08-2006 / 17:26:29 / fm"
    "Modified: / 10-10-2006 / 17:33:29 / cg"
! !

!WinPrinterContext class methodsFor:'testing & examples'!

print: aString font: aFont title: aTitle
    "Open a print dialog to allow printing of the given string
     using the given title & font."

    self print: aString font: aFont title: aTitle wordWrap: false     

   "
    WinPrinterContext print: 'Holaaaa!! (from:  WinPrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test'
    WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: nil title: 'Printing Test String'
    WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String'
   "

    "Created: / 27-07-2006 / 17:52:33 / fm"
    "Modified: / 03-08-2006 / 18:52:31 / fm"
    "Modified: / 16-04-2007 / 13:54:40 / cg"
!

print: aString font: aFont title: aTitle wordWrap: wordWrap
    "Open a print dialog to allow printing of the given string
     using the given title & font."

    | printerInfo printer |

    printerInfo := PrintingDialog getPrinterInfo.
    printerInfo isNil ifTrue:[^self].

    printer := self fromPrinterInfo: printerInfo.
    [ 
        printer
            print: aString
            font: aFont
            title: aTitle 
            wordWrap: wordWrap
            marginsRect: nil 
    ] forkAt: 3

    "
     WinPrinterContext print: 'Holaaaa!! (from:  PrinterContext>>print:aString font:aFont title:aTitle)' font: nil title: 'Printing Test' wordWrap: true
     WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font:nil title:'Printing Test String' wordWrap:true
     WinPrinterContext print: (WinPrinterContext class sourceCodeAt:#'print:font:title:wordWrap:') font: (Font family:'Arial' face:'medium' size:8) title: 'Printing Test String' wordWrap: true
    "

    "Created: / 03-08-2006 / 18:51:53 / fm"
    "Modified: / 16-04-2007 / 15:37:31 / cg"
!

printCircles: arrayOfPointsAndRadius
    "Opens a print dialog and prints the given circles"

    | printerInfo printer |

    printerInfo := PrintingDialog getPrinterInfo.
    printerInfo isNil ifTrue:[^self].

    printer := self fromPrinterInfo: printerInfo.
    [ 
        printer startPrintJob: 'Circles'.
        arrayOfPointsAndRadius
            do:[:pointAndRadius |
                printer displayCircle:(pointAndRadius at:1) 
                        radius:(pointAndRadius at:2).
            ].
        printer endPrintJob.
    ] forkAt: 3

    "
     WinPrinterContext printCircles:  
        (Array with: (Array with: 800@800 with: 600)
               with: (Array with: 1500@1500 with: 1000)
               with: (Array with: 4000@2500 with: 2000))
    "

    "Created: / 07-08-2006 / 11:46:52 / fm"
    "Modified: / 16-04-2007 / 15:37:34 / cg"
!

printCirclesIn: rectangles
    "Opens a print dialog and prints the given circles"

    | printerInfo printer |

    printerInfo := PrintingDialog getPrinterInfo.
    printerInfo isNil ifTrue:[^self].

    printer := self fromPrinterInfo: printerInfo.
    [ 
        printer startPrintJob: 'Circles In Rectangles'.
        rectangles
           do:[:rectangle |
               printer displayCircleIn: rectangle.
           ].
       printer endPrintJob.
    ] forkAt: 3

    "
     WinPrinterContext printCirclesIn:  
        (Array with: (Rectangle left:20 top:20 width:400 height:600)
               with: (Rectangle left:40 top:40 width:600 height:400)    
        )
    "

    "Created: / 07-08-2006 / 11:48:46 / fm"
    "Modified: / 16-04-2007 / 15:37:38 / cg"
!

printLines: pairOfPointsArray
    "Opens a print dialog and prints the given lines"

    | printerInfo printer |

    printerInfo := PrintingDialog getPrinterInfo.
    printerInfo isNil ifTrue:[^self].

    printer := self fromPrinterInfo: printerInfo.
    [ 
        printer startPrintJob: 'Lines'.
        printer foreground:Color black background:Color white.
        pairOfPointsArray
            do:[:pairOfPoints |                 
                 printer displayLineFrom: (pairOfPoints at:1)  to: (pairOfPoints at:2).
            ].
        printer endPrintJob.
    ] forkAt: 3

    "
     WinPrinterContext printLines:  
        (Array with: (Array with:10@10 with:100@10)
               with: (Array with:10@10 with:35@200))
    "

    "Created: / 07-08-2006 / 12:09:48 / fm"
    "Modified: / 07-08-2006 / 14:11:17 / fm"
    "Modified: / 16-04-2007 / 15:37:41 / cg"
!

printPolygons: polygons
    "Opens a print dialog and prints the given polygons"

    | printerInfo printer |

    printerInfo := PrintingDialog getPrinterInfo.
    printerInfo isNil ifTrue:[^self].

    printer := self fromPrinterInfo: printerInfo.
    [ 
        printer startPrintJob: 'Polygons'.
        printer foreground:Color black background:Color white.
        polygons
            do:[:aPolygon |
                 aPolygon displayStrokedOn: printer.
            ].
        printer endPrintJob.
    ] forkAt: 3

    "
     WinPrinterContext printPolygons:  
        (Array with: (Polygon vertices:(
                                Array
                                    with:10@10
                                    with:60@10
                                    with:35@60)))
    "

    "Created: / 07-08-2006 / 12:09:48 / fm"
    "Modified: / 07-08-2006 / 14:11:17 / fm"
    "Modified: / 16-04-2007 / 15:37:43 / cg"
!

printRectangles: rectangles
    "Opens a print dialog and prints the given rectangles"

    | printerInfo printer |

    printerInfo := PrintingDialog getPrinterInfo.
    printerInfo isNil ifTrue:[^self].

    printer := self fromPrinterInfo: printerInfo.
    [ 
        printer startPrintJob: 'Rectangles'.
        rectangles 
            do:[:rectangle |
                printer displayRectangleX: rectangle origin x 
                        y: rectangle origin y 
                        width: rectangle width 
                        height: rectangle height.
            ].
        printer endPrintJob.
    ] forkAt: 3

    "
     WinPrinterContext printRectangles:  
        (Array with: (Rectangle left:20 top:20 width:400 height:600)
               with: (Rectangle left:40 top:40 width:600 height:400)    
        )
    "

    "Created: / 07-08-2006 / 11:40:48 / fm"
    "Modified: / 16-04-2007 / 15:37:46 / cg"
!

printStrings: stringAndPositionsArray
    "Opens a print dialog and prints the given strings"

    | printerInfo printer |

    printerInfo := PrintingDialog getPrinterInfo.
    printerInfo isNil ifTrue:[^self].

    printer := self fromPrinterInfo: printerInfo.
    [ 
        printer startPrintJob: 'Strings with Position'.
        printer foreground:Color black background:Color white.
        stringAndPositionsArray
            do:[:pairOfPointsAndPosition |                 
                 printer displayString:(pairOfPointsAndPosition at: 1) 
                            x:(pairOfPointsAndPosition at: 2) x
                            y:(pairOfPointsAndPosition at: 2) y
            ].
        printer endPrintJob.
    ] forkAt: 3

    "
     WinPrinterContext printStrings:  
        (Array with: (Array with:'Testing printing with standart method' with:10@10)
               with: (Array with:'Another test string to print' with:80@200))
    "

    "Created: / 07-08-2006 / 12:09:48 / fm"
    "Modified: / 07-08-2006 / 14:11:17 / fm"
    "Modified: / 16-04-2007 / 15:37:49 / cg"
! !

!WinPrinterContext methodsFor:'accessing'!

getCharHeight
    "Private - answer the height of the font selected in the receiver's
     device context."
    
    |textMetrics answer|

    
    textMetrics := Win32OperatingSystem::TextMetricsStructure new.
"/    (OperatingSystem getTextMetrics:gcId lpMetrics:textMetrics) ifFalse:[ ^ self error ].
"/    Transcript showCR: 'CHAR HEIGHT PRIM ******* ', '   ',  (textMetrics tmHeight + textMetrics tmExternalLeading) printString.
"/    Transcript showCR: 'CHAR HEIGHT DEVICE ***** ', '   ', (self font heightOf:'PQWEXCZ' on:self device) printString.
    answer := (self font heightOf:'PQWEXCZ' on:self device).
"/    answer := textMetrics tmHeight + textMetrics tmExternalLeading.
    ^answer 

    "Created: / 02-08-2006 / 17:47:20 / fm"
    "Modified: / 03-08-2006 / 10:09:01 / fm"
    "Modified: / 10-10-2006 / 18:15:17 / cg"
!

numberOfColorBitsPerPixel
    ^ OperatingSystem getDeviceCaps:gcId index:12 "Bitspixel"

    "Created: / 03-08-2006 / 09:58:18 / fm"
    "Modified: / 10-10-2006 / 18:15:40 / cg"
!

physicalOffsetX
    ^ OperatingSystem getDeviceCaps:gcId index:112 "PhysicalOffsetX"

    "Created: / 01-08-2006 / 16:28:34 / fm"
    "Modified: / 16-04-2007 / 12:52:06 / cg"
!

physicalOffsetY
    ^ OperatingSystem getDeviceCaps:gcId index:113 "PhysicalOffsetY"

    "Created: / 01-08-2006 / 16:28:34 / fm"
    "Modified: / 16-04-2007 / 12:52:01 / cg"
!

pixelsPerInchOfScreenHeight
    ^ OperatingSystem getDeviceCaps:gcId index:90 "Logpixelsy"

    "Created: / 01-08-2006 / 16:29:16 / fm"
!

pixelsPerInchOfScreenWidth
    ^ OperatingSystem getDeviceCaps:gcId index:88 "Logpixelsx"

    "Created: / 01-08-2006 / 16:28:34 / fm"
!

printerHeightArea
    ^ (OperatingSystem getDeviceCaps:gcId index:10)

    "Modified: / 10-10-2006 / 18:18:31 / cg"
!

printerPhysicalHeight
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:111 "PhysicalHeight"

    "Created: / 01-08-2006 / 16:14:08 / fm"
!

printerPhysicalWidth
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:110 "PhysicalWidth"

    "Created: / 01-08-2006 / 16:14:08 / fm"
!

printerWidthArea
    ^ OperatingSystem getDeviceCaps:gcId "deviceContext" index:8 "Horzres"

    "Created: / 01-08-2006 / 16:14:08 / fm"
!

setViewportOrg: aPoint

    ^ OperatingSystem 
            setViewportOrg: gcId "deviceContext"
            x: aPoint x
            y: aPoint y
            oldOrigin: nil 

    "Created: / 01-08-2006 / 16:14:08 / fm"
! !

!WinPrinterContext methodsFor:'initialization & release'!

createDC
    "Private - Create a device context for the receiver"
    
    gcId := printerInfo createDC

    "Created: / 27-07-2006 / 10:21:05 / fm"
    "Modified: / 02-08-2006 / 17:30:47 / fm"
    "Modified: / 10-10-2006 / 18:14:28 / cg"
!

deleteDC
    "Private - Delete a device context for the receiver"

    OperatingSystem deletePrinterDC: gcId.
!

executor
    |aCopy|

    aCopy := WinWorkstation::PrinterDeviceContextHandle basicNew.
    aCopy setDevice:device id:nil gcId:gcId.
    ^ aCopy

    "Created: / 16-04-2007 / 12:39:02 / cg"
!

releaseDC
    "Private - Delete and clear the device context of the receiver."

    self deleteDC.
    device close.
    gcId := nil
! !

!WinPrinterContext methodsFor:'printing process'!

endPage
    "Informs device that we are finished writing to a page."
    
    (OperatingSystem endPage:gcId) > 0 ifFalse:[
        self error
    ]

    "Created: / 27-07-2006 / 18:20:48 / fm"
    "Modified: / 01-08-2006 / 16:01:34 / fm"
    "Modified: / 10-10-2006 / 18:14:44 / cg"
!

endPrintJobWithoutRelease
    "End the print job.  Everything drawn between startPrintJob
     and endPrintJob will become one entry in the print queue."
    
    |result|

    self endPage.
    result := OperatingSystem endDoc:gcId.
    jobid := nil.
    result >= 0 ifFalse:[ self error ]

    "Created: / 27-07-2006 / 18:21:04 / fm"
    "Modified: / 01-08-2006 / 16:01:38 / fm"
    "Modified: / 10-10-2006 / 18:50:43 / cg"
!

startPage
    "Starts a page."
    
    (OperatingSystem startPage:gcId) > 0 ifFalse:[
        ^ self error
    ].

    "Created: / 27-07-2006 / 18:25:55 / fm"
    "Modified: / 28-07-2006 / 18:19:04 / fm"
    "Modified: / 10-10-2006 / 18:19:02 / cg"
!

startPrintJob:aString fileName:aFileName 
    "Start a print job, using aString as the job title; everything
     drawn between startPrintJob and endPrintJob will become
     one entry in the print queue."
    
    |docInfoStruct nameAddress title fileNameAddress|

    gcId isNil ifTrue:[
        self buildPrinter
    ].
    abort := false.
    title := aString ? 'Smalltalk/X'.
    nameAddress := title asExternalBytes unprotectFromGC.
    aFileName isNil ifFalse:[
        fileNameAddress := aFileName pathName asExternalBytes unprotectFromGC
    ].
    docInfoStruct := Win32OperatingSystem::DocInfoStructure new.
    docInfoStruct
        cbSize:docInfoStruct sizeInBytes;
        lpszDocName:nameAddress address.
    fileNameAddress isNil ifFalse:[
        docInfoStruct lpszOutput:fileNameAddress address
    ].
    jobid := OperatingSystem startDoc:gcId docInfo:docInfoStruct.
    jobid > 0 ifFalse:[
        jobid = -1 ifTrue:[
            abort := true.
            ^ nil
        ].
        ^ self error
    ].
    self startPage

    "Created: / 27-07-2006 / 18:19:31 / fm"
    "Modified: / 03-08-2006 / 15:11:19 / fm"
    "Modified: / 10-10-2006 / 18:20:01 / cg"
! !

!WinPrinterContext methodsFor:'queries'!

supportsColor

"/    | retVal info |
"/
"/    info := (self class getPrinterInformation: self name) asUppercase.
"/    (info includesSubstring: ',PSCRIPT,')
"/    ifTrue: [
"/        retVal := (DAPASX::DapasSystemInfo getYesNoInfoApp: 'Printer' profile: 'PostScriptBlackWhite') not.
"/    ]
"/    ifFalse: [
"/        retVal := (info includesSubstring: 'PDF')
"/            ifTrue: [true]
"/            ifFalse: [self numberOfColorBitsPerPixel > 1].
"/    ].
"/
"/    ^retVal

    ^ false.

    "Created: / 03-08-2006 / 09:55:26 / fm"
    "Modified: / 04-08-2006 / 13:20:40 / fm"
    "Modified: / 10-10-2006 / 18:21:07 / cg"
!

supportsGraphics
    ^(OperatingSystem getDeviceCaps: gcId index: 2 "Technology") ~= 4

    "Created: / 03-08-2006 / 10:07:43 / fm"
    "Modified: / 16-04-2007 / 12:44:03 / cg"
! !

!WinPrinterContext methodsFor:'text printing'!

stringWidthOf:aString at:index 
    "Return the width of aString up to index
     when written using the current font; expand tabs out
     to 4 spaces for calculations"
    
    |answer str size spaceWidth|

    index <= 0 ifTrue:[ ^ 0 ].
    str := index >= aString size ifTrue:[ aString ] ifFalse:[ aString copyFrom:1 to:index ].
    true "self font isNil" ifTrue:[
        "if font not set yet, calculate based on default font"
        "/            extString := str asExternalString.
        size := Win32OperatingSystem::WinPointStructure new.
        (OperatingSystem 
            getTextExtentPoint:gcId
            string:str
            size:size) ifFalse:[ ^ self error ].
        answer := size x.
"/        Transcript showCR: 'FROM PRIM ******* ', str, '   ',  answer printString.
"/        Transcript showCR: 'FROM DEVICE ***** ', str, '   ',(self font widthOf:str on:self device) printString.
        #TODO.
    ] ifFalse:[
        answer := self font widthOf:str on:self device
    ].
    index > aString size ifTrue:[
        spaceWidth := self font widthOf:Character space on:self device.
        answer := answer + ((index - aString size) * spaceWidth)
    ].
    ^ answer.

    "Created: / 03-08-2006 / 10:27:20 / fm"
    "Modified: / 04-08-2006 / 12:27:26 / fm"
    "Modified: / 10-10-2006 / 18:20:43 / cg"
! !

!WinPrinterContext class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview2/WinPrinterContext.st,v 1.5 2007-04-17 11:07:58 fm Exp $'
! !