;============================================================================
;----------------------------------------------------------------------------
;
; fichier ***test1.ll***
; 19.01.88 Ilog/ing bounthara
; test des primitives graphiques, chapitre 20
;
; fichier issu dufichier: ***testgraph.ll*** ILOG
; Les principales modifications concernent l'utilisation de fenetres et
; sous-fenetres
;============================================================================
#|
Test du bitmap virtuel
Le-Lisp v15.2 du 1er Aout 1987
Test du chapitre 20
|#
; Les primitives graphiques
; fonctions testees
; . current-font
; . font-max
; . load-font
; . current-line-style
; . line-style-max
; . current-pattern
; . pattern-max
; . current-mode
; . current-clip
; . #:clip:x, #:clip:y, #:clip:w, #:clip:h
;
; . draw-polyline
; . draw-polymarker
; . fill-area
; . draw-substring
; . draw-ellipse
; . clear-graph-env
;
; . draw-point
; . draw-line
; . draw-rectangle
; . draw-circle
;
; . fill-rectangle
; . fill-circle
;============================================================================
; dernier numero test : #415#
;----------------------------------------------------------------------------
(bitprologue)
;----------------------------------------------------------------------------
; ---- loader les fichiers communs
(unless (featurep 'format)
(libload format))
(unless (featurep 'testcomm)
(libload testcomm))
(unless (featurep 'testbvcomm)
(libload testbvcomm))
;============================================================================
;----------------------------------------------------------------------------
; ---- on teste les fonctions decrites dans le chaitre suivant
(tycls)
(tyflush)
(terpri)
(print " Test interactif des primitives graphiques")
(terpri)
(terpri)
(print " 20. Les primitives graphiques")
(print
"----------------------------------------------------------------------------")
(terpri)
;============================================================================
(sous-titre "#401# Initialisation")
(verif "Fene↑tre w1"
'(setq w1 (create-window 'window 10 (div quarty 2)
demix demiy "w1" 0 1)))
(current-window w1)
; ----
(affich "(current-pattern) = 0 ?"
'(current-pattern))
(affich "(current-line-style) = 0 ?"
'(current-line-style))
(affich "(current-font) = 0 ?"
'(current-font))
; ----
(current-clip)
(affich "#:clip:x ?"
'#:clip:x)
(affich "#:clip:y ?"
'#:clip:y)
(affich "#:clip:w ?"
'#:clip:w)
(affich "#:clip:h ?"
'#:clip:h)
;----------------------------------------------------------------------------
(titre "#402# 20.1.1 Structure des environnements graphiques")
; ----
(affich "Nombre de polices disponibles initialement"
'(add1 (font-max)))
(clear-graph-env)
(verif "affichage des differentes polices"
'(let ((j 0))
(for (i 0 1 (font-max))
(current-font i)
(draw-string 0 (add (add j (height-space)) (x-base-space))
"ABCDEFabcdef GHIJKLghijkl 0123 !@#()*")
(draw-cursor 0 (add (add j (height-space)) (x-base-space)) t)
(incr j (height-space)))))
; ----
(affich "Nombre de styles de lignes disponibles initialement"
(add1 (line-style-max)))
(clear-graph-env)
(verif "Affichage des differents styles de ligne"
'(for (i 0 1 (line-style-max))
(current-line-style i)
(draw-line 0 0 (add 10 (mul i 10)) 200)))
; ----
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
(clear-graph-env)
(verif "Les 2 lignes vont delimiter la zone d'ecriture des caracteres"
'(progn
(draw-line 0 9 (#:window:width w1) 9)
(draw-line 0 (add1 (add 9 (height-space)))
(#:window:width w1) (add1 (add 9 (height-space))))))
(verif "La chaine ""ayt|jlp↑*@{],"" en 10,10"
'(my-draw-string 10 10 "ayt|jlp↑*@{],"))
; ----
(affich "Nombre motifs de remplissage disponibles initialement"
(add1 (pattern-max)))
(clear-graph-env)
(verif "Affichage des differents pattern"
'(for (i 0 1 (pattern-max))
(current-pattern i)
(fill-rectangle (mul i 10) (mul i 10) 100 100)))
; ----
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
;------------------------
(sous-titre "#403# Test des modes avec fill-rectangle")
(clear-graph-env)
(for (i 0 1 15)
(verif (catenate " mode avec fill-rectangle = " (format () "~2,4,'0R" i))
'(progn (clear-graph-env)
(current-mode 3)
(draw-rectangle -1 39 161 41)
(current-pattern 1)
(fill-rectangle 40 40 40 40)
(fill-rectangle 120 40 40 40)
(current-mode i)
(current-pattern 0)
(fill-rectangle 0 40 80 40)
(current-pattern 1)
(fill-rectangle 80 40 80 40)
(current-mode 3))))
;------------------------
(sous-titre "#405# Test des modes avec fill-area")
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
(clear-graph-env)
(print "Le test avec fill-area est effectue' avec 2 trape`zes:")
(print "ces 2 trape`zes (correspondant au pattern 0 et 1) sont dessine's avec")
(print "les 16 modes de combinaison sur les rectangles de pattern 0 et 1.")
(for (i 0 1 15)
(verif (catenate " mode avec fill-area = " (format () "~2,4,'0R" i))
'(progn (clear-graph-env)
(current-mode 3)
(draw-rectangle -1 39 161 41)
(current-pattern 1)
(fill-rectangle 40 40 40 40)
(fill-rectangle 120 40 40 40)
(current-mode i)
(current-pattern 0)
(fill-area 4 #[0 80 80 0] #[40 40 80 60])
(current-pattern 1)
(fill-area 4 #[80 160 160 80] #[40 40 80 60])
(current-mode 3))))
;------------------------
(sous-titre "#406# Test de la zone de de'coupe")
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
(clear-graph-env)
(verif
"Deux diagonales orthogonales dans un cadre (current-clip 100 100 100 100)"
'(progn (draw-rectangle 100 100 100 100)
(current-clip 100 100 100 100)
(draw-line 0 0 300 300)
(draw-line 0 300 300 0)))
(print "Je teste si les valeurs de #:clip:x,y,w,h sont correctes.")
(testsuite)
(progn (current-clip) t) t
#:clip:x 100
#:clip:y 100
#:clip:w 100
#:clip:h 100
(exit eof) ()
(de centre-char (x y cn)
(draw-cn (add x (sub (x-base-space) (quo (width-space) 2)))
(add y (sub (y-base-space) (quo (height-space) 2)))
cn))
(verif "Deux diagonales orthogonales et 9 caracteres coupes dans le cadre"
'(progn (centre-char 100 100 #/A)
(centre-char 150 100 #/B)
(centre-char 200 100 #/C)
(centre-char 100 150 #/D)
(centre-char 150 150 #/E)
(centre-char 200 150 #/F)
(centre-char 100 200 #/G)
(centre-char 150 200 #/H)
(centre-char 200 200 #/K)))
;------------------------
(sous-titre "#407# 20.2 Test des primitives graphiques")
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
(current-clip 0 0
(#:window:width (current-window))
(#:window:height (current-window)))
(clear-graph-env)
(verif "Dessin d'un triangle de sommet (10,10) (100,100) (200,10)"
'(draw-polyline 4 #[10 100 200 10] #[10 100 10 10]))
(clear-graph-env)
(verif "Dessin des sommets du triangle"
'(draw-polymarker 4 #[10 100 200 10] #[10 100 10 10]))
(clear-graph-env)
(verif "Remplissage du triangle avec le motif courant"
'(fill-area 3 #[10 100 200] #[10 100 10]))
(clear-graph-env)
(verif "Remplissage du triangle avec le plus grand motif"
'(with ((current-pattern (pattern-max)))
(fill-area 3 #[10 100 200] #[10 100 10])))
(clear-graph-env)
(verif "Dessin d'une ellipse de centre (120,120) et de rayons 50 et 70"
'(draw-ellipse 120 120 50 70))
;------------------------
(sous-titre "#408# 20.3.1 Test des fonctions etendues: trace de lignes")
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
(clear-graph-env)
(verif "Une ligne de (0,0) a (50,100) en utilisant draw-point"
'(for (i 0 1 50)
(draw-point i (* 2 i))))
(clear-graph-env)
(verif "Une ligne de (0,0) a (50,100) dans style de ligne courant"
'(draw-line 0 0 50 100))
(clear-graph-env)
(verif "Une ligne de (0,0) a (50,100) dans plus grand style de ligne"
'(with ((current-line-style (line-style-max)))
(draw-line 0 0 50 100)))
(clear-graph-env)
(verif
"Un rectangle en (0,0) de width(w1)xheight(w1) (seult 2 cotes visibles)"
'(draw-rectangle 0 0 (#:window:width w1) (#:window:height w1)))
(clear-graph-env)
(verif
"Un rectangle en (0,0) de (w(w1)-1)x(h(w1)-1) (les 4 cotes visibles)"
'(draw-rectangle 0 0
(sub1 (#:window:width w1))
(sub1 (#:window:height w1))))
(clear-graph-env)
(verif "Un rectangle en (10,10) de w = 100 et h = 200"
'(draw-rectangle 10 10 100 200))
(verif "Un rectangle en (20,20) de w = 10 et h = 0 (trait horiz.)"
'(draw-rectangle 20 20 10 0))
(verif "Un rectangle en (20,30) de w = 0 et h = 10 (trait vert.)"
'(draw-rectangle 20 30 0 10))
(verif "Un rectangle en (20,50) de w = 0 et h = 0 (point)"
'(draw-rectangle 20 50 0 0))
(clear-graph-env)
(verif "Un cercle de centre (100,120) de rayon 90"
'(draw-circle 100 120 90))
(clear-graph-env)
(verif "Dessin d'une ellipse et d'un cercle superposees"
'(progn (draw-circle 100 100 100)
(draw-ellipse 100 100 50 70)))
;------------------------
(sous-titre "#409# 20.3.1 Test des fonctions etendues: remplissage")
(print "current-pattern = " (current-pattern 1))
(current-line-style 0)
(current-font 0)
(print "current-mode = " (current-mode #:mode:xor))
(clear-graph-env)
(verif "Un rectangle en (10,10) de w = 100 et h = 200"
'(fill-rectangle 10 10 100 200))
(verif "Un rectangle plein en (300,10) de 10x0 (vous ne devez rien voir)"
'(fill-rectangle 300 10 10 0))
(verif "Un rectangle plein en (300,30) de 0x10 (vous ne devez rien voir)"
'(fill-rectangle 300 30 0 10))
(verif "Un rectangle plein en (300,50) de 0x0 (vous ne devez rien voir)"
'(fill-rectangle 300 50 0 0))
(verif "Un super-rectangle en (-500,-500) de w = 10000 et h = 10000"
'(fill-rectangle -500 -500 10000 10000))
(clear-graph-env)
(verif "Un cercle de centre (100,120) de rayon 90"
'(fill-circle 100 120 90))
(clear-graph-env)
(verif "Un cercle de centre (0,0) de rayon 90"
'(fill-circle 0 0 90))
(verif "Un cercle de centre (100,100) de rayon 0"
'(fill-circle 100 100 0))
(clear-graph-env)
(verif "Remplissage d'une forme convexe avec fill-area (forme de papillon)"
'(fill-area 6 #[10 60 110 110 60 10] #[10 40 10 100 70 100]))
(clear-graph-env)
(verif "Dessin du rectangle et du cercle superposees"
'(progn (fill-rectangle 60 10 100 200)
(with ((current-pattern (pattern-max)))
(fill-circle 110 110 60))))
;------------------------
(sous-titre "#410# 20.3.1 Test des fonctions etendues: affichage de texte")
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
(clear-graph-env)
(verif "Une suite de 20 A espace' de 5 pixels"
'(for (i 0 5 99)
(draw-cn i 50 #/A)))
(verif "Une suite de 20 B"
'(draw-string 10 80 "BBBBBBBBBBBBBBBBBBBB"))
;----------------------------------------------------------------------------
; ---- une seconde fenetre pour tester le cliping
(titre "#411# Une seconde fenetre pour tester la de'coupe")
(verif "Fenetre-bande w2 est cre'e'e"
'(setq w2 (create-window 'window
(sub (#:window:left w1) 50)
(add (#:window:top w1)
(div (#:window:height w1) 4))
(add (#:window:width w1) 100)
(mul (div (#:window:height w1) 5) 3)
"w2" 1 1)))
(print "Je teste (current-clip) avec current-window=w2")
(testsuite)
(progn (current-window w2)
(current-clip) t) t
#:clip:x 0
#:clip:y 0
#:clip:w #.(#:window:width w2)
#:clip:h #.(#:window:height w2)
(exit eof) ()
(verif "w2 au dessus de w1"
'(move-behind-window w1 w2))
(current-window w1)
(current-pattern 0)
(current-line-style 0)
(current-font 0)
(current-mode #:mode:set)
(clear-graph-env)
(quad-window1 w2)
(quad-window1 w1)
(setq left-w1 (#:window:left w1)
top-w1 (#:window:top w1)
width-w1 (#:window:width w1)
height-w1 (#:window:height w1)
bottom-w1 (add top-w1 (#:window:height w1))
right-w1 (add left-w1 (#:window:width w1)))
;------------------------
(sous-titre "#412# Les operations graphiques dans w1")
(current-pattern 1)
(affich "Nous passons en mode XOR"
'(current-mode #:mode:xor))
(verif "Les diagonales de w1"
'(progn (draw-line 0 0 width-w1 height-w1)
(draw-line 0 height-w1 width-w1 0)))
(verif "Un rectangle dans w1 (20 pixels a l'inte'rieur de w1)"
'(draw-rectangle 20 20 (sub width-w1 40) (sub height-w1 40)))
(verif "Un rectangle plein ""vertical"" coupant w1"
'(fill-rectangle 30 -20 (sub width-w1 60) (add height-w1 40)))
(verif "Un cercle plein en 0,0 de rayon width(w1)/4"
'(fill-circle 0 0 (div (#:window:width w1) 4)))
(verif "Une suite de 20 B en 10,10"
'(draw-string 10 10 "BBBBBBBBBBBBBBBBBBBB"))
;----------------------------------------------------------------------------
; ---- une sous-fenetre pour tester le cliping
(titre "#413# Une sous-fenetre de w2")
(verif "Sous-fenetre sw1 de w2 en 1/4,1/4 de 1/3x1/2"
'(setq sw1 (create-subwindow 'window
(div (#:window:width w2) 4)
(div (#:window:height w2) 4)
(div (#:window:width w2) 3)
(div (#:window:height w2) 2)
"sw1"
1 1 w2)))
(affich "Mode set"
'(current-mode #:mode:set))
(current-window sw1)
(clear-graph-env)
(verif "Bordure de sw1 dans sw1"
'(draw-rectangle 0 0 (sub1 (#:window:width sw1))
(sub1 (#:window:height sw1))))
(verif "Une ellipse dans sw1 en (0,0) de width(sw1)/3,height(sw1)/2"
'(fill-ellipse 0 0 (div (#:window:width sw1) 3)
(div (#:window:height sw1) 2)))
(verif "Une suite de 20 B en -10,10"
'(draw-string -10 10 "BBBBBBBBBBBBBBBBBBBB"))
(current-window w2)
(verif "Bordure de sw1 dans w2"
'(draw-rectangle (sub1 (#:window:left sw1))
(sub1 (#:window:top sw1))
(add (#:window:width sw1) 1)
(add (#:window:height sw1) 1)))
(verif "Les 2 diagonales de w2"
'(progn (draw-line 0 0 (#:window:width w2)
(#:window:height w2))
(draw-line 0 (#:window:height w2)
(#:window:width w2) 0)))
(current-window sw1)
(verif "clear sw1"
'(clear-graph-env))
(current-window w1)
(verif "clear w1"
'(clear-graph-env))
;----------------------------------------------------------------------------
(titre "#415# Effacement des fenetres")
(clear-graph-env)
(verif "w1 est tue'e"
'(kill-window w1))
(verif "w2 est tue'e"
'(kill-window w2))
;----------------------------------------------------------------------------
(titre "Fin du test des primitives graphiques")
;----------------------------------------------------------------------------
(terpri)
(terpri)
(terpri)
(bitepilogue)
(setq automatic ())
;----------------------------------------------------------------------------
;============================================================================