Алгоритм и программа для построения графика временной функции

323,325,319,326,327,336,327,328,336,

328,329,336,329,330,336,330,326,336,

326,331,332,326,332,327,327,332,333,

327,333,328,328,333,334,328,334,329,

329,334,335,329,335,330,330,335,331,

330,331,326,331,337,332,332,337,333,

333,337,334,334,337,335,335,337,331,

338,340,339,338,341,340,338,342,341,

338,343,342,338,344,343,338,345,344,

338,346,345,338,347,346,338,348,347,

338,349,348,338,350,349,338,351,350,

338,352,351,338,353,352,338,354,353,

338,339,354,339,356,355,339,340,356,

340,357,356,340,341,357,341,358,357,

341,342,358,342,359,358,342,343,359,

343,360,359,343,344,360,344,361,360,

344,345,361,345,362,361,345,346,362,

346,363,362,346,347,363,347,364,363,

347,348,364,348,365,364,348,349,365,

349,366,365,349,350,366,350,367,366,

350,351,367,351,368,367,351,352,368,

352,369,368,352,353,369,353,370,369,

353,354,370,354,355,370,354,339,355,

355,372,371,355,356,372,356,373,372,

356,357,373,357,374,373,357,358,374,

358,375,374,358,359,375,359,376,375,

359,360,376,360,377,376,360,361,377,

361,378,377,361,362,378,362,379,378,

362,363,379,363,380,379,363,364,380,

364,381,380,364,365,381,365,382,381,

365,366,382,366,383,382,366,367,383,

367,384,383,367,368,384,368,385,384,

368,369,385,369,386,385,369,370,386,

370,371,386,370,355,371,371,388,387,

371,372,388,372,389,388,372,373,389,

373,390,389,373,374,390,374,391,390,

374,375,391,375,392,391,375,376,392,

376,393,392,376,377,393,377,394,393,

377,378,394,378,395,394,378,379,395,

379,396,395,379,380,396,380,397,396,

380,381,397,381,398,397,381,382,398,

382,399,398,382,383,399,383,400,399,

383,384,400,384,401,400,384,385,401,

385,402,401,385,386,402,386,387,402,

386,371,387,387,404,403,387,388,404,

388,405,404,388,389,405,389,406,405,

389,390,406,390,407,406,390,391,407,

391,408,407,391,392,408,392,409,408,

392,393,409,393,410,409,393,394,410,

394,411,410,394,395,411,395,412,411,

395,396,412,396,413,412,396,397,413,

397,414,413,397,398,414,398,415,414,

398,399,415,399,416,415,399,400,416,

400,417,416,400,401,417,401,418,417,

401,402,418,402,403,418,402,387,403,

403,420,419,403,404,420,404,421,420,

404,405,421,405,422,421,405,406,422,

406,423,422,406,407,423,407,424,423,

407,408,424,408,425,424,408,409,425,

409,426,425,409,410,426,410,427,426,

410,411,427,411,428,427,411,412,428,

412,429,428,412,413,429,413,430,429,

413,414,430,414,431,430,414,415,431,

415,432,431,415,416,432,416,433,432,

416,417,433,417,434,433,417,418,434,

418,419,434,418,403,419,419,436,435,

419,420,436,420,437,436,420,421,437,

421,438,437,421,422,438,422,439,438,

422,423,439,423,440,439,423,424,440,

424,441,440,424,425,441,425,442,441,

425,426,442,426,443,442,426,427,443,

427,444,443,427,428,444,428,445,444,

428,429,445,429,446,445,429,430,446,

430,447,446,430,431,447,431,448,447,

431,432,448,432,449,448,432,433,449,

433,450,449,433,434,450,434,435,450,

434,419,435,451,449,450,451,448,449,

451,447,448,451,446,447,451,445,446,

451,444,445,451,443,444,451,442,443,

451,441,442,451,440,441,451,439,440,

451,438,439,451,437,438,451,436,437,

451,435,436,451,450,435,452,453,484,

453,454,484,454,455,484,455,456,484,

456,457,484,457,458,484,458,459,484,

459,460,484,460,461,484,461,462,484,

462,463,484,463,464,484,464,465,484,

465,466,484,466,467,484,467,452,484,

452,468,469,452,469,453,453,469,470,

453,470,454,454,470,471,454,471,455,

455,471,472,455,472,456,456,472,473,

456,473,457,457,473,474,457,474,458,

458,474,475,458,475,459,459,475,476,

459,476,460,460,476,477,460,477,461,

461,477,478,461,478,462,462,478,479,

462,479,463,463,479,480,463,480,464,

464,480,481,464,481,465,465,481,482,

465,482,466,466,482,483,466,483,467,

467,483,468,467,468,452,468,485,469,

469,485,470,470,485,471,471,485,472,

472,485,473,473,485,474,474,485,475,

475,485,476,476,485,477,477,485,478,

478,485,479,479,485,480,480,485,481,

481,485,482,482,485,483,483,485,468,

486,487,488,486,488,489,486,489,490,

486,490,491,486,491,492,486,492,493,

486,493,494,486,494,487,487,495,496,

487,496,488,488,496,497,488,497,489,

489,497,498,489,498,490,490,498,499,

490,499,491,491,499,500,491,500,492,

492,500,501,492,501,493,493,501,502,

493,502,494,494,502,495,494,495,487,

495,503,504,495,504,496,496,504,505,

496,505,497,497,505,506,497,506,498,

498,506,507,498,507,499,499,507,508,

499,508,500,500,508,509,500,509,501,

501,509,510,501,510,502,502,510,503,

502,503,495,511,510,509,511,509,508,

511,508,507,511,507,506,511,506,505,

511,505,504,511,504,503,511,503,510,

512,514,513,512,515,514,512,516,515,

512,517,516,512,518,517,512,513,518,

513,520,519,513,514,520,514,521,520,

514,515,521,515,522,521,515,516,522,

516,523,522,516,517,523,517,524,523,

517,518,524,518,519,524,518,513,519,

525,523,524,525,522,523,525,521,522,

525,520,521,525,519,520,525,524,519,

526,527,528,526,528,529,526,529,530,

526,530,531,526,531,532,526,532,533,

526,533,534,526,534,527,527,535,536,

527,536,528,528,536,537,528,537,529,

529,537,538,529,538,530,530,538,539,

530,539,531,531,539,540,531,540,532,

532,540,541,532,541,533,533,541,542,

533,542,534,534,542,535,534,535,527,

535,543,544,535,544,536,536,544,545,

536,545,537,537,545,546,537,546,538,

538,546,547,538,547,539,539,547,548,

539,548,540,540,548,549,540,549,541,

541,549,550,541,550,542,542,550,543,

542,543,535,551,550,549,551,549,548,

551,548,547,551,547,546,551,546,545,

551,545,544,551,544,543,551,543,550,

552,554,553,552,555,554,552,556,555,

552,557,556,552,558,557,552,553,558,

553,560,559,553,554,560,554,561,560,

554,555,561,555,562,561,555,556,562,

556,563,562,556,557,563,557,564,563,

557,558,564,558,559,564,558,553,559,

565,563,564,565,562,563,565,561,562,

565,560,561,565,559,560,565,564,559,

566,570,582,570,571,583,577,571,584,

571,572,585,578,572,586,572,567,587,

566,568,588,570,579,589,571,580,590,

571,579,591,572,575,592,572,580,593,

580,576,594,576,581,595,575,574,596,

575,581,597,581,573,598,582,570,569,

583,571,577,570,583,577,584,571,578,

577,584,578,585,572,578,571,585,578,

586,572,574,578,586,574,587,567,574,

572,587,574,588,568,570,566,588,570,

589,579,571,570,589,571,590,580,572,

571,590,572,591,579,580,571,591,580,

592,575,567,572,592,567,593,580,575,

572,593,575,594,576,575,580,594,575,

595,581,575,576,595,575,596,574,567,

575,596,567,597,581,574,575,597,574,

598,573,574,581,598,574,599,606,600,

599,605,606,600,607,601,600,606,607,

601,608,602,601,607,608,602,609,603,

602,608,609,603,610,604,603,609,610,

604,605,599,604,610,605,600,612,599,

601,612,600,602,612,601,603,612,602,

604,612,603,599,612,604,605,611,606,

606,611,607,607,611,608,608,611,609,

609,611,610,610,611,605,613,615,614,

613,616,615,613,617,616,613,618,617,

613,619,618,613,620,619,613,621,620,

613,614,621,614,623,622,614,615,623,

615,624,623,615,616,624,616,625,624,

616,617,625,617,626,625,617,618,626,

618,627,626,618,619,627,619,628,627,

619,620,628,620,629,628,620,621,629,

621,622,629,621,614,622,622,631,630,

622,623,631,623,632,631,623,624,632,

624,633,632,624,625,633,625,634,633,

625,626,634,626,635,634,626,627,635,

627,636,635,627,628,636,628,637,636,

628,629,637,629,630,637,629,622,630,

638,636,637,638,635,636,638,634,635,

638,633,634,638,632,633,638,631,632,

638,630,631,638,637,630,639,646,640,

639,645,646,640,647,641,640,646,647,

641,648,642,641,647,648,642,649,643,

642,648,649,643,650,644,643,649,650,

644,645,639,644,650,645,640,652,639,

641,652,640,642,652,641,643,652,642,

644,652,643,639,652,644,645,651,646,

646,651,647,647,651,648,648,651,649,

649,651,650,650,651,645,664,661,669,

655,656,660,655,660,653,654,656,657,

657,658,659,657,659,654,653,658,655,

655,658,657,655,657,656,659,653,665,

653,659,658,654,660,656,664,669,653,

659,661,662,659,662,654,659,665,661,

663,654,667,663,667,661,660,654,663,

660,663,661,660,661,664,660,664,653,

662,661,666,662,666,654,666,661,667,

666,667,654,665,653,668,665,668,661,

668,653,669,668,669,661,670,677,671,

670,676,677,671,678,672,671,677,678,

672,679,673,672,678,679,673,680,674,

673,679,680,674,681,675,674,680,681,

675,676,670,675,681,676,671,683,670,

672,683,671,673,683,672,674,683,673,

675,683,674,670,683,675,676,682,677,

677,682,678,678,682,679,679,682,680,

680,682,681,681,682,676,684,691,685,

684,690,691,685,692,686,685,691,692,

686,693,687,686,692,693,687,694,688,

687,693,694,688,695,689,688,694,695,

689,690,684,689,695,690,685,697,684,

686,697,685,687,697,686,688,697,687,

689,697,688,684,697,689,690,696,691,

691,696,692,692,696,693,693,696,694,

694,696,695,695,696,690,698,700,699,

698,701,700,698,702,701,698,703,702,

698,704,703,698,705,704,698,706,705,

698,699,706,699,708,707,699,700,708,

700,709,708,700,701,709,701,710,709,

701,702,710,702,711,710,702,703,711,

703,712,711,703,704,712,704,713,712,

704,705,713,705,714,713,705,706,714,

706,707,714,706,699,707,707,716,715,

707,708,716,708,717,716,708,709,717,

709,718,717,709,710,718,710,719,718,

710,711,719,711,720,719,711,712,720,

712,721,720,712,713,721,713,722,721,

713,714,722,714,715,722,714,707,715,

723,721,722,723,720,721,723,719,720,

723,718,719,723,717,718,723,716,717,

723,715,716,723,722,715,735,732,740,

726,727,731,726,731,724,725,727,728,

728,729,730,728,730,725,724,729,726,

726,729,728,726,728,727,730,724,736,

724,730,729,725,731,727,735,740,724,

730,732,733,730,733,725,730,736,732,

734,725,738,734,738,732,731,725,734,

731,734,732,731,732,735,731,735,724,

733,732,737,733,737,725,737,732,738,

737,738,725,736,724,739,736,739,732,

739,724,740,739,740,732

);

color: array [0..numfaces3-1] of byte =(

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

0,0,0,0,0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,3,3,3,

3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,

1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,3,3,3,3,3,3,3,3,3,

3,3,3,3,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2);

TYPE

Virtualscreen = Array [1..64000] of byte;

Virscr = ^VirtualScreen;

var

scr2: virscr;

buf: word;

Time: longint;

Timer: Longint ABSOLUTE $0040:$006C;

xscreen1, xscreen2, yscreen1, yscreen2:integer;

Procedure WaitVR; Assembler;

ASM

mov dx, 3DAh

@w1:in al, dx

test al, 8

jnz @w1

@w2:

in al, dx

test al, 8

jz @w2

End;

function SGN (i:single):single;

begin

if i<0 then sgn:=0;

end;

Procedure FlipScreen (source, dest: word);

Assembler; {386 only}

asm

mov dx, ds

mov ax, [dest]

mov es, ax

mov ax, [source]

mov ds, ax

xor si, si

xor di, di

mov cx, 16000

db $66

rep movsw

mov ds, dx {mov's are faster than push / pops}

end;

Procedure Clear (Col: Byte; where:word);

Assembler;

asm

mov cx, 16000;

mov ax, where

mov es, ax

xor di, di

mov al, [col]

mov ah, al

rep stosw

END;

PROCEDURE DrawLineH (X1, X2, Y1:integer; C: Byte; where:word);

var temp:integer;

BEGIN

if x1>x2 then begin {sort}

temp:=x2;

x2:=x1;

x1:=temp;

end;

if (y1<yscreen1) or (y1>yscreen2) then exit;

if (x2<xscreen1) or (x1>xscreen2) then exit;

if x1<xscreen1 then x1:=xscreen1;

if x1>xscreen2 then x1:=xscreen2;

if x2<xscreen1 then x2:=xscreen1;

if x2>xscreen2 then x2:=xscreen2;

ASM

mov ax, where

mov es, ax

mov ax, y1

mov di, ax

shl di, 1

shl di, 1

add di, ax

mov cl, 6

shl di, cl

mov bx, x1

mov dx, x2

{cmp bx, dx

jl @1

xchg bx, dx}

@1: inc dx

add di, bx

mov cx, dx

sub cx, bx

shr cx, 1

mov al, c

mov ah, al

ror bx, 1

jnb @2

stosb

ror dx, 1

jnb @3

dec cx

@3: rol dx, 1

@2: rep

stosw

ror dx, 1

jnb @4

stosb

@4: END;

END;

procedure setonecolor (c, r, g, b:byte); assembler;

asm

mov dx, 3c8h

mov al, c

out dx, al

inc dx

mov al, r

out dx, al

mov al, g

out dx, al

mov al, b

out dx, al

end;

PROCEDURE SetPixel (X, Y: Word; C: Byte; where:word);

BEGIN

ASM

mov ax, where

mov es, ax

mov bx, x

mov dx, y

xchg dh, dl

mov al, c

mov di, dx

shr di, 1

shr di, 1

add di, dx

add di, bx

stosb

END;

END;

procedure VBriz (value, where:word); assembler;

asm

mov bx, [value]

mov es, where

xor di, di

mov dx, 199

mov si, bx

mov bx, 0

@mainloop:

mov cx, 160

@inerloop:

mov al, es: [di+bx]

mov es: [di], al

inc di

inc di

loop @inerloop

xchg bx, si

dec dx

jnz @mainloop

end;

procedure triangle2 (xx1, yy1, xx2, yy2, xx3, yy3, c:integer; where:word);

var

ay, by, cy, ax, bx, cx, sy, x1, x2, temp:integer;

begin

if (yy1>yy2) and (yy1>yy3) then begin

cx:=xx1; cy:=yy1;

if yy2>yy3 then begin bx:=xx2; by:=yy2; ax:=xx3; ay:=yy3; end;

if yy2<yy3 then begin bx:=xx3; by:=yy3; ax:=xx2; ay:=yy2; end;

end;

if (yy2>yy1) and (yy2>yy3) then begin

cx:=xx2; cy:=yy2;

if yy1>yy3 then begin bx:=xx1; by:=yy1; ax:=xx3; ay:=yy3; end;

if yy1<yy3 then begin bx:=xx3; by:=yy3; ax:=xx1; ay:=yy1; end;

end;

if (yy3>yy1) and (yy3>yy2) then begin

cx:=xx3; cy:=yy3;

if yy1>yy2 then begin bx:=xx1; by:=yy1; ax:=xx2; ay:=yy2; end;

if yy1<yy2 then begin bx:=xx2; by:=yy2; ax:=xx1; ay:=yy1; end;

end;

if (yy1=yy2) and (yy2>yy3) then begin ax:=xx3; ay:=yy3; bx:=xx1; by:=yy1; cx:=xx2; cy:=yy2; end;

if (yy1=yy2) and (yy2<yy3) then begin ax:=xx2; ay:=yy2; bx:=xx1; by:=yy1; cx:=xx3; cy:=yy3; end;

if (yy3=yy2) and (yy2>yy1) then begin ax:=xx1; ay:=yy1; bx:=xx3; by:=yy3; cx:=xx2; cy:=yy2; end;

if (yy3=yy2) and (yy2<yy1) then begin ax:=xx2; ay:=yy2; bx:=xx3; by:=yy3; cx:=xx1; cy:=yy1; end;

if (yy3=yy1) and (yy1>yy2) then begin ax:=xx2; ay:=yy2; bx:=xx1; by:=yy1; cx:=xx3; cy:=yy3; end;

if (yy3=yy1) and (yy1<yy2) then begin ax:=xx1; ay:=yy1; bx:=xx3; by:=yy3; cx:=xx2; cy:=yy2; end;

for SY:=AY to CY-1 do begin

if sy>196 then exit;

X1:= AX + (SY - AY) * (CX - AX) div (CY - AY);

if (SY < BY) then X2:= AX + (SY - AY) * (BX - AX) div (BY - AY)

else begin

if (CY = BY) then X2:= BX else

X2:= BX + (SY - BY) * (CX - BX) div (CY - BY);

end;

if x1>x2 then begin {sort}

temp:=x2;

x2:=x1;

x1:=temp;

end;

if (x2>0) and (x1<319) and (sy>0) and (sy<199) then begin

if x1<0 then x1:=0;

if x2>319 then x2:=319;

drawlineh (x1+1, x2, sy, trunc(c), where);

end;

end;

end;

{=========================3D routines =====================================}

type

list = array [0..numFaces3] of integer;

Pind_P = array [0..numFaces3] of integer;

CubeD_P = array [0..numVertex3*3-1] of integer;

Light_P = array [0..numFaces3] of byte;

var

MediumZ: ^list;

Pind:^Pind_P;

CubeD:^CubeD_P;

Light:^Light_P;

p, xx, yy:integer;

pom, q3, q, nx, ny, nz, xt, yt, zt, Xr, Yr, Zr, per, scale:single;

Cosxan, Sinxan, Cosyan, Sinyan, Coszan, Sinzan:single;

function rad (i:single):single;

begin

rad:=i*0.00872664625;

end;

procedure quicksort (var a: list; Lo, Hi: integer);

procedure sort (l, r: integer);

var

i, j, x, y: integer;

begin

i:=l; j:=r; x:=a[(l+r) DIV 2];

repeat

while a[i]<x do i:=i+1;

while x<a[j] do j:=j-1;

if i<=j then

begin

y:=a[i]; a[i]:=a[j]; a[j]:=y;

Y:=Pind^[I]; Pind^[I]:= Pind^[J]; Pind^[J]:=Y;

i:=i+1; j:=j-1;

end;

until i>j;

if l<j then sort (l, j);

if i<r then sort (i, r);

end;

begin {quicksort};

sort (Lo, Hi);

end;

var nxl, nyl, nzl:single;

procedure SetLightSource (xx, yy, zz:single);

var x, y, z, X1, Y1, Z1:single;

begin

CosXan:=cos(Xr); SinXan:=sin(Xr);

CosYan:=cos(Yr); SinYan:=sin(Yr);

CosZan:=cos(Zr); SinZan:=sin(Zr);

x:=xx; y:=yy; z:=zz;

x1:=cosyan*x-sinyan*z;

z1:=sinyan*x+cosyan*z;

x:=coszan*x1+sinzan*y;

y1:=coszan*y-sinzan*x1;

z:=cosxan*z1-sinxan*y1;

y:=sinxan*z1+cosxan*y1;

nxl:=x;

nyl:=y;

nzl:=z;

end;

procedure draw (where:word);

var

ax, ay, az, bx, by, bz, nx, ny, nz:single;

CountPol, lightCall, col, p:integer;

begin

FillChar (pind^, sizeOF (pind^), 0);

CountPol:=0;

for p:=0 to numFaces3-1 do begin

ax:=cubeD^[pindex3 [p*3+2]*3] - cubeD^[pindex3 [p*3]*3];

ay:=cubeD^[pindex3 [p*3+2]*3+1] - cubeD^[pindex3 [p*3]*3+1];

az:=cubeD^[pindex3 [p*3+2]*3+2] - cubeD^[pindex3 [p*3]*3+2];

bx:=cubeD^[pindex3 [p*3+1]*3] - cubeD^[pindex3 [p*3]*3];

by:=cubeD^[pindex3 [p*3+1]*3+1] - cubeD^[pindex3 [p*3]*3+1];

bz:=cubeD^[pindex3 [p*3+1]*3+2] - cubeD^[pindex3 [p*3]*3+2];

nx:=ay*bz-az*by;

ny:=az*bx-ax*bz;

nz:=ax*by-ay*bx;

pom:=nz*q3+nx*ax+ny*ay+nz*az;

if pom>0 then begin MediumZ^[CountPol]:=trunc((cubeD^[pindex3 [p*3]*3+2]+cubeD^[pindex3 [p*3+1]*3+2]+

cubeD^[pindex3 [p*3+2]*3+2])) div 3;

Pind^[CountPol]:=p; lightCall:=(round(((nx*nxl+ny*nyl+nz*nzl)*q3)/(sqrt (nx*nx+ny*ny+nz*nz)*q)*40));

if lightCall<0 then light^[p]:=0 else light^[p]:=lightCall;

inc(CountPol);

end;

end;

QuickSort (MediumZ^, 0, CountPol);

For p:=0 to CountPol do begin

col:=light^[pind^[p]]+color [pind^[p]]*64+1;

triangle2 (round(cubeD^[pindex3 [pind^[p]*3]*3])+xx,

round (cubeD^[pindex3 [pind^[p]*3]*3+1])+yy,

round (cubeD^[pindex3 [pind^[p]*3+1]*3])+xx,

round (cubeD^[pindex3 [pind^[p]*3+1]*3+1])+yy,

round (cubeD^[pindex3 [pind^[p]*3+2]*3])+xx,

round (cubeD^[pindex3 [pind^[p]*3+2]*3+1])+yy,

col, where);

end;

end;

procedure rotate2 (fromV, toV:integer; xx, yy, zz:single);

var x, y, z, X1, Y1, Z1:single; p:integer;

begin

for p:=fromV to toV do begin

x:=cube3 [p*3]+xx;

y:=cube3 [p*3+1]+yy;

z:=cube3 [p*3+2]+zz;

x1:=cosyan*x-sinyan*z;

z1:=sinyan*x+cosyan*z;

x:=coszan*x1+sinzan*y;

y1:=coszan*y-sinzan*x1;

z:=cosxan*z1-sinxan*y1;

y:=sinxan*z1+cosxan*y1;

CubeD^[p*3]:=trunc (x*per/(z-per)*scale);

CubeD^[p*3+1]:=trunc (y*per/(z-per)*scale);

CubeD^[p*3+2]:=trunc (z*scale);

end;

end;

type

rrr = array [0..64000] of byte;

var

bufer:^rrr;

qq, amp1, amp2, amp3, xs, ys, speed, xrs, yrs, zrs:single;

textura, n:word;

Aantal, T1: longint;

texture:pointer;

x, y, d, x1, x2, sinum, col, col1, col2, r, g, b:integer;

begin

Release(HeapOrg);

xscreen1:=0;

xscreen2:=319;

yscreen1:=0;

yscreen2:=199;

new(bufer);

new(MediumZ);

new(Pind);

new(CubeD);

new(Light);

q3:=-4;

q:=6;

asm

mov ax, 13h

int 10h

end;

Clear (0, vga);

buf:=seg (bufer^)+ofs (bufer^);

setonecolor (0,0,0,0);

for r:=1 to 63 do setonecolor (r, trunc (r/1.1)+10, trunc (r/1.1)+10, trunc (r/1.1)+10);

setonecolor (64, r, r, r);

for r:=1 to 63 do setonecolor (r+64,10, r, r); setonecolor (64+64,10, r, r);

for r:=1 to 63 do setonecolor (r+128, r, 10,10); setonecolor (64+128, r, 10,10);

for r:=1 to 63 do setonecolor (r+191,10,10, r); setonecolor (64+191,10,10, r);

setonecolor (255,10,5,0);

Speed:=8;

Aantal:=0; T1:=Timer;

repeat

Clear (0, buf);

qq:=qq+0.02;

scale:=1;

per:=3000;

scale:=sin (qq+2)*0.02+0.15;

r:=trunc (-cos(qq/5)*50)+50;

for y:=0 to r do drawlineh (0,319, y, 200+trunc((r-y)/2), buf);

for y:=r to 199 do drawlineh (0,319, y, 255, buf);

xr:=rad (cos(qq)*360);

yr:=rad (sin(qq/2)*360);

zr:=rad (cos(qq+2)*360);

SetLightSource (1,1,1);

xx:=trunc (nxl*50+160); yy:=trunc (nyl*50+100);

if (xx>0) and (xx<319) and (yy>0) and (yy<199) then begin

SetPixel (xx+1, yy, 40, buf);

SetPixel (xx-1, yy, 40, buf);

SetPixel (xx, yy+1,40, buf);

SetPixel (xx, yy - 1,40, buf);

SetPixel (xx, yy, 60, buf);

end;

xx:=160;

yy:=100+trunc (abs(sin (qq*speed)*5));

xr:=rad (-cos(qq/5)*80+90);

yr:=rad(0);

zr:=rad (cos(qq/2)*150);

CosXan:=cos(Xr); SinXan:=sin(Xr);

CosYan:=cos(Yr); SinYan:=sin(Yr);

CosZan:=cos(Zr); SinZan:=sin(Zr);

rotate2 (0, numVertex3-1,0,0,0);

{====================Foot 1=========================}

xrs:=xr; yrs:=yr; zrs:=zr;

CosXan:=cos(Xr); SinXan:=sin(Xr);

CosYan:=cos(Yr); SinYan:=sin(Yr);

CosZan:=cos(Zr); SinZan:=sin(Zr);

xr:=cos (qq*speed)*0.7+2; zr:=xr*1.2-1.6; yr:=-xr*2+2;

rotate2 (599,604, 0, yr*100, zr*100);

rotate2 (612,638, 0, yr*100, zr*100);

xr:=xrs; yr:=yrs; zr:=zrs;

CosXan:=cos(Xr); SinXan:=sin(Xr);

CosYan:=cos(Yr); SinYan:=sin(Yr);

CosZan:=cos(Zr); SinZan:=sin(Zr);

xr:=cos (qq*speed)*0.7+2; zr:=xr*1.2-1.6; yr:=-xr*2+2;

rotate2 (pindex3 [1157*3], pindex3 [1210*3+1], 0, yr*100, zr*100);

{====================Foot 2=========================}

xr:=xrs; yr:=yrs; zr:=zrs;

CosXan:=cos(Xr); SinXan:=sin(Xr);

CosYan:=cos(Yr); SinYan:=sin(Yr);

CosZan:=cos(Zr); SinZan:=sin(Zr);

xr:=-cos (qq*speed)*0.7+2; zr:=xr*1.2-1.6; yr:=-xr*2+2;

rotate2 (684,689, 0, yr*100, zr*100);

rotate2 (697,723, 0, yr*100, zr*100);

xr:=xrs; yr:=yrs; zr:=zrs;

CosXan:=cos(Xr); SinXan:=sin(Xr);

CosYan:=cos(Yr); SinYan:=sin(Yr);

CosZan:=cos(Zr); SinZan:=sin(Zr);

xr:=-cos (qq*speed)*0.7+2; zr:=xr*1.2-1.6; yr:=-xr*2+2;

rotate2 (pindex3 [1307*3], pindex3 [1336*3+1], 0, yr*100, zr*100);

rotate2 (pindex3 [1211*3], pindex3 [1234*3+1], 0, yr*100, zr*100);

rotate2 (724,740, 0, yr*100, zr*100);

rotate2 (683,683, 0, yr*100, zr*100);

{================================================================}

draw(buf);

Vbriz (2, buf);

WaitVR;

FlipScreen (buf, VGA);

Inc(Aantal);

until keypressed;

asm

mov ah, 0

mov al, 3

int 10h

end;

T1:=timer-T1;

WriteLn (Aantal/(T1/18.2):2:1,' Frames per second');

WriteLn ('Coded by BiTL, 1999');

end;

{$I zagryzka.pas}

{This program demonstrates the Rotate02 Unit - EUROPA Software 1989}

procedure driverot;

var i, j, rxp, ryp, txp, typ: integer;

rx, ry, hrx, hry, tx, ty, htx, hty: coord_vals;

procedure rotate_rectangle (angle: integer);

var i: integer;

begin

rx[1]:= 300; {coordinates to define a rectangle}

ry[1]:= 150;

rx[2]:= 500;

ry[2]:= 150;

rx[3]:= 500;

ry[3]:= 260;

rx[4]:= 300;

ry[4]:= 260;

rx[5]:= 300;

ry[5]:= 150;

rx[0]:= 5; {max num of coords is held in the [0] location}

{of the x coordinate array}

rxp:= 400; {sets the center of rotation}

ryp:= 205;

rotate2d (rx, ry, rxp, ryp, angle); {rotate rectangle}

setcolor(0); {erase old image}

for i:= 1 to rx[0] - 1 do line (hrx[i], hry[i], hrx [i+1], hry [i+1]);

setcolor(14); {redraw new rotated image}

for i:= 1 to rx[0] - 1 do line (rx[i], ry[i], rx [i+1], ry [i+1]);

move (rx[1], hrx[1], rx[0]*2); {save a copy of image so we can}

move (ry[1], hry[1], rx[0]*2); {erase it by redrawing in black}

end;

procedure rotate_triangle (angle: integer);

var i: integer;

begin

tx[1]:= 150; {coordinates to define a triangle}

ty[1]:= 100;

tx[2]:= 250;

ty[2]:= 250;

tx[3]:= 50;

ty[3]:= 250;

tx[4]:= 150;

ty[4]:= 100;

tx[0]:= 4;

txp:= 150;

typ:= 175;

rotate2d (tx, ty, txp, typ, angle); {rotate triangle}

setcolor(0);

for i:= 1 to tx[0] - 1 do line (htx[i], hty[i], htx [i+1], hty [i+1]);

setcolor(4);

for i:= 1 to tx[0] - 1 do line (tx[i], ty[i], tx [i+1], ty [i+1]);

move (tx[1], htx[1], tx[0]*2);

move (ty[1], hty[1], tx[0]*2);

end;

begin

j:= 3;

i:= 0;

InitGraph (i, j, «);

setgraphmode(EGAHi);

if GraphResult <> grOk then begin

Writeln ('Graphics init error: ', GraphErrorMsg(i));

Halt(1);

end;

outtextxy (250, 20, 'ZAGRYZKA');

outtextxy (200, 330, 'XOTITE DALEU ZMI ESC ');

j:= 0;

i:= MaxInt; {Get the largest integer allowed on this machine}

repeat

if j < i then inc(j) else j:= 0; {So j won't go out of range}

rotate_triangle (j*6); {Positive Angle = Clockwise Rotation}

rotate_rectangle (-j*3); {Negative Angle = Counter - Clockwise}

delay(600);

until keypressed;

closegraph;

end;

{$I papor.pas}

procedure nahalo;

const NUMIT = 128000;

var a, b, c, d, e, f: array [1..4] of real;

(*********************************)

procedure Load_Arrays;

begin

a[1]:=0; b[1]:=0; c[1]:=0; d[1]:= 0.16; e[1]:=0; f[1]:=0; {p[1]:=0.01;}

a[2]:=0.85; b[2]:=0.04; c[2]:=-0.04; d[2]:=0.85; e[2]:=0; f[2]:=1.6; {p[2]:=0.85;}

a[3]:=0.20; b[3]:=-0.26; c[3]:=0.23; d[3]:=0.22; e[3]:=0; f[3]:=1.6; {p[3]:=0.07;}

a[4]:=-0.15; b[4]:=0.28; c[4]:=0.26; d[4]:=0.24; e[4]:=0; f[4]:=0.44; {p[4]:=0.07;}

end;

(*********************************)

procedure prepit;

var driver, mode: integer;

begin

driver:= DETECT;

initgraph (driver, mode, «);

end;

(*********************************)

procedure chaos;

var currit, rndnum: longint;

x, y, plotx, ploty: real;

pick: integer;

begin

x:=0; y:=0;

randomize;

for currit:= 1 to NUMIT do

begin

pick:= random(101) - 84;

if (pick <= 0) then rndnum:=2

else if (pick<=7) then rndnum:=3

else if (pick<=15) then rndnum:=4

else rndnum:=1;

plotx:= ((a[rndnum]*x + b[rndnum]*y + e[rndnum]));

ploty:= ((c[rndnum]*x + d[rndnum]*y + f[rndnum]));

x:= plotx;

y:= ploty;

putpixel (round(plotx*100)+320, round (ploty*100), BLUE);

end;

end;

(*********************************)

begin

prepit;

Load_Arrays;

Chaos;

sound(100); sound(1000);

delay(60000);

nosound;

readln;

CloseGraph;

end;

3. Результат расчета

3.1 Распечатка исходных величин

Начальное приближение корня нелинейного уравнения и заданная точность:

Диапазон [0; 0.8]

e=10^-3

Коэффициенты уравнения:

a₁=2; b₁=-3; c₁=-2;

Время (начальное, конечное, квантования):

tn=0;

tk=17;

tkv=0.75

Коэффициенты временной функции:

p=1.3; g=cos35⁰; c=sin35⁰

Диаграмма методов

Список использованной литературы

бисекция итерация горнер программа

Л.А. Тарасевич. Конспект.

Л.М. Климова. PASCAL 7.0 Практическое программирование. Решение типовых задач.

С.А. Немнюгин. TURBO PASCAL учебник.

А.Н. Вальвачев, В.С. Крисевич. Программирование на языке ПАСКАЛЬ для персональных ЭВМ ЕС.

Размещено на Allbest.ru