home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / ALIAS.ZIP / ALIASPAS.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-26  |  11KB  |  586 lines
  1. Program AntiAliasPrototyper;
  2. {
  3.   This is an scaling/rotation/antialiasing prototyping program
  4.   by Lewis A. Sellers, ie Minimalist of The Minimalist Group
  5.   (http://www.1stresource.com/l/lsellers/),
  6.   and the MOSOCI Grail Project (http://www.dwc.edu/grail).
  7.  
  8.   Written 1995-1996 A.D.
  9.  
  10.   You can use it and the code involved if you wish as long as
  11.   you include the standard greetings to me somewhere in your
  12.   program, say in the credits.
  13.  
  14.   It was originally a Turbo Borland C/ASM DOS 16-bit program,
  15.   but I recoded it into Pascal 7.0.
  16.   My first pascal program ever on the IBM platform actually. :-)
  17.   Frankly, it is a lot cleaner looking than the original. Hmmm...
  18.  
  19.   The Keys:
  20.     '1' is no antialiasing.
  21.     '2' is bilinear.
  22.     '3' is trilinear.
  23.     '4' is... something I was playing with.
  24.   The left/right arrows change rotation.
  25.   The - + [ and ] keys zoom.
  26.   Press any key to stop zooming.
  27.   ESC and Space stop the program.
  28.  
  29.   You must supply a BMP filename as an argument such as:
  30.   C:> ALIAS DEATH.BMP
  31.  
  32.   The BMP it uses must be a 320x200 256 color grayscale image.
  33.  
  34.   This is by no means fast. If I want something fast I do it in pure
  35.   assembly.
  36.  
  37.   GREETS:
  38.   Thanks to __Elendil and Lumpy (and Hugh and Bimba) for the impromptu
  39.   Pascal hints. :)
  40.  
  41.   And JMX/Opiate for the incentive to learn pascal.
  42. }
  43.  
  44.  
  45. {$R-}
  46. {$X+} { use FPU }
  47. {$M 16384,196608,196608} {probably too much... but tired of crashes while experimenting }
  48.  
  49. USES
  50.    Crt, DOS;
  51.  
  52. const
  53.     {screen constants}
  54.     WIDTH = 320;
  55.     HEIGHT = 200;
  56.     SCREENSIZE = WIDTH*HEIGHT;
  57.     PALETTESIZE = 256*3;
  58.     VGA : Word = $a000;
  59.     FAILURE = 0;
  60.     SUCCESS = 1;
  61.     PI = 3.14159;
  62.  
  63. type
  64.     pScreen = ^pScreenType;
  65.     pScreenType = array[0..SCREENSIZE] of byte;
  66.  
  67. VAR
  68.     texture : pScreen;
  69.     composite :pScreen;
  70.     y320 : array[0..HEIGHT] of word;
  71.  
  72.  
  73. { switch to 320x200 256 straight VGA }
  74. Procedure SetGraphicsMode; assembler;
  75. Asm
  76.     mov ax,13h
  77.     int 10h
  78.     mov dx,3c2h
  79.     mov al,0e3h
  80.     out dx,al
  81. End;
  82.  
  83.  
  84. { back to 80x25 text mode }
  85. Procedure SetTextMode; assembler;
  86. Asm
  87.     mov ax,03h
  88.     int 10h
  89. End;
  90.  
  91.  
  92. { load the 320x200 grayscale bitmap into memory }
  93. Function LoadImage(filename : string) : byte;
  94. type
  95.     pPalette = ^PaletteType;
  96.     PaletteType = array[0..PALETTESIZE] of byte;
  97.  
  98. Var
  99.     pFileMem : pScreen;
  100.     FileHandle : file;
  101.     thrash : pScreen;
  102.     palette : pPalette;
  103.     result : word;
  104.  
  105. Begin
  106.     Assign(FileHandle, filename);
  107.     Reset(FileHandle, 1);
  108.     GetMem(thrash, 320*200);
  109.     GetMem(palette, 1024);
  110.     Seek(FileHandle, 54);
  111.     BlockRead(FileHandle, palette^, 1024, result);
  112.     BlockRead(FileHandle, thrash^, 320*200, result);
  113.     Close(FileHandle);
  114.  
  115.     { fake thrash for testing }
  116. {    Asm
  117.         les di, thrash
  118.         mov cx,320*200
  119.         sub al,al
  120. @xyloop:
  121.         mov es:[di],al
  122.         inc al
  123.         inc di
  124.         dec cx
  125.         cmp cx,0
  126.         jne @xyloop
  127.     End; }
  128.  
  129.  
  130.     { MS uses funky file formats.
  131.       Change from b-g-r-unused dword format to proper RGB 3byte and write
  132.       it to the video card as we do so. }
  133.  
  134.     port[$3c6]:=$0ff;
  135.     port[$3c8]:=0;
  136.     Asm
  137.  
  138.         les si,palette
  139.         mov cx,256
  140.         cld
  141.         mov dx,$3c9
  142. @ploop:
  143.         mov al,es:[si+2]
  144.         shr al,2
  145.         out dx,al
  146.  
  147.         mov al,es:[si+1]
  148.         shr al,2
  149.         out dx,al
  150.  
  151.         mov al,es:[si]
  152.         shr al,2
  153.         out dx,al
  154.  
  155.         add si,4
  156.         dec cx
  157.         jne @ploop
  158.     End;
  159.  
  160.  
  161.     { Thrash the dumb MS format... The image is stored uncompressed
  162.     UPSIDE-DOWN, each line being on a 32-bit DWORD boundry. Hmm. }
  163.     Begin
  164.         Asm
  165.           push ds
  166.  
  167.           cld
  168.           mov cx, HEIGHT
  169.  
  170.           les di, texture
  171.           lds si, thrash
  172.           add di, (HEIGHT-1)*WIDTH
  173. @tloop:
  174.           push cx
  175.           push si
  176.           push di
  177.           mov cx, WIDTH/2
  178.           rep movsw
  179.           pop di
  180.           pop si
  181.           pop cx
  182.  
  183.           add si, WIDTH
  184.           sub di, WIDTH
  185.  
  186.           dec cx
  187.           cmp cx,0
  188.           jne @tloop
  189.  
  190.           pop ds
  191.         End;
  192.     End;
  193.  
  194.     FreeMem(palette, 1024);
  195.     FreeMem(thrash, 320*200);
  196.     LoadImage:=SUCCESS;
  197. End;
  198.  
  199.  
  200. { This is it. This rotates and scales the image into a 200x200 window. }
  201. Procedure FastRotate(scale, ang : Real);
  202. VAR
  203.     xscale,
  204.     yscale,
  205.     xc,
  206.     yc : Longint;
  207.  
  208.     scanline : word;
  209.     x, y : Integer;
  210.     tempx, tempy : word;
  211.     xlong, ylong : Longint;
  212.  
  213.     tseg, toff : word;
  214.     hseg, hoff : word;
  215.     texel : byte;
  216.  
  217. Begin
  218.     xscale := round ( (sin(ang)*65536.0)*scale);
  219.     yscale := round ( (cos(ang)*65536.0)*scale);
  220.     xc := 160*65536 - (100*(yscale+xscale));
  221.     yc := 100*65536 - (100*(yscale-xscale));
  222.     scanline:=0;
  223.  
  224.     tseg:=seg(texture^);
  225.     toff:=ofs(texture^);
  226.     hseg:=seg(composite^);
  227.     hoff:=ofs(composite^);
  228.  
  229.     for y:=0 to 199 do
  230.     Begin
  231.         xlong:=xc;
  232.         ylong:=yc; { init x/ylong to topleft of square }
  233.         for x:=60 to 60+200 do
  234.         Begin { normally from 0 to 319 }
  235.             tempx:=xlong SHR 16;
  236.             tempy:=ylong SHR 16;
  237.  
  238.             if (tempx<0) OR (tempx>=WIDTH) OR (tempy<0) OR (tempy>=HEIGHT) then
  239.             Begin
  240.                 Mem[hseg:hoff+scanline+x]:=0;
  241.             End
  242.             else
  243.             Begin
  244.                 texel:=Mem[tseg:toff+y320[tempy]+tempx];
  245.                 Mem[hseg:hoff+scanline+x]:=texel;
  246.             End;
  247.  
  248.             inc(xlong,yscale);
  249.             dec(ylong,xscale);
  250.         End;
  251.         inc(scanline,WIDTH);
  252.         inc(xc,xscale);
  253.         inc(yc,yscale);
  254.     End;
  255. End;
  256.  
  257.  
  258. { The bilinear antialiasing is post rotation/scaling here.
  259.   We perform the operation on the HOLDing texture which is then blitted
  260.   to video memory elsewhere in the program. }
  261. Procedure Bilinear; assembler;
  262. Asm
  263.         push ds
  264.         lds di, composite
  265.         add di, (WIDTH+1) + 60
  266.         mov cx, 198
  267. @yloop:
  268.         push cx
  269.         push di
  270.         mov cx, (WIDTH-2) - 120
  271. @xloop:
  272.         sub ax,ax
  273.         sub bx,bx
  274.         mov al,[di-1]
  275.         add bx,ax
  276.         mov al,[di+1]
  277.         add bx,ax
  278.         mov al,[di-WIDTH]
  279.         add bx,ax
  280.         mov al,[di+WIDTH]
  281.         add bx,ax
  282.  
  283.         shr bx,2
  284.  
  285.         mov al,[di]
  286.         add bx,ax
  287.         shr bx,1
  288.  
  289.         mov [di],bl
  290.         inc di
  291.         dec cx
  292.         cmp cx,0
  293.         jne @xloop
  294.  
  295.         pop di
  296.         pop cx
  297.         add di,WIDTH
  298.         dec cx
  299.         cmp cx,0
  300.         jne @yloop
  301.         pop ds
  302. End;
  303.  
  304.  
  305. { The trilinear antialiasing is post rotation/scaling here. }
  306. Procedure Trilinear; assembler;
  307. Asm
  308.         push ds
  309.         lds di, composite
  310.         add di, (WIDTH+1) + 60
  311.         mov cx, (HEIGHT-2)
  312. @yloop:
  313.         push cx
  314.         push di
  315.         mov cx, (WIDTH-2) - 120
  316. @xloop:
  317.         mov ax,0
  318.         mov bx,0
  319.         mov al,[di-1]
  320.         add bx,ax
  321.         mov al,[di+1]
  322.         add bx,ax
  323.         mov al,[di-WIDTH]
  324.         add bx,ax
  325.         mov al,[di+WIDTH]
  326.         add bx,ax
  327.         mov al,[di-(WIDTH-1)]
  328.         add bx,ax
  329.         mov al,[di-(WIDTH-1)]
  330.         add bx,ax
  331.         mov al,[di+(WIDTH+1)]
  332.         add bx,ax
  333.         mov al,[di+(WIDTH-1)]
  334.         add bx,ax
  335.         shr bx,3
  336.         mov al,[di]
  337.         add bx,ax
  338.         shr bx,1
  339.         mov [di],bl
  340.         inc di
  341.         dec cx
  342.         cmp cx,0
  343.         jne @xloop
  344.         pop di
  345.         pop cx
  346.         add di,WIDTH
  347.         dec cx
  348.         cmp cx,0
  349.         jne @yloop
  350.         pop ds
  351. End;
  352.  
  353.  
  354. { The hyper-linear? antialiasing is post rotation/scaling here.
  355.   If you're playing with antialiasing, do it here. This is the most
  356.   interesting of effects I ran across while playing with antialiasing.
  357.   Produces a short of fuzzy-ghosting afterimage. }
  358. Procedure Hyperlinear; assembler;
  359. Asm
  360.         push ds
  361.  
  362.         lds di, composite
  363.         add di, (WIDTH+1)+60
  364.         mov cx, (HEIGHT-2)
  365. @yloop:
  366.         push cx
  367.         push di
  368.         mov cx, (WIDTH-1) - 60*2
  369. @xloop:
  370.         sub ax,ax
  371.         sub dx,dx
  372.         mov al,[di-1]
  373.         add dx,ax
  374.         mov al,[di+1]
  375.         add dx,ax
  376.         mov al,[di-WIDTH]
  377.         add dx,ax
  378.         mov al,[di+WIDTH]
  379.         add dx,ax
  380.  
  381.         mov al,[di-(WIDTH+1)]
  382.         add dx,ax
  383.         mov al,[di-(WIDTH-1)]
  384.         add dx,ax
  385.         mov al,[di+(WIDTH+1)]
  386.         add dx,ax
  387.         mov al,[di+(WIDTH-1)]
  388.         add dx,ax
  389.  
  390.         shr dx,3
  391.  
  392.         mov al,[di]
  393.         add dx,ax
  394.         shr dx,1
  395.  
  396.         mov [di-(WIDTH+1)],dl
  397.         mov [di+(WIDTH+1)],dl
  398.         mov [di-(WIDTH-1)],dl
  399.         mov [di+(WIDTH-1)],dl
  400.  
  401.         inc di
  402.         dec cx
  403.         cmp cx,0
  404.         jg @xloop
  405.  
  406.         pop di
  407.         pop cx
  408.  
  409.         add di, WIDTH
  410.         dec cx
  411.         cmp cx,0
  412.         jg @yloop
  413.         pop ds
  414. End;
  415.  
  416.  
  417. { copy the composition texture to the VGA screen memory. }
  418. Procedure Copycomposite; assembler;
  419. Asm
  420.     push ds
  421.     mov di, VGA
  422.     mov es,di
  423.     sub di,di
  424.     lds    si,composite
  425.     mov cx,320*200/2
  426.     cld
  427.     rep movsw
  428.     pop ds
  429. End;
  430.  
  431.  
  432. { clear the composition texture }
  433. Procedure Clearcomposite; assembler;
  434. Asm
  435.     les di, composite
  436.     mov cx,320*200/2
  437.     sub ax,ax
  438.     cld
  439.     rep stosw
  440. End;
  441.  
  442.  
  443. { the main }
  444. VAR
  445.     angle,
  446.     angle_v,
  447.     scale : Real;
  448.     n,
  449.     alias: Integer;
  450.     key : Char;
  451.  
  452. Begin
  453.     ClrScr;
  454.     Writeln('Antialiasing Prototyper by Minimalist 1995-1996.');
  455.     Writeln;
  456.  
  457.     if ParamCount=0 then
  458.     Begin
  459.         writeln('Use: ALIAS filename.bmp');
  460.         halt(1);
  461.     End;
  462.  
  463.     Writeln('This is the PASCAL version of the original C prototyper written the week of');
  464.     Writeln('March 13-14th in preparation for NAID 96. It is also the very first PASCAL');
  465.     Writeln('program I have written for the IBM PC.');
  466.     Writeln('The BMP must be 320x200 256 grayscale.');
  467.  
  468.     Writeln;
  469.  
  470.     Writeln('You may use any of the following keys:');
  471.     Writeln(' ESC will exit the program.');
  472.     Writeln(' 1   no antialiasing');
  473.     Writeln(' 2   post Bilinear antialising');
  474.     Writeln(' 3   post Trilinear antialiasing');
  475.     Writeln(' 4   post um... hyperlinear antialiasing? :-)');
  476.     Writeln(' Use left/right arrows to change rotation.');
  477.     Writeln(' Zoom with the - + [ and ] keys. Press any other to stop.');
  478.  
  479. {    Writeln;
  480.     Writeln('=texture=');
  481.  
  482.     Writeln('memory ',MaxAvail);
  483. }
  484.     if MaxAvail < 64000 then
  485.     Begin
  486.         Writeln('Low Memory ',MaxAvail);
  487.         Halt(1);
  488.     End;
  489.     GetMem(texture, 64000);
  490. {
  491.     Writeln('texture ',seg(texture),':',ofs(texture));
  492.     Writeln('texture^ ',seg(texture^),':',ofs(texture^));
  493.     Writeln('texture^ seg ',seg(texture^), ' texture^ off', ofs(texture^));
  494.  
  495.  
  496.     Writeln;
  497.     Writeln('=composite=');
  498.  
  499.     Writeln('memory ',MaxAvail);
  500. }
  501.     if MaxAvail < 64000 then
  502.     Begin
  503.         Writeln('Low Memory ',MaxAvail);
  504.         Halt(1);
  505.     End;
  506.     GetMem(composite, 64000);
  507. {
  508.     Writeln('composite ',seg(composite),':',ofs(composite));
  509.     Writeln('composite^ ',seg(composite^),':',ofs(composite^));
  510.     Writeln('composite^ seg ',seg(composite^), ' composite^ off', ofs(composite^));
  511. }
  512.  
  513.     Writeln;
  514.     Writeln('Press any key to begin....');
  515.     Readkey;
  516.  
  517.     for n:=0 to 199 do y320[n]:=n*320;
  518.  
  519.     SetGraphicsMode;
  520.     if LoadImage(ParamStr(1)) = FAILURE then
  521.     Begin
  522.         SetTextMode;
  523.         writeln('The file ', ParamStr(1),' does not exist.');
  524.         halt(2);
  525.     End;
  526.  
  527.     clearcomposite;
  528.  
  529.     angle:=PI/256;
  530.     angle_v:=-PI/128;
  531.     scale:=1.05;
  532.     alias:=0;
  533.  
  534.     key:=#1;
  535.     while key<>#27 do
  536.     Begin
  537.         if keyPressed then key:=ReadKey;
  538.  
  539.         case key of
  540.                '1': alias:=1;
  541.                '2': alias:=2;
  542.                '3': alias:=3;
  543.                '4': alias:=4;
  544.                '5': alias:=5;
  545.  
  546.                '-': scale:=scale-0.05;
  547.                '=': scale:=scale+0.05;
  548.                '[': scale:=scale-0.5;
  549.                ']': scale:=scale+0.5;
  550.         End;
  551.  
  552.         if key=#0 then
  553.         Begin
  554.             key:=ReadKey;
  555.             case key of
  556.                 #75: angle_v:=angle_v-PI/128;
  557.                 #77: angle_v:=angle_v+PI/128;
  558.             End;
  559.         End;
  560.  
  561.         Begin
  562.             Gotoxy(1,1);
  563.             Write('Scale:=',scale,'  ');
  564.             Gotoxy(1,2);
  565.             Write('Angle:=',angle,'  ');
  566.             FastRotate(scale,angle);
  567.             case alias of
  568.                 2: bilinear;
  569.                 3: trilinear;
  570.                 4: hyperlinear;
  571.             End;
  572.         End;
  573.  
  574.         copycomposite;
  575.         angle:=angle+angle_v;
  576.     End;
  577.  
  578.     SetTextMode;
  579.  
  580.     Writeln('By Minimalist (Lewis A. Sellers) 1996. Part of the C/Pascal/Asm package.');
  581.     Writeln('To contact, email: lsellers@1stresource.com (shortly to be lsellers@usit.net).');
  582.     Writeln('or drop by http://www.dwc.edu/grail, site of the Grail Operating System Project.');
  583.     FreeMem(composite,64000);
  584.     FreeMem(texture,64000);
  585. End.
  586.