;============================================================================
;----------------------------------------------------------------------------
;
; fichier ***test1.ll***
; 12.01.88 Ilog/ing bounthara
; test du fenetrage virtuel, chapitre 18
;
;============================================================================
;
; Test du bitmap virtuel
; Le-Lisp v15.2 du 1er Aout 1987
; Test du chapitre 18
;
; les fenetres et l'environnement graphique minimum
; fonctions testees:
; . create-window
; . make-window
; . #:window:left, #:window:top,....
; . current-window
; . modify-window
; . kill-window
; . windowp
; . pop-window
; . move-window-behind
; . find-window
; . map-window
;
; . clear-graph-env
; . draw-cursor
; . draw-cn
; . draw-string
; . draw-substring
; . width-substring
; . height-substring
; . x-base-space
; . y-base-space
;============================================================================
; dernier numero test : #116#
;----------------------------------------------------------------------------
(bitprologue)
;----------------------------------------------------------------------------
; ---- loader les fichiers communs
(unless (featurep 'testcomm)
(libload testcomm))
(unless (featurep 'testbvcomm)
(libload testbvcomm))
;============================================================================
;----------------------------------------------------------------------------
; ---- on teste les fonctions decrites dans le chaitre suivant
(tycls)
(tyflush)
(titre "Creation des fenetres")
(print "Tests des fontions du chapitre 18:")
(print """Le Fenetrage Virtuel""")
(print "Les tests portent sur l'utilisation de ces fonctions dans un")
(print "contexte de fenetrage sans sous-fenetre.")
(print "Les tests utilisent les 3/4 haut-gauche de l'ecran.")
(print
"----------------------------------------------------------------------------")
(terpri)
;============================================================================
(sous-titre "#101# Creation d'UNE fenetre avec create-window")
(verif "Fene↑tre w1 en 1/4,1/4 de 1/3x1/3, hilited, visible"
'(setq w1 (create-window 'window quartx quarty tierx tiery "w1" 1 1)))
(print "Je teste les fonctions d'acces aux champs des fenetres")
(print "#:window:left, #:window:top,...")
(testsuite)
(#:window:left w1) #.quartx
(#:window:top w1) #.quarty
(#:window:title w1) "w1"
(#:window:width w1) #.tierx
(#:window:height w1) #.tiery
(#:window:hilited w1) 1
(#:window:visible w1) 1
(exit eof) ()
; ATTENTION: nous faisons appel souvent a ces fonctions d'acces aux champs
;------------------------
; ---- Test avec SEULEMENT UNE fenetre
(sous-titre "#102# Fenetre totalement visible")
;------------------------
(sous-titre "#103# Test des fonctions sur les fenetres")
(test-window w1)
;------------------------
; ---- nous testons les deplacements
(sous-titre "#104# Deplacements")
(test-move w1)
;------------------------
(sous-titre "#105# L'environnement graphique minimum")
; --- les fonctions d'ecriture des chaines de caractere
(test-env-graph-min w1)
(sous-titre "#106# Petit test sur le clip")
(test-clip-window w1)
;------------------------
; ---- les memes tests mais avec une fenetre non entierement visible
(sous-titre "#107# Fenetre partiellement visible sur l'ecran")
; ---- tuer la fenetre w1 et la rescuciter en un point hors de l'ecran!
(verif "La fenetre w1 est tuee"
'(kill-window w1))
(testsuite)
(windowp w1) ()
(exit eof) ()
; ---- pour la remttre ailleurs
(verif "w1 est rescucite (make-window); sa moitie droite visible sur l'ecran"
'(progn
(#:window:left w1 (- (div (#:window:width w1) 2)))
(make-window w1)))
(testsuite)
(not (windowp w1)) ()
(exit eof) ()
(small-test-env-graph-min w1)
;----------------------------------------------------------------------------
; ----- maintenant avec 2 fenetres
; tester les combinaisons suivantes pour la superposition des fenetres
; . disjointes
; . inclusion
; . intersection
(titre "#108# Maintenant, avec DEUX fenetres")
;------------------------
(sous-titre "#108# Creation d'une deuxieme fenetre")
(verif "creation de w2 avec make-window en 1/4,1/4 de 1/4x1/4, non-hilited"
'(progn
(setq w2 (#:window:make))
(#:window:left w2 quartx)
(#:window:top w2 quarty)
(#:window:width w2 quartx)
(#:window:height w2 quarty)
(#:window:title w2 "w2")
(#:window:hilited w2 0)
(#:window:visible w2 1)
(make-window w2)))
;------------------------
(sous-titre "#109# Les chaines de caracteres dans w2")
(affich "w2 devient la fenetre courante"
'(current-window w2))
(small-test-env-graph-min w2)
;------------------------
(sous-titre "#110# Les superpositions")
; ---- les 2 fenetres ont disjointes
(sous-titre "#111# Les 2 fenetres sont disjointes")
(verif "Je remplis w1 de 1 et w2 de 2"
'(progn
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
; ---- les 2 fenetres se chevauchent
(sous-titre "#112# Les 2 fenetres se chevauchent partiellement")
(verif "w1 en 1/8,1/8"
'(modify-window w1 (div quartx 2) (div quarty 2)
() () () () ()))
; ---- est aussi utilise pour le cas : superposition totale
(verif "w2 au dessus de w1 (pop-window)"
'(progn
(pop-window w2)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(verif "clear w1"
'(progn (current-window w1)
(clear-graph-env)))
(verif "w1 au dessus de w2 (move-behind-window)"
'(progn
(move-behind-window w2 w1)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(small-test-env-graph-min w2)
(verif "La fenetre w1 devient invisible"
'(progn
(modify-window w1 () () () () () () 0)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(verif "w2 au dessus de w1 (move-behind-window)"
'(move-behind-window w1 w2))
(verif "La fenetre w1 redevient visible"
'(modify-window w1 () () () () () () 1))
; ---- l'une des fenetres est contenu dans l'autre
(sous-titre "#113# Superposition totale")
(verif "w2 en left(w1)+20,top(w1)+20"
'(modify-window w2
(add (#:window:left w1) 20)
(add (#:window:top w1) 20)
() () () () ()))
; ---- meme que superposition partielle
(verif "w2 au dessus de w1 (pop-window)"
'(progn
(pop-window w2)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(verif "clear w1"
'(progn (current-window w1)
(clear-graph-env)))
(verif "w1 au dessus de w2 (move-behind-window)"
'(progn
(move-behind-window w2 w1)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(verif "clear w2"
'(progn (current-window w2)
(clear-graph-env)))
(verif "La fenetre w1 devient invisible"
'(modify-window w1 () () () () () () 0))
(verif "Je remplis w1 de 1 et w2 de 2"
'(progn
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(verif "w2 au dessus de w1 (move-behind-window)"
'(progn
(move-behind-window w1 w2)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(verif "La fenetre w1 redevient visible"
'(modify-window w1 () () () () () () 1))
;------------------------
(sous-titre "#114# Les fonctions current-window, find-window et map-window")
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)
; ---- current-window
(affich "La fonction current-window "
'(current-window))
(verif "call (current-window ()) qui doit inhiber les operations d'affichage"
'(current-window ()))
(verif "J`appelle (draw-string 0 0 ""ESSAI D'AFFICHAGE"")"
'(catcherror t (my-draw-string 0 0 "ESSAI D'AFFICHAGE")))
; ---- find-window
; ---- dans aucune fenetre Lisp
(print "Coin sup gauche de w1 = "
(list (#:window:left w1) (#:window:top w1)))
(print"Coin sup gauche de w2 = "
(list (#:window:left w2) (#:window:top w2)))
(print "Les coord glob du point left(w1)-50,top(w1)-50 (en dehors de w1) = "
(progn
(setq left-50 (sub (#:window:left w1) 50)
top-50 (sub (#:window:top w1) 50))
(list left-50 top-50)))
(affich "Appartenance du point left(w1)-50,top(w1)-50 (doit etre ())"
'(setq w (find-window left-50 top-50)))
; ---- dans une fenetre Lisp
(print "Les coord glob du centre(w1) = "
(progn
(setq midx-w1 (add (#:window:left w1) (div (#:window:width w1) 2))
midy-w1 (add (#:window:top w1) (div (#:window:height w1) 2)))
(list midx-w1 midy-w1)))
(affich "Je teste l'appartenance du centre de w1"
'(and (setq w (find-window midx-w1 midy-w1))
(win-title w)))
(print "Test des coordonnees locales")
(testsuite)
(progn
(map-window w midx-w1 midy-w1 'lx 'ly)
(list lx ly) ) #.(list (sub midx-w1 (#:window:left w))
(sub midy-w1 (#:window:top w)))
(exit eof) ()
; ---- changement de fenetre
(verif "w2 au dessus de w1 (pop-window)"
'(progn
(pop-window w2)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(affich "Je teste l'appartenance du centre de w1 (doit etre w2)"
'(and (setq w (find-window midx-w1 midy-w1))
(win-title w)))
(print "Test des coordonnees locales")
(testsuite)
(progn
(map-window w midx-w1 midy-w1 'lx 'ly)
(list lx ly) ) #.(list (sub midx-w1 (#:window:left w))
(sub midy-w1 (#:window:top w)))
(exit eof) ()
; ---- changement de fenetre
(verif "w2 est invisible"
'(progn
(modify-window w2 () () () () () () 0)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
(affich "Je teste l'appartenance du centre de w1 (doit etre w1)"
'(and (setq w (find-window midx-w1 midy-w1))
(win-title w)))
(print "Test des coordonnees locales")
(testsuite)
(progn
(map-window w midx-w1 midy-w1 'lx 'ly)
(list lx ly) ) #.(list (sub midx-w1 (#:window:left w))
(sub midy-w1 (#:window:top w)))
(exit eof) ()
(verif "w2 redevient visible"
'(progn
(modify-window w2 () () () () () () 1)
(fill-window-with-char w1 #/1)
(fill-window-with-char w2 #/2)))
;------------------------
(sous-titre "#115# La fonction move-behind-window")
(verif "Je cree une 3eme fenetre en -1/3,1/4 de 2x1/4, hilited"
'(setq w3 (create-window 'window (- tierx) quarty
(mul tierx 6) quarty "w3" 1 1)))
(verif "w3 devant w1"
'(move-behind-window w1 w3))
(verif "w2 devant w3"
'(move-behind-window w3 w2))
(verif "w1 devant w2 (ordre w1 w2 w3, w2 non visible)"
'(move-behind-window w2 w1))
(verif "w2 devant w3 (w2 non visible)"
'(move-behind-window w3 w2))
;----------------------------------------------------------------------------
; ---- destruction des fenetres
(titre "#116# Destruction des fenetres")
(verif "La fenetre w1 est tuee (w2 doit etre au dessus de w3)"
'(kill-window w1))
(verif "La fenetre w2 est tuee"
'(kill-window w2))
(verif "La fenetre w3 est tuee"
'(kill-window w3))
;----------------------------------------------------------------------------
; ---- fin du test(ouffff...)
(titre "Fin du test du chapitre 18 / fenetres")
;----------------------------------------------------------------------------
(terpri)
(terpri)
(terpri)
(bitepilogue)
(setq automatic ())
;----------------------------------------------------------------------------
;============================================================================