DEMO.DESIGN
Frequently Asked Questions
 
оглавление | demo party в ex-СССР | infused bytes e-mag | новости от ib/news | другие проекты | письмо | win koi lat

следующий фpагмент (2)
- Demo/intro making and discussion (2:5030/84) ------------------ DEMO.DESIGN - Msg : 13163 of 13163 From : Ilya Katargin 2:5029/9 03 Jun 36 03:07:33 To : Evgeniy Antonov 27 Apr 00 00:03:11 Subj : линза ------------------------------------------------------------------------------- EA> Hедавно в эхе пролетал эффект субжа, мог бы кто-нибудь повторить ? не то, чтобы недавно, но очень информативное письмо ;-) -={ cUt }=- - Интересные мессаги (2:5029/9) -------------------- DEVILS.INT (DEMO.DESIGN) - From : Andrew Usachov 2:5100/87 04 Sep 98 20:37:40 To : Max Lanskih 05 Sep 98 22:09:54 Subj : линзы ------------------------------------------------------------------------------- г=[¦]========================[ Hello Max! ]=======---------------- ¦ 03 Sep 98 22:33, Max Lanskih wrote to Andrey Sergeew: AS>> е подскажет-ли Алл алгоpитм наложения линз? можно мылом. ML> Лучше сюда, т.к. мне тоже это интерестно. Если линза на экpане - окpужность (x0,y0,r0), то в точках (x,y), для котоpых (x-x0)^2+(y-y0)^2<=r0^2, pисуется точка, котоpая, если бы линзы не было, изобpажалась бы в точке (x0+(x-x0)*k1,y0+(y-y0)*k), где k=const1/([sqrt]((x-x0)^2+(y-y0)^2)+const2). Можно заpанее пpосчитать таблицу смещений - array[-r0..r0,-r0..r0] of integer. - - - 8< - - - - - 8< - - [ begin of Lens.Pas ] - - 8< - - - - - 8< - - - {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+} {$M 16384,0,655360} Uses CRT; Const vx0 = 3; vy0 = 2; v0 = vx0; r0 = 50; r02 = (r0-v0)*(r0-v0); d = r02 * 10 div 10; Type ScreenType = Array[0..199,0..319] of Byte; DispType = Array[-r0..r0,-r0..r0] of Integer; Var Screen : ScreenType Absolute $a000:$0000; Buffer1, Buffer2 : ^ScreenType; Disp : ^DispType; x,y,vx,vy,r2,c : LongInt; Procedure Move(Var A,B; Count: Word); assembler; asm push ds mov cx, Count les di, B lds si, A shr cx, 1 jz @zero rep movsw @zero: pop ds end; BEGIN asm mov ax, $13 int $10 end; New(Buffer1); New(Buffer2); New(Disp); FillChar(Screen, SizeOf(Screen), 3); y:=0; repeat For x:=0 to 319 do Screen[y,x]:=11; Inc(y,10); until y>199; x:=0; repeat For y:=0 to 199 do Screen[y,x]:=11; Inc(x,10); until x>319; Move(Screen, Buffer1^, SizeOf(Screen)); Move(Buffer1^,Screen,64000); For y:=-r0 to r0 do For x:=-r0 to r0 do begin r2:=x*x+y*y; if r2>r02 then Disp^[y,x] := y*320+x else Disp^[y,x] :=( y*(r2+d)div(r02+d))*320 + (x*(r2+d)div(r02+d) ); end; x:=r0; y:=r0; vx:=vx0; vy:=vy0; repeat asm mov ax, Integer(y) mov bx, 320 imul bx add ax, Integer(x) mov di, ax mov dx, -r0*320-r0 les si, Disp mov ch, 2*r0+1 @next_dy: mov cl, 2*r0+1 @next_dx: mov es, Word(Disp+2) mov bx, es:[si] mov es, Word(Buffer1+2) mov al, es:[di+bx] mov bx, Seg(Screen) mov es, bx mov bx, dx mov es:[di+bx], al add si, 2 inc dx dec cl jnz @next_dx add dx, 320-(2*r0+1) dec ch jnz @next_dy end; if ((x+vx)>=r0) and ((x+vx)<=319-r0) then Inc(x, vx) else vx:=-vx; if ((y+vy)>=r0) and ((y+vy)<=199-r0) then Inc(y,vy) else vy:=-vy; Delay(25); until Port[$60]=$01; Dispose(Buffer1); Dispose(Buffer2); Dispose(Disp); asm mov ax, $03 int $10 end; END. - - - 8< - - - - - 8< - - [ end of Lens.Pas ] - - 8< - - - - - 8< - - - L=[ Andrew Usachov ]=====================[ 04 Sep 98, 23:16 ]==------
следующий фpагмент (3)|пpедыдущий фpагмент (1)
- Demo/intro making and discussion (2:5030/84) ------------------ DEMO.DESIGN - Msg : 13165 of 13165 From : Michael Uvarov 2:5030/937.21 03 Jun 36 13:52:16 To : Evgeniy Antonov 28 Apr 00 00:46:47 Subj : линза ------------------------------------------------------------------------------- EA> Hедавно в эхе пролетал эффект субжа, мог бы кто-нибудь повторить ? Плз: *[* */дальше идёт непереводимое ругательство: DEMOVGA.PAS/* *]* { Coded by Dasaev } Unit DemoVga; Interface Const Name = 'DEMOVGA : Базовый модуль для построения демок в 320x200x256!!!'; Font8 = 3; Font14 = 2; Font16 = 6; Var DBuffer,Origin : Pointer; MemStor : Pointer; Procedure InitDemoPart; Procedure RestoreDemo; Procedure SetRGBColor( C, R, G, B : Byte); Procedure ClearDBuffer; Procedure DBuff2Video; Function GetFontPtr( Size : Byte) : Pointer; Implementation Uses {Effect,}Crt; Procedure InitDemoPart; Begin Mark( MemStor); GetMem( DBuffer, 65500); Origin := DBuffer; Inc( LongInt( DBuffer), $10000); LongInt( DBuffer) := LongInt( DBuffer) And $FFFF0000; SegA000 := Seg( DBuffer^); ClearDBuffer; Asm Mov AX,13h Int 10h End; End; Procedure RestoreDemo; Begin FreeMem( Origin, 65500); Release( MemStor); Asm Mov AX,3h Int 10h End; End; Procedure SetRGBColor( C, R, G, B : Byte); Begin Port[ $3C8] := C; Port[ $3C9] := R; Port[ $3C9] := G; Port[ $3C9] := B; End; Procedure ClearDBuffer;Assembler; Asm Les DI,DBuffer Db $66; Xor AX,AX Mov CX,16200 Db $66; Rep Stosw End; Procedure DBuff2Video;Assembler; Asm Push DS Mov DS,SEGA000 Xor SI,SI Mov AX,0A000h Mov ES,AX Xor DI,DI Mov CX,16001 Db $66; Rep Movsw Pop DS End; Function GetFontPtr( Size : Byte) : Pointer; Var Font : Pointer; Begin Asm Push BP Mov AX,1130h Mov BH,Size Int 10h Mov AX,BP Pop BP Mov Word Ptr [Font],AX Mov Word Ptr [Font+2],ES End; GetFontPtr := Font; End; Procedure RunDemoVga; Far; Var I : Integer; Begin InitDemoPart; Repeat For I := 0 To 199 Do FillChar( Ptr( $A000, I * 320)^, 320 , I); Until KeyPressed; ReadKey; RestoreDemo; End; begin end. *[* */ругательство кончилось/* *]* *[* */дальше идёт непереводимое ругательство: GLASS.PAS/* *]* { Алгоритм линзы. Это достаточно интересный алгоритм. Его суть довольно проста. Исходник с линзой я обнаружил в архиве DEMOSTUF by Bjarke Viksoe. Вообще-то все программы из этого архива отличаются сложностью чтения, т.к. они оптимизированы под 4-х слойный режим и содержать кучу массивов и прочего. У меня основная идея осталась , но реализация упростилась , а читабельность улучшилась. Пусть у нас есть матрица , которую нужно преобразовать. Т.е. у нас есть какой-то прямоугольный массив, который мы хотим показать в линзе. Формулу преломления я оставил без изменения. Итак у нас есть исходная матрица. Каждая пара координат в матрице (I,J) переходит в новую пару координат (X,Y). Формулу см. в исходнике. Тогда элемент матрицы с новыми координатами (X,Y) становиться равным смещению в матрице , которое соответствует координатам (I,J). Это первый этап, для дальнейшего ускорения вывода , расчитаем еще два массива. Один массив - это смещения по которому мы берем значение цвета точки. А второй массив - смещения по которым мы этот цвет будет ставить. Тогда весь вывод линзы сведеться к циклу, в котором мы берем точку по одному смещению , а ставим по другому. Coded by Dasaev } Uses DemoVga,Crt; Const Max = 30; Type PXlatOfs = ^TXlatOfs; TXlatOfs = Array[1..2*Max*Max] Of Word; PMem = ^TMem; TMem = Array[0..64000] Of Byte; Var GlassOld,GlassNew : PXlatOfs; TotalOfs : Integer; Picture : PMem; GlassX, GlassY,dX,dY : Integer; Procedure InitGlass; Var S,I,J,X,Y : LongInt; Matr : Array[-Max..Max,-Max..Max] Of Word; Begin FillChar(Matr , SizeOf( Matr), 0); New(GlassOld); New(GlassNew); TotalOfs := 1; For J := -Max To Max-1 Do For I := -Max To Max-1 Do Begin S := Round( Sin(Pi/2.0 + (Pi/2.0)/(Max*2.0) * Round(Sqrt(I * I + J * J)) ) * 2500 ); X := (I * S) Div 2170; Y := (J * S) Div 2300; If(Matr[X][Y] = 0 ) Then Matr[X][Y] := Word(I + J * 320); End; For Y := -Max To Max-1 Do For X := -Max To Max-1 Do If Matr[X][Y] <> 0 Then Begin GlassNew^[TotalOfs] := X + Y * 320; GlassOld^[TotalOfs] := Matr[X][Y]; Inc(TotalOfs); End; End; Procedure DrawGlass; Var O,I : Word; Begin O := GlassX + GlassY * 320; For I := 1 To TotalOfs-1 Do Begin Byte( Ptr( Seg( DBuffer^), O + GlassNew^[ I])^) := Picture^[ O + GlassOld^[ I]]; End; End; Procedure RunGlass; Var I,J : Integer; Begin InitDemoPart; InitGlass; GetMem( Picture, 64000); GlassX := 100; GlassY := 100; dX := 1; dY := 1; For I := 0 To 319 Do For J := 0 To 199 Do Picture^[I + J * 320] := LongInt( I) * J * I Div 180 + LongInt( J) * J Div 140; Repeat ClearDBuffer; Move( Picture^, DBuffer^, 64000); DrawGlass; Inc( GlassX, dX); Inc( GlassY, dY); If ( GlassX <= Max) Or (GlassX >= 320 - Max) Then dX := -dX; If ( GlassY <= Max) Or (GlassY >= 200 - Max) Then dY := -dY; DBuff2Video; Until KeyPressed; ReadKey; FreeMem( Picture, 64000); Dispose( GlassNew); Dispose( GlassOld); RestoreDemo; End; Begin RunGlass; End.

Всего 2 фpагмент(а/ов) |пpедыдущий фpагмент (2)

Если вы хотите дополнить FAQ - пожалуйста пишите.

design/collection/some content by Frog,
DEMO DESIGN FAQ (C) Realm Of Illusion 1994-2000,
При перепечатке материалов этой страницы пожалуйста ссылайтесь на источник: "DEMO.DESIGN FAQ, http://www.enlight.ru/demo/faq".