temp.lisp 3.7 KB
Newer Older
David O'Toole's avatar
David O'Toole committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
(in-package :xelf)

(defparameter *default-icon-size* 64)

(defvar *icon-size* *default-icon-size*)

(defparameter *default-icon-color* "white")

(defparameter *icon-images*
  '(:empty "icon-empty.png"
    :caption "icon-caption.png"
    :document "icon-document.png"
    :folder "icon-folder.png"
    :grid "icon-grid.png"
    :open-folder "icon-open-folder.png"
    :project "icon-project.png"))

(defun icon-image (name)
  (getf *icon-images* name))

(defclass icon (node)
  ((image :initform (icon-image :empty) :initarg :image :accessor image)
   (color :initform *default-icon-color* :initarg :color :accessor color)
   (left-margin :initform 10 :initarg :left-margin :accessor left-margin)
   (right-margin :initform 10 :initarg :right-margin :accessor right-margin)
   (caption :initform "New Icon" :initarg :caption :accessor caption)
   (action :initform nil :initarg :action :accessor action)))

(defmethod initialize-instance :after ((icon icon) &key)
  (resize icon *icon-size* *icon-size*))

(defmethod draw ((icon icon))
  (with-slots (x y width height caption color left-margin right-margin image) icon
    (set-vertex-color color)
    (draw-image image x y :width width :height height)
    (set-vertex-color "white")
    (draw-string caption (+ x left-margin) (- (+ y height) 25) :color "black" :font "sans-10")))

(defparameter *default-desktop-background-color* "gray40")

(defclass desktop (buffer)
  ((background-color :initform *default-desktop-background-color*)
   (top-margin :initform 18 :initagr :top-margin :accessor top-margin)
   (icon-spacing :initform 10 :initarg :icon-spacing :accessor icon-spacing)
   (icon-size :initform *default-icon-size* :initarg :icon-size :accessor icon-size)
   (snap-to-grid-p :initform t :initarg :snap-to-grid-p :accessor snap-to-grid-p)))

(defmethod icon-stride ((desktop desktop))
  (+ (icon-size desktop)
     (icon-spacing desktop)))

(defmethod initialize-instance :after ((desktop desktop) &key)
  (open-shell desktop))

(defmethod grid-position ((desktop desktop) x y)
  (let ((stride (icon-stride desktop))
	(spacing (icon-spacing desktop))
	(top-margin (top-margin desktop)))
    (values (+ spacing (* x stride))
	    (+ top-margin spacing (* y stride)))))

(defmethod place-icon ((desktop desktop) (icon icon) x y)
  (multiple-value-bind (ix iy) (grid-position desktop x y)
    (move-to icon ix iy)))

(defmethod auto-resize ((icon icon) (desktop desktop))
  (let ((size (icon-size desktop)))
    (resize icon size size)))

(defmethod last-column ((desktop desktop))
  (1- (truncate (/ *screen-width* (icon-stride desktop)))))

73 74 75
(defmethod last-row ((desktop desktop))
  (- (truncate (/ *screen-height* (icon-stride desktop))) 2))

David O'Toole's avatar
David O'Toole committed
76
(defmethod snap-to-grid ((icon icon) (desktop desktop))
77 78 79 80
  (with-slots (x y) icon
    (place-icon desktop icon
		(truncate (/ x (icon-stride desktop)))
		(truncate (/ y (icon-stride desktop))))))
David O'Toole's avatar
David O'Toole committed
81 82 83 84

(defmethod arrange ((desktop desktop))
  (dolist (icon (find-instances desktop 'icon))
    (snap-to-grid icon desktop)
85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
    (auto-resize icon desktop)))

(defmethod auto-arrange-column ((desktop desktop) icons column)
  (let ((row 0))
    (dolist (icon icons)
      (multiple-value-bind (x y) (grid-position desktop column row)
	(place-icon desktop icon x y)
	(incf row)))))

(defmethod auto-arrange ((desktop desktop))
  (let* ((icons-per-column (1+ (last-row desktop)))
	 (last-column (last-column desktop))
	 (column last-column)
	 (icons (find-instances desktop 'icon)))
    (loop while (and icons
		     (not (minusp column)))
	 do (if (> (length icons) icons-per-column)
		(progn
		  (auto-arrange-column desktop (subseq icons 0 (1- icons-per-column)) column)
		  (setf icons (subseq icons icons-per-column)))
		(auto-arrange-column desktop icons column))
	 do (decf column))))
	 
David O'Toole's avatar
David O'Toole committed
108 109