[Back to MATH SWAG index] [Back to Main SWAG index] [Original]

    Program SinCosFilter;

    {Salvatore Meschini
     E-Mail: smeschini@ermes.it - http://www.ermes.it/pws/mesk
     Check this: http://www.gdsoft.com/swag/downloads.html}
    {Original idea: Dirty Abe (Albert Veli)}

    {The following program ins't optimized (lookup tables,assembler...) because
    it only show how to write a filter with sin/cos. Just an idea :) }

    {Press ESC to quit - OTHER keys to browse filters}
    {Useful routines: Keypressed/GetPixel/SetPixel/GetKey/CyclePal/Get&SetPal/
     vretrace}

    const kx=2*pi/320;
          ky=2*pi/200;

    var x,y:word;
        i,counter:byte;
        ch:char;

    function KeyPressed: Boolean; Assembler;
    {FASTEST keypressed replacement! No interrupts}
      asm
       mov  ax, 40h
       mov  es, ax
       mov  dx, es:[1ah]
       mov  bx, es:[1ch]
       xor  ax, ax
       cmp  dx, bx
       je  @fine
       mov  al, 1
       @fine:
     end;

    procedure Putpixel(X, Y: word; Col: Byte); assembler; {Draw a point at x,y}
    asm
              mov     ax,$A000                { 8  Cycles}
              mov     es,ax                   { 2  }
              mov     bx,[X]                  { 8  }
              mov     dx,[Y]                  { 8  }
              mov     di,bx                   { 2  }
              mov     bx, dx                  { 2  }
              shl     dx, 8                   { 8  }
              shl     bx, 6                   { 8  }
              add     dx, bx                  { 3  }
              add     di, dx                  { 3  }
              mov     al, [Col]               { 8  }
              stosb                           { 11 }
    end;

    Function GetPixel(x,y:word):byte;Assembler;   {Get color of pixel at x,y}
     asm
       mov ax,0a000h
        mov es,ax
        mov bx,y
        mov di,bx
        xchg bh,bl
        shl di,6
        add di,bx
        add di,x
        mov al,[es:di]
     end;

    procedure Setmode(mode: byte); assembler; {Set graphical/text mode}
    asm
     xor ah,ah
     mov al,mode
     int 10h
    end;

    procedure Vretrace; assembler; {Wait for vertical retrace}

    label
      l1, l2;

    asm
        mov dx,3DAh
    l1:
        in al,dx
        and al,08h
        jnz l1
    l2:
        in al,dx
        and al,08h
        jz  l2
    end;

    function GetKey: Char;   {Get last keypressed}

      var
        AsciiK: byte;

      begin
        asm
         xor ah,ah
         int 16h
         mov asciik,al
        end;
        getkey := chr(asciik);
      end;

    Procedure SinCos;
     var col:byte;
     begin
     for x:=1 to 320 do
      for y:=1 to 200 do
      begin
      col:=round((sin(x*KX*0.5)*sin(y*KY*0.5))*(127-20)+128);
      putpixel(x,y,col);
      end;
     end;

    Procedure ApplyFilter;
     var col:byte;

     begin
      sincos;
      for x:=1 to 320 do
       for y:=1 to 200 do
        begin
        col:=getpixel(x,y);
        case counter of
        0:col:=col + y - x ;
        1:col:=col + round((sin(x*KX*10)*sin(y*KY*10))*20);
        2:col:=col xor x xor y;
        3:col:=col - round((cos(x*Ky*10)*cos(y*Kx*10))*2);
        4:counter:=0;
        end;
        if col=0 then inc(col);
        putpixel(x,y,col);
        end;
     end;

    Procedure SetPal(ColorNo: Byte; R, G, B: Byte);
      begin
        Port[$3c8] := ColorNo;
        Port[$3c9] := R;
        Port[$3c9] := G;
        Port[$3c9] := B;
      end;

    procedure GetPal(ColorNo: Byte; var R, G, B: Byte);
      begin
        Port[$3c7] := ColorNo;
        R := Port[$3c9];
        G := Port[$3c9];
        B := Port[$3c9];
      end;

    Procedure CyclePal(startc,endc:byte);
     var j,r,g,b,r1,g1,b1:byte;
     begin
      getpal(startc,r1,b1,g1);
      for j:=startc to endc do
       begin
         getpal(j+1,r,g,b);
         setpal(j,r,g,b);
       end;
      setpal(endc,r1,b1,g1);
     end;

     begin
     setmode($13);      {GoTo mode $13}
      for i:=1 to 170 do setpal(i,i,i or 32,i); {Set colors}
      for i:=171 to 255 do setpal(i,i or 32,i,i);
      applyfilter;{Apply custom filter to screen}
     repeat
     cyclepal(1,255);
     vretrace;
     if keypressed then begin ch:=getkey; if ch <> #27 then begin
     inc(counter); applyfilter;
     end;
     end;
     until ch=#27;           {Press ESC to quit!}
     setmode(3);
     end.

[Back to MATH SWAG index] [Back to Main SWAG index] [Original]