; dwtest.lsp             Gordon S. Novak Jr.                 20 Oct 94

; Some examples for testing the window interface in dwindow.lsp / dwtrans.lsp

; Copyright (c) 1994 Gordon S. Novak Jr. and The University of Texas at Austin.

; See the file gnu.license .

; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 1, or (at your option)
; any later version.

; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.

; You should have received a copy of the GNU General Public License
; along with this program; if not, write to the Free Software
; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

; Written by: Gordon S. Novak Jr., Department of Computer Sciences,
; University of Texas at Austin  78712.    novak@cs.utexas.edu


(defvar myw)  ; my window

; Make a window to play in.
(defun wtesta ()
  (setq myw (window-create 300 300 "test window")) )

; 15 Aug 91; 12 Sep 91; 05 Oct 94; 06 Oct 94
; Draw some basic things in the window
(defun wtestb ()
  (window-clear myw)
  (window-draw-box-xy myw 50 50 50 20 1)
  (window-printat myw "howdy" '(58 55))
  (window-draw-line myw '(100 70) '(200 170))
  (window-draw-arrow-xy myw 200 170 165 205)
  (window-draw-circle-xy myw 200 170 50 2)
  (window-draw-ellipse-xy myw 100 170 40 20 1)
  (window-printat-xy myw "ellipse" 70 165)
  (window-draw-arc-xy myw 100 250 20 20 0 90 1)
  (window-draw-arc-xy myw 100 250 20 20 0 -90 1)
  (window-printat-xy myw "arcs" 80 244)
  (window-printat-xy myw "invert" 54 200)
  (window-invert-area-xy myw 50 160 60 60)
  (window-copy-area-xy myw 40 150 200 50 60 40)
  (window-printat-xy myw "copy" 210 100)
  (window-set-color-rgb myw 65535 0 0)       ; red foreground
  (window-printat-xy myw "Red" 20 20)
  (window-draw-rcbox-xy myw 15 15 32 20 5)
  (window-set-color-rgb myw 0 0 65535 t)     ; blue background
  (window-set-color-rgb myw 0 65535 0)       ; green foreground
  (window-printat-xy myw "Green" 120 20)
  (window-set-color-rgb myw 0 65535 0 t)     ; green background
  (window-set-color-rgb myw 0 0 65535)       ; blue foreground
  (window-printat-xy myw "Blue" 220 20)
  (window-reset-color myw)
  (window-force-output myw) )

; 15 Aug 91; 19 Aug 91; 03 Sep 91
; Illustrate mouse interaction:
; click in window myw (2 times for line, 3 times for region).
(defun wtestc ()
  (prog (command mymenu result start)
    (setq mymenu (menu-create '(quit point line box region) "Choose One:"))
 lp (setq command (menu-select mymenu))
    (setq result (case command
		   (quit   (menu-destroy mymenu)
			   (return))
		   (point  (window-get-point myw))
		   (line   (setq start (window-get-point myw))
			   (list start
				 (window-get-line-position myw (car start)
							       (cadr start))))
		   (box    (window-get-box-position myw 40 20))
		   (region (window-get-region myw)) ))
    (format t "Result: ~A~%" result)
    (go lp) )) 

; 09 Sep 91
; Illustrate icons in menus
(defun wtestd ()
  (menu '(("Triangle" . triangle)
	  (dwtest-square . square)
	  (dwtest-circle . circle)
	  hexagon)
	"Icons in Menu") )

(defun dwtest-square (w x y)  (window-draw-box-xy w x y 20 20 1))
(setf (get 'dwtest-square 'display-size) '(20 20))

(defun dwtest-circle (w x y)  (window-draw-circle-xy w (+ x 10) (+ y 10) 10 1))
(setf (get 'dwtest-circle 'display-size) '(20 20))

(defvar mypms nil)
; 09 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91
; Illustrate a diagrammatic menu-like object: square with sensitive spots
(defun wteste ()
  (let (pm val)
    (or mypms (mypms-init))
    (setq pm (picmenu-create-from-spec mypms "Points on Square"))
    (setq val (picmenu-select pm))
    (picmenu-destroy pm)
    val ))

; 14 Sep 91
(defun mypms-init ()
  (setq mypms (picmenu-create-spec
	       '((bottom-left   ( 20  20))
		 (center-left   ( 20  70))
		 (top-left      ( 20 120))
		 (bottom-center ( 70  20))
		 (center        ( 70  70) (20 20))  ; larger
		 (top-center    ( 70 120))
		 (bottom-right  (120  20))
		 (center-right  (120  70))
		 (top-right     (120 120)))
	       140 140 'wteste-draw-square t)) )

(defvar mypm nil)
; 10 Sep 91; 11 Sep 91; 12 Sep 91; 14 Sep 91; 17 Sep 91
; A picmenu that is "flat" within another window, in this case myw.
; Must do (wtesta) first.
(defun wtestf ()
  (or mypms (mypms-init))
  (or mypm (setq mypm (picmenu-create-from-spec mypms "Points on Square"
						myw 50 50 nil t t)))
  (picmenu-select mypm))

(defun wteste-draw-square (w x y)
  (window-draw-box-xy w (+ x 20) (+ y 20) 100 100 1))

(defvar mym nil)
; 10 Sep 91; 17 Sep 91
; A menu that is "flat" within another window, in this case myw.
; Must do (wtesta) first.
(defun wtestg ()
  (or mym (setq mym (menu-create '(red white blue) "Flag" myw 50 50 nil t)))
  (menu-select mym))

; 09 Oct 91
; Demonstrate arrows.  Optional arg is line width.
(defun wtesth ( &optional (lw 1))
  (window-clear myw)
  (dotimes (i 5) (window-draw-arrow-xy myw 100 100 (+ 40 (* i 30)) 160 lw))
  (dotimes (i 5) (window-draw-arrow-xy myw 100 100 (+ 40 (* i 30)) 40 lw))
  (dotimes (i 5) (window-draw-arrow-xy myw 100 100 40 (+ 40 (* i 30)) lw))
  (dotimes (i 5) (window-draw-arrow-xy myw 100 100 160 (+ 40 (* i 30)) lw))
  (dotimes (i 5) (window-draw-arrow-xy myw 200 (+ 40 (* i 30))
				           240 (+ 40 (* i 30))
					   (1+ i) ))
  (window-force-output myw) )

; 04 Jan 94
; Redo some of the arrows from wtesth in color
(defun wtesti ()
  (window-set-color-rgb myw 65535 0 0)
  (window-draw-arrow-xy myw 200 70 240 70 2)
  (window-set-color-rgb myw 0 65535 0)
  (window-draw-arrow-xy myw 200 100 240 100 3)
  (window-set-color-rgb myw 0 0 65535)
  (window-draw-arrow-xy myw 200 130 240 130 4)
  (window-reset-color myw)
  (window-force-output myw) )

; 04 Jan 94
; Get text from a window.  Move mouse pointer into test window.
; Add characters and/or backspace, Return.
; Note: it might be necessary to change the keyboard mapping, using
; (window-init-keyboard-mapping myw) and (window-print-keyboard-mapping)
(defun wtestj () (window-input-string myw "Foo" 50 200 200))

; 04 Jan 94
; Change foreground and background colors and input a string
(defun wtestk ()
  (window-set-color-rgb myw 0 65535 0)    ; green foreground
  (window-set-color-rgb myw 0 0 65535 t)  ; blue background
  (prog1 (window-input-string myw "Foo" 50 200 200)
    (window-reset-color myw)
    (window-force-output myw) ) )
