Перейти к содержимому

Фотография

Графическая задачка на Pascalпомогите найти ошибку

pascal паскаль

  • Авторизуйтесь для ответа в теме
Сообщений в теме: 3

#1
Тохан

Тохан
  • Свой человек
  • 954 сообщений

Добрый час! Помогите, пожалуйста, найти ошибку в программе.

Вроде работает но немного не так. Не могу понять в чем проблема.

 

Постановказадачи. Написать программу для изображения Октаэдра, вращающегося вокруг оси ОY. Ось вращения не должна совпадать с собственной вертикальной осью 
фигуры. Применить диметрию. 
Описаниеметода решения задачи. Для создания фигуры указываем координаты вершины и порядок их соединения через ребра. С фигурой 
осуществляются преобразования через матрицу 4*4 

 

program octahedron; 
uses crt,graph; 
type point_position = array [1..3] of real; 
type side_position = array [1..3] of point_position; 
type oct_coord = array [1..8] of side_position; 
const Color: array[1..8] of Integer = (1,2,3,4,5,6,9,10); 
{фигура Октаэдр} 
const oct: oct_coord= (((100,100,60),(50,100,-40),(100,50,-40)), 
((100,100,60),(50,100,-40),(100,150,-40)), 
((100,100,-140),(100,50,-40),(50,100,-40)), 
((100,100,-140),(100,150,-40),(50,100,-40)), 
((100,100,-140),(150,100,-40),(100,50,-40)), 
((100,100,-140),(100,150,-40),(150,100,-40)), 
((100,100,60),(100,50,-40),(150,100,-40)), 
((100,100,60),(150,100,-40),(100,150,-40))); 
const p=-0.002; 
var 
pcos,psin:real; 
oct_new,oct_old:oct_coord; 
dv,mv,x0, y0: integer; 
  
procedure init; 
var i,j,k:integer; 
  
begin 
x0 := getMaxX div 2; 
y0 := getMaxY div 2; 
for i:=1 to High(oct) do 
for j:=1 to High(oct) do 
for k:=1 to High(oct[i,j]) do 
begin 
oct_new[i,j,k] := oct[i,j,k]; 
oct_old[i,j,k] := oct[i,j,k]; 
end; 
  
end; 
{алгоритм робертса} 
function robert(side:side_position):boolean; 
var 
a,b,c:real; 
i,j:integer; 
begin 
c:=0; 
robert:=true; 
for i:=1 to high(side) do 
begin 
if i=high(side) then j:=1 
else j:=i+1; 
  
c:=c+(side[i,1]-side[j,1])*(side[i,2]+side[j,2]); 
end; 
if c<=0 then robert:=false; 
  
end; 
{процедура получения перспективы в одной точке схода} 
procedure modif(x,y,z:real;var x1,y1,z1:real); 
begin 
x1:=x/(p*y+1); 
y1:=y/(p*y+1); 
z1:=z/(p*y+1); 
end; 
{прорисовка/стирание октаэдра в зависимости от флага new} 
procedure draw_oct(new: boolean;figure:oct_coord); 
var 
i,j,k:integer; 
area: array [1..3] of PointType; 
new_side:side_position; 
begin 
setcolor(0); 
for i:=1 to high(oct_new) do 
  begin 
   for k:=1 to high(new_side) do 
     begin 
      modif(figure[i,k,1], figure[i,k,2], figure[i,k,3], 
      new_side[k,1],new_side[k,2],new_side[k,3]); 
     end; 
   if robert(new_side) then 
      if new then setFillStyle(solidfill, Color) 
      else setFillStyle(solidfill, 0); 
   for j:=1 to High(new_side) do 
     begin 
      area

.X :=x0+ round(new_side[j,1]); 
      area

.Y := round(new_side[j,2]); 
     end; 
   fillpoly(sizeOf(area) div sizeOf(pointtype),area); 
  end; 
end; 

{поворот октаэдра} 
procedure rotate; 
var 
i, j: integer; 
x_new, z_new: real; 
begin 
for i:=1 to High(oct_new) do 
for j:=1 to High(oct_new[1]) do 
begin 
oct_old[i,j,1] := oct_new[i,j,1]; 
oct_old[i,j,3] := oct_new[i,j,3]; 
x_new:=oct_new[i,j,1]*pcos-oct_new[i,j,3]*psin; 
z_new:=oct_new[i,j,1]*psin+oct_new[i,j,3]*pcos; 
oct_new[i,j,1]:=x_new; 
oct_new[i,j,3]:=z_new; 
end; 
end; 
{основная часть программы} 
begin 
pcos:=cos(0.05); 
psin:=sin(0.05); 
dv := detect; 
initGraph(dv,mv,''); 
init; 
repeat 
rotate; 
draw_oct(false,oct_old); 
draw_oct(true,oct_new); 
delay(100); 
until keypressed; 
closegraph; 
end.


  • 0

#2
Иксилимьюз

Иксилимьюз
  • Свой человек
  • 966 сообщений

Вроде работает но немного не так.

А можно немного по конкретнее? )) Что именно не так?


  • 0

#3
Тохан

Тохан
  • Свой человек
  • 954 сообщений

Не правильно отрисовывает грани. Подозреваю что не правильно рассчитывается угол поворота и при этом не правильно отрабатывает удаление невидимых граней


  • 0

#4
lexx821

lexx821
  • Свой человек
  • 816 сообщений
Гляньте книгу "Turbo Pascal" С.А.Немнюгин
В этой книги была работа с 3D графикой, гляньте страницу 265, там всё написано.
 
Книга "Turbo Pascal" С.А.Немнюгин
WP_20190531_20_03_31_Pro-min.jpg
 
Урок 6 "Графика VGA, программирование трёхмерных и динамических изображений"
WP_20190531_20_03_45_Pro-min.jpg
 
Гляньте сюда, на 365 страницу
WP_20190531_20_04_01_Pro-min.jpg
 
P.S. для моих хейтеров:
Скрытый текст

  • 0


Количество пользователей, читающих эту тему: 1

пользователей: 0, неизвестных прохожих: 1, скрытых пользователей: 0

Размещение рекламы на сайте     Предложения о сотрудничестве     Служба поддержки пользователей

© 2011-2022 vse.kz. При любом использовании материалов Форума ссылка на vse.kz обязательна.