(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED " 2-May-88 13:47:17" {ERINYES}MEDLEY>HEADLINE.;2 8211 changes to%: (FNS CLOSE.HEADLINES BANNER.MAKE) previous date%: " 1-Apr-86 15:45:51" {ERINYES}KOTO>LISPUSERS>HEADLINE.;1) (* " Copyright (c) 1985, 1986, 1988 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 (* ; "Edited 2-May-88 13:47 by Briggs") (* ;; "changed ACTIVEWINDOWS to OPENWINDOWS for Lyric & beyond") (for WINDOW in (OPENWINDOWS) 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 1988)) (DECLARE%: DONTCOPY (FILEMAP (NIL (602 8121 (BANNER 612 . 1341) (BANNER.ARRAY 1343 . 1880) (BANNER.MAKE 1882 . 4057) ( BILLBOARD 4059 . 4236) (CLOSE.HEADLINES 4238 . 4479) (HEADLINE 4481 . 5222) (HEADLINE.ABSTRACTER 5224 . 5477) (HEADLINE.ARRAY 5479 . 6002) (HEADLINE.MAKE 6004 . 7726) (HEADLINE.RECOGNIZER 7728 . 7813) ( HEADLINE.RECONSTITUTER 7815 . 8119))))) STOP