program fixedpoint;

{$A+,B-,E+,F-,G+,N+,Q-,R-,S-}

uses crt;


{above is needed for x and y flip, 286/386 instructions }


Const VGA=$A000;
      Npages=2;
      MinX=0;
      MaxX=319;
      MinY=0;
      MaxY=199;

Type RgbItem=Record
                   R,G,B:Byte;
             End;
     RgbList=Array[0..255] of RgbItem;
     Table=Array[0..1799] Of integer;
     PTable=^Table;

Var Sines:Ptable;
    Cosines:Ptable;
    Virt:Array[1..Npages] Of Pointer;
    VP:Array[1..Npages] Of Word;

Procedure video_mode (mode : Byte); Assembler;
Asm
  mov  AH,00
  mov  AL,mode
  int  10h
end;

Procedure Cls(Col:Byte;Where:Word);
Begin
     Fillchar(Mem[Where:0000],64000,Col);
End;

Procedure WaitVBL; Assembler;
Label A1,A2;
Asm
   Mov DX,3DAh
   A1:
      In AL,DX
      And AL,08h
      Jnz A1
   A2:
      In AL,DX
      And AL,08h
      Jz A2
End;

Procedure GetColor(Col:Byte;Var R,G,B:Byte);
Begin
     Port[$3C7]:=Col;
     R:=Port[$3C9];
     G:=Port[$3C9];
     B:=Port[$3C9];
End;

Procedure SetColor(Col,R,G,B:Byte);
Begin
     Port[$3C8]:=Col;
     Port[$3C9]:=R;
     Port[$3C9]:=G;
     Port[$3C9]:=B;
End;

Procedure InitTables;
Var A:Word;
    B:Real;
Begin
     Getmem(Sines,Sizeof(Sines^));
     Getmem(Cosines,Sizeof(Cosines^));
     B:=0;
     For A:=0 To 1799 Do
     Begin
          Sines^[A]:=round(Sin(B)*100);
          Cosines^[A]:=round(Cos(B)*100);
          B:=B+0.005;
     End;
End;

Procedure ClearTables;
Begin
     Freemem(Sines,Sizeof(Sines^));
     Freemem(Cosines,Sizeof(Cosines^));
End;

Procedure InitVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          GetMem(Virt[A],64000);
          VP[A]:=Seg(Virt[A]^);
     End;
End;

Procedure CloseVirt;
Var A:Byte;
Begin
     For A:=1 To Npages Do
     Begin
          Freemem(Virt[A],64000);
          VP[A]:=$A000;
     End;
End;

Procedure CopyPage(From,Too:Word;a:integer);
var m:word;
Begin
     for m:=0 to 64000 do
         begin
              if mem[from:m]<>a then Move(Mem[From:m],Mem[Too:m],1);
         end;
End;

Procedure PutPixel(X,Y:word;Col:Byte;Where:Word);
Begin
     if x>-1 then if x<320 then if y>-1 then if y<200 then
     Mem[Where:(y*320)+x]:=Col;
End;

Function GetPixel(X,Y:word;Where:Word):Byte;
Begin
     GetPixel:=Mem[Where:(y*320)+x];
End;

Procedure SetPalette(Pal:RgbList);
Var A:Byte;
Begin
     WaitVBL;
     For A:=0 To 255 do SetColor(A,Pal[A].R,Pal[A].G,Pal[A].B);
End;

Procedure LoadPCX(Filename:String;Where:Word);
Var Fil:File;
    Dx,Dy:Word;
    J,M:Byte;
    Ph:Word;
    Buff:Array[0..127] of byte;
    PCXPal:RgbList;
Begin
     Assign(Fil,Filename);
     Reset(Fil,1);
     Blockread(Fil,Buff,128);
     Dy:=0;
     Repeat
           Dx:=0;
           Repeat
                 BlockRead(Fil,J,1);
                 If J>192 Then
                 Begin
                      BlockRead(Fil,M,1);
                      Dec(J,192);
                      For Ph:=1 To J Do
                      Begin
                           PutPixel(Dx,Dy,M,Where);
                           Inc(Dx);
                      End;
                 End
                 Else
                 Begin
                      PutPixel(Dx,Dy,J,Where);
                      Inc(Dx);
                 End;
           Until Dx>=320;
           Inc(Dy);
     Until Dy=200;
     BlockRead(Fil,M,1);
     If M=12 Then
     Begin
          BlockRead(Fil,PCXPal,768);
          For M:=0 To 255 Do
          Begin
               PCXPal[M].R:=PCXPal[M].R Div 4;
               PCXPal[M].G:=PCXPal[M].G Div 4;
               PCXPal[M].B:=PCXPal[M].B Div 4;
          End;
          SetPalette(PCXPal);
     End;
     Close(Fil);
End;

{starts here!}
{starts here!}
{starts here!}
{starts here!}
{starts here!}

var x,y,x1,y1,a,counter,add,value1,value2:integer;
    func1,func2,func3,func4:integer;
    c:char;

begin
     video_mode ( $13);
     initvirt;
     inittables;

     cls (0,vp[1]);
     cls (0,vp[2]);
     cls (0,vga);

     loadpcx ('ps-00000.pcx',vp[2]);

     counter:=0;
     add:=30;

     repeat

      counter:=counter+add;
      if counter>1279 then counter:=counter-1279;

      for x:=-160 to 160 do
       for y:=-100 to 100 do
           begin

                value1:=(counter+x*16);
                value2:=(counter+y*4+x*16);
                if value1>1279 then repeat value1:=value1-1279 until value1<1279;
                if value1<0 then repeat value1:=value1+1279 until value1>0;
                if value2>1279 then repeat value2:=value2-1279 until value2<1279;
                if value2<0 then repeat value2:=value2+1279 until value2>0;

                {func1:=round(x*cosines^[value1]-y*sines^[value1]);
                func2:=round(y*cosines^[value1]+x*sines^[value1]);}
                func1:=sines^[value1]*12;
                func2:=cosines^[value2]*12;

                x1:=x+func1 div 100;
                y1:=y+func2 div 100;
                if x1<-159 then repeat x1:=x1+319 until x1>-159;;
                if x1>159 then repeat x1:=x1-319 until x1<159;
                if y1<-99 then repeat y1:=y1+199 until y1>-99;
                if y1>99 then repeat y1:=y1-199 until y1<99;

                mem[vp[1]:(160-x)+(100+y)*320]:=mem[vp[2]:(160-x1)+(100+y1)*320];
           end;

      move(mem[vp[1]:0],mem[vga:0],64000);

      if keypressed=true then c:=readkey;
     until c=#27;

     cleartables;
     closevirt;
     video_mode ( 03);
end.

{programmed: here catch! :)
             its like this... pic on vp[1] is formed multipling vp[2] values
             with counters, rotozoomer can be found on the 1st func1 and 2
             x1:=x+func1 div 100 can be replaced by x+(func1*x) div 100 or
             similar so you have lots of diferent possible effects!
             div 100 is needed to transform back into integer values (i used
             to have a float version and then re-coded this with new sintables
             so all i need to do to get the REAL value back is divide by 100
             there is a faster way to use the table (using 256 and then using
             an intern asm op to divide by 16) but i don't know much more on
             it!
             Other than that, there are a couple of cycles to put the values
             back between 0 and 1297 and x-y screen! center of distortion is
             100,160! hum... try to implement an tg(x) function! it will look
             good now...
             anyways... for the rotozoomer value1 and 2 should be counter ONLY!
             also the func1 and 2 values can be multiplied by x and y!
             REALLY LOTS of possibilities! either fiddle a little or go for
             something you think will look good! :)
                           Psychic Symphony}
