home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / data / frame-win.gwm < prev    next >
Lisp/Scheme  |  1995-07-03  |  4KB  |  155 lines
  1. ; General-frame decoration (for clock, mail, ...)
  2. ; ========================
  3.  
  4. ;;File: frame-win.gwm -- General-frame decoration
  5. ;;Author: vincent@mirsa.inria.fr (Vincent BOUTHORS) -- Bull Research FRANCE
  6. ;;Revision: 1.0 -- Feb 7 1989
  7. ;;State: Exp
  8. ;;GWM Version: 1.4
  9.  
  10.  
  11. ; Exported functions and variables:
  12.  
  13. ; frame-win
  14. ; frame3d-win
  15. ; frame3d-context
  16. ; frame2d-win
  17. ; frame2d-context
  18.  
  19. ; External variable used: 
  20.  
  21. ;     look-3d:
  22. ;         can be set to () (default) or tri-dim1  (t)
  23.  
  24. ;     frame.top-text 
  25. ;     frame.bottom-text
  26. ;        if these variables are set they are evaluated at creation
  27. ;         to form a label (string type is mandatory)
  28. ;     frame.font
  29. ;        font of text
  30.  
  31. ;    frame.pixmap-file must contain prefix of 8 bitmap files:
  32. ;         suffixes are:     t l r b (top left right bottom)
  33. ;                 tl tr bl br (corners)
  34. ;         default: "frame2d"
  35.  
  36. ;     frame.pixmap-format indicates wich format is used; 
  37. ;         'bitmap    (default) standard bitmap format, pixmap-make is used
  38. ;         'pixmap       pixmap oriented format, pixmap-load is used
  39.  
  40. ;     frame.name-separator indicates which character is used to separate
  41. ;        suffix from prefix in filename (default "-")
  42.  
  43. ;     frame.bar-width 
  44. ;            (default 1)
  45.  
  46. ;      frame.inner-border-width
  47. ;        (default 1)
  48.  
  49. (de frame.suffix (name1 name2)
  50.     (+ name1 frame.name-separator name2))
  51.  
  52. (de frame.win ()
  53.     (with (
  54.        fsm (fsm-make (state-make window-behavior standard-behavior))
  55.        name (default frame.pixmap-file "frame2d")       
  56.        frame.name-separator (default frame.name-separator "-")
  57.        frame.font (default frame.font small-font)
  58.        pixmap-make (if (= (default frame.pixmap-format 'bitmap) 'pixmap)
  59.                pixmap-load
  60.                pixmap-make)
  61.        frame.bar-width (if (boundp 'frame.bar-width)
  62.                    frame.bar-width
  63.                    10)
  64.       )
  65.       (with (
  66.          borderwidth 0 
  67.          bar-min-width frame.bar-width
  68.          bar-max-width frame.bar-width)
  69.         (: side-top     (pixmap-make (frame.suffix name "t")))
  70.         (: side-left     (pixmap-make (frame.suffix name "l")))
  71.         (: side-right     (pixmap-make (frame.suffix name "r")))
  72.         (: side-bottom      (pixmap-make (frame.suffix name "b")))
  73.         (: plug-corner-tl (plug-make(pixmap-make(frame.suffix name "tl"))))
  74.         (: plug-corner-br (plug-make(pixmap-make(frame.suffix name "br"))))
  75.         (: plug-corner-bl (plug-make(pixmap-make(frame.suffix name "bl"))))
  76.         (: plug-corner-tr (plug-make(pixmap-make(frame.suffix name "tr"))))
  77.         (: bar-top 
  78.            (with (tile side-top borderwidth 0)
  79.              (if (boundp 'frame.top-text)
  80.                  (bar-make 
  81.                  plug-corner-tl 
  82.                  () 
  83.                  (list 'plug-make
  84.                        (list 'label-make
  85.                          frame.top-text
  86.                          'frame.font))
  87.                  ()
  88.                  plug-corner-tr)
  89.                  (bar-make 
  90.                  plug-corner-tl
  91.                  ()
  92.                  plug-corner-tr))))
  93.         (: bar-bottom 
  94.            (with (tile side-bottom borderwidth 0)
  95.              (if (boundp 'frame.bottom-text)
  96.                  (bar-make 
  97.                  plug-corner-bl 
  98.                  () 
  99.                  (list 'plug-make
  100.                        (list 'label-make
  101.                          frame.bottom-text
  102.                          'frame.font))
  103.                  ()
  104.                  plug-corner-br)
  105.                  (bar-make 
  106.                  plug-corner-bl
  107.                  ()
  108.                  plug-corner-br))))
  109.         
  110.         
  111.         (: bar-left     (with (tile side-left)  (bar-make)))
  112.         (: bar-right    (with (tile side-right) (bar-make)))
  113.       )    
  114.       
  115.       ;    : result
  116.       (with (
  117.          inner-borderwidth (default frame.inner-border-width 1)
  118.          borderwidth (default frame.border-width 1))
  119.         (window-make bar-top bar-left bar-right bar-bottom ())))
  120. )
  121.  
  122. (setq frame3d-context
  123.     '(  
  124.     frame.pixmap-file "frame3d"
  125.     frame.name-separator "-"
  126.     frame.bar-width 8
  127.     frame.pixmap-format 'pixmap
  128.     frame.inner-border-width 0
  129.     frame.border-width (default frame.border-width 1)
  130.      ))
  131.  
  132. (df frame3d-win ()
  133.     (with frame3d-context
  134.       (frame.win)))
  135.  
  136. (setq frame2d-context
  137.     '(  
  138.     frame.pixmap-file "frame2d"
  139.     frame.name-separator "-"
  140.     frame.bar-width 10
  141.     frame.pixmap-format 'bitmap
  142.     frame.inner-border-width 0
  143.     frame.border-width (default frame.border-width 1)
  144.      ))
  145.  
  146. (df frame2d-win ()
  147.     (with frame2d-context
  148.       (frame.win)))
  149.  
  150. (df frame-win ()
  151.     (if (= t (default look-3d ()))
  152.     (frame3d-win)
  153.     (frame2d-win)))
  154.  
  155.