Программа для отображения вращающиеся спирали на экране с разрешением 320x200x256 MCGA. Архимедова спираль — спираль, плоская кривая, траектория точки M, которая равномерно движется вдоль некоторого луча с началом в O, в то время как сам луч равномерно вращается вокруг O. Другими словами, расстояние ρ = OM пропорционально углу поворота φ луча. Повороту луча на один и тот же угол соответствует одно и то же приращение ρ. Уравнение Архимедовой спирали в полярной системе координат записывается так: Program Spiral; {$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V-,X+,Y+} Uses Crt,dos; Type RGB = Array[1..3] of Byte; TPalette = Array[0..255] of RGB; const MaxX = 319; { Размеры экрана } MaxY = 199; MidX = MaxX div 2; MidY = MaxY div 2; var MyPal, InitPal: TPalette; TimesRun: LongInt; i, j: registers; Time: Longint Absolute $0000:$046c; StartTime, EndTime: Longint; { Ожидает VGAшную вертикальную ретрасировку. } procedure WaitVRetrace; Assembler; Asm mov dx, 3DAh @@1: in al, dx and al, 08h jnz @@1 @@2: in al, dx and al, 08h jz @@2 end; { Определяет окончательную палитру. } procedure SetPal(var Palet: TPalette); Assembler; Asm call WaitVRetrace push ds lds si, Palet mov dx, 3c8h mov al, 0 out dx, al inc dx mov cx, 768 rep outsb pop ds end; { Переключает экран на режим 320x200x256 MCGA} procedure SetMCGAMode; var Palet: TPalette; begin Asm mov ax, 0013h int 10h end; FillChar(Palet, 768, 0); { Полагает все цвета палитры черными. } SetPal(Palet); end; { Переключает экран на текстовый режим } procedure SetTextMode; Assembler; Asm mov ax, $0003 int 10h end; { Ставит пиксель в режиме 320x200x256. } procedure PutPixel(x, y: Word; Color: Byte); Assembler; Asm mov ax, y mov bx, x xchg ah, al add bx, ax shr ax, 2 add bx, ax mov ax, $A000 mov es, ax mov al, Color mov es:[bx], al end; { Циклически обрабатывает все цвета в палитре. } procedure CyclePalettes; var ColMin: RGB; i, j, k: registers; begin ColMin := MyPal[1]; for i.ax := 1 to 254 do MyPal[i.ax] := MyPal[i.ax+1]; MyPal[255] := ColMin; ColMin := InitPal[1]; for i.ax := 1 to 254 do InitPal[i.ax] := InitPal[i.ax+1]; InitPal[255] := ColMin; SetPal(MyPal); end; { Рисует спираль на экране. } procedure DrawSpiral(Phi0: Double; Colour: Byte); var x, y, i: registers; Phase1, Phase2: Double; begin Phase1 := Phi0; Phase2 := 0; for i.ax := 0 to 1850 do begin x.cx := MidX + round(Phase2*sin(Phase1)); y.dx := MidY + round(Phase2*cos(Phase1)/1.2); if (x.cx >= 0) and (x.cx <= MaxX) and (y.dx >= 0) and (y.dx <= MaxY) then PutPixel(x.cx, y.dx, Colour); Phase1 := Phase1 + 0.0035*Pi; Phase2 := Phase2 + 0.035*Pi; end; end; begin SetMCGAMode; MyPal := Palette; InitPal := Palette; StartTime := Time; for i.ax := 0 to 255 do { Рисует спираль в 255 различных цветах. } DrawSpiral(i.ax*2*Pi/255, i.ax); EndTime := Time; TimesRun := 0; Repeat if (TimesRun < 256) then { Начинает поворот цветов с верху вних. } begin for i.ax := 0 to 255 do for j.ax := 1 to 3 do MyPal[i.ax,j.ax] := round(InitPal[i.ax,j.ax]*TimesRun/255); end; if (TimesRun > 3000-256) then begin for i.ax := 0 to 255 do for j.ax := 1 to 3 do MyPal[i.ax,j.ax] := round(InitPal[i.ax,j.ax]*(3000-TimesRun)/255); end; CyclePalettes; Inc(TimesRun); Until KeyPressed or (TimesRun > 3000); SetTextMode; end.
Ключевые слова:
Архимедова спираль
|
|||||||