; Anders Hoslt virtual screen package loader for the standard profile
; ===================================================================

;;Author: colas@mirsa.inria.fr (Colas NAHABOO) -- Bull Research FRANCE
;;Revision: 1.0 -- June 28 1995

;; A wrapper to use Anders very nice virtual screen package in the 
;; standard profile
;; see virtual.gwm and virtual-door.gwm for complete options

;; here is an example of use in your .profile.gwm:

;; (setq std-virtual.doors '(
;;     ("Home" screen-background)
;;     ("Comp" "LightBlue3")
;;     ("Mail" 
;;       (pixmap-make (color-make "seagreen3") "grainy" (color-make "seagreen2"))
;;       background (color-make "seagreen3"))    
;;     ("WWW" lightgrey door-icon (pixmap-load "netscape-small.xpm"))
;;     ("Text" "LightYellow3")
;;     ("Games" grey)
;; ))
;; 
;; (load "std-virtual.gwm")


;;=============================================================================
;;                    cosmetic changes, can be overriden before load
;;=============================================================================

(if (not (boundp 'frame3d-win)) (load "frame-win"))
(set-window Gwm.menu.door-mgr frame3d-win)
(set-window Gwm.menu.virtual frame3d-win)

(defvar door-borderwidth 1)
(defvar door-mgr-no-outer-border t)
(defvar show-virtual t)
(defvar std-virtual.menupos 5)
(defvar std-virtual.windowmenupos 5)
(defvar std-virtual.iconmenupos 0)
(defvar lightgrey (color-make "LightGrey"))
(defvar door-background lightgrey)
(defvar virtual-background (color-make "grey90"))
(defvar initial-doors ())
(defvar std-virtual.doors '("Home" "Free"))
(defvar virtual-horizontal-step screen-width)
(defvar virtual-vertical-step screen-height)

(defvar door-mgr-xpos (- screen-width 250))
(defvar door-mgr-ypos (- screen-height 
    (+ 16 (* 16 (/ (+ 1 (length std-virtual.doors)) 2)))))

(defvar virtual-pixsize 181)
(defvar virtual-xpos door-mgr-xpos)
(defvar virtual-ypos (- door-mgr-ypos (+ virtual-pixsize 16)))

;;=============================================================================
;;                    behaviors
;;=============================================================================
;; a change: button 2 (action) on icon de-iconifies and follows the window

(: icon-behavior
  (state-make
    (on (buttonrelease action-button any)
      (with (deiconified-win window-window)
	(std-iconify-window)
	(setq window window-window)
	(virtual-make-window-visible)
))))

(reparse-standard-behaviors)

(de de-iconify-window-in-current-room ()
  (with (win window-window
      x 0 y 0
    )
    (std-iconify-window)
    (setq window win)
    (setq x (% window-x screen-width))
    (setq y (% window-y screen-height))
    (if (< x 0) (setq x (+ x screen-width)))
    (if (< y 0) (setq y (+ y screen-height)))
    (move-window x y)
))

;;=============================================================================
;;                    menu entries
;;=============================================================================

;; add entries in the root, window, icon menus
;; root: entry to toggle global map
;; window: nail/un-nail virtual window
;; icon: an entry to de-iconify in this room

(if (not (boundp 'std-virtual.menu-added)) (progn
    (setq std-virtual.menu-added t)
    
    (insert-at '(multi-item-make
	("Virtual Map On" (progn (setq show-virtual t) (virtual-show)))
	("Off" (progn (setq show-virtual ()) (virtual-show)))
      )
      root-pop-items
      std-virtual.menupos
    )
    (insert-at '(multi-item-make
	"Virtual" ()
	("Pick" (progn
	    (if (virtual-nailed) () (virtual-nail))
	    (if virtual-omit-nailed (virtual-update))
	))
	("Drop" (progn
	    (if (virtual-nailed) (virtual-unnail))
	    (if virtual-omit-nailed (virtual-update))
	))
      )
      window-pop-items
      std-virtual.windowmenupos
    )
    (insert-at '(item-make "de-icon here" (de-iconify-window-in-current-room))
      icon-pop-items
      std-virtual.iconmenupos
    )
))

;;=============================================================================
;;                    load the packages themselves
;;=============================================================================

(load "load-virtual.gwm")
(load "virtual-action.gwm")
(load "pick.gwm")

;;=============================================================================
;;                    door manager
;;=============================================================================

;; then create the defaults doors specified in std-virtual.doors

(for doorname std-virtual.doors
  (with (context '() name doorname)
    (if (= (type doorname) 'list) (progn
	(setq color (eval (# 1 doorname)))
	(setq name (# 0 doorname))
	(if color
	  (if (= (type color) 'number) 
	    ()				;already a color
	    (= (type color) 'pixmap)	;a tile
	    (setq context (+ (list
		  'tile color
		) context	 
	    ))
	    (setq color (color-make color)) ;default
	))
	(setq context (+ 
	    (if (= (type color) 'pixmap) () (list 'background color))
	    context)
	)
	(setq context (+ context (sublist 2 (length doorname) doorname)))
	(setq door-context (+ (list (atom name) context) door-context))
        (setq screen-opening (+ screen-opening (list 
              (list 'std-virtual.add-door name 
                    (list 'list ''door-set-background color))))))
      (setq screen-opening (+ screen-opening (list 
              (list 'add-door name)))))
))


(defun door-set-background (color)
  (with (wob root-window) 
    (if color 
      (if (= (type color) 'pixmap)
	(setq wob-tile color)
	(setq wob-background color))
)))

(defun std-virtual.add-door (name action)
  (with (position (add-door name))
    (virtual-action-add position action)
  )
)