Blur Effekt in Pascal

[Dragonsphere]

Ich versuche mich aktuell daran, in Pascal einen guten "Blur Effekt" hinzubekommen. Das klappt auch schon recht gut, nur ist meine Funktion leider sehr langsam... Jetzt hoffe ich auf etwas "Optimierungshilfe" von euch

Falls jemand den Effekt nicht kennt:
Das ist der klassische "Milchglas"-Effekt, also z.B. wenn im Fernsehen Gesichter nicht gezeigt werden sollen, oder sie einem die Details bei nackigen Damen in Spielen "zensieren"
Damit kann man viel machen und wenn man den Effekt im repeat über das Bild laufen lässt, bekommt man einen interessanten "Auflösungseffekt". Um den geht es mir hier und deshalb ist auch die Geschwindigkeit wichtig.

Das Prinzip: Jeder Pixel bekommt als neue Farbe den Durchschnittswert der vier Pixel um ihn herum.

Code: Alles auswählen

for y := 1 to 200 do
begin
 for x := 1 to 320 do
 begin
    mem[$0A000:x+(320*y)] := 
  ( mem[$0A000:(x-1)+(320*y)]+
    mem[$0A000:(x+1)+(320*y)]+
    mem[$0A000:x+(320*(y-1))]+
    mem[$0A000:x+(320*(yp+1))] ) div 4;
 end;
end;

Das funktioniert sehr gut, ist aber sehr langsam.

Meine optimierteste / schnellste Version ist jetzt diese hier:

Code: Alles auswählen

 xt:=0;
 for y := 1 to 200 do 
 begin
   for x := 1 to 320 do
           mem[$0A000:x+jt] := 
         ( mem[$0A000:(x+1)+xt]+
           mem[$0A000:(x-1)+xt]+
           mem[$0A000:x+(xt+320)]+
           mem[$0A000:x+(xt-320)] ) shr 2;
  xt := xt+320;
 end;

Das ist schon schneller, aber noch deutlich zu langsam, um zum Beispiel mit einem zweiten Segment als Puffer zu arbeiten, um Flackern zu vermeiden.
Mir würde jetzt nur noch einfallen, das Ganze in Assembler umzusetzen. Da bin ich nur total raus... Oder habt ihr noch eine gute Idee für mich?

[wobo]

Mal kurz "aus der Hüfte" :

- For-Schleifen durch Repeat-Until-Schleifen ersetzen (Repeat until ist schneller)
- und die in der x-Schleife berechneten Konstanten xt+320 und xt-320 herausnehmen und nur in der y-Schleife als eigene Variablen berechnen
- oder alternativ gleich mit Offsets und einer großen Repeat until - Schleife arbeiten, also z.B.

Code: Alles auswählen

{$R-}
xOffs := 0;
xOffsMinus320 := xOffs-320;
xOffsPlus320 := xOffs+320;
Repeat 
   Mem[$A000:xOffs] := (Mem[$A000:xOffs+1]+Mem[$A000:xOffs-1]+Mem[$A000:xOffsMinus320]+Mem[$A000:xOffsPlus320]) shr 2;
   Inc (xOffs);
   Inc (xOffsMinus320);
   Inc (xOffsPlus320);
Until xOffs=64000;

[Felmar Loyd]

im Inline-ASM könnte es in etwa wie folgt aussehen. (Ungetestet, da ich hier auf Arbeit keinen DOS-Rechner mit Pascal habe)

Code: Alles auswählen

ASM
	mov ax, $A000
	mov es, ax
	xor di,di
	mov cx, 64000
	xor ax, ax
Label1:
	xor dx, dx
	mov al, es:[di-320]
	add dx, ax
	mov al, es:[di-1]
	add dx, ax
	mov al, es:[di+1]
	add dx, ax
	mov al, es:[di+320]
	add dx, ax
	shr dx, 2
	mov es:[di], dl
	dec cx
	jne Label1
end;

vieleicht hilft es dir ja weiter.

[DOSferatu]

Ja, so in etwa. Man müßte höchstens noch dazusagen, daß es natürlich an den Bildschirmrändern zu "Fehlern" kommt, aber das wäre wohl die schnellste Variante.
Vielleicht geht es mit DS: statt ES: noch schneller (natürlich vorher DS sichern, klar), das kommt aufs Rechnermodell an.
Und: Wenn es innerhalb des gleichen Bilds passiert, sind natürlich der jeweils obere und linke Pixel schon "betroffen" (geändert worden), der untere und rechte noch nicht. Weiß nicht, inwiefern das dann natürlich einen unangenehmen "Zieh-Effekt" nach rechts unten bewirkt. Das Problem wäre natürlich weg, wenn man hier mit einem extra Puffer arbeitet.
(Hier reichen dann auch 960 Bytes, die man als Ringpuffer benutzt, der Code wäre etwas umfangreicher... Ich habe dergleichen schonmal getan als ich Conway's "Game of Life" für 320x200 programmiert habe)

[DOSferatu]

Check mal das.
Hier könnte man auch noch mit sog. "unrolled Loops" arbeiten und ähnlichem Zeugs.

Code: Alles auswählen

program Blur;
var SC:array[0..199,0..319]of byte absolute $A000:0;
var i:byte;
var HEAD:word absolute $40:$1C;
var TAIL:word absolute $40:$1A;

procedure BlurPage; assembler;
asm
  push DS
  mov AX,$A000
  mov DS,AX
  xor AH,AH
  mov CL,198
  db $66;mov DI,321;dw -318 {=mov EDI..}
@OuterLoop:
@InnerLoop:
  xor DH,DH
  mov DL,[DI-320]
  mov AL,[DI-1]
  add DX,AX
  mov AL,[DI+1]
  add DX,AX
  mov AL,[DI+320];
  add DX,AX
  shr DX,2
  mov [DI],DL
  db $66,$81,$C7;dw 1,1 {=add EDI $00010001}
  jnc @InnerLoop
  db $66,$81,$C7;dw 2,-318 {add EDI...}
  dec CL;
  jnz @OuterLoop
  pop DS;
end;

procedure SwapWords(var A,B:word);
var C:word;
begin
if A>B then begin C:=A;A:=B;B:=C;end;
end;

procedure Rectangle(X0,Y0,X1,Y1:word;C:byte);
var Y:word;
begin
SwapWords(X0,X1);SwapWords(Y0,Y1);
X1:=succ(X1-X0);
for Y:=Y0 to Y1 do fillchar(SC[Y,X0],X1,C);
end;

begin
randomize;
asm mov ax,$13;int $10;end;
for i:=0 to 99 do Rectangle(random(320),random(200),random(320),random(200),random(128));
repeat
BlurPage;
repeat i:=port[$60];until i<$80;
repeat i:=port[$60];until i>=$80;
TAIL:=HEAD;{avoid keyboard buffer overflow}
until i=$81;{ESC to quit}
end.

[DOSferatu]

Und hier das ganze nochmal mit einem Puffer:

Code: Alles auswählen

program Blur2;
type ScType=array[0..199,0..319]of byte;
var P,P_Buffer:Pointer;
var PP:record O,S:word;end absolute P_Buffer;
var SC:ScType absolute $A000:0;
var i:byte;
var HEAD:word absolute $40:$1C;
var TAIL:word absolute $40:$1A;

procedure BlurPage; assembler;
asm
  push DS
  mov DS,word ptr[P_Buffer+2]
  push ES
  mov AX,$A000
  mov ES,AX
  xor AH,AH
  mov CL,198
  db $66;mov DI,321;dw -318 {=mov EDI..}
@LoopStart:
  xor DH,DH
  mov DL,[DI-320]
  mov AL,[DI-1]
  add DX,AX
  mov AL,[DI+1]
  add DX,AX
  mov AL,[DI+320];
  add DX,AX
  shr DX,2
  {insert adc DL,AH here to make it "rounded"!}
  mov ES:[DI],DL
  db $66,$81,$C7;dw 1,1 {=add EDI $00010001}
  jnc @LoopStart
  db $66,$81,$C7;dw 2,-318 {add EDI...}
  dec CL
  jnz @LoopStart
  pop ES
  pop DS
end;

procedure PageToBuffer; assembler;
asm
  push ES
  mov ES,word ptr[P_Buffer+2]
  push DS
  mov AX,$A000
  mov DS,AX
  mov CX,16000;
  xor SI,SI;
  mov DI,SI;
  cld
  rep;db $66;movsw;{=rep movsd}
  pop DS
  pop ES;
end;

procedure SwapWords(var A,B:word);
var C:word;
begin
if A>B then begin C:=A;A:=B;B:=C;end;
end;

procedure Rectangle(X0,Y0,X1,Y1:word;C:byte);
var Y:word;
begin
SwapWords(X0,X1);SwapWords(Y0,Y1);
X1:=succ(X1-X0);
for Y:=Y0 to Y1 do fillchar(SC[Y,X0],X1,C);
end;

begin
GetMem(P,64016);
P_Buffer:=P;
with PP do begin inc(S,succ(O shr 4));O:=0;end;{Pointer "normalize" to full segment}
randomize;
asm mov ax,$13;int $10;end;
for i:=0 to 99 do Rectangle(random(320),random(200),random(320),random(200),random(128));
repeat
PageToBuffer;
BlurPage;
repeat i:=port[$60];until i<$80;
repeat i:=port[$60];until i>=$80;
TAIL:=HEAD;{avoid keyboard buffer overflow}
until i=$81;{ESC to quit}
FreeMem(P,64016);
end.

Vielleicht hilft das ja.
Wichtig: Beide Lösungen funktionieren natürlich erst ab 386er, da erst ab da 32-Bit-Register zur Verfügung stehen.

[Dragonsphere]

Vielen Dank! Jetzt funktioniert alles einwandfrei!

Bevor ich die letzten Posts von DOSferatu gesehen habe, habe ich es auch nochmal mit Puffer probiert und dabei die Assmebler-Routine von Felmar Loyd genommen und noch etwas optimiert.

Hier mein Programm:

Code: Alles auswählen

Program Blur;
uses crt;

Type
 Buffer = array [1..64000] of byte; 
 BPtr = ^Buffer;                  

var
xp,yp : word;
scrBuffer  : BPtr;                     {Puffer für Page 1}
Vaddr  : word;                        {Adresse vom Puffer}
cnt : byte;


procedure flip(source,dest:Word); 
{Kopiert Daten an Segemntadresse "source" in "dest"}
assembler;
asm
  push    ds
  mov     ax, [Dest]
  mov     es, ax
  mov     ax, [Source]
  mov     ds, ax
  xor      si, si
  xor      di, di
  mov     cx, 16000
  db       $F3, $66, $A5
  pop     ds
end;

Procedure Setrgb(index:word;R,G,B:Byte);
{Setzt einen Eintrag in der Palette mit RGB Werten}
begin;
 port[968]:=index;   
 port[968]:=index;   
 port[969]:=r;      
 port[969]:=g;       
 port[969]:=b;       
 port[968]:=index;  
 port[968]:=index;  
 port[969]:=r;      
 port[969]:=g;       
 port[969]:=b;      
end;

Procedure Waitkey;
begin
 while keypressed do readkey;
 repeat until keypressed;
 while keypressed do readkey;
end;

Procedure Drawpattern;
{Zeichnet ein hübsches Muster}
begin
for yp := 1 to 199 do
 for xp := 1 to 319 do
  mem[$A000:xp+(320*yp)] := (xp xor yp);
end;

Procedure Blurscreen;
assembler;
asm
   mov ax, vaddr
   mov es, ax
   mov di, 65535             {Wir haben ja eh ein ganzes Segment und so gibt es keine Grafikfehler}
   xor ax, ax
@Label1:
   xor dx, dx
   mov al, es:[di-320]
   add dx, ax
   mov al, es:[di-1]
   add dx, ax
   mov al, es:[di+1]
   add dx, ax
   mov al, es:[di+320]
   add dx, ax
   shr dx, 2
   mov es:[di], dl
   dec di
   cmp di,320              {Wir lassen die erste Zeile aus, sonst hier "jnz @Label1"}
   jne @Label1
end;


Procedure InitBuffer;
begin
  GetMem(ScrBuffer,64000);
  vaddr := seg(ScrBuffer^);
end; 

Procedure FreeBuffer;
begin
  FreeMem (ScrBuffer,64000);
end;

begin
asm
 mov ax,13h
 int 10h
end;
InitBuffer;

for cnt  :=  0 to 255 do
setrgb(cnt,cnt,0,0);

Drawpattern;
waitkey;

repeat;
flip($A000,vaddr);
blurscreen;
flip(vaddr,$A000);
until keypressed;

asm
 mov ax,03h
 int 10h
end;
Freebuffer;
end.