!  Screen dump routines
!
!  a True BASIC, Inc. product
!
!  Copyright (c) 1986 by True BASIC, Inc.
!  All rights reserved.
!

EXTERNAL

!
!
!     These are the definitions for values which must be passed to the
!  ScreenDump routine to control the method of printing.  Combinations
!  of these values may be formed by addition:
!
!     call ScreenDump(screenflag,SPECIAL_FULLCOLS+SPECIAL_FULLROWS)
!
!     If none of the flags is set, the printer will print one pixel
!  for each pixel on the screen.  Since printer-pixels are normally
!  much smaller than screen-pixels, this can result in a very small
!  screen image.
!
!     Results vary widely with each printer, so you will have to experiment
!  with these flags to get the best results.  One combination that
!  often works well is:
!
!       SPECIAL_FULLCOLS+SPECIAL_FULLROWS+SPECIAL_ASPECT
!
!  This tries to print the largest image possible with the original
!  aspect ratio.
!

DEF SPECIAL_MILCOLS  = 2^0        ! 1 screen-pixel width = 1/1000 inch
DEF SPECIAL_MILROWS  = 2^1        ! 1 screen-pixel height = 1/1000 inch
DEF SPECIAL_FULLCOLS = 2^2        ! as wide as possible
DEF SPECIAL_FULLROWS = 2^3        ! as long as possible (in a page)
DEF SPECIAL_ASPECT   = 2^7        ! preserve aspect ratio of screen
DEF SPECIAL_DENSITY1 = 1*2^8      ! low res
DEF SPECIAL_DENSITY2 = 2*2^8      ! med-low res
DEF SPECIAL_DENSITY3 = 3*2^8      ! med-high res
DEF SPECIAL_DENSITY4 = 4*2^8      ! high res


!
!
!  ScreenDump
!  ==========
!
!     This routine prints a screen image on the printer.  The first
!  argument, screenflag, determines which area of the screen is printed:
!
!          0 -- the current window
!          1 -- the whole screen
!
!     If your program is using the small output window, passing a 0 in
!  screenflag will print just the contents of that window, while passing
!  a 1 will print the entire screen:  output window, other windows,
!  everything.  If your program is using the full-screen output window,
!  it doesn't matter what you pass in screenflag -- either way, the
!  whole screen is printed.
!
!     The second argument, special, controls the method of printing.  The
!  routines above, like SPECIAL_ASPECT, return values which can be added
!  together and passed to ScreenDump in this parameter.  The effects 
!  differ with each printer, so you'll have to experiment with different
!  combinations to see what works best for you.
!
!     To use this routine, you must have a printer with graphics capability,
!  and that printer must be selected as the current printer by the
!  Preferences program.
!

SUB ScreenDump(screenflag,special)

    DECLARE DEF DoIO, Addr, OpenDevice, CloseDevice, Nullt$
    DECLARE DEF CreatePort, DeletePort, CreateExtIO, DeleteExtIO
    DECLARE DEF CurrentWindow, CurrentRPort, peekl, peekw

    DEF DumpRPort(r,RastPort,colorMap,modes,sx,sy,sw,sh,dc,dr,s)
        CALL pokew(r+28,11)       ! PRD_DUMPRPORT
        CALL pokel(r+32,RastPort)
        CALL pokel(r+36,colorMap)
        CALL pokel(r+40,modes)
        CALL pokew(r+44,sx)
        CALL pokew(r+46,sy)
        CALL pokew(r+48,sw)
        CALL pokew(r+50,sh)
        CALL pokel(r+52,dc)
        CALL pokel(r+56,dr)
        CALL pokew(r+60,s)
        LET DumpRPort = DoIO(r)
    END DEF

    DEF OpenPrinter(r)
        LET dev$ = Nullt$("printer.device")
        LET OpenPrinter = OpenDevice(Addr(dev$),0,r,0)
    END DEF

    DEF ClosePrinter(r)
        LET ClosePrinter = CloseDevice(r)
    END DEF

    LET sc = peekl(CurrentWindow+46)   ! wd_WScreen
    LET vp = sc+44                ! sc_ViewPort
    LET cm = peekl(vp+4)          ! vp_ColorMap
    LET modes = peekw(vp+32)      ! vp_Modes
    IF screenflag = 1 then
       LET rp = sc+84
       LET width = peekw(vp+24)   ! vp_DWidth
       LET height = peekw(vp+26)  ! vp_DHeight
    ELSE
       LET rp = CurrentRPort
       LET lr = peekl(rp)         ! rp_Layer
       LET width = peekw(lr+20) - peekw(lr+16)   ! lr_MaxX - lr_MinX
       LET height = peekw(lr+22) - peekw(lr+18)  ! lr_MaxY - lr_MinY
    END IF

    LET printerPort = CreatePort(0,0)
    IF printerPort <> 0 then
       LET ioreq = CreateExtIO(printerPort,62)
       IF ioreq <> 0 then
          IF OpenPrinter(ioreq) = 0 then
             LET xxx = DumpRPort(ioreq,rp,cm,modes,0,0,width,height,width,height,special)
             LET xxx = ClosePrinter(ioreq)
          END IF
          LET xxx = DeleteExtIO(ioreq,62)
       END IF
       LET xxx = DeletePort(printerPort)
    END IF

END SUB