# Commande principale: demo
pour b :x :y
billard :x :y
fin
pour billard :ncol :nlig
si et egal? 0 :ncol egal? 0 :nlig [effplateau stop]
si :ncol < :nlig [billard :nlig :ncol stop]
SI :ncol >160 [billard 160 :nlig stop]
SI :nlig > 120 [billard :ncol 120 stop]
initplateau :ncol :nlig
donne "numcases 0
derive 0 0 :ncol :nlig 1 1
fin
pour initplateau :ncol :nlig
ftd [1000 800]  ve ct fsep 1
donne "delta0 minimum quotient 800 :ncol quotient 600 :nlig
# :delta0 contient une valeur supérieure à 5
donne "delta1 quotient :delta0 2 # :delta1 retient une valeur entière supérieure ou égale à 2
donne "lv produit :delta0 :nlig
donne "lh produit :delta0 :ncol
lc fpos liste (moins quotient :lh 2) quotient :lv 2
fcc gris Quadrille :ncol :nlig
donne "NumCoulRemplissage numcoul blanc
donne "deltaNcr quotient  :NumCoulRemplissage ppcm :ncol :nlig 
fin
pour effplateau
fsep 0.6 ve
fin
pour derive :x :y :ncol :nlig :dx :dy
SI coin? :x :y :ncol :nlig [termine :ncol :nlig stop]
soit "sym aubord? :x :y :ncol :nlig :dx :dy
glisse  prem :sym der :sym
donne "numcases somme :numcases 1
derive (:x + prem :sym) (:y + der :sym) :ncol :nlig prem :sym der :sym 
fin
pour quadrille :ncol :nlig
soit "OldPos pos
verticales :ncol + 1 :OldPos :lv :delta0
lc fpos :OldPos
horizontales :nlig + 1 :OldPos :lh :delta0
lc fpos :OldPos
fin
pour horizontales :fois :pos :larg :d0
si egal? :fois 0 [stop]
bc fpos liste somme prem :pos :larg der :pos lc
fpos liste prem :pos diff der :pos :d0
horizontales (:fois - 1) pos :larg :d0
fin
pour verticales :fois :pos :haut :d0
si egal? :fois 0 [stop]
bc fpos liste prem :pos diff der :pos :haut lc
fpos liste (somme :d0 prem :pos) der :pos
verticales (:fois - 1) pos :haut :d0
fin
pour glisse :dx :dy
# dx=1 => on glisse horizontalement vers la droite
# dy=1 => on glisse verticalement vers le bas
# on profite du glissement pour remplir le carré visité
soit "oldpos pos
# bc fcc gris 
fpos liste somme prem pos produit :delta1 :dx diff der pos produit :delta1 :dy
donne "NumCoulRemplissage diff :NumCoulRemplissage :deltaNcr
fcc coulnum :NumCoulRemplissage remplis
fpos :oldpos bc fcc blanc
fpos liste somme prem pos produit :delta0 :dx diff der pos produit :delta0 :dy lc
fin
pour coin? :x :y :ncol :nlig
si egal? 0 :numcases [ret "faux] # on est pas parti
ret membre? liste :x :y (liste [0 0] liste 0 :nlig liste :ncol 0 liste :ncol :nlig)
fin

pour aubord? :x :y :ncol :nlig :dx :dy
# on corrige le vecteur unitaire de déplacement
si egal? :numcases 0 [ret liste :dx :dy] # on est pas parti
soit  "a :dx soit  "b :dy
si membre? :y liste 0 :nlig [donne "b moins :b]
si membre? :x liste 0 :ncol [donne "a moins :a]
ret liste :a :b
fin
pour minimum :x :y
SI :x <  :y [ret :x] [ret :y]
fin
pour montre :quoi
ec (ph  car 91 :quoi car 93)
fin

pour diff :a :b
ret :a - :b
fin
pour termine :ncol :nlig
ct lc fpos  liste (moins quotient :LH 2) diff -20 quotient :LV 2
fcc noir etiquette (PH :numcases [CASES TRAVERSEES SUR QUADRILLAGE] :ncol "par :nlig)
fin

pour numcoul :rvb
# retourne la valeur entière entre 0 et 16 777 216 associée à la liste [rouge vert bleu]
soit "xcoul der :rvb
donne "xcoul :xcoul + 256 * item 2 :rvb
donne "xcoul  :xcoul + 65536 * prem :rvb
ret :xcoul
fin

pour coulnum :xcoul
# retourne sous forme de liste rvb la couleur associée à une valeur entière comprise entre 0 et 16 777 216
soit "r quotient :xcoul 65536
soit "vb reste :xcoul 65536
soit "v quotient :vb 256
soit "b reste :vb 256
ret (liste :r :v :b)
fin

pour pgcd :t1 :t2
#t1 et t2 sont assumés positifs
soit "repons 0 soit "aux 0 soit "lereste 0
tantque [:repons = 0] [
si :t1 < :t2 [donne "aux :t1 donne "t1 :t2 donne "t2 :aux] #un petit swap
donne "lereste reste :t1 :t2
si egal? 0 :lereste [donne "repons :t2] [donne "aux :t2 donne "t2 :lereste donne "t1 :aux]
] # fin de la boucle
ret :repons
fin

pour ppcm :t1 :t2
si :t1 < :t2 [ret ppcm :t2 :t1]
# t1 est donc le plus grand
soit "p pgcd :t1 :t2
soit "q quotient :t1 :p
ret produit :q :t2
fin
pour multiple? :n :q
ret egal? 0 reste :n :q 
fin
# -----------------
pour demo
b (11 + hasard 41) (9 + hasard 41)
fin