Blur Effekt in Pascal

Blur Effekt in Pascal

Beitragvon Dragonsphere » Di 15. Nov 2016, 20:20

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?
Kleiner Schaltschrank Industrie-PC, der sich langsam zu einer tollen kleinen DOS-Spielekiste entwickelt.
Intel 80486DX-4, 32 MB EDO-RAM, 2 GB Seagate-Festplatte, SB 16 CT2770, Diamond SpeedSTAR Plus Rev. C6
Benutzeravatar
Dragonsphere
MemMaker-Benutzer
 
Beiträge: 91
Registriert: Di 2. Feb 2016, 10:44
Wohnort: 0000:700h

Re: Blur Effekt in Pascal

Beitragvon wobo » Mi 16. Nov 2016, 09:33

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;
wobo
DOS-Guru
 
Beiträge: 555
Registriert: So 17. Okt 2010, 13:40

Re: Blur Effekt in Pascal

Beitragvon Felmar Loyd » Mi 16. Nov 2016, 16:29

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.
Felmar Loyd
MemMaker-Benutzer
 
Beiträge: 78
Registriert: Do 5. Mär 2015, 17:17
Wohnort: Magdeburg

Re: Blur Effekt in Pascal

Beitragvon DOSferatu » Mi 16. Nov 2016, 18:22

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
DOS-Übermensch
 
Beiträge: 1095
Registriert: Di 25. Sep 2007, 11:05

Re: Blur Effekt in Pascal

Beitragvon DOSferatu » Mi 16. Nov 2016, 20:11

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
DOS-Übermensch
 
Beiträge: 1095
Registriert: Di 25. Sep 2007, 11:05

Re: Blur Effekt in Pascal

Beitragvon DOSferatu » Mi 16. Nov 2016, 20:36

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.
DOSferatu
DOS-Übermensch
 
Beiträge: 1095
Registriert: Di 25. Sep 2007, 11:05

Re: Blur Effekt in Pascal

Beitragvon Dragonsphere » Mi 16. Nov 2016, 21:40

Vielen Dank! Jetzt funktioniert alles einwandfrei! :like:

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.

Kleiner Schaltschrank Industrie-PC, der sich langsam zu einer tollen kleinen DOS-Spielekiste entwickelt.
Intel 80486DX-4, 32 MB EDO-RAM, 2 GB Seagate-Festplatte, SB 16 CT2770, Diamond SpeedSTAR Plus Rev. C6
Benutzeravatar
Dragonsphere
MemMaker-Benutzer
 
Beiträge: 91
Registriert: Di 2. Feb 2016, 10:44
Wohnort: 0000:700h


Zurück zu Programmierung

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste