home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / turbopas / amouse55.zip / SQUARE.PAS < prev   
Pascal/Delphi Source File  |  1988-02-17  |  7KB  |  253 lines
  1. (*
  2.  
  3.         This program computes a solution to game #5 on a Merlin!
  4.  
  5. *)
  6.  
  7. {$M 16300,0,655360}
  8. program ai_1;
  9. uses
  10.   crt,mouse,graph;
  11.  
  12. procedure display(config_num:integer);
  13. var x,y:integer;
  14. begin
  15.   y:=0;
  16.   for x:=1 to 9 do begin
  17.     y:=y+1;
  18.     if (config_num and 1)=1
  19.       then write('*  ')
  20.       else write('   ');
  21.     if y=3 then begin
  22.       writeln;
  23.       y:=0
  24.       end;
  25.     config_num:=config_num shr 1
  26.     end
  27.   end;
  28.  
  29. function config_after(config_num,move_num:integer):integer;
  30. begin
  31.   case move_num of
  32.     1: config_after:=config_num xor 27;    {  1  2   4    }
  33.     2: config_after:=config_num xor 7;     {  8  16  32   }
  34.     3: config_after:=config_num xor 54;    {  64 128 256  }
  35.     4: config_after:=config_num xor 73;
  36.     5: config_after:=config_num xor 186;
  37.     6: config_after:=config_num xor 292;
  38.     7: config_after:=config_num xor 216;   (*** 495 ***)
  39.     8: config_after:=config_num xor 448;
  40.     9: config_after:=config_num xor 432
  41.     end
  42.   end;
  43.  
  44. procedure human_plays;
  45. var move_num,config_num : integer;
  46. begin
  47.   write('Initial Config # '); readln(config_num);
  48.   display(config_num);
  49.   while true do begin
  50.     write('Move # '); readln(move_num);
  51.     config_num:=config_after(config_num,move_num);
  52.     writeln('Generates config ',config_num);
  53.     display(config_num)
  54.     end
  55.   end;
  56. type c_or_p = (con,poi);
  57.      chain9pointer = ^chain9;
  58.      config_or_pointer = record
  59.                            kind : c_or_p;
  60.                            config : word;
  61.                            point  : chain9pointer
  62.                            end;
  63.      c_or_p9 = array[1..9] of config_or_pointer;
  64.      chain9 = record
  65.                 nextchain : chain9pointer;
  66.                 data : c_or_p9
  67.                 end;
  68.  
  69. var  initial_move : c_or_p9;
  70.  
  71. procedure create_initial_chain(config_num:integer);
  72. var x:integer;
  73. begin
  74.   for x:=1 to 9 do begin
  75.     initial_move[x].kind:=con;
  76.     initial_move[x].config:=config_after(config_num,x);
  77.     if initial_move[x].config=495 then begin
  78.       writeln('I got it... just press ',x);
  79.       halt
  80.       end
  81.     end
  82.   end;
  83.  
  84. function is_in(a_chain : c_or_p9):boolean;
  85. var x:integer;
  86. begin
  87.   is_in:=false;
  88.   for x:=1 to 9 do
  89.     if a_chain[x].kind=poi
  90.       then if is_in(a_chain[x].point^.data)
  91.         then begin
  92.                writeln('Middle move ',x);
  93.                is_in:=true;
  94.                exit
  95.                end
  96.         else
  97.       else if a_chain[x].config=495 then begin
  98.         writeln('Final move ',x);
  99.         is_in:=true;
  100.         exit
  101.         end
  102.   end;
  103.  
  104.  
  105. procedure trace_out;
  106. var x : integer;
  107. begin
  108.   for x:=1 to 9 do
  109.     if is_in(initial_move[x].point^.data) then begin
  110.       writeln('First move ',x);
  111.       halt
  112.       end;
  113.   writeln('Done tracing');
  114.   halt
  115.   end;
  116.  
  117.  
  118. procedure make_a_chain(thechain:chain9pointer;initial_config:integer);
  119. var x: integer;
  120. begin
  121.     for x:=1 to 9 do begin
  122.       thechain^.data[x].kind:=con;
  123.       thechain^.data[x].config:=config_after(initial_config,x);
  124.       if thechain^.data[x].config=495 then trace_out
  125.       end
  126.     end;
  127.  
  128. var chain_levelptr : array[1..7] of chain9pointer;
  129.  
  130. procedure make_second_chain(var initial_move : c_or_p9;
  131.                                        level : integer;
  132.                                   var engineptr : chain9pointer;
  133.                                   var cabooseptr : chain9pointer);
  134. var y : integer;
  135.     nextchain9,oldchain : chain9pointer;
  136.  
  137. begin
  138.   oldchain:=nil;
  139.  
  140.   for y:=1 to 9 do begin
  141.     new(nextchain9);
  142.     gotoxy(1,1); writeln(memavail,' ');
  143.     nextchain9^.nextchain:=nil;
  144.     if oldchain<>nil
  145.       then oldchain^.nextchain:=nextchain9
  146.       else engineptr:=nextchain9;
  147.     oldchain:=nextchain9;
  148.  
  149.     initial_move[y].kind:=poi;
  150.     initial_move[y].point:=nextchain9;
  151.     cabooseptr:=nextchain9;
  152.  
  153.     make_a_chain(nextchain9,initial_move[y].config)
  154.  
  155.  
  156.     end
  157.   end;
  158.  
  159. procedure make_third_chain(curr_chain : chain9pointer;level:integer);
  160. var engineptr,cabooseptr,oldcabooseptr : chain9pointer;
  161. begin
  162.   while curr_chain<>nil do begin
  163.     make_second_chain(curr_chain^.data,level,engineptr,cabooseptr);
  164.     if chain_levelptr[level]=nil
  165.       then chain_levelptr[level]:=engineptr
  166.       else oldcabooseptr^.nextchain:=engineptr;
  167.     oldcabooseptr:=cabooseptr;
  168.     curr_chain:=curr_chain^.nextchain
  169.     end
  170.   end;
  171.  
  172.  { here is a mouse_area array used by calls to mouse_area  }
  173.  { You should make the first index as small as needed, but }
  174.  { the function can take up to 100. Note that the last     }
  175.  { entry is all zeros }
  176. const
  177.   ma : array[1..10,1..4] of word =
  178.          ( (30,130,30,60) , (160,260,30,60) , (290,390,30,60) ,
  179.            (30,130,80,110) , (160,260,80,110) , (290,390,80,110) ,
  180.            (30,130,130,160) , (160,260,130,160) , (290,390,130,160) ,
  181.            (0,0,0,0) );
  182.  
  183. procedure read_config(var config_num : integer);
  184. var num_buttons : word;
  185.     grDriver,
  186.     grMode,
  187.     ErrCode     : Integer;
  188.     button,x,y : word;
  189. label finish;
  190. begin
  191.   config_num:=0;
  192.   if not mouseparams(num_buttons) then begin    { call first to reset }
  193.      writeln('Need a mouse for this.');         { the mouse }
  194.      halt
  195.      end;
  196.   grDriver := Detect;
  197.   InitGraph(grDriver,grMode,'c:\program\turbopas\bgi');
  198.   ErrCode := GraphResult;
  199.   if ErrCode = grOk then
  200.     begin
  201.       for x:= 1 to 9 do rectangle(ma[x,1],ma[x,3],ma[x,2],ma[x,4]);
  202.       settextstyle(defaultfont,vertdir,1);
  203.       outtextxy(640,20,'Click here when done');
  204.  
  205.       set_speed2(100);       { sets the double speed to 100 cps }
  206.       mouse_cursor(true);    { displays the mouse cursor }
  207.       set_mouse_cursor(5,2,hand); { sets the cursor to a hand & hot spots }
  208.       while true do begin
  209.         while mousebutton=0 do;   { mousebutton = 0 if not pressing anything }
  210.         if mousex>630 then goto finish; { mousex = x location }
  211.         x:=mouse_area(ma);              { returns 1 - 9 or 0 if not in any }
  212.         if x>0 then begin
  213.           config_num:=config_num or (1 shl (x-1));
  214.           mouse_cursor(false);          { shuts off cursor before drawing over it}
  215.           bar(ma[x,1],ma[x,3],ma[x,2],ma[x,4]);
  216.           mouse_cursor(true)            { turns it back on }
  217.           end
  218.         end
  219.       end
  220.     else
  221.       WriteLn('Graphics error:',
  222.               GraphErrorMsg(ErrCode));
  223.       halt;
  224. finish:
  225.     closegraph;
  226.     end;
  227.  
  228. var
  229.     x,move_num,
  230.     config_num : integer;
  231.     garbage : chain9pointer;
  232.  
  233. begin                          (* 499 - 2 moves , 453 - 3 moves *)
  234.   read_config(config_num);
  235. clrscr;
  236. {  if config_num=0 then human_plays;
  237. }
  238.   for x:=1 to 7 do chain_levelptr[x]:=nil;
  239.   writeln('Move 1');
  240.   create_initial_chain(config_num);
  241.   writeln('Move 2');
  242.   make_second_chain(initial_move,1,chain_levelptr[1],garbage);
  243.  
  244.   for x:=1 to 90 do begin
  245.     writeln('Move ',x+2);
  246.     make_third_chain(chain_levelptr[x],x+1)
  247.     end;
  248.  
  249.  
  250.   end.
  251.  
  252.  
  253.