NetNews Usenet Archive 1992 #19

home *** CD-ROM | disk | FTP | other *** search

/ NetNews Usenet Archive 1992 #19 / NN_1992_19.iso / spool / comp / os / vms / 13996 < prev next >

Wrap

Internet Message Format | 1992-08-23 | 33.4 KB

Path: sparky!uunet!cis.ohio-state.edu!ucbvax!PFC.MIT.EDU!MRL From: MRL@PFC.MIT.EDU (MARK LONDON) Newsgroups: comp.os.vms Subject: LASER New (different) LASER symbiont. 1/7 Message-ID: <086A78068713402E1D@NERUS.PFC.MIT.EDU> Date: 22 Aug 92 16:21:00 GMT Sender: daemon@ucbvax.BERKELEY.EDU Distribution: world Organization: The Internet Lines: 927 $! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.2-007 22-FEB-1990 $! On 22-AUG-1992 10:42:38.95 By user MRL $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 7 PARTS, TO KEEP EACH PART $! BELOW 70 BLOCKS $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. AAAREADME.DOC;3 $! 2. BITIMAGE_HEX.PS;1 $! 3. DEFINE.H;2 $! 4. HEADERS_STR.PS;26 $! 5. IMAGE_HEX.PS;1 $! 6. LASER.C;253 $! 7. LASER.DBG;4 $! 8. LASER.HLP;17 $! 9. LASER.LNK;10 $! 10. LASER.OPT;1 $! 11. LASER_ERR.MSG;12 $! 12. LBRDEF.H;1 $! 13. NUMBER_UP.PS;10 $! 14. PAINT_HEX.PS;1 $! 15. PARSER.PS;1 $! 16. PATCH.PS;1 $! 17. PS.PS;1 $! 18. SIDES.PS;3 $! 19. SMBDEF.H;1 $! 20. STARTEND.PS;13 $! 21. SYST.COM;4 $! 22. TEK.H;4 $! 23. TEK2PS.C;53 $! 24. TEK4014.PS;15 $! 25. TRAILER.PS;1 $! 26. ZETA.PS;1 $! $set="set" $set symbol/scope=(nolocal,noglobal) $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ ve=f$getsyi("version") $ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ v=f$verify(v) $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ if .not. f$verify() then $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:= CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b)); LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1); IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE; MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1; ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")= 1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF"; POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r); ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1; COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE, "output_file"));ENDPROCEDURE;Unpacker;QUIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create 'f' XLASER is a user-written print symbiont that is tailored specifically to the XApple LaserWriter family, but works with other PostScript printers,`20 Xincluding DEC printers. X XThe symbiont as distributed is configured to print normal text files in Xa variety of formats on the laser printer. Support is also included for Xprinting PostScript, MacPaint, Tektronix plot, and Zeta plot files. See XLASER.HLP and LASER.C for additional capabilities of the symbiont. X XThis distribution consists of the following files: X XFile`09`09Destination`09`09Purpose X--------------------------------------------------------------------------- XAAAREADME.DOC`09`09`09`09This file XLASER.EXE`09SYS$SYSTEM:LASER.EXE`09The symbiont executable. X*.PS`09`09SYS$LIBRARY:LASER.TLB`09Library of PostScript header files. XLASER.C`09`09`09`09`09Symbiont sources. XLASER_ERR.MSG`09`09`09`09Error message source. XQUIDEF.H`09`09`09`09Source header files. XSMBDEF.H XLBRDEF.H XLASER.OPT`09`09`09`09Link options file. XLASER.HLP`09SYS$HELP:HELPLIB.HLB`09Description of forms supported. XSYST.COM`09SYS$MANAGER:SYSTARTUP.COM Queue startup commands. X XInstallation. X XInstallation of the files can be accomplished with the following set of Xcommands: X X$ LIBRARY/CREATE/TEXT LASER *.PS X$ COPY LASER.EXE SYS$SYSTEM:/PROT=W:RE X$ COPY LASER.TLB SYS$LIBRARY:/PROT=W:RE X$ LIBRARY /HELP SYS$HELP:HELPLIB LASER`09`09! Optional X XSelect a terminal port to attach the printer to, and edit SYST.COM to Xreflect your change. SYST.COM may be invoked by your system startup Xprocedures. The printer may be connected with a cable that has only Xtransmit, receive and ground pins connected. Transmit and receive Xshould (I think) be swapped. The switch on the LaserWriter should be Xswitched to the "9600" position. If you are sharing your LaserWriter Xwith a Macintosh connected via AppleTalk, use the following procedure Xwhen switching the printer: X XTo switch the printer to the VAX: X1. Insure that no AppleTalk jobs are in progress. X2. Disconnect the appletalk connector from the laserwriter. X3. Switch switch on LaserWriter to "9600". X4. $START/QUEUE ALW X XTo switch the printer to the MAC: X1. $STOP/QUEUE/NEXT ALW X2. Allow any jobs in progress to complete. X3. Switch switch on LaserWriter to "AppleTalk". X4. Connect the appletalk connector to the laserwriter. X XTo build the symbiont from the sources: X X$ CC LASER X$ MESSAGE LASER_ERR X$ LINK LASER.OPT/OPT X XPostScript is a trademark of Adobe Inc. XLaserWriter and MacPaint are trademarks of Apple Computer. $ CALL UNPACK AAAREADME.DOC;3 1951667499 $ create 'f' X%%%`09bitimage - puts an uncompressed hex bitmap on the page X% X%`09R. Watson X%`0905-Feb-1987 X% X%`09inputs:`09/param1 /ncopies /nc - number of copies (default 1) X%`09`09/param2 /scale - scale factor to multiply by (default 1.0) X%`09`09/param3 /xsize - x size in pixels (default 512) X%`09`09/param4 /ysize - y size in pixels (default 512) X%`09`09/param5 /pxlwid - number of bits in a pixel (1,2,4,8) X% X X%%`09main program X% X/main X`7B X`09/iscale 1 scale div def`09`09% compute scale factor X% X% get the image, fill black if run out of data. Note that readhexstring X% returns false if we don't fill the string, so the input data should X% be a multiple of sizeof(tmp) bytes long. Assume that it is more`20 X% efficient to read more than 1 byte at a time. Note that line boundaries X% do not matter. X% X`09xsize ysize pxlwid `5Biscale 0.0 0.0 iscale 0.0 0.0`5D X`09`09`7B currentfile tmp readhexstring not `7Bpop <00>`7D if `7D image X X`09showpage X`09currentfile flushfile`09`09`09% avoid laser_log's X`7D def X X X%%`09executable initialization X% X/table `5B X `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X `5B/scale 1.0 (.sf .scale .param2)`5D`09`09% scale factor X `5B/xsize 512 (.xsize .param3)`5D`09`09`09% x size X `5B/ysize 512 (.ysize .param4)`5D`09`09`09% y size X `5B/pxlwid 1 (.pxlwid .param5)`5D`09`09`09% pixel width X`5D def X Xtable `7B`09`09`09`09`09`09% apply defaults X`09/ta exch def`09`09`09`09% save array X`09ta 0 get`09`09`09`09% key X`09ta 1 get`09`09`09`09% default value X`09def`09`09`09`09`09% define default value X`7D forall X Xcurrentdict /parser known `7Bparser`7D if`09`09% if user inputs X X/identity matrix def`09`09`09% make an identity matrix X/tmp 8 string def X1 72 mul 10 72 mul moveto currentpoint translate Xcurrentpoint transform`09`09`09% see where we are in device coords Xidentity setmatrix`09`09`09% turn off transformation - switch to X`09`09`09`09`09% device coordinate system Xtranslate`09`09`09`09% move origin to transformed currpt X Xmain $ CALL UNPACK BITIMAGE_HEX.PS;1 1514953140 $ create 'f' Xextern struct `7B X`09int`09item_code;`09`09/* code */ X`09unsigned short `09item_size;`09/* size of item */ X`09char`09*buffer;`09`09/* address of item */ X`7D item`5BMAXITEMS`5D; X Xextern int ii;`09`09`09`09/* item index */ Xextern int start_task;`09`09`09/* start task flag */ Xextern int stop_task;`09`09`09/* stop task flag */ Xextern int stop_reason;`09`09`09/* stop task reason code */ Xextern int spooled_file;`09`09/* TRUE if spooled file */ Xextern int laser_efn;`09`09`09/* laser read event flag */ Xextern int startpage;`09`09`09/* task start page */ Xextern int endpage;`09`09`09/* task end page */ Xextern int jobstart;`09`09`09/* job start page */ Xextern int ascii;`09`09`09/* TRUE if ascii main file */ Xextern int hex;`09`09`09`09/* TRUE if hexified main file */ Xextern int string;`09`09`09/* TRUE if string main file */ Xextern int status_idle;`09`09`09/* TRUE if idle status received */ Xextern int patchneeded;`09`09`09/* TRUE if patch module sent */ Xextern short laserchan;`09`09`09/* laserwriter channel */ Xextern unsigned short laser_iosb`5B4`5D;`09/* laser read iosb */ Xextern char laser_buf`5B1024`5D;`09`09/* laser read buffer */ Xextern struct FAB main_fab;`09`09/* main file rms stuff */ Xextern struct NAM main_nam; Xextern struct RAB main_rab; Xextern struct FAB log_fab;`09`09/* log file rms stuff */ Xextern struct RAB log_rab; Xextern struct dsc$descriptor_d library_spec; Xextern struct dsc$descriptor_d buffer_des; Xextern struct dsc$descriptor_d savelog; Xextern int userlog;`09`09`09/* user log file */ Xextern int notify; X Xextern char msg`5B255`5D;`09`09`09/* error message to user */ Xextern struct dsc$descriptor_s errmsg_dsc; X Xextern char user_text`5B20`5D;`09`09/* user name to send error message to */ Xextern struct dsc$descriptor_s user_notify; $ CALL UNPACK DEFINE.H;2 1098663394 $ create 'f' X%%`09headers_str - print text with headers on LaserWriter X% X%`09R. Watson 25-Sep-1986 X% X/EOF X`7B X`09linecount 0 ne column 0 ne or `7B`09% if we've printed a line X`09`09/column ncolumns def`09% force page out X`09`09newpage X`09`7D if X`7D def X`20 X/XCR`20 X`7B X`09/xpos xmargin def`09%%%was leftmargin X`7D def X`20 X/XLF `7Bnewline`7D def X`20 X/XFF X`7B X`09topmargin lineh sub ypos ne `7B`09% if not top of page X`09`09newpage X`09`7D if X`7D def X`20 X`20 X%%`09<string> XSTR X% X%`09prints a line of text from the stack X% X/XSTR X`7B X`09/line exch def`09`09`09`09% get text X`20 X`09line length 1 ge `7B`09`09`09% show the line X`09`09xpos ypos moveto X`09`09squish 0 line ashow X`09`09/xpos currentpoint pop def`09% save current x position X`09`7D if X`7D def X`20 X`20 X%%`09newline - move down 1 line. X% X/newline `7B X`09/linecount linecount 1 add def`09% advance line count X`09ypos lineh sub /ypos exch def`09% debit y pos on page X`09ypos bottommargin lt`20 X`09 linecount linelimit gt or `7B`09% if bottom of page X`09`09newpage X`09`09newline X`09`7D if X`7D def X`20 X`20 X%%`09newpage - initialize for a new page. X% X/newpage `7B X`09/linecount 0 def`09`09`09% reset line count X`09/ypos topmargin lineh sub def`09`09% reset line on page X`20 X`09/column column 1 add def`09`09% advance column X`09column ncolumns lt `7B`09`09`09% if not last column X`09`09/xmargin columnwidth column mul leftmargin add def X`09`09/xpos xmargin def X`09`7D `7B X`09`09/column 0 def`09`09`09% reset column X`20 X`09`09title `7B`09`09`09`09`09% if title X`09`09`09leftmargin`20 X`09`09`09 topmargin titlemargin add moveto % setup header X`09`09`09currentfont`09`09`09% save current font X`09`09`09/Helvetica-Bold findfont 12 scalefont setfont X`09`09`09filename show X`09`09`09pagewidth 1.5 inch sub`20 X`09`09`09 topmargin titlemargin add moveto % page number X`09`09`09(page ) show X`09`09`09page 10 5 string cvrs show X`09`09`09setfont`09`09`09`09% restore font X`09`09`7D if`09`09 X`20 X`09`09showpage X`09`09landscape X`20 X`09`09page`09`09`09`09`09% save this X`09`09saveobj restore `09`09`09% flush vm X`09`09/saveobj save def X`09`09/page exch def`09`09`09`09% restore this X`20 X`09`09alternate page 1 and 1 eq and X`09`09`09 `7B/temp leftmargin def X /leftmargin rightmargin def X /rightmargin temp def`7D if X`09`09/page page 1 add def`09`09`09% advance page number X`09`09/xmargin leftmargin def`09`09`09% reset left side X`09`09/xpos xmargin def X`09`7D ifelse X`7D def`09 X`20 X`20 X%%`09landscape - set landscape mode X% X/landscape `7B X`09wide `7B X`09`098.5 inch 0 translate 90 rotate X`09`7D if X`7D def X`20 X%%`09<ivalue> inch <value>. X% X%`09convert <ivalue> to inches X% X/inch `7B 72. mul`7D def X`20 X`20 X%%`09<ivalue> point <value>. X% X%`09convert <ivalue> to points X% X/point `7B `7D def X`20 X`20 X%%`09executable initialization. X% Xinitgraphics X`20 Xcurrentdict /formname known not `7B/formname (2UP) def`7D if X`20 Xformname (2UP) eq `7B X`09/table `5B X`09 `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X`09 `5B/fsizetmp 0 (.fsize .fs .param2)`5D`09`09% font size X`09 `5B/wide true (.wide .w .param3)`5D`09`09% landscape mode X`09 `5B/title false (.title .param4)`5D `09`09% title X`09 `5B/ncolumns 2 (.ncolumns .param5)`5D`09`09% number of columns X`09 `5B/linelimit 66 (.linelimit .nlines .param6)`5D`09% lines per page X `5B/hdr () (.hdr .header. param7)`5D`09`09% page header X `5B/font (Courier) (.font .param8)`5D`09 `09% font X `5B/topmargin -1 (.topmargin .top .param9)`5D`09% topmargin X `5B/leftmargin -1 (.leftmargin .left .param10)`5D`09% leftmargin X `5B/rightmargin -1 (.rightmargin .right .param11)`5D`09% rightmargi Vn X `5B/bottommargin -1 (.bottommargin .bottom .param12)`5D`09% bottomm Vargin X `5B/alternate false (.alternate .param13)`5D`09% alternate X `09 `5B/swedish false (.swedish)`5D`09`09`09% set swedish mode X`09`5D def X`7D if X`20 Xformname (LETTER) eq `7B X`09/table `5B X`09 `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X`09 `5B/fsizetmp 0 (.fsize .fs .param2)`5D`09`09% font size X`09 `5B/wide false (.wide .w .param3)`5D`09`09% landscape mode X`09 `5B/title false (.title .param4)`5D `09`09% title X`09 `5B/ncolumns 1 (.ncolumns .param5)`5D`09`09% number of columns X`09 `5B/linelimit 77 (.linelimit .nlines .param6)`5D`09% lines per page X `5B/hdr () (.hdr .header. param7)`5D`09`09% page header X `5B/font (Courier) (.font .param8)`5D`09 `09% font X `5B/topmargin -1 (.topmargin .top .param9)`5D`09% topmargin X `5B/leftmargin -1 (.leftmargin .left .param10)`5D`09% leftmargin X `5B/rightmargin -1 (.rightmargin .right .param11)`5D`09% rightmargi Vn X `5B/bottommargin -1 (.bottommargin .bottom .param12)`5D`09% bottomm Vargin X `5B/alternate false (.alternate .param13)`5D`09% alternate X`09 `5B/swedish false (.swedish)`5D`09`09`09% set swedish mode X`09`5D def X`7D if X`20 Xformname (LANDSCAPE) eq `7B X`09/table `5B X`09 `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X`09 `5B/fsizetmp 0 (.fsize .fs .param2)`5D`09`09% font size X`09 `5B/wide true (.wide .w .param3)`5D`09`09% landscape mode X`09 `5B/title false (.title .param4)`5D `09`09% title X`09 `5B/ncolumns 1 (.ncolumns .param5)`5D`09`09% number of columns X`09 `5B/linelimit 66 (.linelimit .nlines .param6)`5D`09% lines per page X `5B/hdr () (.hdr .header. param7)`5D`09`09% page header X `5B/font (Courier) (.font .param8)`5D`09 `09% font X `5B/topmargin -1 (.topmargin .top .param9)`5D`09% topmargin X `5B/leftmargin -1 (.leftmargin .left .param10)`5D`09% leftmargin X `5B/rightmargin -1 (.rightmargin .right .param11)`5D`09% rightmargi Vn X `5B/bottommargin -1 (.bottommargin .bottom .param12)`5D`09% bottomm Vargin X `5B/alternate false (.alternate .param13)`5D`09% alternate X`09 `5B/swedish false (.swedish)`5D`09`09`09% set swedish mode X`09`5D def X`7D if X`20 Xformname (HEADERS) eq `7B X`09/table `5B X`09 `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X`09 `5B/fsizetmp 0 (.fsize .fs .param2)`5D`09`09% font size X`09 `5B/wide false (.wide .w .param3)`5D`09`09% landscape mode X`09 `5B/title true (.title .param4)`5D `09`09% title X`09 `5B/ncolumns 1 (.ncolumns .param5)`5D`09`09% number of columns X`09 `5B/linelimit 77 (.linelimit .nlines .param6)`5D`09% lines per page X `5B/hdr () (.hdr .header. param7)`5D`09`09% page header X `5B/font (Courier) (.font .param8)`5D`09 `09% font X `5B/topmargin -1 (.topmargin .top .param9)`5D`09% topmargin X `5B/leftmargin -1 (.leftmargin .left .param10)`5D`09% leftmargin X `5B/rightmargin -1 (.rightmargin .right .param11)`5D`09% rightmargi Vn X `5B/bottommargin -1 (.bottommargin .bottom .param12)`5D`09% bottomm Vargin X `5B/alternate false (.alternate .param13)`5D`09% alternate X`09 `5B/swedish false (.swedish)`5D`09`09`09% set swedish mode X`09`5D def X`7D if X`20 Xformname (SWEDISH) eq `7B X`09/table `5B X`09 `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X`09 `5B/fsizetmp 0 (.fsize .fs .param2)`5D`09`09% font size X`09 `5B/wide false (.wide .w .param3)`5D`09`09% landscape mode X`09 `5B/title false (.title .param4)`5D `09`09% title X`09 `5B/ncolumns 1 (.ncolumns .param5)`5D`09`09% number of columns X`09 `5B/linelimit 66 (.linelimit .nlines .param6)`5D`09% lines per page X `5B/hdr () (.hdr .header. param7)`5D`09`09% page header X `5B/font (Courier) (.font .param8)`5D`09 `09% font X `5B/topmargin -1 (.topmargin .top .param9)`5D`09% topmargin X `5B/leftmargin -1 (.leftmargin .left .param10)`5D`09% leftmargin X `5B/rightmargin -1 (.rightmargin .right .param11)`5D`09% rightmargi Vn X `5B/bottommargin -1 (.bottommargin .bottom .param12)`5D`09% bottomm Vargin X `5B/alternate false (.alternate .param13)`5D`09% alternate X`09 `5B/swedish true (.swedish)`5D`09`09`09% set swedish mode X`09`5D def X`7D if X`20 Xcurrentdict /table known not `7B X`09/table `5B X`09 `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X`09 `5B/fsizetmp 0 (.fsize .fs .param2)`5D`09`09% font size X`09 `5B/wide false (.wide .w .param3)`5D`09`09% landscape mode X`09 `5B/title true (.title .param4)`5D `09`09% title X`09 `5B/ncolumns 1 (.ncolumns .param5)`5D`09`09% number of columns X`09 `5B/linelimit 66 (.linelimit .nlines .param6)`5D`09% lines per page X `5B/hdr () (.hdr .header. param7)`5D`09`09% page header X `5B/font (Courier) (.font .param8)`5D`09 `09% font X `5B/topmargin -1 (.topmargin .top .param9)`5D`09% topmargin X `5B/leftmargin -1 (.leftmargin .left .param10)`5D`09% leftmargin X `5B/rightmargin -1 (.rightmargin .right .param11)`5D`09% rightmargi Vn X `5B/bottommargin -1 (.bottommargin .bottom .param12)`5D`09% bottomm Vargin X `5B/alternate false (.alternate .param13)`5D`09% alternate X`09 `5B/swedish false (.swedish)`5D`09`09`09% set swedish mode X`09`5D def X`7D if X`20 Xtable `7B`09`09`09`09`09`09% apply defaults X`09/ta exch def`09`09`09`09% save array X`09ta 0 get`09`09`09`09% key X`09ta 1 get`09`09`09`09% default value X`09def`09`09`09`09`09% define default value X`7D forall X`20 Xcurrentdict /parser known `7Bparser`7D if`09`09% if user inputs X`20 X% if the user specified a string for /hdr then use it, also imply title true Xhdr length 0 ne `7B/filename hdr def /title true def`7D if X Xcurrentdict /filename known not `7B/filename () def`7D if X%filename (_DUA0:`5B`5D) anchorsearch `7Bpop /filename exch def`7D `7Bpop`7D V ifelse %cleanup Xfilename (`5B`5D) search `7Bpop pop /filename exch def`7D `7Bpop`7D ifelse`2 V0 X`20 X/inp currentfile def`09`09`09`09% define files X`20 Xwide `7B X`09leftmargin 0 lt `7B/leftmargin .4 inch def`7D if X`09topmargin 0 lt `7B/topmargin 8.1 inch def`7D `20 X`09`09`09`7B/topmargin 8.5 topmargin sub inch def`7D ifelse X`09bottommargin 0 lt `7B/bottommargin .3 inch def`7D if `20 X`09rightmargin 0 lt `7B/rightmargin .25 inch def`7D if `20 X`09currentdict /fsize known not `7B/fsize 10 point def`7D if X`09fsizetmp 0 ne `7B/fsize fsizetmp def`7D if X`09/pagewidth 11 inch def X`09/squish -0.3 def X`09/titlemargin 3 point def X`7D `7B`09 X`09leftmargin 0 lt `7B/leftmargin 1. inch def`7D if `20 X`09topmargin 0 lt `7B/topmargin 10.39 inch def`7D X`09`09`09`7B/topmargin 11 topmargin sub inch def`7D ifelse X`09rightmargin 0 lt `7B/rightmargin .25 inch def`7D if `20 X`09bottommargin 0 lt `7B/bottommargin .5 inch def`7D if `20 X`09currentdict /fsize known not `7B/fsize 10 point def`7D if X`09fsizetmp 0 ne `7B/fsize fsizetmp def`7D if X`09/pagewidth 8.5 inch def X`09/squish -0.3 def X`09/titlemargin .185 inch def X`7D ifelse X/lineh fsize point def`09`09`09% line height X/lineh lineh 1.2 sub def X/linecount 0 def X/column 0 def X/columnwidth pagewidth leftmargin sub rightmargin sub ncolumns div def X/ibuf 200 string def`09`09`09% input buffer X/page 1 def`09`09`09`09% page number X/xpos leftmargin def X/xmargin leftmargin def X/ypos topmargin lineh sub def X`20 X% The following section of code makes a new font with a backspace X% character defined. The width of the backspace character is X% the negative of the width of an underscore character. X X/selectfont `7B`20 Xdup Xfindfont`09`09`09`09`09% select the font X%lineh scalefont setfont`09`09`09% find width of an underscore X% (_) stringwidth pop 100 mul /uwid exch def X X% X% find the width of a character in the font coordinate system. X% add back in the scaled amount that squish will offset us so we X% end up in the right place after a backspace X% X1000 scalefont setfont X (_) stringwidth pop`092000 squish mul fsize div add /uwid exch def`20 X`20 Xfindfont`09`09`09`09`09% copy the font Xdup length 1 add dict /newdict exch def`09% leaving room for a Metrics entr Vy X`7B X`09exch dup /FID ne `7B`09`09`09% if not /FID X`09`09dup /Encoding eq `7B`09`09% if /Encoding copy the entry X`09`09`09exch dup length array copy`20 X`09`09`09newdict 3 1 roll put X`09`09`7D `7B X`09`09`09exch newdict 3 1 roll put % else just use the object X`09`09`7D ifelse X`09`7D `7B X`09pop pop`09`09`09`09`09% dump /FID X`09`7D ifelse X`7D forall X`20 X1 dict begin`09`09`09`09`09% create Metrics dictionary X`09/backspace uwid neg def`09`09`09% define backspace width X`09newdict /Metrics currentdict put Xend X`20 Xnewdict begin`09`09`09`09`09% set encoding for backspace X`09Encoding 8 /backspace put X`09swedish `7B X`09`09Encoding 16#7b /aring put`09% `7B X`09`09Encoding 16#7d /adieresis put`09% `7D X`09`09Encoding 16#7c /odieresis put`09% `7C X`09`09Encoding 16#5b /Aring put`09% `5B X`09`09Encoding 16#5d /Adieresis put`09% `5D X`09`09Encoding 16#5c /Odieresis put`09% \ X`09`7D if Xend X/xfont newdict definefont pop`09`09`09% define the new font X`20 X/xfont findfont fsize scalefont setfont`09% select the new font X`7D def Xfont selectfont X`20 Xlandscape X/saveobj save def $ CALL UNPACK HEADERS_STR.PS;26 1397197447 $ create 'f' X%%%`09image - puts a raster image file on the laserwriter. X% X%`0902/26/87 R. Watson Derived from paint_hex.ps X% X X%%`09deCompress <string>. X% X%`09returns a bitimage string on the stack X% X/deCompress X`7B X`09/count readbyte def`09`09`09% get count X`09count 16#80 and 0 eq `7B`09`09`09% if bit stream X`09`09/count count 1 add def X`09`09outstring 0 count getinterval % get right size string X`09`09inp exch readhexstring`09`09% get bytes X`09`09pop`09`09`09`09% toss readhexstring status X`09`7D X`09`7B`09`09`09`09`09% else repeated string X`09`09/byte readbyte def`09`09% get byte to repeat X`09`0916#100 count sub 1 add /count exch def% get abs val of count X`09`090`09`09`09`09% preset index X`09`09count `7B X`09`09`09dup outstring exch byte put X`09`09`091 add`09`09`09% advance index X`09`09`7D repeat X`09`09pop`09`09`09`09% index X`09`09outstring 0 count getinterval`09% return string X`09`7D ifelse X`7D def X X X%%`09getByte X% X%`09returns /byte = next input byte X%`09`09 = 0 if no more bytes on input stream X% X/getByte X`7B X`09inp instring readhexstring `7B`09`09% if got one X`09`090 get /byte exch def`09`09% store in byte X`09`7D X`09`7B`09`09`09`09`09% else 0 X`09`09pop /byte 0 def X`09`7D ifelse X`7D def X X X%%`09decodeheader - decodes the info in the header record. X% X/decodeheader X`7B X`09/bytesinhead 512 def`09`09`09% default 512 bytes X`09`7B`09`09`09`09`09% 512 bytes default X`09 getlong 10 10string cvrs cvlit `09% key to lit X`09 dup where X`09`09`7B pop load exec `7D`09`09% if defined func X`09`09`7B pop getlong pop `7D ifelse`09% if no func (key, fix file) X`09 /bytesinhead bytesinhead 8 sub def`09% debit header length X`09 bytesinhead 8 lt `7B`09`09`09% if end of header X`09`09bytesinhead `7B`09`09`09% flush remaining bytes X`09`09`09readbyte pop X`09`09`7D repeat X`09`09exit`09`09`09`09% exit loop X`09 `7D if X`09`7D loop X`7D def X X/0 `7Bgetlong pop`7D def`09`09`09`09% 0 - nop X/1 `7B/xsize getlong def`7D def`09`09`09% 1 - x size X/2 `7B/ysize getlong def`7D def`09`09`09% 2 - y size X/3 `7B/pxlwid getlong def`7D def`09`09`09% 3 - pixel width X/4 `7B/scale getlong def`7D def`09`09`09% 4 - scale factor X/5 `7B/invert getlong def`7D def`09`09`09% 5 - invert if nonzero X/8 `7Bgetlong 512 sub `09`09`09`09% 8 - header length X bytesinhead add /bytesinhead exch def`7D def % apply correction factor X/9 `7B/compressed getlong def`7D def`09`09% 9 - true if compressed X X%%`09getlong <int> X% X%`09converts 4 hex bytes from currentfile to an integer X%`09longwords from the vax are transmitted low order byte first. X% X/getlong X`7B X`09/acc 0 def`09`09`09`09% preset accumulator X`090 1 3 `7B X`09`09readbyte exch 8 mul bitshift acc or /acc exch def X`09`7D for X`09acc X`7D def X X X%%`09readbyte <int> X% X%`09reads a hex byte from currentfile and returns it on the stack X%`09executes "readbyteeof" if EOF encountered X% X/readbyte X`7B X`09currentfile 1string readhexstring `7B`7D`7Bpop readbyteeof`7D ifelse 0 ge Vt X`7D def X X X X%%`09main program X% X/main X`7B X`09decodeheader`09`09`09`09% apply user user header X`09currentdict /parser known `7Bparser`7D if`09% if user inputs X X`09invert 0 ne `7B X`09`09`7B1.0 exch sub`7D settransfer`09% invert image X`09`7D if X X`09/sTime usertime def`09`09`09% save start time X vmstatus 10 20 string cvrs dbg exch writestring dbg ( ) writestring X 10 20 string cvrs dbg exch writestring dbg ( ) writestring X 10 20 string cvrs dbg exch writestring dbg ( \n) writestring X flush X`09/iscale 1 scale div def`09`09`09% compute scale factor X`09 X`09compressed 1 eq `7B`09`09`09% if encoded X`09`09xsize ysize pxlwid `5Biscale 0.0 0.0 iscale 0.0 0.0`5D X`09`09`09`09`09`09`09`7B deCompress `7D image X`09`7D `7B X`09`09xsize ysize pxlwid `5Biscale 0.0 0.0 iscale 0.0 0.0`5D X`09`09 `7B currentfile tmp readhexstring not `7Bpop <00>`7D if `7D image X`09`7D ifelse X X`09usertime sTime sub 1000 div 10 20 string cvrs X`09 dbg exch writestring dbg ( seconds ) X`09 writestring X X vmstatus 10 20 string cvrs dbg exch writestring dbg ( ) writestring X 10 20 string cvrs dbg exch writestring dbg ( ) writestring X 10 20 string cvrs dbg exch writestring dbg ( \n) writestring X flush X X`09showpage X`09currentfile flushfile`09`09% avoid laser_log's X`7D def X X X%%`09executable initialization X% X/inp (%stdin) (r) file def`09`09`09% define files X/dbg (%stdout) (w) file def`09 X/1string 1 string def`09`09`09`09% scratch 1 byte string X/10string 10 string def`09`09`09`09% scratch 10 byte string X/identity matrix def`09`09`09`09% make an identity matrix X/outstring 128 string def`09`09`09% storage for output string X/instring 1 string def`09`09`09`09% input buffer X/tmp 8 string def`09`09`09`09% for uncompressed images X X/table `5B X `5B/#copies 1 (.nc .ncopies .param1)`5D`09`09% number of copies X `5B/scale 1.0 (.sf .scale .param2)`5D`09`09% scale factor X `5B/xsize 512 (.xsize .param3)`5D`09`09`09% x size X `5B/ysize 512 (.ysize .param4)`5D`09`09`09% y size X `5B/pxlwid 1 (.pxlwid .param5)`5D`09`09`09% pixel width X `5B/invert 0 (.invert .param6)`5D`09`09`09% invert image if 1 X `5B/compressed 1 (.compressed .param7)`5D`09`09% default to compressed X`5D def X Xtable `7B`09`09`09`09`09`09% apply defaults X`09/ta exch def`09`09`09`09% save array X`09ta 0 get`09`09`09`09% key X`09ta 1 get`09`09`09`09% default value X`09def`09`09`09`09`09% define default value X`7D forall X X1 72 mul 10 72 mul moveto currentpoint translate Xcurrentpoint transform`09`09`09% see where we are in device coords Xidentity setmatrix`09`09`09% turn off transformation - switch to X`09`09`09`09`09% device coordinate system Xtranslate`09`09`09`09% move origin to transformed currpt X X/doit `7B X`09`7Bmain`7D stopped `7B (error stack:\n) = pstack flush quit`7D if X`7D def X%doit Xmain $ CALL UNPACK IMAGE_HEX.PS;1 1701784921 $ create 'f' X/***`09LASER - A Single-Threaded Asynchronous Symbiont to driver X*`09`09an Apple LaserWriter X* X*`09Copyright 1987-1990, The University of Texas at Austin X* X*`09Revised: X*`09Mark London X*`09mrl@tardis.pfc.mit.edu X* X*`09This user-writter symbiont is tailored specifically to the Apple X*`09LaserWriter and similar PostScript printers. It has the following X*`09features: X* X*`091. Page counting is done by reading the page count from the X*`09 laserwriter at the beginning and the end of each file. X*`09 This mechanism also "synchronizes" the user job with the X*`09 laserwriter. If the laserwriter does not respond to the X*`09 first request for a page count, the symbiont notifies the X*`09 operator, and continues to poll the laserwriter. This is X*`09 useful if the laserwriter is being shared with MAC users. X* X*`092. Parameters may be passed to postscript modules in the setup X*`09 library via 2 mechanisms. The text from a $PRINT /NOTE=<text> X*`09 command will be sent first. X* X*`09 The /PARAMETER switch may also be used. Each entry can be X*`09 one of two formats. An entry without the "=" character in X* `09 it is sent as (param<n>) <parameter>. An entry with the`20 X*`09 "=" character in is is sent as (<left side>) <right side>. X*`09 The parameters are defined in an array called /param. X*`09 Example: /PARAMETER=(1,SIZE=5,"str=(a+b)") generates: X*`09 /param `5B(param1) 1 (size) 5 (str) (a+b)`5D def X*`09 All alphabetics are forced to lower case. Using the /PARAMETER X*`09 switch forces sending PARSER from LASER.TLB as part of the X*`09 PostScript program sent to the printer. Look at`20 X*`09 other files in LASER.TLB for examples of using the PARSER X*`09 module. X* X*`093. If the name of a setup module ends with "_HEX" the file to`20 X*`09 be printed is "hexified" to the laser printer. This is useful X*`09 for sending bitimage files to the laserwriter. X* X*`094. A log of responses from the laserwriter is created if`20 X*`09 /PARAMETER=MESSAGE=KEEP is specified . This is`20 X*`09 useful for debugging postscript programs. The file is created X*`09 as <printfilespec>.LASER_LOG. These files are automatically X*`09 deleted if empty. X* X*`095. A "%%`5B Flushing:" response from the printer will abort the X*`09 current file. X* X*`096. Spooled files: Spooled files normally default to FORMS=LETTER X*`09 if the recommended queue initialize procedure is followed. X*`09 By specifying special filenames, the user can override the X*`09 forms used, and pass parameters to the setup module. X*`09 The syntax is: "_<formname>._<parameter list>" X*`09 where <formname> is the name of a form to use and X*`09 <parameter list> is of the form: <parameter>-<value>`5B_...`5D. X*`09 (Note the use of "-" instead of "=" for a separator.) X*`09 For example: $ copy zeta.plt alw:_zeta._ncopies-5_scale-2 X*`09 (The kludge of the century, huh?) X* X*`09Outputs (in the following order) to the laserwriter: X* X*`091. "/note <notestring> def\r\n". X*`092. /param definition and library module PARSER if /parameter switch`20 X*`09 present X*`093. If the setup module is "HEADERS", the string "/filename <filename> X*`09 def" and "/formname <name of form> def" X*`093. The first file or forms setup module if specified. X*`094. The file to be printed itself. If the setup module name ends in X*`09 "_HEX" the file is hex-ified to the printer instead. X* X*`09where: <notestring> is the string from $PRINT /NOTE=<notestring> X*`09 <paramstring> is the string from $PRINT /PARAM=("<string>"...) X*`09 <filename> is the file specification for the file to print. X* X*`09Limitations, bugs, etc: X* X*`091. No checkpointing is done. X*`092. $PRINT/COPIES=n sends the job to the LaserWriter n times. This X*`09 is not optimal, but is how the job controller handles things. X*`09 It makes sense for most printers. Multiple copy handling is X*`09 better handled in most of the postscript setup files. Also X*`09 /note="/#copies n def" will usually work. X*`093. $PRINT/SPACE=n is not implemented. X*`094. /BURST is identical to /FLAG. X*`095. Does not handle lists of setup modules. X* X*`09Recommended device setup: X* X*`09$ define/system/exec/trans=(concealed,terminal) alw <term>: ! laser X*`09$ set term /perm /speed=9600 /nomodem /notype /nohang alw X*`09$ set term /perm /hostsync /pasthru /ttsync /eightbit /nobroad alw X*`09$ set term /perm /noauto alw X*`09$ set prot=o:rwlp /dev alw X*`09$ set device /spooled=(ALW,sys$sysdevice:) alw X* X*`09Recommended queue initialize: X* X*`09$ initialize/queue/start - X*`09/default=(noburst,nofeed,noflag,notrailer,form=headers) - X*`09/separate=(noburst,noflag,trailer) -`20 X*`09/library=laser /form=letter - +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+-