181 lines
5.6 KiB
Plaintext
181 lines
5.6 KiB
Plaintext
; 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)
|
|
)
|
|
)
|