(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