home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / b / binprolog / !BinPro330 / progs / tetris < prev    next >
Encoding:
Text File  |  1993-10-06  |  6.9 KB  |  332 lines
  1. % Tetris en Prolog (C) Paul Tarau 1989
  2.  
  3. % version avec evaluation complete mais non-optimisee
  4. % on minimise "l'energie" du relief = la somme des
  5. % hauteurs des briques, y compris les espaces vides
  6. % (apres une chutte hypothetique)
  7.  
  8. % tetris9.pro
  9. % 
  10. % FAITES: d.
  11.  
  12. :-op(900,yfx,:).
  13.  
  14. max(20,10). % L,C
  15.  
  16. % interface ALS
  17.  
  18. scr_clear:-for(_,1,60),nl,fail; true.
  19.  
  20. scr_send(p(L0,C0),Char):-
  21.   L is L0+1, C is C0+1,
  22.   put(27),
  23.   cwrite('['),cwrite(L),
  24.   cwrite(';'),cwrite(C),
  25.   cwrite('H'),
  26.   put(Char).
  27.  
  28. scr_rec(_):-fail.
  29.  
  30. rtest:-for(I,1,50),random(20,R),cwrite(R),nl,fail.
  31.  
  32. random(Max,R):-
  33.     random(N),
  34.     R is N mod Max.  
  35.  
  36. cputime(X):-statistics(runtime,[X,_]).
  37.  
  38. dir_depl(0,p( 0, 1)).   % right -77
  39. dir_depl(1,p( 1, 0)).   % down -80
  40. dir_depl(2,p( 0,-1)).   % left -75
  41. dir_depl(3,p(-1, 0)).   % up -72
  42.  
  43. usr_dir(-77,0).
  44. usr_dir(-80,1).
  45. usr_dir(-75,2).
  46. usr_dir(-72,3).
  47. usr_dir(13,-1).
  48. usr_dir(27,0):-fin.
  49.  
  50.  
  51. % mouvement
  52.  
  53. next(Dir,p(L1,C1),p(L2,C2)):-
  54.         max(MaxL,MaxC),
  55.         dir_depl(Dir,p(DL,DC)),
  56.         L2 is L1+DL,C2 is C1+DC,
  57.         L2>=0,L2<MaxL,C2>=0,C2<MaxC.
  58.  
  59. select(-1,bloc(T,O1,P),bloc(T,O2,P)):-!,
  60.         O2 is (O1+1) mod 4.
  61. select(Dir,bloc(T,O,P1),bloc(T,O,P2)):-
  62.         next(Dir,P1,P2).
  63.  
  64. /* lecture d'une direction: chutte par defaut */
  65. scr_dir(1).
  66. /*
  67. scr_dir(D):-
  68.         cputime(T0),
  69.         repeat,
  70.         ( scr_rec(C)->usr_dir(C,D)
  71.         ; cputime(T1), DeltaT is T1-T0,DeltaT>0.20,D is 1
  72.         ).
  73. */
  74.  
  75. % objets
  76.  
  77. /* image(Type,[Dir|Ds]) */
  78. image(0,[0,1,0]).       % z.
  79. image(1,[1,0,1]).       % -z.
  80. image(2,[0,1,1]).       % l.
  81. image(3,[0,0,1]).       % -l.
  82. image(4,[1,1,1]).       % i.
  83. image(5,[0,1,2,3]).     % carre.
  84. image(6,[0,0,2,1]).     % a.
  85.  
  86. bloc2briques(B,Qs):-
  87.         B=bloc(Type,_,_),
  88.         image(Type,Dirs),
  89.         bloc2briques(Dirs,B,Ps),
  90.         sort(Ps,Qs).
  91.  
  92. bloc2briques([],bloc(_,_,P),[P]):-!.
  93. bloc2briques([D|Ds],bloc(T,O,P1),[P1|Ps]):-
  94.         Dir is (O+D) mod 4,
  95.         next(Dir,P1,P2),
  96.         !,
  97.         bloc2briques(Ds,bloc(T,O,P2),Ps).
  98.  
  99. afficher_briques([],_):-!.
  100. afficher_briques([P|Ps],Image):-
  101.         scr_send(P,Image),
  102.         !,
  103.         afficher_briques(Ps,Image).
  104.  
  105. deplacer_briques(Old,New):- 
  106.                 "*"=[Brique],
  107.         afficher_briques(Old,32),
  108.         afficher_briques(New,Brique).     
  109.  
  110. tester_briques(Briques,Relief):-
  111.         member(X,Briques),member(X,Relief)->fail
  112. ;       true.
  113.  
  114. deplacer_bloc(B1,B2,R):-
  115.         bloc2briques(B2,New),
  116.         tester_briques(New,R),
  117.         bloc2briques(B1,Old),
  118.         deplacer_briques(Old,New).
  119.  
  120. comprimer_relief(N1:R1,N2:R2):-
  121.         max(MaxL,MaxC),
  122.         bagof(Plein:L-Cs,
  123.         Len^(
  124.           bagof(C,member(p(L,C),R1),Cs),
  125.           length(Cs,Len),
  126.           ( Len=MaxC->Plein=1
  127.           ; Plein=0
  128.           )
  129.         ),
  130.         BLCs),
  131.         !,
  132.         eliminer(BLCs,LCs,N),
  133.         !,
  134.         N>0,N2 is N1+N,
  135.         elements(LCs,R2).
  136.  
  137. score(N):-
  138.         max(MaxL,MaxC),
  139.         Score is N*MaxC,MesL is MaxL+1,
  140.         scr_send(p(MesL,0),32), % 7 if not quiet
  141.     cwrite('Score:'),cwrite(Score).
  142.  
  143. element(LCs,p(L,C)):-member(L-Cs,LCs),member(C,Cs).
  144.  
  145. elements(LCs,Ps):-findall(P,element(LCs,P),Ps).
  146.  
  147. eliminer([],[],0):-!.
  148. eliminer([L|Ls],Rs2,N2):-
  149.         eliminer(Ls,Rs1,N1),
  150.         enlever(L,Rs1,Rs2,N1,N2).
  151.  
  152. enlever(1:_,Rs,Rs,N1,N2):-N2 is N1+1,!.
  153. enlever(0:L-Cs,Rs1,[L1-Cs|Rs1],N,N):-L1 is L+N.
  154.  
  155. touche(p(L,_),_):-max(M,_),L>=M,!. % no free space down
  156. touche(P,Ps):-member(P,Ps),!.
  157.  
  158.  
  159. % essayer
  160.  
  161. essayer_animer_bloc(B,N:R1,N:R2):-
  162.     bloc2briques(B,Ps),
  163.     essayer_descendre_bloc(Ps,R1,R2).
  164.  
  165. essayer_descendre_bloc(Ps1,R1,R2):-
  166.         essayer_changer_bloc(Ps1,Ps2,R1),
  167.         !,
  168.         essayer_descendre_bloc(Ps2,R1,R2).
  169. essayer_descendre_bloc(Ps,R1,R3):-       
  170.         det_append(Ps,R1,R2),
  171.         !,
  172.         essayer_reduire(R2,R3).
  173.  
  174. essayer_reduire(R1,R2):-
  175.         comprimer_relief(0:R1,_:R2),
  176.         !.
  177. essayer_reduire(R,R).
  178.  
  179. descendre([],[],MaxL):-!.
  180. descendre([p(L1,C)|Ps1],[p(L2,C)|Ps2],MaxL):-
  181.     L2 is L1+1,
  182.     L2<MaxL,
  183.     !,
  184.     descendre(Ps1,Ps2,MaxL).
  185.  
  186. essayer_changer_bloc(Bs1,Bs2,R):-
  187.     max(MaxL,_),
  188.     descendre(Bs1,Bs2,MaxL),
  189.   ( member(X,Bs2),member(X,R)->fail
  190.   ; true
  191.     ),
  192.   !.
  193.  
  194.  
  195. % evaluer
  196.  
  197. minimiser_energie_relief(B0,_,N:R1):-
  198.         B0=bloc(Type,_,_),
  199.         re_init_best(B0),
  200.         generer_bloc(Type,B),
  201.         essayer_animer_bloc(B,N:R1,_:R2),
  202.         energie(R2,Val),
  203.         the_best(OldB,OldVal),
  204.         Val<OldVal,
  205.         set_best(B,Val),
  206.         deplacer_bloc(OldB,B,R1),
  207.         max(MaxL,_),L is MaxL+2,
  208.     [Prompt]=">",
  209.         scr_send(p(L,0),Prompt),
  210.         statistics(global_stack,Stat),statistics(bboard,BBStat),
  211.         write('Energie':Val),write(' Heap':Stat),write('    '),
  212.     write('Blackboard':BBStat),write('     '),
  213.         fail.
  214. minimiser_energie_relief(_,B,_):-
  215.         the_best(B,_).
  216.  
  217. generer_bloc(Type,bloc(Type,Orientation,p(3,C))):-
  218.         max(_,MaxC),
  219.         MaxC1 is MaxC-1,
  220.         for(C,0,MaxC1),
  221.         for(Orientation,0,3).
  222.  
  223. surface(R1,S):-
  224.         findall(C-Ls,
  225.               setof(L,member(p(L,C),R1),Ls),
  226.         CLs),
  227.         findall(p(L1,C0),
  228.            (member(C0-[L0|_],CLs),L1 is L0-1),
  229.         S).
  230.  
  231. energie(Briques,G):-
  232.         surface(Briques,S),
  233.         energie(S,0,G).
  234.  
  235. energie([],G,G):-!.
  236. energie([p(L,_)|Ps],G1,G3):-
  237.         max(MaxL,_),
  238.         G2 is G1+((MaxL-L)*(MaxL-L+1) // 2),
  239.         !,
  240.         energie(Ps,G2,G3).
  241.  
  242.  
  243. init_best:-bb_let(tetris,best(bloc(3,0,p(1,1)),99999)).
  244.  
  245. re_init_best(B):-set_best(B,99999).
  246.  
  247. set_best(Bloc,V):-bb_set(tetris,best(Bloc,V)).
  248.  
  249. the_best(Bloc,V):-bb_val(tetris,best(Bloc,V)).
  250.  
  251. % animer
  252.  
  253. impact(B,N:R1,N:R2):-
  254.         bloc2briques(B,Ps),       
  255.         member(p(L,C),Ps),L1 is L+1,
  256.         touche(p(L1,C),R1),
  257.         det_append(Ps,R1,R2),
  258.         !.
  259.  
  260. reduire(N1:R1,N2:R2):-
  261.         comprimer_relief(N1:R1,N2:R2),
  262.         deplacer_briques(R1,R2),
  263.         score(N2),
  264.         !.
  265. reduire(R,R).
  266.  
  267.  
  268. changer_bloc(B1,B2,_:R):-
  269.         scr_dir(Dir),
  270.         select(Dir,B1,B2),
  271.         deplacer_bloc(B1,B2,R),
  272.         !.
  273. changer_bloc(B,B,_).
  274.  
  275. animer_bloc(B,R1,R3):-impact(B,R1,R2),!,
  276.         reduire(R2,R3).
  277. animer_bloc(B1,R1,R2):-
  278.         changer_bloc(B1,B2,R1),
  279.         !,
  280.         animer_bloc(B2,R1,R2).
  281.  
  282.  
  283. % jouer
  284.  
  285. plein(Relief):-member(p(L,_),Relief), L=<5. % no free space up
  286.  
  287. creer_bloc(bloc(Type,0,p(5,MidC))):-!,
  288.         max(_,MaxC),MidC is MaxC // 2,
  289.         random(7,Type).
  290.  
  291. meilleur_bloc(jeu,B0,B0,_):-!.
  292. meilleur_bloc(demo,B0,B,NR):-
  293.         minimiser_energie_relief(B0,B,NR).
  294.  
  295. jouer(_,_:Relief):-plein(Relief),!.
  296. jouer(Mode,Relief1):-
  297.         creer_bloc(B0),
  298.         meilleur_bloc(Mode,B0,B,Relief1),
  299.         !,
  300.     gc_call( 
  301.         animer_bloc(B,Relief1,Relief2)
  302.     )
  303.     ,
  304.         !,
  305.         jouer(Mode,Relief2).
  306.  
  307. init(N:[]):-
  308.         scr_clear,
  309.         max(MaxL,MaxC),[Board]="#",
  310.         init_best,
  311.         (for(L,6,MaxL),scr_send(p(L,MaxC),Board),fail; true),
  312.         (for(C,0,MaxC),scr_send(p(MaxL,C),Board),fail; true),
  313.         N=0,score(N),
  314.         !.
  315.  
  316. fin :- 
  317.         max(L,_),L1 is L+3,
  318.         scr_send(p(L1,0),32),nl,
  319.         abort.
  320.  
  321. go(Mode):-
  322.         init(State),
  323.         jouer(Mode,State),
  324.         fin.
  325.  
  326. g:-go(jeu).
  327.  
  328. go:-go(demo).
  329.  
  330. d:-go.
  331.  
  332.