(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")

(FILECREATED "26-Jun-90 19:31:43" |{DSK}<usr>local>lde>lispcore>internal>library>USPS.;2|
 9175   

      |changes| |to:|  (VARS USPSCOMS)

      |previous| |date:| "13-Feb-89 13:49:35" |{DSK}<usr>local>lde>lispcore>internal>library>USPS.;1|
)


; Copyright (c) 1989, 1990 by Venue & Xerox Corporation.  All rights reserved.

(PRETTYCOMPRINT USPSCOMS)

(RPAQQ USPSCOMS

       (
        (* |;;| "Image Objects and functions for dealing with various kinds of mail.")


        (COMS 
              (* |;;| "FIMs -- \"Facing Identification Marks\" used with Business Reply Mail.  The top of a FIM must be within 1/8\" of the top of the envelope or card, and the right edge of the FIM must be 2\" +/- 1/8\" from the right edge of the card.  You can tilt the FIM no more than 5 degrees from vertical.")


              (FNS USPS-FIM.BUTTONEVENTINFN USPS-FIM.COPYFN USPS-FIM.CREATE USPS-FIM.CREATE.MENU 
                   USPS-FIM.DISPLAYFN USPS-FIM.GETFN3 USPS-FIM.IMAGEBOXFN USPS-FIM.INIT 
                   USPS-FIM.PUTFN)
              (GLOBALVARS USPS-FIM.IMAGEFNS USPS-FIM.MENU
                     (USPS-FIM.STYLES '((A T T NIL NIL T NIL NIL T T)
                                        (B T NIL T T NIL T T NIL T)
                                        (C T T NIL T NIL T NIL T T)
                                        (D T T T NIL T NIL T T T))))
              (P (USPS-FIM.INIT)))))



(* |;;| "Image Objects and functions for dealing with various kinds of mail.")





(* |;;| 
"FIMs -- \"Facing Identification Marks\" used with Business Reply Mail.  The top of a FIM must be within 1/8\" of the top of the envelope or card, and the right edge of the FIM must be 2\" +/- 1/8\" from the right edge of the card.  You can tilt the FIM no more than 5 degrees from vertical."
)


(DEFINEQ

(USPS-FIM.BUTTONEVENTINFN

  (LAMBDA (IMAGEOBJ WINDOW SELECTION X Y SELWINDOW TEXTSTREAM BUTTON OPERATION)

                                                             (* \; "Edited 13-Feb-89 12:29 by jds")


(* |;;;| "the user has pressed a button inside the bitmap object IMAGEOBJ.  Bring up a menu of bitmap edit operations.")


    (PROG* ((FIM-STYLE (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)))
           (COND
              ((OR (EQ BUTTON 'RIGHT)
                   (AND OPERATION (NEQ OPERATION 'NORMAL)))  (* \; " If he's extending a selection, or is selecting for move/copy/delete, DON'T bring up the bitmap editing menu!")

               (RETURN)))
           (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM (OR (MENU (COND
                                                            ((|type?|
 MENU USPS-FIM.MENU)
                                                             USPS-FIM.MENU)
                                                            (T (SETQ USPS-FIM.MENU (

                                                                               USPS-FIM.CREATE.MENU

                                                                                    )))))
                                                   FIM-STYLE))
           (IMAGEOBJPROP IMAGEOBJ 'CACHED.BITMAP NIL)        (* \; 

                             "And clear any cached shrunk bitmaps so the display looks reasonable.")

           (RETURN 'CHANGED))))

(USPS-FIM.COPYFN

  (LAMBDA (IMAGEOBJ)
                                     (* \; "Edited 13-Feb-89 13:03 by jds")


    (* |;;| "makes a copy of a bitmap image object.")


    (USPS-FIM.CREATE
 (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM))))

(USPS-FIM.CREATE

  (LAMBDA (FIM-STYLE)
                                    (* \; "Edited 13-Feb-89 12:00 by jds")


    (* |;;| "returns an IMAGEOBJ that displays/prints as a Postal Service Facing Identification Mark for business-reply mail.")


    (IMAGEOBJCREATE FIM-STYLE BITMAPIMAGEFNS)))

(USPS-FIM.CREATE.MENU

  (LAMBDA NIL
                                            (* \; "Edited 13-Feb-89 12:27 by jds")


    (* |;;| "Creates the menu that comes up when you button in a FIM image object.")


    (|create|
 MENU
           TITLE _ "New Facing Style"
           ITEMS _ '(A B C D)
           CENTERFLG _ T
           CHANGEOFFSETFLG _ 'Y
           MENUOFFSET _ (|create|
 POSITION
                               XCOORD _ -1
                               YCOORD _ 0))))

(USPS-FIM.DISPLAYFN

  (LAMBDA (IMAGEOBJ IMAGE.STREAM)
                        (* \; "Edited 13-Feb-89 12:18 by jds")


    (* |;;| "Display a bitmap IMAGEOBJ on IMAGE.STREAM.  Scales and rotates it if appropriate, and moves it down by DESCENT.")


    (LET* ((FIM-STYLE-LIST (CDR (ASSOC (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM)
                                       USPS-FIM.STYLES)))
           (STREAM-SCALE (DSPSCALE NIL IMAGE.STREAM))
           (LINE-PITCH (FIXR (FTIMES STREAM-SCALE 72.27 1/16)))
           (LINE-WIDTH (FIXR (FTIMES STREAM-SCALE 72.27 0.031)))
           (FIM-HEIGHT (FIXR (FTIMES STREAM-SCALE (CONSTANT (TIMES 72.27 5/8)))))
           SHRUNK.BITMAP)
          (RELMOVETO 0 (IMINUS FIM-HEIGHT)
                 IMAGE.STREAM)
          (|for|
 LINE-P |in|
 FIM-STYLE-LIST |do|
 (COND
                                                                (LINE-P (RELDRAWTO 0 FIM-HEIGHT 
                                                                               LINE-WIDTH
                                                                               'PAINT IMAGE.STREAM)
                                                                       (RELMOVETO LINE-PITCH
                                                                              (IMINUS FIM-HEIGHT)
                                                                              IMAGE.STREAM))
                                                                (T (RELMOVETO LINE-PITCH 0 
                                                                          IMAGE.STREAM)))))))

(USPS-FIM.GETFN3

  (LAMBDA (STREAM)
                                       (* \; "Edited 13-Feb-89 13:49 by jds")


(* |;;;| "reads a bitmap image object from a file.  This version stores the binary data rather than the character representation used by READBITMAP.")


    (USPS-FIM.CREATE
 (SELECTQ (\\BIN STREAM)
                             (0 'A)
                             (1 'B)
                             (2 'C)
                             (3 'D)
                             (HELP "Illegal FIM style")))))

(USPS-FIM.IMAGEBOXFN

  (LAMBDA (IMAGEOBJ IMAGE.STREAM CURRENT.X RIGHT.MARGIN)
 (* \; "Edited 13-Feb-89 12:19 by jds")


    (* |;;| "returns an imagebox describing the size of the scaled bitmap")


    (LET* ((FIM-STYLE (IMAGEOBJPROP IMAGEOBJ 'OBJECTDATUM))
           (SCALE (DSPSCALE NIL IMAGE.STREAM))
           WIDTH HEIGHT)
          (SETQ WIDTH (FIXR (FTIMES SCALE (CONSTANT (FTIMES 72.27 (+ 9/16 0.031))))))
          (SETQ HEIGHT (FIXR (FTIMES SCALE (CONSTANT (TIMES 72.27 5/8)))))
          (|create|
 IMAGEBOX
                 XSIZE _ WIDTH
                 YSIZE _ HEIGHT
                 YDESC _ HEIGHT
                 XKERN _ 0))))

(USPS-FIM.INIT

  (LAMBDA NIL
                                            (* \; "Edited 13-Feb-89 12:02 by jds")


    (* |;;| 

  "returns the function vector which gives the functional information for a bitmap image object.")


    (SETQ BITMAPIMAGEFNS (IMAGEFNSCREATE (FUNCTION USPS-FIM.DISPLAYFN)
                                (FUNCTION USPS-FIM.IMAGEBOXFN)
                                (FUNCTION USPS-FIM.PUTFN)
                                (FUNCTION USPS-FIM.GETFN3)
                                (FUNCTION USPS-FIM.COPYFN)
                                (FUNCTION USPS-FIM.BUTTONEVENTINFN)
                                (FUNCTION NILL)
                                (FUNCTION NILL)
                                (FUNCTION NILL)
                                (FUNCTION NILL)
                                (FUNCTION NILL)
                                (FUNCTION NILL)
                                (FUNCTION NILL)))))

(USPS-FIM.PUTFN

  (LAMBDA (OBJECT STREAM)
                                (* \; "Edited 13-Feb-89 12:05 by jds")

                                                             (* \; 

                                                 "Put a description of a FIM object into the file.")

    (LET* ((FIM-STYLE (IMAGEOBJPROP OBJECT 'OBJECTDATUM)))
          (\\BOUT STREAM (SELECTQ FIM-STYLE
                             (A 0)
                             (B 1)
                             (C 2)
                             (D 3)
                             (HELP "Invalid FIM Style" FIM-STYLE))))))
)
(DECLARE\: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS USPS-FIM.IMAGEFNS USPS-FIM.MENU
       (USPS-FIM.STYLES '((A T T NIL NIL T NIL NIL T T)
                          (B T NIL T T NIL T T NIL T)
                          (C T T NIL T NIL T NIL T T)
                          (D T T T NIL T NIL T T T))))
)

(USPS-FIM.INIT
)
(PUTPROPS USPS COPYRIGHT ("Venue & Xerox Corporation" 1989 1990))
(DECLARE\: DONTCOPY
  (FILEMAP (NIL (1863 8764 (USPS-FIM.BUTTONEVENTINFN 1873 . 3332) (USPS-FIM.COPYFN 3334 . 3583) (
USPS-FIM.CREATE 3585 . 3891) (USPS-FIM.CREATE.MENU 3893 . 4397) (USPS-FIM.DISPLAYFN 4399 . 5982) (
USPS-FIM.GETFN3 5984 . 6518) (USPS-FIM.IMAGEBOXFN 6520 . 7182) (USPS-FIM.INIT 7184 . 8146) (
USPS-FIM.PUTFN 8148 . 8762)))))
STOP