doc@pucc-j.UUCP (06/28/86)
Reply-To: ihnp4!cbmvax!carolyn@ecn (Carolyn Scheppner)
REM ScreenPrint
REM Carolyn Scheppner CBM 04/86
REM
REM Graphic screen dump to the printer
REM using exec library calls
REM Requires exec.bmap
REM Use Preferences to select options
REM such as GrayScale and Negative
REM *** Calling Program ***
REM Custom Screen, some graphics
w = 320: h = 200: d = 5
SCREEN 2,w,h,d,1
t$=" D = Draw P = Print Q = Quit "
WINDOW 2,t$,,15,2
PALETTE 0,1,1,1
PALETTE 1,.2,.4,.8
GOSUB DrawLines:
MainLoop:
k$ = INKEY$
IF k$ = "d" THEN
GOSUB DrawLines:
ELSEIF k$ = "p" THEN
BorderFlag% = 0 'No borders printed
GOSUB ScreenDump
REM Time to read any error msgs
FOR de = 1 TO 5000: NEXT
ELSEIF k$ = "q" THEN
GOTO Quit:
END IF
GOTO MainLoop:
Quit:
WINDOW CLOSE 2
SCREEN CLOSE 2
END
DrawLines:
CLS
RANDOMIZE TIMER
FOR k = 1 TO 12
x1 = 80 + INT(RND(1) * (w - 160))
x2 = 80 + INT(RND(1) * (w - 160))
y1 = 40 + INT(RND(1) * (h - 100))
y2 = 40 + INT(RND(1) * (h - 100))
dx = 2 + INT(RND(1) * 3)
IF RND(1) < .5 THEN dx = -dx
dy = 2 + INT(RND(1) * 2)
IF RND(1) < .5 THEN dy = -dy
co = 1 + INT(RND(1) * 16)
nl = 12 + INT(RND(1) * 10)
FOR j = 1 TO nl
LINE (x1,y1)-(x2,y2),co
x1 = x1 + dx
x2 = x2 + dx
y1 = y1 + dy
y2 = y2 - dy
NEXT
NEXT
RETURN
END
ScreenDump:
REM If first call of this routine
REM declare the exec library functions
REM which return values
IF AlreadyDeclared = 0 THEN
DECLARE FUNCTION AllocSignal%() LIBRARY
DECLARE FUNCTION AllocMem&() LIBRARY
DECLARE FUNCTION FindTask&() LIBRARY
DECLARE FUNCTION DoIO&() LIBRARY
DECLARE FUNCTION OpenDevice& LIBRARY
AlreadyDeclared = 1
END IF
REM Get addresses of the structures
sWindow& = WINDOW(7)
sScreen& = PEEKL(sWindow& + 46)
sViewPort& = sScreen& + 44
sRastPort& = sScreen& + 84
sColorMap& = PEEKL(sViewPort& + 4)
REM Get Screen width, height, modes
maxWidth% = PEEKW(sScreen& + 12)
maxHeight% = PEEKW(sScreen& + 14)
viewModes% = PEEKW(sViewPort& + 32)
REM Set up parameters for dump command
command% = 11 'Printer command number
srcX% = 0 'Send whole screen
srcY% = 0
srcWidth% = maxWidth%
srcHeight% = maxHeight%
destRows& = 0 'Dump will compute
destCols& = 0
special% = &H84 'FullCol | Aspect
IF BorderFlag% = 0 THEN 'No Borders
srcX% = srcX% + 3
srcY% = srcY% + 11
srcWidth% = srcWidth% - 3 - 11
srcHeight% = srcHeight% - 11 - 3
END IF
LIBRARY "exec.library"
REM *** CreatePort ***
sigBit% = AllocSignal%(-1)
ClearPublic& = 65537&
msgPort& = AllocMem&(40,ClearPublic&)
IF msgPort& = 0 THEN
PRINT "Can't allocate msgPort"
GOTO cleanup4
END IF
POKE(msgPort& + 8), 4 'Type=NT_MSGPORT
POKE(msgPort& + 9), 0 'Priority 0
portName$ = "MyPrtPort"+CHR$(0)
POKEL(msgPort& + 10), SADD(portName$)
POKE(msgPort& + 14), 0 'Flags
POKE(msgPort& + 15), sigBit%
sigTask& = FindTask&(0)
POKEL(msgPort& + 16), sigTask&
CALL AddPort(msgPort&) 'Add the port
REM *** CreatExtIO ***
ioRequest& = AllocMem&(64,ClearPublic&)
IF ioRequest& = 0 THEN
PRINT "Can't allocate ioRequest"
GOTO cleanup3
END IF
POKE(ioRequest& + 8),5 'Type=NT_MESSAGE
POKE(ioRequest& + 9),0 'Priority 0
POKEL(ioRequest& + 14), msgPort&
REM *** Open the Printer Device ***
devName$ = "printer.device"+CHR$(0)
pError& = OpenDevice&(SADD(devName$),0,ioRequest&,0)
IF pError& <> 0 THEN
PRINT "Can't open printer"
GOTO cleanup2
END IF
REM *** Dump the RastPort ***
POKEWW(ioRequest& + 28), command%
POKEL(ioRequest& + 32), sRastPort&
POKEL(ioRequest& + 36), sColorMap&
POKEL(ioRequest& + 40), viewModes%
POKEW(ioRequest& + 44), srcX%
POKEW(ioRequest& + 46), srcY%
POKEW(ioRequest& + 48), srcWidth%
POKEW(ioRequest& + 50), srcHeight%
POKEL(ioRequest& + 52), destCols&
POKEL(ioRequest& + 56), destRows&
POKEW(ioRequest& + 60), special%
ioError& = DoIO&(ioRequest&)
IF ioError& <> 0 THEN
PRINT "DumpRPort error =" ioError&
GOTO cleanup1
END IF
cleanup1:
REM *** Close Printer Device ***
CALL CloseDevice(ioRequest&)
cleanup2:
REM *** DeleteExtIO ***
POKE(ioRequest& + 8), &HFF
POKEL(ioRequest& + 20), &HFFFF
POKEL(ioRequest& + 24), &HFFFF
CALL FreeMem(ioRequest&,64)
cleanup3:
REM *** DeletePort ***
CALL RemPort(msgPort&)
POKE(msgPort& + 8), &HFF
POKEL(msgPort& + 20), &HFFFF
CALL FreeSignal(sigBit%)
CALL FreeMem(msgPort&,40)
cleanup4:
LIBRARY CLOSE
RETURN