pull more newer library lispusers internal(/library) files from envos (#813)
This commit is contained in:
Larry Masinter
GitHub
194
internal/envos/USPS
Normal file
194
internal/envos/USPS
Normal file
@@ -0,0 +1,194 @@
|
||||
(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
|
||||
Reference in New Issue
Block a user