;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT -*-
;;;_____________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Dispel Examples
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Juergen Herczeg
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/examples/dispel-examples.lisp
;;; File Creation Date: 6/23/89 10:31:37
;;; Last Modification Time: 07/31/92 14:02:34
;;; Last Modification By: Matthias Ressel
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;;_____________________________________________________________________________

(in-package :xit)

;_______________________________________________________________________________

(proclaim '(special dispel-window
	            icon-menu
		    text-dispel-1 text-dispel-2 text-dispel-3 text-dispel-4
	            multi-line-text-dispel-1
		    bitmap-dispel-1 bitmap-dispel-2
		    *display*))


(setq dispel-window
      (make-window 'intel-example-window
		   :name :dispel-examples
		   :x 200 :y 100 :width 726 :height 550
		   :window-icon `(intel-example-icon :parent ,icon-menu
						     :text "Dispels")
		   :title "Dispels"))

(setq text-dispel-1 (make-window 'text-dispel :parent dispel-window
				 :x 20 :y 40
				 :text "border"
				 :mouse-feedback :border
				 :mouse-documentation
				 "Text dispel with mouse-feedback = border"
				 :compute-mouse-documentation? :never))

(setq text-dispel-2 (make-window 'text-dispel :parent dispel-window
				 :x 150 :y 40
				 :text "inverse"
				 :mouse-feedback :inverse
				 :mouse-documentation
				 "Text dispel with mouse-feedback = inverse"
				 :compute-mouse-documentation? :never))

(setq text-dispel-3 (make-window 'text-dispel :parent dispel-window
				 :x 20 :y 80 :width 150 :height 40
				 :border-width 1
				 :adjust-size? nil
				 :cursor "bottom_side"
				 :font '(:face :italic)
				 :text "fixed width"
				 :edit? t
				 :mouse-documentation
				 "Editable text dispel with fixed width"
				 :compute-mouse-documentation? :never))

(setq text-dispel-4 (make-window 'text-dispel :parent dispel-window
				 :x 200 :y 80
				 :border-width 1
				 :inside-border 12
				 :cursor "bottom_side"
				 :font '(:face :italic)
				 :text "variable width"
				 :edit? t
				 :mouse-documentation
				 "Editable text dispel with variable width"
				 :compute-mouse-documentation? :never))

(let ((*font-defaults* '(:family :lucida
			 :face :normal
			 :size 12)))
  (setq multi-line-text-dispel-1 (make-window 'multi-line-text-dispel
					    :parent dispel-window
					    :x 400 :y 250
			                    :border-width 1
					    :inside-border 4
					    :adjust-size? t
					    :text ""))

(let ((font-map '((:small "a small font" (:face :normal :size :very-small))
		  (:medium "a medium sized font" :default)
		  (:large "a large font" (:face :normal :size :large)))))
  (with-output-to-text-dispel (stream multi-line-text-dispel-1 :mode :clear)
     (format stream "This is text written in the standard font~%")
     ;; changing fonts...
     (dotimes (i 3)
       (dolist (font-entry font-map)
	 (with-font ((third font-entry) multi-line-text-dispel-1 stream)
	   (format stream "~A " (second font-entry))))
       (terpri stream))
     ;; nesting fonts...
     (with-font ((third (first font-map)) multi-line-text-dispel-1 stream)
       (dotimes (i 3)
	 (format stream "~A ~%" (second (first font-map))))
       (with-font ((third (second font-map)) multi-line-text-dispel-1 stream)
	 (dotimes (i 3)
	   (format stream "~A ~%" (second (second font-map)))))
       (dotimes (i 3)
	 (format stream "~A ~%" (second (first font-map)))))))
  )

(let ((*font-defaults* '(:family :lucida
			 :face :normal
			 :size 12)))
  (setq multi-line-text-dispel-2 (make-window 'multi-line-text-dispel
					    :parent dispel-window
					    :x 10 :y 250
					    :width 380
					    :height 290
			                    :border-width 1
					    :inside-border 5
					    :adjust-size? nil		 
					    :text ""
					    :separators `(#\Space #\- #\_)
					    :edit? t))

  (with-output-to-text-dispel (stream multi-line-text-dispel-2)
  (with-font ('(:face :bold) multi-line-text-dispel-2 stream)
    (with-color ("blue" multi-line-text-dispel-2 stream)
      (write-string "Mehrzeilige Text-Dispels: " stream)))
  (write-string "Text-Dispels repraesentieren und visualisieren Texte. Der "
		stream)
  (with-font ('(:face :bold) multi-line-text-dispel-2 stream)
    (write-string "X" stream))
  (with-font ('(:face :bold :size :small) multi-line-text-dispel-2 stream)
    (write-string "IT" stream))
  (write-string " Basis-Baukasten stellt eine Klasse fuer "
		stream)
  (with-font ('(:face :italic) multi-line-text-dispel-2 stream)
    (write-string "einzeilige" stream))
  (write-string " Textelemente zur Verfuegung. Diese Texte werden in einer  
bestimmten Schriftart visualisiert 
und sind auf der Benutzerschnittstelle editierbar. Die Groesse eines 
Text-Dispels kann wahlweise fixiert sein oder sich an die Ausdehnung 
des aktuellen Textes dynamisch anpassen. Bei fixierter Groesse kann 
der Text im Dispel an verschiedene Stellen positioniert werden (z.B. 
zentriert, links- oder rechtsbuendig). 

Mehrzeilige Text-Dispel werden durch die Definition einer Subklasse 
"
		stream)
  (with-font ('(:family :lucidatypewriter :face :normal :size 12)
	      multi-line-text-dispel-2 stream)
    (write-string "multiline-text-dispel" stream))
  (write-string " eingefuehrt. Objekte dieser Klasse beinhalten "
		stream)
  (with-font ('(:face :italic) multi-line-text-dispel-2 stream)
    (write-string "formatierte" stream))
  (write-string " Texte, die sich ueber mehrere Zeilen erstrecken koennen. 
Diese Texte bestehen aus Zeichenketten, in die Formatierbefehle eingebettet sein koennen. Im Moment werden diese Befehle dazu verwendet, die "
		stream)
  (with-font ('(:face :bold) multi-line-text-dispel-2 stream)
    (write-string "Schriftart" stream)
    (with-color ("orange" multi-line-text-dispel-2 stream)
      (write-string " und" stream))
    (with-color ("blue" multi-line-text-dispel-2 stream)
      (write-string " die" stream)))
  (with-font ('(:face :italic) multi-line-text-dispel-2 stream)
    (with-color ("red" multi-line-text-dispel-2 stream)
      (write-string " Farbe" stream))
    (write-string " innerhalb" stream))
  (with-font ('(:face :normal) multi-line-text-dispel-2 stream)
    (write-string " des " stream))
  (with-font ('(:face :bolditalic) multi-line-text-dispel-2 stream)
    (write-string "Textes" stream))
  (with-font ('(:face :normal :size :small) multi-line-text-dispel-2 stream)
    (write-string " umzuschalten" stream))
  (with-font ('(:face :normal) multi-line-text-dispel-2 stream)
    (write-string "." stream))))

(do-adjust-window-size multi-line-text-dispel-2)



(setq bitmap-dispel-1 (make-window 'bitmap-dispel :parent dispel-window
				   :x 20 :y 150
				   :inside-border 5
				   :bitmap "camera"
				   :mouse-feedback :border
				   :mouse-documentation
				   "Bitmap dispel with mouse-feedback = border"
				   :compute-mouse-documentation? :never))

(setq bitmap-dispel-2 (make-window 'bitmap-dispel :parent dispel-window
				   :x 100 :y 150
				   :bitmap "nomail"
				   :mouse-feedback :inverse
				   :mouse-documentation
				   "Bitmap dispel with mouse-feedback = inverse"
				   :compute-mouse-documentation? :never))

(update-state *display*)
(process-all-events *display*)

(shrink dispel-window)

(update-state *display*)
(process-all-events *display*)
