[Комп. граф.] Лабораторная работа №1, Вариант №№39, 40
Давненько я ничего сюда не постил. А теперь начался новый учебный год, поэтому продолжаем :).
Заказали мне тут третьекурсники лабораторки по компьютерной графике. Как я посмотрел, задания немножко изменились по сравнению с прошлым годом, ну да ладно.
Смысл первой лабораторки состоит в следующем: на Паскале без подключения модуля Graph нарисовать некие геометрические фигуры, заданные уравнениями.
Почитав присланную мне методичку (скачать можно ниже), я выделил для себя два правила:
1) "Если не указано иное, то текстовым режимом по умолчанию следует считать 20х25х16, а графическим - 320х200х256".
2) "Каждое изображение, построенное в графическом режиме, должно обязательно сопровождаться комментарием на русском языке, выведенным поточечно".
Итак, по умолчанию используем видеорежим 320х200х256. Его номер по стандарту VGA = 13h. Этот режим 256-цветный, на один пиксел в видеопамяти отводится ровно один байт. Самый удобный видеорежим. Видеопамять начинается с адреса A000h:0, имеет 1 слой и 1 видеостраницу. Одной точке соотвествует байт видеопамяти. Другими словами, чтобы отобразить на экране пиксел какого-либо цвета, нужно записать соответствующее значение цвета в память по адресу $A000:$140*y+x, где x и y соответственно горизонтальная и вертикальная координаты пиксела.
Пример. Отобразить пиксел с координатами (123; 125) и заданным цветом в режиме 13h.
x:= 123;
y:= 45;
color:=14;
Mem[$A000:$140*y+x]:=color;
А теперь формулировка заданий:
Вар №39. Нарисовать спираль Архимеда.
Формула фигуры:
x(t) = r(t)*cos(t);
y(t) = r(t)*sin(t);
r(t) = r0+r1*t;
Отсюда видно, что спираль Архимеда имеет равномерно увеличивающийся радиус.
Вар №40. Нарисовать спираль Бернулли.
Формула фигуры:
x(t) = r(t)*cos(t);
y(t) = r(t)*sin(t);
r(t) = r0+e^(r1*t);
Спираль Бернулли образуется при экспоненциально изменяющемся радиусе.
Самый гемор конечно был с поточечной отрисовкой надписей около фигуры. Но я написал универсальную процедуру, с помощью которой можно вывести любую надпись на английском языке поточечно, не используя модуль Graph и какие-либо шрифты.
Для 39-го варианта получилось следующее:
program lab1_39 ;
var st: string;
procedure PutPixel(x,y:integer;color:byte);
var addr:word;
begin
addr:=320*y+x;
Mem[$A000:addr]:=color;
end;
const
bits: array[1 .. 28] of array[1 .. 14] of word = (
(0,0,24,24,36, 36, 36, 126, 66, 66, 129, 129,0,0), {A}
(0,0,254,129,129,129,254,129,129,129,129,254,0,0), {B}
(0,0,255,128,128,128,128,128,128,128,128,255,0,0), {C}
(0,0,254,129,129,129,129,129,129,129,129,254,0,0), {D}
(0,0,255,128,128,128,254,128,128,128,128,255,0,0), {E}
(0,0,255,128,128,128,254,128,128,128,128,128,0,0), {F}
(0,0,126,129,129,128,128,143,131,131,133,125,0,0), {G}
(0,0,129,129,129,129,255,129,129,129,129,129,0,0), {H}
(0,0,124,16,16,16,16,16,16,16,16,124,0,0), {I}
(0,0,1,1,1,1,1,1,1,129,129,126,0,0), {J}
(0,0,130,132,136,144,224,144,136,132,130,129,0,0), {K}
(0,0,128,128,128,128,128,128,128,128,129,255,0,0), {L}
(0,0,129,195,165,153,153,129,129,129,129,129,0,0), {M}
(0,0,129,193,161,145,137,133,131,129,129,129,0,0), {N}
(0,0,126,129,129,129,129,129,129,129,129,126,0,0), {O}
(0,0,254,129,129,129,254,128,128,128,128,128,0,0), {P}
(0,0,126,129,129,129,129,129,129,133,131,127,0,0), {Q}
(0,0,254,129,129,129,254,144,136,132,130,129,0,0), {R}
(0,0,127,128,128,128,126,1,1,1,1,254,0,0), {S}
(0,0,254,16,16,16,16,16,16,16,16,16,0,0), {T}
(0,0,129,129,129,129,129,129,129,129,129,126,0,0), {U}
(0,0,129,129,66,66,36,36,36,24,24,24,0,0), {V}
(0,0,129,129,129,129,129,129,153,153,165,66,0,0), {W}
(0,0,129,66,36,36,24,24,36,36,66,129,0,0), {X}
(0,0,130,68,68,40,16,16,16,16,16,16,0,0), {Y}
(0,0,255,2,4,4,8,16,32,32,64,255,0,0), {Z}
(0,0,0,0,0,0,0,0,0,0,0,0,0,0), {SPACE}
(0,0,24,24,24,0,0,0,0,0,0,0,0,0) {'}
);
procedure putChar(var px, py: integer; ch: char; color:byte);
var x, y: integer;
begin
for x := 0 to 7 do
for y := 1 to 14 do begin
if(bits[pos(ch, st)][y] shr x) and $01 > 0
then putpixel(px + (7 - x), py + y, color);
end;
inc(px, 10);
end;
procedure PrintString( px, py: integer; s: string;color:byte);
var i: integer;
begin
for i := 1 to length(s) do
putChar(px, py, s[i],color);
end;
procedure DrawSpiral(color:byte);
var t,r:real;
x,y:integer;
const r0: real = 1.0;
r1: real = 1.0;
x0: integer = 160;
y0: integer = 100;
begin
t:=0;
while t<=16*pi do
begin
r:=r0+r1*t;
x:=x0+round(r*cos(t));
y:=y0+round(r*sin(t));
PutPixel(x,y,color);
t:=t+0.001;
end;
end;
const figureName:string = 'ARCHIMED''S SPIRAL';
begin
asm
mov ax,13h
int 10h
end;
DrawSpiral(6);
st:='ABCDEFGHIJKLMNOPQRSTUVWXYZ ''';
PrintString(80,25,figureName,5);
ReadLn;
end.Результат:
Вариант №40:
program lab1_40 ;
var st: string;
procedure PutPixel(x,y:integer;color:byte);
var addr:word;
begin
addr:=320*y+x;
Mem[$A000:addr]:=color;
end;
const
bits: array[1 .. 28] of array[1 .. 14] of word = (
(0,0,24,24,36, 36, 36, 126, 66, 66, 129, 129,0,0), {A}
(0,0,254,129,129,129,254,129,129,129,129,254,0,0), {B}
(0,0,255,128,128,128,128,128,128,128,128,255,0,0), {C}
(0,0,254,129,129,129,129,129,129,129,129,254,0,0), {D}
(0,0,255,128,128,128,254,128,128,128,128,255,0,0), {E}
(0,0,255,128,128,128,254,128,128,128,128,128,0,0), {F}
(0,0,126,129,129,128,128,143,131,131,133,125,0,0), {G}
(0,0,129,129,129,129,255,129,129,129,129,129,0,0), {H}
(0,0,124,16,16,16,16,16,16,16,16,124,0,0), {I}
(0,0,1,1,1,1,1,1,1,129,129,126,0,0), {J}
(0,0,130,132,136,144,224,144,136,132,130,129,0,0), {K}
(0,0,128,128,128,128,128,128,128,128,129,255,0,0), {L}
(0,0,129,195,165,153,153,129,129,129,129,129,0,0), {M}
(0,0,129,193,161,145,137,133,131,129,129,129,0,0), {N}
(0,0,126,129,129,129,129,129,129,129,129,126,0,0), {O}
(0,0,254,129,129,129,254,128,128,128,128,128,0,0), {P}
(0,0,126,129,129,129,129,129,129,133,131,127,0,0), {Q}
(0,0,254,129,129,129,254,144,136,132,130,129,0,0), {R}
(0,0,127,128,128,128,126,1,1,1,1,254,0,0), {S}
(0,0,254,16,16,16,16,16,16,16,16,16,0,0), {T}
(0,0,129,129,129,129,129,129,129,129,129,126,0,0), {U}
(0,0,129,129,66,66,36,36,36,24,24,24,0,0), {V}
(0,0,129,129,129,129,129,129,153,153,165,66,0,0), {W}
(0,0,129,66,36,36,24,24,36,36,66,129,0,0), {X}
(0,0,130,68,68,40,16,16,16,16,16,16,0,0), {Y}
(0,0,255,2,4,4,8,16,32,32,64,255,0,0), {Z}
(0,0,0,0,0,0,0,0,0,0,0,0,0,0), {SPACE}
(0,0,24,24,24,0,0,0,0,0,0,0,0,0) {'}
);
procedure putChar(var px, py: integer; ch: char; color: byte);
var x, y: integer;
begin
for x := 0 to 7 do
for y := 1 to 14 do begin
if(bits[pos(ch, st)][y] shr x) and $01 > 0
then putpixel(px + (7 - x), py + y, 14);
end;
inc(px, 10);
end;
procedure PrintString( px, py: integer; s: string; color: byte);
var i: integer;
begin
for i := 1 to length(s) do
putChar(px, py, s[i],color);
end;
procedure DrawSpiral(color:byte);
var t,r:real;
x,y:integer;
const r0: real = 0.5;
r1: real = 0.15;
x0: integer = 160;
y0: integer = 100;
begin
t:=0;
while t<=11*pi do
begin
r:=r0*exp(r1*t);
x:=x0+round(r*cos(t));
y:=y0+round(r*sin(t));
PutPixel(x,y,color);
t:=t+0.001;
end;
end;
const figureName:string = 'BERNULLI''S SPIRAL';
begin
asm
mov ax,13h
int 10h
end;
DrawSpiral(10);
st:='ABCDEFGHIJKLMNOPQRSTUVWXYZ ''';
PrintString(70,25,figureName,13);
ReadLn;
end.
Результат:
Как-то так. А теперь список всего, что было необходимо, и что получилось в итоге:
1. Методичка по компьютерной графике - Скачать [.RAR / 66,5 МБ]
2. Задания к лабораторным - Скачать [.JPG / 1,89 МБ]
3. Дистрибутив Turbo Pascal 7 - Скачать
Все вопросы - в камменты.
Постов: 1
Комментарий #1 от : Fri April 13, 2012, 22:31:23