(FILECREATED " 1-Apr-86 15:45:51" {ERIS}<LISPUSERS>KOTO>HEADLINE.;4 11450
changes to: (FNS CLOSE.HEADLINES BANNER.BOARD BANNER.ARRAY HEADLINE.ARRAY BILLBOARD)
(VARS HEADLINECOMS)
previous date: " 4-Mar-86 11:20:58" {QV}<AHENDERSON>LISP>HEADLINE.;10)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT HEADLINECOMS)
(RPAQQ HEADLINECOMS ((FNS BANNER BANNER.ARRAY BANNER.MAKE BILLBOARD CLOSE.HEADLINES HEADLINE
HEADLINE.ABSTRACTER HEADLINE.ARRAY HEADLINE.MAKE HEADLINE.RECOGNIZER
HEADLINE.RECONSTITUTER)))
(DEFINEQ
(BANNER
[LAMBDA (PHRASE FONT POSITION ALIGNMENT) (* DAHJr " 4-Mar-86 11:09")
(PROG (TITLE FNT REFERENCE.POINT XALIGNMENT YALIGNMENT W)
[SETQ TITLE (COND
((NULL PHRASE)
"The British are coming")
(T (MKSTRING PHRASE]
[SETQ FNT (OR FONT (QUOTE (TIMESROMAND 36]
[SETQ REFERENCE.POINT (OR POSITION (PROGN (GETMOUSESTATE)
(create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY]
[SETQ XALIGNMENT (COND
(ALIGNMENT (COND
((LISTP ALIGNMENT)
(CAR ALIGNMENT))
(T ALIGNMENT)))
(T (QUOTE CENTER]
[SETQ YALIGNMENT (COND
(ALIGNMENT (COND
((LISTP ALIGNMENT)
(CDR ALIGNMENT))
(T ALIGNMENT)))
(T (QUOTE CENTER]
(SETQ W (BANNER.MAKE TITLE FNT REFERENCE.POINT (CONS XALIGNMENT YALIGNMENT)))
(COND
((NULL POSITION)
(MOVEW W])
(BANNER.ARRAY
[LAMBDA (TITLES ALIGNMENT SEPARATION POSITION) (* DAHJr " 1-Apr-86 15:34")
(* edited: " 5-AUG-82 10:42")
(PROG ((X (COND
(POSITION (FETCH (POSITION XCOORD) OF POSITION))
(T 50)))
(ALIGN (OR ALIGNMENT (QUOTE CENTER)))
(SEP (OR SEPARATION 70)))
(for TITLE in TITLES
do (BANNER (CAR TITLE)
(CADR TITLE)
[create POSITION
XCOORD ← X
YCOORD ←(COND
(POSITION (fetch (POSITION XCOORD) of POSITION))
(T (SELECTQ ALIGN
(BOTTOM 30)
(CENTER 400)
(TOP 750)
(SHOULDNT]
(CONS (QUOTE LEFT)
ALIGN))
(SETQ X (IPLUS X SEP)))
NIL])
(BANNER.MAKE
[LAMBDA (TITLE FONT REFERENCE.POINT ALIGNMENT) (* DAHJr " 4-Mar-86 11:04")
(PROG (W FNTDESC FONT.HEIGHT REGION DSP BOUNDARY BORDER INFO MAX.WIDTH CHAR WIDTH HEIGHT
XALIGNMENT YALIGNMENT LEFT BOTTOM OFF.SCREEN PLEFT PBOTTOM)
(SETQ FNTDESC (FONTCREATE FONT))
(SETQ FONT.HEIGHT (FONTHEIGHT FNTDESC))
(SETQ BORDER 4)
(SETQ BOUNDARY 4)
[SETQ INFO (for I to (NCHARS TITLE) collect (CONS (SETQ CHAR
(NTHCHAR TITLE I))
(STRINGWIDTH CHAR FNTDESC]
(SETQ MAX.WIDTH (OR (CDR (for ELEM in INFO largest (CDR ELEM)))
0))
(SETQ WIDTH (IPLUS BORDER BORDER BOUNDARY BOUNDARY MAX.WIDTH))
(SETQ HEIGHT (IPLUS BORDER BORDER BOUNDARY BOUNDARY (ITIMES (LENGTH INFO)
FONT.HEIGHT)))
(SETQ XALIGNMENT (CAR ALIGNMENT))
(SETQ YALIGNMENT (CDR ALIGNMENT))
(SETQ LEFT (SELECTQ XALIGNMENT
((LEFT BOTTOM LOW)
(fetch (POSITION XCOORD) of REFERENCE.POINT))
((CENTER MIDDLE)
(IDIFFERENCE (fetch (POSITION XCOORD) of
REFERENCE.POINT)
(IQUOTIENT WIDTH 2)))
((RIGHT TOP HIGH)
(IDIFFERENCE (fetch (POSITION XCOORD) of
REFERENCE.POINT)
WIDTH))
(SHOULDNT)))
(SETQ BOTTOM (SELECTQ YALIGNMENT
((LEFT BOTTOM LOW)
(fetch (POSITION YCOORD) of REFERENCE.POINT))
((CENTER MIDDLE)
(IDIFFERENCE (fetch (POSITION YCOORD) of
REFERENCE.POINT)
(IQUOTIENT HEIGHT 2)))
((RIGHT TOP HIGH)
(IDIFFERENCE (fetch (POSITION YCOORD) of
REFERENCE.POINT)
HEIGHT))
(SHOULDNT)))
[SETQ PLEFT (MAX 0 (MIN LEFT (IDIFFERENCE SCREENWIDTH WIDTH]
[SETQ PBOTTOM (MAX 0 (MIN BOTTOM (IDIFFERENCE SCREENHEIGHT HEIGHT]
(SETQ REGION (create REGION
LEFT ← PLEFT
BOTTOM ← PBOTTOM
WIDTH ← WIDTH
HEIGHT ← HEIGHT))
(SETQ W (CREATEW REGION NIL BORDER))
(WINDOWPROP W (QUOTE HEADLINE.TYPE)
(QUOTE BANNER))
(WINDOWPROP W (QUOTE HEADLINE.FONT)
FONT)
(WINDOWPROP W (QUOTE HEADLINE.TITLE)
TITLE)
(WINDOWPROP W (QUOTE HEADLINE.ALIGNMENT)
ALIGNMENT)
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION MOVEW))
(WINDOWPROP W (QUOTE RESHAPEFN)
(QUOTE DON'T))
(SETQ DSP (WINDOWPROP W (QUOTE DSP)))
(DSPFONT FNTDESC DSP)
(for ELEM in INFO as I from (SUB1 (LENGTH INFO)) by -1
do (MOVETO (IPLUS BOUNDARY (IQUOTIENT (IDIFFERENCE MAX.WIDTH (CDR ELEM))
2))
(IPLUS BOUNDARY (ITIMES I FONT.HEIGHT)
(FONTDESCENT FNTDESC))
W)
(PRIN3 (CAR ELEM)
W))
(RETURN W])
(BILLBOARD
[LAMBDA (TITLES ALIGNMENT SEPARATION POSITION) (* DAHJr " 1-Apr-86 15:45")
(* edited: " 5-AUG-82 10:42")
(HEADLINE.ARRAY TITLES ALIGNMENT SEPARATION POSITION])
(CLOSE.HEADLINES
[LAMBDA NIL (* DAHJr " 1-Apr-86 15:30")
(for WINDOW in (ACTIVEWINDOWS) do (COND
((WINDOWPROP WINDOW (QUOTE HEADLINE.TYPE))
(CLOSEW WINDOW])
(HEADLINE
[LAMBDA (PHRASE FONT POSITION ALIGNMENT) (* DAHJr " 4-Mar-86 11:10")
(PROG (TITLE FNT FNTDESC REFERENCE.POINT XALIGNMENT YALIGNMENT W)
[SETQ TITLE (COND
((NULL PHRASE)
"The British are coming")
(T (MKSTRING PHRASE]
[SETQ FNT (OR FONT (QUOTE (TIMESROMAND 36]
[SETQ REFERENCE.POINT (OR POSITION (PROGN (GETMOUSESTATE)
(create POSITION
XCOORD ← LASTMOUSEX
YCOORD ← LASTMOUSEY]
[SETQ XALIGNMENT (COND
(ALIGNMENT (COND
((LISTP ALIGNMENT)
(CAR ALIGNMENT))
(T ALIGNMENT)))
(T (QUOTE CENTER]
[SETQ YALIGNMENT (COND
(ALIGNMENT (COND
((LISTP ALIGNMENT)
(CDR ALIGNMENT))
(T ALIGNMENT)))
(T (QUOTE CENTER]
(SETQ W (HEADLINE.MAKE TITLE FNT REFERENCE.POINT (CONS XALIGNMENT YALIGNMENT)))
(COND
((NULL POSITION)
(MOVEW W])
(HEADLINE.ABSTRACTER
[LAMBDA (WINDOW) (* DAHJr " 4-Mar-86 11:15")
(LIST (WINDOWPROP WINDOW (QUOTE HEADLINE.TYPE))
(WINDOWPROP WINDOW (QUOTE HEADLINE.TITLE))
(WINDOWPROP WINDOW (QUOTE HEADLINE.FONT))
(WINDOWPROP WINDOW (QUOTE HEADLINE.ALIGNMENT])
(HEADLINE.ARRAY
[LAMBDA (TITLES ALIGNMENT SEPARATION POSITION) (* edited: " 5-AUG-82 10:42")
(PROG ((Y (COND
(POSITION (FETCH (POSITION YCOORD) OF POSITION))
(T 670)))
(ALIGN (OR ALIGNMENT (QUOTE CENTER)))
(SEP (OR SEPARATION 70)))
(for TITLE in TITLES
do (HEADLINE (CAR TITLE)
(CADR TITLE)
(create POSITION
XCOORD ←[COND
(POSITION (fetch (POSITION XCOORD) of POSITION))
(T (SELECTQ ALIGN
(LEFT 30)
(CENTER 500)
(RIGHT 1000)
(SHOULDNT]
YCOORD ← Y)
(CONS ALIGN (QUOTE BOTTOM)))
(SETQ Y (IDIFFERENCE Y SEP)))
NIL])
(HEADLINE.MAKE
[LAMBDA (TITLE FONT REFERENCE.POINT ALIGNMENT) (* DAHJr " 4-Mar-86 11:04")
(PROG (FNTDESC BOUNDARY BORDER XALIGNMENT YALIGNMENT WIDTH HEIGHT LEFT BOTTOM REGION W DSP)
(SETQ FNTDESC (FONTCREATE FONT))
(SETQ BORDER 4)
(SETQ BOUNDARY 4)
(SETQ XALIGNMENT (CAR ALIGNMENT))
(SETQ YALIGNMENT (CDR ALIGNMENT))
(SETQ WIDTH (IPLUS BORDER BORDER BOUNDARY BOUNDARY (STRINGWIDTH TITLE FNTDESC)))
(SETQ HEIGHT (IPLUS BORDER BORDER BOUNDARY BOUNDARY (FONTHEIGHT FNTDESC)))
(SETQ LEFT (SELECTQ XALIGNMENT
((LEFT BOTTOM LOW)
(fetch (POSITION XCOORD) of REFERENCE.POINT))
((CENTER MIDDLE)
(IDIFFERENCE (fetch (POSITION XCOORD) of
REFERENCE.POINT)
(IQUOTIENT WIDTH 2)))
((RIGHT TOP HIGH)
(IDIFFERENCE (fetch (POSITION XCOORD) of
REFERENCE.POINT)
WIDTH))
(SHOULDNT)))
(SETQ BOTTOM (SELECTQ YALIGNMENT
((LEFT BOTTOM LOW)
(fetch (POSITION YCOORD) of REFERENCE.POINT))
((CENTER MIDDLE)
(IDIFFERENCE (fetch (POSITION YCOORD) of
REFERENCE.POINT)
(IQUOTIENT HEIGHT 2)))
((RIGHT TOP HIGH)
(IDIFFERENCE (fetch (POSITION YCOORD) of
REFERENCE.POINT)
HEIGHT))
(SHOULDNT)))
(SETQ REGION (create REGION
LEFT ←(MAX 0 (MIN LEFT (IDIFFERENCE SCREENWIDTH WIDTH)))
BOTTOM ←(MAX 0 (MIN BOTTOM (IDIFFERENCE SCREENHEIGHT
HEIGHT)))
WIDTH ← WIDTH
HEIGHT ← HEIGHT))
(SETQ W (CREATEW REGION NIL BORDER))
(WINDOWPROP W (QUOTE HEADLINE.TYPE)
(QUOTE HEADLINE))
(WINDOWPROP W (QUOTE HEADLINE.FONT)
FONT)
(WINDOWPROP W (QUOTE HEADLINE.TITLE)
TITLE)
(WINDOWPROP W (QUOTE HEADLINE.ALIGNMENT)
ALIGNMENT)
(WINDOWPROP W (QUOTE BUTTONEVENTFN)
(FUNCTION MOVEW))
(WINDOWPROP W (QUOTE RESHAPEFN)
(QUOTE DON'T))
(SETQ DSP (WINDOWPROP W (QUOTE DSP)))
(DSPFONT FNTDESC DSP)
(MOVETO BOUNDARY (IPLUS BOUNDARY (FONTDESCENT FNTDESC))
W)
(PRIN3 TITLE W)
(RETURN W])
(HEADLINE.RECOGNIZER
[LAMBDA (WINDOW)
(WINDOWPROP WINDOW (QUOTE HEADLINE.TYPE])
(HEADLINE.RECONSTITUTER
[LAMBDA (DESCRIPTION) (* DAHJr " 4-Mar-86 11:19")
(SELECTQ (CAR DESCRIPTION)
(HEADLINE (HEADLINE.MAKE (CADR DESCRIPTION)
(CADDR DESCRIPTION)
(CONS 0 0)
(CADDDR DESCRIPTION)))
(BANNER (BANNER.MAKE (CADR DESCRIPTION)
(CADDR DESCRIPTION)
(CONS 0 0)
(CADDDR DESCRIPTION)))
NIL])
)
(PUTPROPS HEADLINE COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (592 11366 (BANNER 602 . 1614) (BANNER.ARRAY 1616 . 2469) (BANNER.MAKE 2471 . 5640) (
BILLBOARD 5642 . 5907) (CLOSE.HEADLINES 5909 . 6172) (HEADLINE 6174 . 7198) (HEADLINE.ABSTRACTER 7200
. 7552) (HEADLINE.ARRAY 7554 . 8320) (HEADLINE.MAKE 8322 . 10792) (HEADLINE.RECOGNIZER 10794 . 10891)
(HEADLINE.RECONSTITUTER 10893 . 11364)))))
STOP