View script | License | Download script | History | Other scripts by: tbertrand |
7-Sep 23:43 UTC
[0.049] 13.889k
[0.049] 13.889k
Archive version of: bridge.r ... version: 1 ... tbertrand 13-Jan-2016Amendment note: new script || Publicly available? Yes REBOL [ File: %bridge.r Date: 12-jan-2016 Title: "distribution bridge table" Author: Bertrand Thierry Purpose: { Distribute 4 hands of bridge table count of H, L and D points like with SEF methode and caracterize the distribution} ] Version: 0.1 Noms-Cartes: ["2" "3" "4" "5" "6" "7" "8" "9" "T" "V" "D" "R" "A"] Noms-Couleurs: ["Trefle" "Carreau" "Coeur" "Pique"] Contrat-Hauteur: ["1" "2" "3" "4" "5" "6" "7"] Contrat-Couleur: ["Trefle" "Carreau" "Coeur" "Pique" "Sans-Atout"] pointsHonneur: ["A" 4 "R" 3 "D" 2 "V" 1] Mains: [[]] pointsD: [[]] distrib: [[]] laDonne: [[]] typeDistrib: [[]] Jeu-cartes: [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52]; mesPH: 0 ;======================================= ; distribution des cartes ;======================================= distribue: does [ Donne: [] laDonne: [] Nb-Cards: 52 random/seed now Jeu-cartes: copy [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52] While [Nb-Cards > 0] [ Carte: Pick Jeu-cartes random Nb-Cards append Donne Carte remove find Jeu-cartes Carte Nb-Cards: Nb-Cards - 1 ] clear Mains; for Hd 0 3 1 [ append/only Mains make block! sort copy/part Donne 13 remove/part Donne 13 ] foreach Main Mains [ Cards-Main: [] Cards-Couleur: [] laMain: [] foreach Card Main [ append Cards-Main pick Noms-Cartes Card - 1 // 13 + 1 append Cards-Couleur pick Noms-Couleurs Card - 1 / 13 + 1 append/only laMain join join pick Cards-Main Length? Cards-Main " " pick Cards-Couleur Length? Cards-Couleur ] print " " append/only laDonne make block! laMain clear laMain ] ] pointH: func [ main ] [ pH: to-integer 0 pL: to-integer 0 nC: to-integer 0 pD: [] nbC: [] c1: make string! first Noms-Couleurs cIdx: 1 foreach chaine main [ card: make string! first chaine 1 if not none? find pointsHonneur card [ ph: ph + first find/tail pointsHonneur card ] coul: make string! skip chaine 2 either coul = c1 [ nC: nC + 1 ] [ append nbC nC cIdx: cIdx + 1 c1: make string! pick Noms-Couleurs cIdx case [ nC > 4 [ pL: pL + nC - 4 append pD 0 ] ; points de longueur uniquement ?quid 9eme carte etc... nC = 4 [ append pD 0 ] ; ? quid 9eme carte ... nC = 3 [ append pD 0 ] nC < 3 [ append pD 3 - nC ] ; potentiellement des points de chicane, etc... ] while [ coul <> c1 ] [ cIdx: cIdx + 1 c1: make string! pick Noms-Couleurs cIdx append pD 3 ; chicanes potentielles append nbC 0 ] nC: 1 ] ] append nbC nC case [ nC > 4 [ pL: pL + nC - 4 append pD 0 ] ; points de longueur uniquement ?quid 9eme carte etc... nC = 4 [ append pD 0 ] ; ? quid 9eme carte ... nC = 3 [ append pD 0 ] nC < 3 [ append pD 3 - nC ] ; potentiellement des points de chicane, etc... ] if CIdx <> 4 [ while [ CIdx < 4 ] ; si pas de piques ... [ append pD 3 append nbC nC cIdx: CIdx + 1 ] ] append/only pointsD make block! pD append/only distrib make block! nbC append/only typeDistrib make block! sort/reverse nbC clear pD clear nbC pH: pH + pL ] analyseMains: does [ num: 1 mesPH: 0 clear pointsD clear distrib clear typeDistrib foreach main laDonne [ print "===========================================================================================================" print join "main N" num ; foreach chaine main [ prin chaine prin "," ] print " " print "-----------------------------------------------------------------------------------------------------------" mesPH: pointH main ; print join "avec " join mesPH " points HL" print join pick pointsD num " points D potentiels" print join " distribution par couleur:" pick distrib num print join " type de distribution:" pick typeDistrib num num: num + 1 ; ] ] go: does [ distribue analyseMains clear laDonne clear distrib clear typeDistrib r: ask "une autre (o)?" ] r: ask "une autre (o)?" while [ r == "o" ] [ go ] |