Развевающийся флаг
Hужна пpогpамма на ассемблеpе, котоpая бы выводила колышущийся флаг (типа застаки DOS NAVIGATORA).
program sinmap; { Source by Bas van Gaalen, Holland, PD } uses crt; const gseg : word = $a000; spd = 2; size = 3; curve = 125; xmax = 150 div size; ymax = 100 div size; sofs = 50; samp = 10; slen = 255; var stab : array[0..slen] of word; procedure csin; var i : byte; begin for I := 0 to slen do stab[i] := round(sin(i*4*pi/slen)*samp)+sofs; end; procedure displaymap; type scrarray = array[0..xmax,0..ymax] of byte; var postab : array[0..xmax,0..ymax] of word; bitmap : scrarray; x,y,xp,yp,sidx : word; begin fillchar(bitmap,sizeof(bitmap),0); sidx := 0; for x := 0 to xmax do for y := 0 to (ymax div 3) do bitmap[x,y] := lightred; for x := 0 to xmax do for y := (ymax div 3) to 2*(ymax div 3) do bitmap[x,y] := white; for x := 0 to xmax do for y := 2*(ymax div 3) to ymax do bitmap[x,y] := lightblue; repeat while (port[$3da] and 8) <> 0 do; while (port[$3da] and 8) = 0 do; for x := 0 to xmax do for y := ymax downto 0 do begin mem[gseg:postab[x,y]] := 0; xp := size*x+stab[(sidx+curve*x+curve*y) mod slen]; yp := size*y+stab[(sidx+4*x+curve*y+y) mod slen]; postab[x,y] := xp+yp*320; mem[gseg:postab[x,y]] := bitmap[x,y]; end; sidx := (sidx+spd) mod slen; until keypressed; end; begin csin; asm mov ax,13h; int 10h; end; displaymap; textmode(lastmode); end. 0/ === Cut === 0\ === Cut === Program Flag2; {$Q-,R-}{If you have any questions please send me mail at OleRom@hotmail.com} {3d wavig flag} {--------------------------------} { Copyright by Bostjan Gabrovsek } {--------------------------------} Program Rulz; Const SloFake : Array[1..17,1..50] of Byte = ( (2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,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), (2,2,2,2,2,2,2,2,3,1,1,1,1,1,1,1,2,2,3,3,3,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), (2,2,2,2,2,2,2,2,3,1,1,1,1,1,1,2,2,2,2,1,2,3,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), (2,2,2,2,2,2,2,2,3,1,4,4,1,1,2,2,2,2,2,1,2,2,3,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), (2,2,2,2,2,2,2,2,3,1,4,4,1,1,1,2,2,2,2,2,1,2,2,3,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), (2,2,2,2,2,2,2,3,1,1,1,1,1,1,1,2,2,2,2,2,1,2,2,3,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), (2,2,2,2,2,2,2,3,1,1,1,1,1,1,2,2,2,2,2,1,2,2,1,2,3,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), (2,2,2,2,2,2,2,3,1,4,4,1,1,2,2,2,2,2,2,1,2,2,1,2,2,3,1,1,1,1,1,1,1,3,3,3,3,3,3, 3,3,3,3,3,3,3,3,3,3,3), (2,2,2,2,2,2,2,3,1,4,4,1,1,2,2,2,2,2,2,2,1,2,2,1,2,3,1,1,1,1,1,1,1,3,3,3,3,3,3, 3,3,3,3,3,3,3,3,3,3,3), (2,2,2,2,2,2,2,3,1,1,1,1,1,1,2,2,2,2,2,2,1,2,2,1,3,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), (2,2,2,2,2,2,2,3,1,1,1,1,1,1,1,2,2,2,2,1,2,2,1,3,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), (2,2,2,2,2,2,2,2,3,1,4,4,1,1,1,2,2,2,2,1,2,2,1,3,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), (2,2,2,2,2,2,2,2,3,1,4,4,1,1,2,2,2,2,2,2,1,1,3,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), (2,2,2,2,2,2,2,2,3,1,1,1,1,1,1,2,2,2,2,2,1,3,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), (2,2,2,2,2,2,2,2,3,1,1,1,1,1,1,1,2,2,3,3,3,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), (2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,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), (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,3,3,3,3,3,3, 3,3,3,3,3,3,3,3,3,3,3)); Type SloType = array[1..80,1..50] of Byte; ScreenType = Array[1..200,1..320] of Byte; SloPointType = array[1..80,1..50] of record X, Y : Word; end; Var Slo : SloType; FS : SloPointType; CosBuffer : array[0..63] of ShortInt; Sk: ^ScreenType; Fo, Ka : Byte; X, Y, Fx, Fy, Cnt : Word; Procedure SetPal(Color,R,G,B:Byte); Begin Port[$3C8] := Color; Port[$3C9] := R; Port[$3C9] := G; Port[$3C9] := B; End; Function KeyPressed:boolean; Begin KeyPressed := Mem[$40:$1C] - Mem[$40:$1A] <> 0; end; Begin {Telo programa} WriteLn('Copyright by Boчtjan Gabrovчek'); WriteLn; New(Sk); Ka := 0; While (Char(Ka) < '1') or (Char(Ka) > '5') do Begin Write('Enter Waving 1 - 5 : '); ReadLn(Char(Ka)); End; Ka := Ka - Byte('1') + 7; asm mov ax,19; int 10h; end; For Fo := 1 to 80 do Move(SloFake[17],Slo[Fo],50); For Fo := 1 to 17 do Move(SloFake[Fo],Slo[Fo+5],50); For Fo := 1 to 64 do CosBuffer[Fo-1] := Round(Cos(Fo/10)*Ka); For Fo := 1 to 31 do SetPal(Fo,0,0,Fo*2-10); For Fo := 32 to 63 do SetPal(Fo,(Fo-32)*2-10,(Fo-32)*2-10,(Fo-32)*2-10); For Fo := 64 to 95 do SetPal(Fo,(Fo-64)*2-10,0,0); For Fo := 96 to 127 do SetPal(Fo,(Fo-96)*2-10,(Fo-96)*2-10,0); Cnt := 0; Repeat Inc(Cnt,2); FillChar(Sk^,64000,0); FillChar(Fs,850*2,0); For X := 1 to 80 do For Y := 1 to 50 do Begin Fs[X,Y].Y := 20+Y*3+CosBuffer[(X+Y+Cnt) mod 64]; Fs[X,Y].X := 40+X*3+CosBuffer[(Y+X+Cnt) mod 64]; For Fx := Fs[X-1,Y].X to Fs[X,Y].X-1 do For Fy := Fs[X,Y-1].Y to Fs[X,Y].Y-1 do Sk^[Fy,Fx] := (SLO[X,Y])*32 - CosBuffer[(X+Y+Cnt) mod 64] - 12; End; asm cli; mov bx,ds; lds si,Sk; mov ax,0A000h; mov es,ax; xor di,di; mov cx,32000; REP movsw; mov ds,bx; sti; end; Until KeyPressed; asm mov ax,3; int 10h; end; Dispose(Sk); WriteLn('Copyright by Boчtjan Gabrovчek'); WriteLn; End.