Информационный сервер для программистов: Исходники со всего света. Паскальные исходники со всего света
  Powered by Поисковый сервер Яndex: Найдется ВСЁ!
На Главную Pascal Форум Информер Страны мира
   Demo Making    >>    sinmap
   
 
 Sinus-Curve Waving Flag  Unknown 20.11.97

Развевающийся на ветру сине-бело-красный флаг, состоящий из точек. [320x200x256]
A sinus-curve waving flag.



1k 
 

  {> Cut here. FileName= SINMAP.PAS } program sinmap; uses crt; const gseg : word = $a000; spd = 1; size = 3; curve = 125; xmax = 230 div size; ymax = 140 div size; sofs = 30; 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.