Add MAKESYSDATE to logo window title, just delete Venue logo code
This commit is contained in:
Larry Masinter
114
sources/LOGOW
114
sources/LOGOW
@@ -1,23 +1,21 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "XCL" BASE 10)
|
||||
|
||||
(FILECREATED " 2-Mar-2022 16:44:21" |{DSK}<home>larry>medley>sources>LOGOW.;4| 18595
|
||||
(FILECREATED " 4-Mar-2022 19:31:19" |{DSK}<home>larry>medley>sources>LOGOW.;2| 13188
|
||||
|
||||
:CHANGES-TO (VARS LOGOWCOMS)
|
||||
:CHANGES-TO (FNS LOGOW)
|
||||
|
||||
:PREVIOUS-DATE "28-Feb-2022 21:48:48" |{DSK}<home>larry>medley>sources>LOGOW.;1|)
|
||||
:PREVIOUS-DATE " 4-Mar-2022 19:17:17" |{DSK}<home>larry>medley>sources>LOGOW.;1|)
|
||||
|
||||
|
||||
; Copyright (c) 1986-1991, 2022 by Venue.
|
||||
|
||||
(PRETTYCOMPRINT LOGOWCOMS)
|
||||
|
||||
(RPAQQ LOGOWCOMS
|
||||
((FNS KOTOLOGOW LOGOW \\DRAWLOGOWINDOWIMAGE)
|
||||
(VARS LOGOBITMAP)
|
||||
(INITVARS (LOGOW NIL)
|
||||
(LOGOTITLEFONT (FONTCREATE '(HELVETICA 6)))
|
||||
(LOGONAMEFONT (FONTCREATE 'HELVETICA 36 'BOLD)))
|
||||
(PROP (LOGOW FILETYPE))))
|
||||
(RPAQQ LOGOWCOMS ((FNS KOTOLOGOW LOGOW \\DRAWLOGOWINDOWIMAGE)
|
||||
(VARS LOGOBITMAP)
|
||||
(INITVARS (LOGOW NIL))
|
||||
(ADDVARS (AFTERMAKESYSFORMS (LOGOW)))
|
||||
(PROP (LOGOW FILETYPE))))
|
||||
(DEFINEQ
|
||||
|
||||
(KOTOLOGOW
|
||||
@@ -67,95 +65,17 @@
|
||||
(RETURN W))))
|
||||
|
||||
(LOGOW
|
||||
(LAMBDA (STRING WHERE TITLE TITLE-LOCATION) (* \; "Edited 28-Feb-2022 20:14 by larry")
|
||||
(LAMBDA (STRING WHERE TITLE TITLE-LOCATION) (* \; "Edited 4-Mar-2022 19:05 by larry")
|
||||
(* \; "Edited 12-Jul-91 03:12 by jds")
|
||||
(PROG (WINDOW)
|
||||
(CL:WHEN (WINDOWP LOGOW)
|
||||
(CLOSEW LOGOW))
|
||||
(OR STRING (SETQ STRING (OR "Medley" (CL:STRING-CAPITALIZE MAKESYSNAME))))
|
||||
(OR TITLE (SETQ TITLE "https://Interlisp.org")) (* \; "(LOGOW NIL) gives default")
|
||||
(OR TITLE (SETQ TITLE (CONCAT "https://Interlisp.org" " " MAKESYSDATE)))
|
||||
|
||||
(* |;;| "(LOGOW NIL) gives default")
|
||||
|
||||
(SETQ WINDOW (KOTOLOGOW STRING T TITLE))
|
||||
(|if| NIL
|
||||
|then| (OR TITLE-LOCATION (SETQ TITLE-LOCATION :LINE))
|
||||
(OR TITLE (SETQ TITLE (CL:FORMAT NIL
|
||||
"Copyright (c) ~D Venue, Oakland, CA. All Rights Reserved."
|
||||
(LOADTIMECONSTANT (CL:MULTIPLE-VALUE-BIND
|
||||
(A B C D E YEAR)
|
||||
(CL:GET-DECODED-TIME)
|
||||
YEAR)))))
|
||||
(LET* ((SHADOWDX 2)
|
||||
(SHADOWDY 2)
|
||||
(TITLE-BOTTOM-HEIGHT (COND
|
||||
((EQ TITLE-LOCATION :BOTTOM)
|
||||
(* \;
|
||||
"Magic 4 again, just a little space above the copyright notice.")
|
||||
(+ (FONTHEIGHT LOGOTITLEFONT)
|
||||
4))
|
||||
(T 0)))
|
||||
(LINE (COND
|
||||
((EQ TITLE-LOCATION :LINE)
|
||||
(FONTHEIGHT LOGOTITLEFONT))
|
||||
(T 4)))
|
||||
(SLEN (STRINGWIDTH STRING LOGONAMEFONT))
|
||||
(WLEN (+ (MAX SLEN (+ (BITMAPWIDTH LOGOBITMAP)
|
||||
2 2)
|
||||
(STRINGWIDTH TITLE LOGOTITLEFONT))
|
||||
(PROG1 (+ 4 4) (* \; "left and right margin")
|
||||
)))
|
||||
(WHT (+ (FONTHEIGHT LOGONAMEFONT)
|
||||
(PROG1 (+ 4 LINE 4 4) (* \;
|
||||
"below line, line, above line, above bitmap")
|
||||
)
|
||||
(BITMAPHEIGHT LOGOBITMAP)
|
||||
TITLE-BOTTOM-HEIGHT))
|
||||
(TEMP (BITMAPCREATE WLEN WHT))
|
||||
(IMAGE (BITMAPCREATE WLEN WHT))
|
||||
(MASK (BITMAPCREATE WLEN WHT))
|
||||
(STREAM (DSPCREATE TEMP))
|
||||
WINDOW LINEY LINEX TITLEWIDTH)
|
||||
(BITBLT LOGOBITMAP NIL NIL STREAM (DIFFERENCE WLEN (+ (BITMAPWIDTH
|
||||
LOGOBITMAP)
|
||||
(PROG1 6
|
||||
(* \; "right margin"))))
|
||||
(+ TITLE-BOTTOM-HEIGHT (FONTHEIGHT LOGONAMEFONT)
|
||||
4 LINE 4))
|
||||
(DSPFONT LOGONAMEFONT STREAM)
|
||||
(MOVETO (- WLEN 4 (STRINGWIDTH STRING STREAM))
|
||||
(+ (FONTDESCENT LOGONAMEFONT)
|
||||
TITLE-BOTTOM-HEIGHT)
|
||||
STREAM)
|
||||
(PRIN3 STRING STREAM)
|
||||
(BITBLT STREAM 0 0 IMAGE NIL NIL NIL NIL NIL 'ERASE)
|
||||
(BITBLT STREAM 0 0 IMAGE SHADOWDX (- SHADOWDY)
|
||||
NIL NIL NIL 'PAINT)
|
||||
(BITBLT STREAM 0 0 MASK SHADOWDX (- SHADOWDY)
|
||||
NIL NIL NIL 'PAINT)
|
||||
(BITBLT STREAM 0 0 MASK NIL NIL NIL NIL NIL 'PAINT)
|
||||
(SETQ TITLEWIDTH (STRINGWIDTH TITLE LOGOTITLEFONT))
|
||||
(BITBLT NIL NIL NIL IMAGE (SETQ LINEX 6)
|
||||
(SETQ LINEY (+ TITLE-BOTTOM-HEIGHT (FONTHEIGHT LOGONAMEFONT)
|
||||
4))
|
||||
(IMAX TITLEWIDTH (BITMAPWIDTH LOGOBITMAP))
|
||||
LINE
|
||||
'TEXTURE
|
||||
'PAINT BLACKSHADE)
|
||||
(BITBLT NIL NIL NIL MASK LINEX LINEY TITLEWIDTH LINE 'TEXTURE 'PAINT
|
||||
BLACKSHADE)
|
||||
(SETQ STREAM (DSPCREATE IMAGE))
|
||||
(DSPFONT LOGOTITLEFONT STREAM)
|
||||
(DSPOPERATION 'ERASE STREAM)
|
||||
(DSPTEXTURE BLACKSHADE STREAM)
|
||||
(MOVETO (ADD1 LINEX)
|
||||
(+ (FONTDESCENT LOGOTITLEFONT)
|
||||
(COND
|
||||
((EQ TITLE-LOCATION :BOTTOM)
|
||||
0)
|
||||
(T LINEY)))
|
||||
STREAM)
|
||||
(PRIN3 TITLE STREAM)
|
||||
(SETQ WINDOW (ICONW IMAGE MASK (OR WHERE (CREATEPOSITION (- SCREENWIDTH
|
||||
WLEN)
|
||||
(- SCREENHEIGHT WHT)))))))
|
||||
(WINDOWPROP WINDOW 'BUTTONEVENTFN 'MOVEW)
|
||||
(WINDOWPROP WINDOW 'TYPE 'LOGOW)
|
||||
(WINDOWPROP WINDOW 'CLOSEFN (FUNCTION (LAMBDA NIL
|
||||
@@ -184,11 +104,9 @@
|
||||
|
||||
(RPAQ? LOGOW NIL)
|
||||
|
||||
(RPAQ? LOGOTITLEFONT (FONTCREATE '(HELVETICA 6)))
|
||||
|
||||
(RPAQ? LOGONAMEFONT (FONTCREATE 'HELVETICA 36 'BOLD))
|
||||
(ADDTOVAR AFTERMAKESYSFORMS (LOGOW))
|
||||
(PUTPROPS LOGOW COPYRIGHT ("Venue" 1986 1987 1988 1989 1990 1991 2022))
|
||||
(DECLARE\: DONTCOPY
|
||||
(FILEMAP (NIL (644 10406 (KOTOLOGOW 654 . 3448) (LOGOW 3450 . 9697) (\\DRAWLOGOWINDOWIMAGE 9699 .
|
||||
10404)))))
|
||||
(FILEMAP (NIL (596 5071 (KOTOLOGOW 606 . 3400) (LOGOW 3402 . 4362) (\\DRAWLOGOWINDOWIMAGE 4364 . 5069)
|
||||
))))
|
||||
STOP
|
||||
|
||||
Reference in New Issue
Block a user