TOX_SIMU.PAS 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q-,R+,S+,T-,V+,X+,Y+}
  2. {$M 65520,0,655360}
  3. program Toxic_Simulation;
  4. {JP 2000-1-10}
  5. uses Graph, Crt;
  6. const
  7. fin = 'toxic.in';
  8. fon = 'toxic.out';
  9. Dir : array[1..6,1..3]of ShortInt =
  10. ((0,0,1),(0,0,-1),
  11. (0,1,0),(0,-1,0),
  12. (0,0,1),(0,0,-1));
  13. Max = 32;
  14. type
  15. T2d = array[0..max+1,0..max+1]of Byte;
  16. T3d = array[0..max+1]of T2d;
  17. var
  18. Ans : Integer;
  19. Block : T3d;
  20. n,m,p,x,y : array[0..3]of Integer;
  21. w,a,b,r : integer;
  22. x1,y1,x2,y2 : integer;
  23. i,j : integer;
  24. procedure Change(i,j,k:integer);
  25. begin
  26. m[1]:=i; m[2]:=j; m[3]:=k;
  27. p[1]:=n[i]; p[2]:=n[j]; p[3]:=n[k];
  28. end;
  29. procedure DataIn;
  30. var f:text;
  31. begin
  32. Assign(f,fin); Reset(f);
  33. ReadLn(f,n[1],n[2],n[3]);
  34. Change(1,2,3);
  35. n:=p;
  36. Close(f);
  37. end;
  38. procedure GetZPos(k:integer; var xx,yy:integer);
  39. var x,y:integer;
  40. begin
  41. y:=(k-1)div a;
  42. x:=k-1-a*y;
  43. xx:=11+x*(w*n[1]+11);
  44. yy:=7+w*n[2]+y*(w*n[2]+21);
  45. end;
  46. procedure GetCoords(i,j,k:integer; var xx,yy:integer);
  47. begin
  48. GetZPos(k,xx,yy);
  49. xx:=xx+(i-1)*w;
  50. yy:=yy-j*w;
  51. end;
  52. procedure DrawBlock(i,j,k:integer; s:integer);
  53. var x0,y0:integer;
  54. begin
  55. GetCoords(i,j,k,x0,y0);
  56. SetColor(White);
  57. Rectangle(x0,y0,x0+w,y0+w);
  58. case s of
  59. 0:begin
  60. SetFillStyle(1,Green);
  61. Bar(x0+1,y0+1,x0+w-1,y0+w-1);
  62. end;
  63. 1:begin
  64. SetFillStyle(1,Black);
  65. Bar(x0+1,y0+1,x0+w-1,y0+w-1);
  66. end;
  67. 2:begin
  68. SetColor(Red);
  69. SetFillStyle(1,Red);
  70. x1:=x0+w div 2;
  71. y1:=y0+w div 2;
  72. PieSlice(x1,y1,0,360,R);
  73. end;
  74. 3:begin
  75. SetColor(Black);
  76. SetFillStyle(1,Black);
  77. x1:=x0+w div 2;
  78. y1:=y0+w div 2;
  79. PieSlice(x1,y1,0,360,R);
  80. end;
  81. end;
  82. end;
  83. procedure InitDraw;
  84. var i,j,k:integer;
  85. s:string[10];
  86. xx,yy:integer;
  87. begin
  88. for k:=1 to n[3] do
  89. begin
  90. Str(k,s); s:='Z = '+s;
  91. GetZPos(k,xx,yy);
  92. SetColor(White);
  93. OutTextXY(xx+30,yy+6,s);
  94. for i:=1 to n[1] do
  95. for j:=1 to n[2] do
  96. DrawBlock(i,j,k,0);
  97. end;
  98. end;
  99. procedure Initialize;
  100. var gd,gm:integer;
  101. begin
  102. gd:=0;
  103. InitGraph(gd, gm, 'c:\bp\bgi');
  104. w:=400;
  105. repeat
  106. a:=620 div (w*n[1]+1+10);
  107. b:=460 div (w*n[2]+1+20);
  108. if (n[3]<=a*b) then
  109. break;
  110. dec(w);
  111. until w<2;
  112. R:=(w-1) div 2-2;
  113. InitDraw;
  114. end;
  115. var
  116. f:text;
  117. ch:char;
  118. sum:integer;
  119. s:string[30];
  120. begin
  121. DataIn; Initialize;
  122. p[1]:=0;p[2]:=0;p[3]:=0;
  123. Assign(f,fon); Reset(f);
  124. while not eof(f) do
  125. begin
  126. Read(f,ch);
  127. ReadLn(f,x[1],x[2],x[3]);
  128. for i:=1 to 3 do
  129. y[i]:=x[m[i]];
  130. x:=y;
  131. case ch of
  132. 'E':begin
  133. Block[x[1],x[2],x[3]]:=1;
  134. DrawBlock(x[1],x[2],x[3],1);
  135. inc(sum);
  136. end;
  137. 'M':begin
  138. if p[1]>0 then
  139. DrawBlock(p[1],p[2],p[3],3);
  140. x2:=x1; y2:=y1;
  141. DrawBlock(x[1],x[2],x[3],2);
  142. SetLineStyle(0, 0, ThickWidth);
  143. { if p[3]=x[3]
  144. then SetColor(LightBlue)
  145. else SetColor(LightRed);
  146. Line(x1,y1,x2,y2);}
  147. p:=x;
  148. SetLineStyle(0, 0, 0);
  149. end;
  150. end;
  151. if readkey=#27 then halt;
  152. end;
  153. Close(f);
  154. setcolor(yellow);
  155. str(sum, s);
  156. outtextxy(100, 450, s + ' END...');
  157. repeat until readkey = #13;
  158. end.