Merge pull request #711 from Interlisp/medley-logow

Medley logow

lispusers/KOTOLOGO

@@ -1,70 +0,0 @@
-(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP")
-
(filecreated "17-Aug-88 03:42:15" {erinyes}<lispusers>medley>kotologo.\;1
 3467   
-
-      |changes| |to:|  (vars kotologocoms)
-                       (fns kotologow))
-
-
-; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.
-
-(prettycomprint kotologocoms)
-
-(rpaqq kotologocoms
 ((fns kotologow \\drawlogowindowimage)))
-(defineq
-
-(kotologow

-  (lambda (string where title angledelta)
                (* |edited:| " 1-AUG-83 22:55")

-                                                             (* |creates| \a |logo| |window.|)

-    (prog ((circlesize 60)
-           (logoxcenter 70)
-           (logoycenter 65)
-           (logowindowheight 180)
-           w logowindowwidth wimagewidth wimageheight (string (or string "Interlisp-D")))
-          (or angledelta (setq angledelta 23))
-          (setq wimagewidth (fix (ftimes circlesize 0.62)))
-          (setq wimageheight (fix (ftimes circlesize 0.5)))
-          (setq logowindowwidth (iplus logoxcenter 30 wimagewidth (stringwidth string
-                                                                         '(timesromand 36))))
-          (setq w (cond
-                     ((typenamep where 'window)
-                      where)
-                     (t (createw (cond
-                                    ((positionp where)
-                                     (|create|
 region
-                                            left _ (|fetch|
 (position xcoord) |of|
 where)
-                                            bottom _ (|fetch|
 (position ycoord) |of|
 where)
-                                            width _ logowindowwidth
-                                            height _ logowindowheight))
-                                    (t (getboxregion logowindowwidth logowindowheight nil nil nil 
-                                              "Specify location for logo window.")))
-                               (or title (concat "Copyright (c) by Xerox Corporation" "             "
-                                                (or makesysdate (date))))))))
-          (|for|
 angle |from|
 0 |to|
 270 |by|
 angledelta
-             |do|
 (\\drawlogowindowimage
 (iplus logoxcenter (ftimes circlesize (cos angle)))
-                             (iplus logoycenter (ftimes circlesize (sin angle)))
-                             wimagewidth wimageheight 2 w))
-          (moveto (iplus logoxcenter 10 wimagewidth)
-                 (iplus 2 (idifference logoycenter circlesize))
-                 w)
-          (dspfont '(timesromand 36)
-                 w)
-          (prin3 string w)
-          (return w))))
-
-(\\drawlogowindowimage

-  (lambda (xpos ypos width height border w)
              (* |rrb| "22-FEB-82 18:04")

-                                                             (* |makes| \a |window| |image.|
-
                                                           |This| |is| |part| |of| |the| |logo| 
-
                                                           |drawing.|)

-    (bitblt nil nil nil w xpos ypos width height 'texture 'replace blackshade)
-    (bitblt nil nil nil w (iplus border xpos)
-           (iplus border ypos)
-           (idifference width (itimes border 2))
-           (idifference height (itimes border 3))
-           'texture
-           'replace whiteshade)))
-)
-(putprops kotologo copyright ("Xerox Corporation" 1988))
-(declare\: dontcopy
-  (filemap (nil (393 3387 (kotologow 403 . 2682) (\\drawlogowindowimage 2684 . 3385)))))
-stop