pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

 >  > Запись оставлена aleks 08.01.2025 в 18:36 Получить справку

Запись оставлена aleks 08.01.2025 в 18:36
Показать изменения, внесённые aleks | запустить | скачать | новая запись

  1. program lab4_10;
  2.  
  3. uses
  4.   crt,graph;
  5.  
  6. const
  7.   prism : array[1..8,1..3] of real = ((300,170,0),
  8.                                       (300,170,100),
  9.                                       (500,170,100),
  10.                                       (500,170,0),
  11.                                       (300,320,0),
  12.                                       (300,320,100),
  13.                                       (500,320,100),
  14.                                       (500,320,0));
  15.   edge : array [1..12,1..2] of byte = ((1,2),
  16.                                        (1,4),
  17.                                        (1,5),
  18.                                        (2,3),
  19.                                        (2,6),
  20.                                        (3,4),
  21.                                        (3,7),
  22.                                        (4,8),
  23.                                        (5,8),
  24.                                        (5,6),
  25.                                        (6,7),
  26.                                        (7,8));
  27.   sk1 : array [1..6,1..4] of byte = ((1,2,6,4),
  28.                                      (1,5,10,3),
  29.                                      (4,7,11,5),
  30.                                      (6,8,12,7),
  31.                                      (2,3,9,8),
  32.                                      (9,10,11,12));
  33.   skeleton : array [1..6,1..4] of byte =((1,4,3,2),
  34.                                          (1,2,6,5),
  35.                                          (6,2,3,7),
  36.                                          (7,3,4,8),
  37.                                          (8,4,1,5),
  38.                                          (6,7,8,5));
  39.   TransMatr : array[1..4,1..4] of real =((1,0,0,0),
  40.                                          (0,1,0,0),
  41.                                          (0.70710678,0.70710678,0,0),
  42.                                          (0,0,0,1));
  43.  
  44. var
  45.   gd,gm:integer;
  46.   seeedge:array[1..6] of boolean;
  47.   Matr2D:array[1..8,1..2] of real;
  48.   chk:byte;
  49.  
  50. procedure ConvTo2D;
  51. var
  52.   i:byte;
  53. begin
  54.   for i:=1 to 8 do
  55.   begin
  56.     Matr2D[i,1]:=prism[i,1]+prism[i,3]*sqrt(0.5 );
  57.     Matr2D[i,2]:=prism[i,2]+prism[i,3]*sqrt(0.5);
  58.   end
  59. end;
  60.  
  61. procedure check;
  62. var
  63.   c:boolean;
  64.   cnt:byte;
  65.   ax,bx,cx,ay,by,cy:real;
  66. begin
  67. for cnt:=1 to 6 do
  68.   begin
  69.     ax:=Matr2D[skeleton[cnt,1],1];
  70.     ay:=Matr2D[skeleton[cnt,1],2];
  71.     bx:=Matr2D[skeleton[cnt,2],1];
  72.     by:=Matr2D[skeleton[cnt,2],2];
  73.     cx:=Matr2D[skeleton[cnt,3],1];
  74.     cy:=Matr2D[skeleton[cnt,3],2];
  75.     seeedge[cnt]:=((ax*by+ay*cx+bx*cy-by*cx-ay*bx-cy*ax)>0)
  76.   end
  77. end;
  78.  
  79. procedure retsc(r:byte; var e1,e2:byte);
  80. var
  81.   i,j:byte;
  82. begin
  83.   e1:=0;
  84.   e2:=0;
  85.   for i:=1 to 6 do
  86.     for j:=1 to 4 do
  87.       if r=sk1[i,j] then
  88.         if e1<>0 then e2:=i else e1:=i;
  89. end;
  90.  
  91. procedure DrawPrism(an:integer);
  92. var
  93.   i,j,e1,e2: byte;
  94. begin
  95.   for i:=1 to 12 do
  96.   begin
  97.     retsc(i,e1,e2);
  98.     case chk of
  99.     1:
  100.       Line(round(Matr2D[edge[i,1],1]),round(Matr2D[edge[i,1],2]),round(Matr2D[edge[i,2],1]),round(Matr2D[edge[i,2],2]));
  101.     2:
  102.     begin
  103.     if ((seeedge[e1]) or (seeedge[e2])) then
  104.     SetLineStyle(SolidLn,0,NormWidth)
  105.     else SetLineStyle(DashedLn,0,NormWidth);
  106.       Line(round(Matr2D[edge[i,1],1]),round(Matr2D[edge[i,1],2]),round(Matr2D[edge[i,2],1]),round(Matr2D[edge[i,2],2]));
  107.     end;
  108.     3:
  109.     if ((seeedge[e1]) or (seeedge[e2])) then
  110.       Line(round(Matr2D[edge[i,1],1]),round(Matr2D[edge[i,1],2]),round(Matr2D[edge[i,2],1]),round(Matr2D[edge[i,2],2]));
  111.     end;
  112.   end;
  113. end;
  114.  
  115. procedure Turn;
  116. var
  117.   phi,an:integer;
  118.   rvec:real;
  119.   i:byte;
  120.   zt,xt:real;
  121. begin
  122.   an:=0;
  123.   for phi:=1 to 360 do
  124.   begin
  125.     for i:=1 to 8 do
  126.       if ((i<>1) and (i<>5)) then begin
  127.       zt:=prism[i,3];
  128.       xt:=prism[i,1];
  129.       prism[i,3]:=(zt-prism[1,3])*cos(-pi*1/180)-(xt-prism[1,1])*sin(-pi*1/180)+prism[1,3];
  130.       prism[i,1]:=(zt-prism[1,3])*sin(-pi*1/180)+(xt-prism[1,1])*cos(-pi*1/180)+prism[1,1];
  131.     end;  ConvTo2D;
  132.    check;
  133.   Setcolor(Magenta);
  134.  DrawPrism(an);
  135.    Delay(5000);
  136.     Setcolor(White); DrawPrism(an);
  137.   end
  138. end;
  139.  
  140. begin
  141. writeln('Choose the kind of the model:');
  142. writeln('1-wire frame model;');
  143. writeln('2-dashed unvisible lines;');
  144. writeln('3-opaque model.');
  145. readln(chk);
  146. gd:=detect;
  147. gm:=0;
  148. initgraph(GD,gm,'');
  149. ConvTo2D;
  150. check;
  151. SetBkColor(White);
  152. SetColor(Magenta);
  153. DrawPrism(0);
  154. ReadKey;
  155.  Setcolor(White); DrawPrism(0);
  156. Turn;
  157.  Setcolor(Magenta); DrawPrism(0);
  158. ReadKey;
  159. closegraph;
  160. end.

Отправка исправлений и поправок. (cоздать новую запись)
После отправки поправок вы сможете посмотреть различия между старой и новой записью.

Использовать подсветку синтаксиса
В текущей реализации JS-DOS Read/ReadLn работают только при подключенном модуле Crt! Для подсветки отдельных строк используйте для них префикс @@


картинка


Запомнить мои настройки