LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031887. :SYSTEM-TYPE :LOGICAL :VERSION 9. :TYPE "LISP" :NAME "TALARIS" :DIRECTORY ("REL3-SOURCE" "PRINTER") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758743640. :AUTHOR "REL3" :LENGTH-IN-BYTES 6925. :LENGTH-IN-BLOCKS 7. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               ;;; -*- Mode: common-LISP; Package: PRINTER; Base: 10 -*-;;;                           RESTRICTED RIGHTS LEGEND;;;Use, duplication, or disclosure by the Government is subject to;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in;;;Technical Data and Computer Software clause at 52.227-7013.;;;                     TEXAS INSTRUMENTS INCORPORATED.;;;                              P.O. BOX 2909;;;                           AUSTIN, TEXAS 78769;;;                                 MS 2151;;; Copyright (C) 1984,1987 Texas Instruments Incorporated. All rights reserved.;;; This file defines print device:  TALARIS;;CHANGES:;;--changed displaced-array in :write-bitmap to be of :element-type '(unsigned-byte 4),;;  rather than 'art-4b. - lco 2-11-87(DEFPROP TALARIS (454) DOTS-PER-INCH) (DEFVAR *TALARIS-PAPER-SIZE* (LIST 8.5 11.0 300)   "List of paper width, paper height, pixels per inch") (DEFVAR *TALARIS-RESET-STRING*   "^PY^-^G^A^IGE^IWE^ISYNTAX00000^IS1217^G^IOL^IJ005^IT008^IL08^IC00^IF0T01^O^X*********************************************************        **        *This Will Reset a TALARIS 1200 to reasonable  *        *defaults. Change to suit your parameters.*        ***********************************************************^PN^-") (DEFFLAVOR TALARIS   ((DARK-COUNT 0)    (BRIGHT-COUNT 0)    (SINCE-CR 0)    (SINCE-CR-THRESHOLD 75)    (TALARIS-PAPER-SIZE *TALARIS-PAPER-SIZE*)    (TALARIS-RESET-STRING *TALARIS-RESET-STRING*)    (SCALE NIL)    (SET-MARGIN-STRING NIL))   (BASIC-PRINTER)) (DEFMETHOD (TALARIS :PRINT-BITMAP) (BITMAP-ARRAY &OPTIONAL WIDTH HEIGHT (START-X 0) (START-Y 0) ORIENTATION DOTS-PER-INCH &AUX  LANDSCAPEP)  "Copy the bitmap array to a print stream;printer-stream can only be a file stream, since TALARIS is currently only on a VAX"  (UNLESS WIDTH    (SETQ WIDTH (array-dimension BITMAP-ARRAY 1)))  (UNLESS HEIGHT    (SETQ HEIGHT (array-dimension BITMAP-ARRAY 0)))  (UNLESS (ZEROP (REM WIDTH 16))    (SETQ WIDTH (array-dimension BITMAP-ARRAY 1)))  (UNLESS (ZEROP (REM HEIGHT 16))    (SETQ HEIGHT (array-dimension  BITMAP-ARRAY 0)))  (SETQ LANDSCAPEP (SEND SELF :COMPUTE-ORIENTATION ORIENTATION DOTS-PER-INCH WIDTH HEIGHT))  (SEND SELF :COMPUTE-SCALE-AND-MARGINS WIDTH HEIGHT DOTS-PER-INCH LANDSCAPEP)  (SEND SELF :WRITE-BITMAP BITMAP-ARRAY WIDTH HEIGHT START-X START-Y LANDSCAPEP)  T) (DEFMETHOD (TALARIS :COMPUTE-ORIENTATION) (ORIENTATION IGNORE WIDTH HEIGHT)  "Returns whether or not landscape orientation is desired"  (CASE ORIENTATION    (:LANDSCAPE T)    (:PORTRAIT NIL)    (:BEST (> WIDTH HEIGHT)))) (DEFMETHOD (TALARIS :COMPUTE-SCALE-AND-MARGINS) (WIDTH HEIGHT DOTS-PER-INCH LANDSCAPEP &AUX Y-INCHES Y-TOP-MARGIN X-DIMENSION Y-DIMENSION  HORIZONTAL-DIMENSION VERTICAL-DIMENSION)  "Sets up scale and margin"  (SETQ X-DIMENSION (IF DOTS-PER-INCH      (TV:SHEET-WIDTH TV:MAIN-SCREEN)      WIDTH)Y-DIMENSION (IF DOTS-PER-INCH      (TV:SHEET-HEIGHT TV:MAIN-SCREEN)      HEIGHT))  (SETQ HORIZONTAL-DIMENSION X-DIMENSIONVERTICAL-DIMENSION Y-DIMENSION)  (IF LANDSCAPEP    (ROTATEF HORIZONTAL-DIMENSION VERTICAL-DIMENSION))  (SETQ SCALE(VALUES (FLOOR  (MIN    (QUOTIENT (* (SECOND TALARIS-PAPER-SIZE) (THIRD TALARIS-PAPER-SIZE))      VERTICAL-DIMENSION)    (QUOTIENT (* (FIRST TALARIS-PAPER-SIZE) (THIRD TALARIS-PAPER-SIZE))      HORIZONTAL-DIMENSION)))))  (SETQ Y-INCHES (QUOTIENT (FLOAT (* SCALE Y-DIMENSION)) (FLOAT (THIRD TALARIS-PAPER-SIZE))))  (SETQ Y-TOP-MARGIN(/ (FLOAT  (- (IF LANDSCAPEP       (FIRST TALARIS-PAPER-SIZE)       (SECOND TALARIS-PAPER-SIZE))     Y-INCHES)) 2.0))  (SETQ SET-MARGIN-STRING(FORMAT () "^IJ~5,48D^IB~5,48D^IT~5,48D" (VALUES (FLOOR (* Y-TOP-MARGIN 1000)))(VALUES (FLOOR (* (+ Y-TOP-MARGIN Y-INCHES) 1000)))(VALUES (FLOOR  (*   (FLOAT    (- (IF LANDSCAPEP (SECOND TALARIS-PAPER-SIZE) (FIRST TALARIS-PAPER-SIZE))        (QUOTIENT (FLOAT (* SCALE X-DIMENSION)  (FLOAT (THIRD TALARIS-PAPER-SIZE)) ) 1)))   500)))))) (DEFMETHOD (TALARIS :WRITE-BITMAP) (BITMAP-ARRAY WIDTH HEIGHT START-X START-Y LANDSCAPEP &AUX HEX-PER-LINE DISPLACED-ARRAY)  (SETQ SCALE (FORMAT () "~2,48D" SCALE))  (SETQ SCALE (STRING-APPEND SCALE SCALE))  (SETQ HEX-PER-LINE(*  (QUOTIENT (+ WIDTH 15) 16) 4))  (SETQ DISPLACED-ARRAY(MAKE-ARRAY  (list height (QUOTIENT WIDTH 4))  :element-TYPE '(UNSIGNED-BYTE 4)   :DISPLACED-TO BITMAP-ARRAY))  (SEND PRINTER-STREAM :STRING-OUT     (FORMAT () "~%^PY^-~%^IO~A~%~A~%^F~%^IP~A~%^P~4,48D" (IF LANDSCAPEP    "L"    "P")     SET-MARGIN-STRING SCALE (- WIDTH START-X)))  (LOOP FOR Y FROM START-Y BELOW HEIGHT DO     (LOOP FOR X FROM START-X BELOW (QUOTIENT WIDTH 4)DO (SEND SELF :TALARIS-OUT (BACKWARDS-HEX (ARRAY-2-REF DISPLACED-ARRAY X Y))))     DO (LOOP FOR X FROM WIDTH BELOW (* HEX-PER-LINE 4) BY 4 DO (SEND SELF :TALARIS-OUT "0")))  (TERPRI PRINTER-STREAM)  (SEND SELF :TALARIS-OUT "^G^,^PN^-")  (SEND SELF :TALARIS-OUT TALARIS-RESET-STRING)) (DEFUN BACKWARDS-HEX (DIGIT)  "reverses order of bits of a single hex digit and returns the hex value"  (STRING (AREF "084C2A6E195D3B7F" DIGIT))) (DEFUN PACK (B0 B1 B2 B3)  (LOGIOR B0 (LSH B1 1) (LSH B2 2) (LSH B3 3))) (DEFUN SAFE-AREF-X (BITMAP-ARRAY X Y)  (IF (>= X (array-dimension BITMAP-ARRAY 1))    0    (ARRAY-2-REF BITMAP-ARRAY X Y))) (DEFMETHOD (TALARIS :TALARIS-OUT) (CHAR)  (WHEN (> SINCE-CR SINCE-CR-THRESHOLD)    (TERPRI PRINTER-STREAM)    (SETQ SINCE-CR 0))  (COND    ((STRING-EQUAL CHAR "0") (INCF DARK-COUNT)     (COND       ((> DARK-COUNT 999) (SEND PRINTER-STREAM :STRING-OUT "^D999")(SETQ DARK-COUNT (- DARK-COUNT 1747)) (SETQ SINCE-CR (+ 5 SINCE-CR)))       ((PLUSP BRIGHT-COUNT)(SEND PRINTER-STREAM :STRING-OUT (FORMAT () "^B~3,48D" BRIGHT-COUNT))(SETQ BRIGHT-COUNT 0) (SETQ SINCE-CR (+ 5 SINCE-CR)))))    ((STRING-EQUAL CHAR "F") (INCF BRIGHT-COUNT)     (COND       ((> BRIGHT-COUNT 999) (SEND PRINTER-STREAM :STRING-OUT "^B999")(SETQ BRIGHT-COUNT (- BRIGHT-COUNT 1747)) (SETQ SINCE-CR (+ 5 SINCE-CR)))       ((PLUSP DARK-COUNT) (SEND PRINTER-STREAM :STRING-OUT (FORMAT () "^D~3,48D" DARK-COUNT))(SETQ DARK-COUNT 0) (SETQ SINCE-CR (+ 5 SINCE-CR)))))    (T     (COND       ((PLUSP DARK-COUNT) (SEND PRINTER-STREAM :STRING-OUT (FORMAT () "^D~3,48D" DARK-COUNT))(SETQ SINCE-CR (+ 5 SINCE-CR)) (SETQ DARK-COUNT 0))       ((PLUSP BRIGHT-COUNT)(SEND PRINTER-STREAM :STRING-OUT (FORMAT () "^B~3,48D" BRIGHT-COUNT))(SETQ BRIGHT-COUNT 0) (SETQ SINCE-CR (+ 5 SINCE-CR))))     (SEND PRINTER-STREAM :STRING-OUT CHAR) (INCF SINCE-CR)))) (DEFMETHOD (TALARIS :SCREEN-IMAGE-FILE-P) (FILENAME)  (LET ((FILE-TYPE (SEND FILENAME :TYPE)))    (OR (EQUALP "talaris" FILE-TYPE) (EQUALP "tal" FILE-TYPE) (EQUALP "qms" FILE-TYPE)))) (COMPILE-FLAVOR-METHODS TALARIS)   ILE-TO-PRINT (FS:MERGE-PATHNAME-DEFAULTS (USER-HOMEDIR-PATHNAME)))(PRINTER-NAME (GET-DEFAULT-PRINTER))(COPIES 1)(LINES *DEFAULT-LINES*)(HEADER *DEFAULT-HEADER*)(PAGE-HEADING-P (NOT (NULL *DEFAULT-PAGE-HEADING*)))(PAGE-HEADING-STRIN