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

    version 2.02
    copile/use this in far model
    wait for the new 3.00 version - 70k large

    {$G+}
    type VirtualArray = array[1..64000] of byte;
         VPointer = ^VirtualArray;
         coor = record
                   x,y:word;
                end;
         coordtyp = array [1..2,1..12] of integer;
         fp = longint;
    var  coord : array [1..20] of coor;

    { ******************************* DOS ************************************ }

    function DosMax : longint;assembler;{vrati velikost volne dol. pam. v bytech}
    asm  {OK}
      mov bx,0ffffh
      mov ah,48h
      int 21h
      mov ax,bx
      mov bx,16
      mul bx
    end;

    function GMem(size:longint) : pointer;assembler;
    asm   {OK}
    @@1:
      mov ax,word ptr [size]
      mov dx,word ptr [size+2]
      mov cx,16
      div cx
      inc ax
      mov bx,ax
      mov ah,48h
      int 21h
      jnc @@2
      xor ax,ax
    @@2:
      mov dx,ax
      xor ax,ax
    end;

    procedure FMem(p:pointer);assembler;
    asm   {OK}
      mov es,word ptr [p+2]
      mov ah,49h
      int 21h
    end;

    function ReAlloc(p:pointer; newsize:longint) : pointer;assembler;
    asm   {OK}
      mov ax,word ptr [p+2]
      mov es,ax
      mov ax,word ptr [newsize]
      mov dx,word ptr [newsize+2]
      mov cx,16
      div cx
      inc ax
      mov bx,ax
      mov ah,4ah
      int 21h
      jnc @@end
      xor dx,dx
      xor ax,ax
    @@end:
    end;

    { ******************************* CRT ************************************ }

    { MOUSE }

    procedure MouseInit(no:word);assembler;
    asm
      mov ax,no
      int 33h
    end;

    procedure GetMouse(var x,y,b:word);assembler;
    asm   {OK}
      mov ax,3
      int 33h
      les di,dword ptr [bp+0eh]
      mov word ptr es:[di],bx
      les di,dword ptr [bp+0ah]
      mov word ptr es:[di],cx
      les di,dword ptr [bp+6]
      mov word ptr es:[di],dx
    end;

    procedure SetMWin(x,y,x2,y2:word);assembler;
    asm   {OK}
      mov ax,7
      mov cx,[x]
      mov dx,[x2]
      int 33h
      inc ax
      mov cx,[y]
      mov dx,[y2]
      int 33h
    end;  {OK}

    procedure NewCur(hotspotx,hotspoty:word;var newcursor);assembler;
    asm
    mov ax,word ptr newcursor+2
    mov es,ax
    mov dx,word ptr newcursor
    mov ax,9h
    mov bx,hotspotx
    mov cx,hotspoty
    int 33h
    end;

    { KEYBOARD }

    procedure KeybOn;assembler;
    asm   {OK}
      in al,21h
      and al,11111101b
      out 21h,al
    end;

    procedure KeybOff;assembler;
    asm   {OK}
      in al,21h
      or al,00000010b
      out 21h,al
    end;

    function KeyPressed:boolean;
    begin
      asm
        mov	ah,1
        int	16h
        jnz	@true
        mov	[@result],false
        jmp	@end
    @true:
        mov	[@result],true
    @end:
      end;
    end;

    function ReadKey:char;assembler;
    asm   {OK}
      mov ah,0h
      int 16h
    end;

    { PC SPEAKER }

    procedure NoSound;assembler;
    asm   {OK}
      in al,61h
      and al,0fch
      out 61h,al
    end;

    procedure Sound(hz:word);assembler;
    asm   {OK}
      mov bx,hz
      mov ax,34ddh
      mov dx,0012h
      cmp dx,bx
      jnc @2
      div bx
      mov bx,ax
      in al,61h
      test al,3
      jnz @1
      or al,3
      out 61h,al
      mov al,0b6h
      out 43h,al
    @1:
      mov al,bl
      out 42h,al
      mov al,bh
      out 42h,al
    @2:
    end;

    { MISCELANEOUS }

    procedure XDelay(ms:word);assembler;
    asm   {OK}
      mov ax,1000
      mul ms
      mov cx,dx
      mov dx,ax
      mov ah,86h
      int 15h
    end;

    { ******************************** GRAPH ********************************** }

    { BASIC }

    procedure SetVga(mode:word);assembler;
    asm   {OK}
      mov ax,[mode]
      int 10h
    end;

    procedure Cls(target:word);assembler;
    asm   {OK}
      mov ax,[bp+offset target]
      mov es,ax
      xor di,di
      db 66h; xor ax,ax
      mov cx,16000
      db 0f3h,66h,0abh
    end;

    procedure CCls(color:byte;target:word);assembler;
    asm   {OK}
      mov ax,[target]
      mov es,ax
      xor di,di
      mov cx,16000
      mov al,[color]
      mov ah,al          {hi i low maji hodnotu barvy}
      mov bx,ax
      db 66h; shl ax,16  {ax*65535 -> hi word eax}
      mov ax, bx         {dolni word eax - v kazdym bytu eax je hodnota barvy}
      db 0f3h,66h,0abh   {rep movsd}
    end;

    procedure PPix(x,y: Integer;color:byte;target:word); assembler;
    asm   {OK}
      mov ax,target
      mov es,ax
      mov ax,y
      mov di,ax
      shl ax,6
      shl di,8
      add di,ax
      add di,x
      mov al,color
      mov es:[di],al
    end;

    function GPix(x,y:integer;target:word):byte;assembler;
     asm  {OK}
      mov ax,target
      mov es,ax
       mov ax,y
       mov di,ax
       shl ax,6
       shl di,8
       add di,ax
       add di,x
       mov al,es:[di]
       mov [bp-1],al
    end;

    { 2D GRAPHIC }

    procedure HLn(x1,x2,y:word;col:byte;target:word);assembler;
    asm   {OK}
      mov ax,target
      mov es,ax
      mov ax,y
      mov di,ax
      shl ax,8
      shl di,6
      add di,ax
      add di,x1        {pocatecni x1}
      mov al,col
      mov ah,al
      mov cx,x2
      sub cx,x1        {cx:=x2-x1}
      inc cx
      shr cx,1         {cx:=cx/2}
      jnc @1           {sklace na @1 a misto stosb jede 2* rychlejsi stosw}
      mov es:[di],ah
      inc di
    @1:
      rep stosw      {mov es:[di],ah cx/2*2 krat}
    end;

    procedure HLn32(x1,x2,y:word;col:byte;target:word);assembler;
    asm   {OK}
      mov ax,target
      mov es,ax
      mov ax,y
      mov di,ax
      shl ax,8
      shl di,6
      add di,ax
      add di,x1        {pocatecni x1}
      mov al,col
      mov ah,al
      mov bx,ax
      db $66; shl ax,16
      mov ax,bx
      mov cx,x2
      sub cx,x1        {cx:=x2-x1}
      inc cx
      mov bx,cx
      and bx,3
      shr cx,2
      db 66h; rep stosw
    @2:
      mov es:[di],al
      add di,1
      dec cx
    jns @2
    end;

    procedure VLn(x1,y1,y2:word;c:byte;target:word);assembler;
    asm   {OK}
      mov ax,x1
      mov bx,y1
      mov dx,y2
    @1:
      mov di,bx
      mov cx,di
      shl cx,8
      shl di,6
      add di,cx
      add di,ax
      mov cx,[target]
      mov es,cx
      mov cx,dx
      sub cx,bx
      inc cx
      mov al,c
    @2:
      stosb
      add di,319
      loop @2
    end;

    procedure XLine(x,y,x2,y2:integer;color:byte;target:word);
    var ax,bx,ay,by,f,aa,bb:integer;
    begin
      if x<x2 then begin ax:=1;bx:=x2-x; end
              else begin ax:=-1;bx:=x-x2; end;
      if y<y2 then begin ay:=1;by:=y2-y; end
              else begin ay:=-1;by:=y-y2; end;
      if bx>by then begin
        aa:=(by-bx)*2;
        bb:=by*2;
        f:=bb-bx;
        repeat
          if(f>=0)then begin inc(y,ay);inc(f,aa);end
                  else inc(f,bb);inc(x,ax);
          PPix(x,y,color,target);
        until(x=x2);
      end
               else begin
        aa:=(bx-by)*2;
        bb:=bx*2;
        f:=bb-by;
        repeat
          if(f>=0)then begin inc(x,ax);inc(f,aa);end
                  else inc(f,bb);inc(y,ay);
          PPix(x,y,color,target);
        until(y=y2);
      end;
    end;

    procedure XCircle(x,y:integer;radius,ankle:word;color:byte;
                      presnost:word;posun:integer;target:word); {posun- 1/8 presnosti}
    var g,h,e,f,c,d,a:real;
    i,rotX,rotY:integer;
    b:word;
    begin
      a:=presnost/ankle;
      b:=round(presnost*(ankle/360));
      c:=a*radius;
      d:=(2*Pi)/presnost;
      e:=5/6;
      for i:=posun to posun+b do begin
        f:=d*i;
        g:=c*sin(f);
        h:=c*cos(f);
        rotX:=round((g-h)/a);
        rotY:=round(((g+h)/a)*e);
        ppix((rotX+x),(rotY+y),color,target);
      end;
    end;

    procedure Ellipse(x,y,a,b:integer;c:byte;target:word);
    var xa,ya:integer;
        aa,aa2,bb,bb2,d,dx,dy:longint;
    begin
      xa:=0;ya:=b;
      aa:=longint(a)*a;aa2:=2*aa;
      bb:=longint(b)*b;bb2:=2*bb;
      d:=bb-aa*b+aa div 4;
      dx:=0;dy:=aa2*b;
      ppix(x,y-ya,c,target);
      ppix(x,y+ya,c,target);
      ppix(x-a,y,c,target);
      ppix(x+a,y,c,target);
      while(dx<dy)do begin
          if(d>0)then begin dec(ya);
          dec(dy,aa2);
          dec(d,dy);
        end;
        inc(xa);
        inc(dx,bb2);
        inc(d,bb+dx);
        ppix(x+xa,y+ya,c,target);
        ppix(x-xa,y+ya,c,target);
        ppix(x+xa,y-ya,c,target);
        ppix(x-xa,y-ya,c,target);
      end;
      inc(d,(3*(aa-bb)div 2-(dx+dy))div 2);
      while(ya>0)do begin
          if(d<0)then begin
          inc(xa);
          inc(dx,bb2);
          inc(d,bb+dx);
        end;
        dec(ya);
        dec(dy,aa2);
        inc(d,aa-dy);
        ppix(x+xa,y+ya,c,target);
        ppix(x-xa,y+ya,c,target);
        ppix(x+xa,y-ya,c,target);
        ppix(x-xa,y-ya,c,target);
      end;
    end;

    procedure FillEllipse(x,y,a,b:integer;c:byte;target:word);
    var xa,ya:integer;
        aa,aa2,bb,bb2,d,dx,dy:longint;
    begin
      xa:=0;ya:=b;
      aa:=longint(a)*a;
      aa2:=2*aa;
      bb:=longint(b)*b;
      bb2:=2*bb;
      d:=bb-aa*b+aa div 4;
      dx:=0;dy:=aa2*b;
      vLn(x,y-ya,y+ya,c,target);
      while(dx<dy)do begin
          if(d>0)then begin dec(ya);
          dec(dy,aa2);
          dec(d,dy);
        end;
        inc(xa);
        inc(dx,bb2);
        inc(d,bb+dx);
        vLn(x-xa,y-ya,y+ya,c,target);
        vLn(x+xa,y-ya,y+ya,c,target);
      end;
      inc(d,(3*(aa-bb)div 2-(dx+dy))div 2);
      while(ya>=0)do begin
          if(d<0)then begin
          inc(xa);
          inc(dx,bb2);
          inc(d,bb+dx);
          vLn(x-xa,y-ya,y+ya,c,target);
          vLn(x+xa,y-ya,y+ya,c,target);
        end;
        dec(ya);
        dec(dy,aa2);
        inc(d,aa-dy);
      end;
    end;

    procedure Triangle(x1,y1,x2,y2,x3,y3:integer;color:byte;target:word);
    var
     x,minY,maxY,ax,bx,yy,p1,q1,p2,q2,p3,q3:integer;
    begin
      minY:=y1; maxY:=y1;
      if y2<minY then minY:=y2;
      if y2>maxY then maxY:=y2;
      if y3<minY then minY:=y3;
      if y3>maxY then maxY:=y3;
      p1:=x1-x3; q1:=y1-y3;
      p2:=x2-x1; q2:=y2-y1;
      p3:=x3-x2; q3:=y3-y2;
      for yy:=minY to maxY do
        begin
          ax:=320;
          bx:=-1;
          if (y3>=yy) or (y1>=yy) then
            if (y3<=yy) or (y1<=yy) then
              if not(y3=y1) then begin
                  x:=(yy-y3)*p1 div q1+x3;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
          if (y1>=yy) or (y2>=yy) then
            if (y1<=yy) or (y2<=yy) then
              if not(y1=y2) then begin
                  x:=(yy-y1)*p2 div q2+x1;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
          if (y2>=yy) or (y3>=yy) then
            if (y2<=yy) or (y3<=yy) then
              if not(y2=y3) then begin
                  x:=(yy-y2)*p3 div q3+x2;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
          if ax<=bx then hln(ax,bx,yy,color,target);
        end;
    end;

    procedure XTriangle(x1,y1,x2,y2,x3,y3:integer;color:byte;target:word);assembler;
    var tmp1,tmp2,neg1,neg2,ax1,ax2,ay1,ay2:integer;
    asm   {OK}
      cli                      {y-trideni}
      mov cx,2                 {cx=2}
    @sort:
      mov ax,[y2]
      cmp ax,[y3]
      jbe @ok1                { if y2 <= y3 then @ok1 }
      xor ax,[y3]
      xor [y3],ax
      xor ax,[y3]
      mov [y2],ax
      mov ax,[x2]             {ted neco jako xchg y2,y3}
      xor ax,[x3]
      xor [x3],ax
      xor ax,[x3]
      mov [x2],ax             {stejne pro x}
      @ok1:
        mov ax,[y1]
        cmp ax,[y2]
        jbe @ok2              {kdyz je y1 vetsi,jak y2 pak na @3}
        xor ax,[y2]
        xor [y2],ax
        xor ax,[y2]
        mov [y1],ax           {jinak xchg y1,y2}
        mov ax,[x1]
        xor ax,[x2]
        xor [x2],ax
        xor ax,[x2]
        mov [x1],ax           {xchg x1,x2}
      @ok2:
        mov ax,[y1]
        cmp ax,[y3]
        jbe @ok3              {y1<=y3 pak ok}
        xor ax,[y3]
        xor [y3],ax
        xor ax,[y3]
        mov [y1],ax           {xchg y1,y3}
        mov ax,[x1]
        xor ax,[x3]
        xor [x3],ax
        xor ax,[x3]           {xchg x1,x3}
        mov [x1],ax
      @ok3:
    loop @sort
      mov dx,[y1]             {vypocet offsetu}
      shl dx,6
      mov bx,dx
      shl dx,2
      add dx,bx
      add dx,[x1]
      mov si,dx               {si,dx:=320*y1+x1}
      mov ax,[y3]             {vypocet ay-nu}
      sub ax,[y1]
      inc ax
      mov [ay1],ax            {*ay1=y3-y1}
      mov [tmp1],ax           {*tmp1=y3-y1}
      mov ax,[y2]
      sub ax,[y1]
      inc ax
      mov [ay2],ax            {*ay2=y2-y1}
      mov [tmp2],ax           {*tmp2=y2-y1}
                              {vypocet ax-u}
      mov [neg1],1            {*if1=1}
      mov ax,[x3]
      sub ax,[x1]             {ax,sirka}
      jnc @noneg1             {kdyz>=0 pak skip, jinak}
      neg ax                  {a dostanu abs(x3-x1)}
      neg [neg1]              {*neg1=65535}
    @noneg1:
      inc ax                  {inc sirka}
      mov [ax1],ax            {*ax1=x3-x1}
      mov [neg2],1            {*neg2=1}
      mov ax,[x2]
      sub ax,[x1]
      jnc @noneg2             {x2-x1 jnc skok}
      neg ax                  {neg-abs}
      neg [neg2]              {*neg2=65535}
    @noneg2:
      inc ax
      mov [ax2],ax            {*ax2=x2-x1}

      mov ax,[target]
      mov es,ax
      mov al,[color]
      mov ah,al               {ax,color}
      mov cx,[ay2]            {od y1 do y2}
    @draw1:
      push cx
      mov di,dx               {hln}
      mov cx,si
      cmp cx,di
      ja @noswap1
      xchg cx,di
    @noswap1:
      sub cx,di
      inc cx
      shr cx,1
      jnc @1
      stosb
    @1:
      rep stosw
                              {zmena tmpu a ay}
      mov bx,[tmp1]           {bx=y3-y1}
      sub bx,[ax1]            {bx:=(y3-y1)-(x3-x1)}
      cmp bx,0
      jg @no1                 {=0 then skok, else..}
    @yes1:
      add bx,[ay1]            {bx:=2*(y3-y1)-(x3-x1)}
      add dx,[neg1]           {add dx,1 nebo 65535}
      cmp bx,0
      jle @yes1               {loop}
    @no1:
      add dx,320              {offset+320}
      mov [tmp1],bx

      mov bx,[tmp2]           {y2-y1}
      sub bx,[ax2]            {-(x2-x1)}
      cmp bx,0
      jg @no2
    @yes2:
      add bx,[ay2]
      add si,[neg2]
      cmp bx,0
      jle @yes2               {dokud bx>=0}
    @no2:
      add si,320              {add ofs2,320}
      mov [tmp2],bx
      pop  cx
    loop @draw1

    {2. cast polyho}
      push dx
      mov dx,[y3]
      sub dx,[y2]
      inc dx
      mov [ay2],dx
      mov [tmp2],dx
      mov [neg2],1
      mov dx,[x3]
      sub dx,[x2]
      jnc @x2pos
      neg dx
      neg [neg2]
    @x2pos:
      inc dx
      mov [ax2],dx
      pop dx
      mov cx,[ay2]
    @draw2:
      push cx
      mov di,dx
      mov cx,si
      cmp cx,di
      ja @noswap2
      xchg cx,di
    @noswap2:
      sub cx,di
      inc cx
      shr cx,1
      jnc @2
      stosb
    @2:
      rep stosw
      mov bx,[tmp1]
      sub bx,[ax1]
      cmp bx,0
      jg @no3
    @yes3:
      add bx,[ay1]
      add dx,[neg1]
      cmp bx,0
      jle @yes3
    @no3:
      add dx,320
      mov [tmp1],bx

      mov bx,[tmp2]
      sub bx,[ax2]
      cmp bx,0
      jg @no4
    @yes4:
      add bx,[ay2]
      add si,[neg2]
      cmp bx,0
      jle @yes4
    @no4:
      add si,320
      mov [tmp2],bx
      pop cx
      loop @draw2
    @exit:
      sti
    end;

    procedure Poly4(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;target:word);
    var
     x,minY,maxY,ax,bx,yy,p1,q1,p2,q2,p3,q3,p4,q4:integer;
    begin
      minY:=y1; maxY:=y1;
      if y2<minY then minY:=y2;
      if y2>maxY then maxY:=y2;
      if y3<minY then minY:=y3;
      if y3>maxY then maxY:=y3;
      if y4<minY then minY:=y4;
      if y4>maxY then maxY:=y4;
    {y2-4 se porovnaji k y1, ziska se nejmensi a nejvetsi y}
      if minY<0 then minY:=0;
      if maxY>199 then maxY:=199;
      if minY>199 then exit;
      if maxY<0 then exit;
    {nebude se prekreslovat zpatky}
      p1:=x1-x4; q1:=y1-y4;
      p2:=x2-x1; q2:=y2-y1;
      p3:=x3-x2; q3:=y3-y2;
      p4:=x4-x3; q4:=y4-y3;
    {vzdalenosti mezi vsemy x a mezi vsemy y}
    {pro vysku polyho dela..}
      for yy:=minY to maxY do
        begin
          ax:=320;
          bx:=-1;
          if (y4>=yy) or (y1>=yy) then
            if (y4<=yy) or (y1<=yy) then   {jestlize je yy mezi y1 a y4 pak.. }
              if not(y4=y1) then begin
                  x:=(yy-y4)*p1 div q1+x4;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
          if (y1>=yy) or (y2>=yy) then
            if (y1<=yy) or (y2<=yy) then   {jestlize je yy mezi y1 a y2 pak..}
              if not(y1=y2) then begin
                  x:=(yy-y1)*p2 div q2+x1;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
          if (y2>=yy) or (y3>=yy) then
            if (y2<=yy) or (y3<=yy) then  {jestlize je yy mezi y2 a y3 pak..}
              if not(y2=y3) then begin
                  x:=(yy-y2)*p3 div q3+x2;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
          if (y3>=yy) or (y4>=yy) then
            if (y3<=yy) or (y4<=yy) then   {jestlize je yy mezi y3 a y4 pak..}
              if not(y3=y4) then begin
                  x:=(yy-y3)*p4 div q4+x3;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
          if ax<0 then ax:=0;
          if bx>319 then bx:=319;
          if ax<=bx then hln(ax,bx,yy,color,target);      {horesli horiz. caru}
        end;
    end;

    procedure PolyInit(var init:coordtyp;PocetBodu:byte);
    var i:byte;
    begin
    for i:=1 to PocetBodu do
      begin
        coord[i].x:=init[1,i];
        coord[i].y:=init[2,i];
      end;
    end;

    procedure XPoly(rohu:byte;color:byte;target:word);
    type int=record
           p,q:integer;
           end;
    var yy,x,ax,bx,i,minY,maxY:integer;
    internal:array[1..20] of int;
    begin
      minY:=coord[1].y;
      maxY:=coord[1].y;
      for i:=2 to rohu do begin
        if coord[i].y<minY then minY:=coord[i].y;
        if coord[i].y>maxY then maxY:=coord[i].y;
      end;
      if minY<0 then minY:=0;
      if maxY>199 then maxY:=199;
      if minY>199 then exit;
      if maxY<0 then exit;
      internal[1].p:=coord[1].x-coord[rohu].x;
      internal[1].q:=coord[1].y-coord[rohu].y;
      for i:=0 to rohu-2 do
        begin
          internal[i+2].p:=coord[i+2].x-coord[i+1].x;
          internal[i+2].q:=coord[i+2].y-coord[i+1].y;
        end;
      for yy:=minY to MaxY do
        begin
          ax:=320;
          bx:=-1;
          if (coord[rohu].y>=yy) or (coord[1].y>=yy) then
            if (coord[rohu].y<=yy) or (coord[1].y<=yy) then
              if not(coord[rohu].y=coord[1].y) then begin
                  x:=(yy-coord[rohu].y)*internal[1].p div internal[1].q+coord[rohu].x;
                  if x<ax then ax:=x;
                  if x>bx then bx:=x;
                end;
              if ax<0 then ax:=0;
              if bx>319 then bx:=319;
              if ax<=bx then hln(ax,bx,yy,color,target);
           for i:=0 to rohu-2 do begin
             if (coord[i+1].y>=yy) or (coord[i+2].y>=yy) then
               if (coord[i+1].y<=yy) or (coord[i+2].y<=yy) then
                 if not(coord[i+1].y=coord[i+2].y) then begin
                     x:=(yy-coord[i+1].y)*internal[i+2].p div internal[i+2].q+coord[i+1].x;
                     if x<ax then ax:=x;
                     if x>bx then bx:=x;
                 if ax<0 then ax:=0;
                 if bx>319 then bx:=319;
                 if ax<=bx then hln(ax,bx,yy,color,target);
          end;
        end;
      end;
    end;

    { PALETTE }

    procedure SetRGB(color,r,g,b:Byte);assembler;
    asm   {OK}
      mov dx,3c8h
      mov al,[Color]
      out dx,al
      inc dx
      mov al,[r]
      out dx,al
      mov al,[g]
      out dx,al
      mov al,[b]
      out dx,al
    end;

    procedure GetRGB(Color:byte;var r,g,b:byte);assembler;
    asm   {OK}
      mov dx,3c7h
      mov al,[color]
      out dx,al
      inc dx
      inc dx
      in  al,dx
      les di,dword ptr [bp+14]
      mov byte ptr es:[di],al
      in al,dx
      les di,dword ptr [bp+10]
      mov byte ptr es:[di],al
      in al,dx
      les di,dword ptr [bp+6]
      mov byte ptr es:[di],al
    end;

    procedure RotPal(r,g,b:byte;skipR,skipG,skipB:boolean;loops,ms:integer);
    type
      tcount = record
                r,g,b:real;
              end;
    var
      i,c,rr,gg,bb:byte;
      red,blue,green:real;
      current,count:array [0..255] of tcount;
    begin
      for c:=0 to 255 do begin
        getrgb(c,rr,gg,bb);
        if skipr=false then count[c].r:=(r-rr)/loops;
        if skipg=false then count[c].g:=(g-gg)/loops;
        if skipb=false then count[c].b:=(b-bb)/loops;
        current[c].r:=rr;
        current[c].g:=gg;
        current[c].b:=bb;
      end;
      for i:=1 to loops do begin
        for c:=0 to 255 do begin
          if skipr=false then current[c].r:=count[c].r+current[c].r;
          if skipg=false then current[c].g:=count[c].g+current[c].g;
          if skipb=false then current[c].b:=count[c].b+current[c].b;
          setrgb(c,round(current[c].r),round(current[c].g),round(current[c].b));
        end;
        xdelay(ms);
      end;
    end;

    procedure FadeIn(r,g,b:byte;loops,ms:integer);
    type
      tcount = record
                r,g,b:real;
              end;
    var
      i,c,rr,gg,bb:byte;
      red,blue,green:real;
      current,count:array [0..255] of tcount;
    begin
      for c:=0 to 255 do begin
        getrgb(c,rr,gg,bb);
        count[c].r:=(r-rr)/loops;
        count[c].g:=(g-gg)/loops;
        count[c].b:=(b-bb)/loops;
        current[c].r:=rr;
        current[c].g:=gg;
        current[c].b:=bb;
      end;
      for i:=1 to loops do begin
        for c:=0 to 255 do begin
          current[c].r:=count[c].r+current[c].r;
          current[c].g:=count[c].g+current[c].g;
          current[c].b:=count[c].b+current[c].b;
          setrgb(c,round(current[c].r),round(current[c].g),round(current[c].b));
        end;
        xdelay(ms);
      end;
    end;

    { VIRTUAL SCREENS }

    function VSetup(VScreen:VPointer):word;
    begin {OK}
      new(Vscreen);
      VSetup:=seg(vscreen^);
    end;

    procedure VDispose(Va:word);
    var vscreen:pointer absolute va;
    begin {OK}
      dispose(Vscreen);
    end;

    procedure Flip(source,target:word);assembler;
    asm   {OK}
      push ds {kdyz se neulozi, pak je hodnota pointru nil a je to v prdeli}
      mov ax,target
      mov es,ax         {target:=es:[di]}
      mov ax,Source
      mov ds,ax         {sourcre:=ds:[si]}
      xor si,si
      xor di,di
      mov cx,16000
      db $f3,66h,$a5    {rep movsd}
      pop ds
    end;

    procedure FImage(x1,y1,x2,y2,sx,sy:integer;source,target:word);assembler;
    asm
    push ds
      mov ax,target
      mov es,ax         {target:=es:[di]}
      mov ax,Source
      mov ds,ax         {sourcre:=ds:[si]}
      mov si,y1
      mov ax,si
      shl si,6
      shl ax,8
      add si,ax
      add si,x1          {source}
      mov di,sy
      mov ax,di
      shl di,6
      shl ax,8
      add di,ax
      add di,sx           {dest}
      mov cx,y2
      sub cx,y1
      inc cx  {h}
      mov dx,x2
      sub dx,x1
      inc dx  {w}
      mov ax,dx
      and ax,3
    @loop:
      mov bx,cx
      mov cx,dx
      shr cx,2
      db 66h; rep movsw
      mov cx,ax
      rep movsb
      add si,320
      add di,320
      sub si,dx
      sub di,dx
      mov cx,bx
      loop @loop
      pop ds
    end;

    { IMGAES & BITMAPS }

    procedure Bitmap(x,y,w,h:word;var bitmap);assembler;
    asm
      push ds
      mov ax,word ptr bitmap+2
      mov ds,ax
      mov ax,$0a000
      mov es,ax
      mov si,word ptr bitmap
      mov ax,[y]
      mov di,ax
      shl ax,8
      shl di,6
      add di,ax
      add di,[x]
      mov cx,[h]
    @loop:
      mov bx,cx
      mov cx,[w]
      shr cx,1
      jnc @1
      movsb
    @1:
      rep movsw
      add di,320
      sub di,[w]
      mov cx,bx
      loop @loop
      pop ds
    end;

    procedure RLEBitmap(x,y,w,h:word;var bitmap);assembler;
    asm
      push ds
      mov ax,word ptr bitmap+2
      mov ds,ax
      mov ax,$0a000
      mov es,ax
      xor si,si
      xor di,di
      mov si,word ptr bitmap
      mov ax,[y]
      mov di,ax
      shl ax,8
      shl di,6
      add di,ax
      add di,[x]
      mov cx,[h]
    @loop:
      mov bx,cx
      mov cx,[w]
    @1:
      mov al,ds:[si]
      cmp al,0
      je @2
      mov es:[di],al
      @2:
      inc di
      inc si
    loop @1
      add di,320
      sub di,[w]
      mov cx,bx
      loop @loop
      pop ds
    end;

    procedure ScBitmap(x,y,w,h,tox,toy:word;var bitmap);
    var tmp1,rx,repx,restx,ry,repy,resty:word;
    {tmp1=add di,320 sub di,tox}
    begin
    repx:=tox div w;
    restx:=tox mod w;
    rx:=restx;
    repy:=toy div h;
    resty:=toy mod h;
    ry:=resty;
    asm
    mov ax,320
    sub ax,tox
    mov tmp1,ax

    push ds
    mov ax,word ptr bitmap+2
    mov ds,ax
    mov ax,0a000h
    mov es,ax
    mov si,word ptr bitmap
    mov ax,[y]
    mov di,ax
    shl ax,8
    shl di,6
    add di,ax
    add di,[x]

    mov cx,[h]
    @loop:
      mov dx,cx
      mov bx,repy
      @line:
         mov cx,[w]
         @pixel:
            mov ax,repx
            @rep:
              movsb
              dec si
              dec ax
            jnz @rep
            mov ax,restx
            cmp ax,0
            je @no_rest
              movsb
              dec restx
              dec si
            @no_rest:
            inc si
            dec cx
        jnz @pixel
      add di,tmp1
      mov ax,rx
      mov restx,ax
    sub si,[w]
    dec bx
    jnz @line

    mov bx,resty
    cmp bx,0
    je @no_ry
      mov cx,[w]
      @pixel2:
         mov ax,repx
         @rep2:
           movsb
           dec si
           dec ax
         jnz @rep2
         mov ax,restx
         cmp ax,0
         je @no_rest2
           movsb
           dec restx
           dec si
         @no_rest2:
         inc si
         dec cx
      jnz @pixel2
      add di,tmp1
      mov ax,rx
      mov restx,ax
    sub si,[w]
    dec bx
    mov resty,bx
     @no_ry:
    add si,[w]
    mov cx,dx
    dec cx
    jnz @loop
    end;
    end;

    procedure GImage(x,y,x2,y2:word;p:pointer);assembler;
    asm   {OK}
      push ds
      mov es,word ptr p+2
      mov di,word ptr p
      mov ax,0a000h
      mov ds,ax
      mov dx,[bp+offset x2]
      sub dx,[bp+offset x]
      inc dx
      mov ax,dx
      and ax,3
      mov es:[di],dx        {sirka dx}
      mov cx,[bp+offset y2]
      sub cx,[bp+offset y]
      inc cx
      mov es:[di+2],cx      {vyska cx}
      add di,4
      mov si,[bp+offset y]
      mov bx,si
      shl si,8
      shl bx,6
      add si,bx
      add si,[bp+offset x]
    @loop:
      mov bx,cx
      mov cx,dx
      shr cx,2
      db 66h; rep movsw
      mov cx,ax
      rep movsb
      add si,320
      sub si,dx
      mov cx,bx
      loop @loop
      pop ds
    end;

    procedure PImage(x,y:word;p:pointer);assembler;
    asm
      push ds
      mov ds,word ptr p+2
      mov si,word ptr p
      mov ax,0a000h
      mov es,ax
      mov cx,word ptr ds:[si+2]   {vyska}
      mov ax,word ptr ds:[si]
      mov dx,ax                   {sirka}
      and ax,3   {sub dx,(dx shr,2 ; dx shl,2)}
      add si,4
      mov di,[bp+offset y]
      mov bx,di
      shl di,8
      shl bx,6
      add di,bx
      add di,[bp+offset x]
    @loop:
      mov bx,cx
      mov cx,dx
      shr cx,2
      db 66h; rep movsw
      mov cx,ax
      rep movsb
      add di,320
      sub di,dx
      mov cx,bx
      loop @loop
      pop ds
    end;

    procedure Save2File(x,y,x2,y2:integer;filename:string);
    var
    f:file;
    p:pointer;
    size:word;
    begin
      assign(f,filename);
      size:=abs(x2-x)*abs(y2-y)+10;
      rewrite(f,size);
      GetMem(p,size);
      GImage(x,y,x2,y2,p);
      BlockWrite(f,p^, 1);
      freemem(p,size);
      close(f);
    end;

    procedure LoadFFile(x,y,sx,sy,sx2,sy2:integer;filename:string);
    var
    f:file;
    p:pointer;
    size:word;
    begin
      assign(f,filename);
      size:=abs(sx2-sx)*abs(sy2-sy)+10;
      reset(f,size);
      GetMem(p,size);
      BlockRead(f,p^, 1);
      PImage(x,y,p);
      FreeMem(p,size);
      close(f);
    end;

    { SCROLLING }

    procedure ScrollDown(x1,y1,x2,y2:integer);assembler;
    asm   {OK}
      push ds
      mov ax,$a000
      mov es,ax
      mov ds,ax
      mov si,[y1]
      mov cx,[y2]
      mov ax,cx
      mov bx,cx
      shl ax,8
      shl bx,6
      add ax,bx
      sub cx,si
      inc cx
      mov bx,[x1]
      mov dx,[x2]
      add ax,bx
      sub dx,bx
      inc dx
      cld
    @1:
      mov bx,cx
      mov di,ax
      mov si,ax
      sub si,320
      mov cx,dx
      shr cx,2
      db $f3,$66,$a5  {rep movsd}
      mov cx,dx
      and cx,3
      rep movsb
    @2:
      mov cx,bx
      sub ax,320
      loop @1
      pop ds
    end;

    procedure ScrollLeft(X1,Y1,X2,Y2:integer);assembler;
    asm   {OK}
      push ds
      mov ax,$a000
      mov es,ax
      mov ds,ax
      mov si,[y1]
      mov ax,si
      shl ax,6
      shl si,8
      add si,ax
      mov cx,[y2]
      sub cx,si
      inc cx
      mov dx,[x1]
      add ax,dx
      mov bx,[x2]
      sub bx,dx
      inc bx
      cld
    @1:
      mov dx,cx
      mov di,ax
      dec di
      mov si,ax
      mov cx,bx
      shr cx,2
      db $f3,$66,$a5  {rep movsd}
      mov cx,bx
      and cx,3
      rep movsb
    @2:
      mov cx,dx
      add ax,320
      loop @1
      pop ds
    end;

    procedure ScrollRight(x1,y1,x2,y2:integer);assembler;
    asm   {OK}
      push ds
      mov ax,$a000
      mov es,ax
      mov ds,ax
      mov si,[y1]
      mov ax,si
      shl ax,6
      shl si,8
      add si,ax
      mov cx,[y2]
      sub cx,si
      inc cx
      mov dx,[x1]
      mov bx,[x2]
      add ax,bx
      sub bx,dx
      inc bx
      std
    @1:
      mov dx,cx
      mov di,ax
      mov si,ax
      dec si
      mov cx,bx
      shr cx,2
      db $f3,$66,$a5  {rep movsd}
      mov cx,bx
      and cx,3
      rep movsb

    @2:
      mov cx,dx
      add ax,320
      loop @1
      cld
      pop ds
    end;

    procedure ScrollUp(x1,y1,x2,y2:integer);assembler;
    asm   {OK}
      push ds
      mov ax,$a000
      mov es,ax
      mov ds,ax
      mov si,[y1]
      mov cx,[y2]
      sub cx,si
      inc cx
      mov ax,si
      shl si,8
      shl ax,6
      add ax,si
      mov dx,[x1]
      add ax,dx
      mov bx,[x2]
      sub bx,dx
      inc bx
      cld
    @1:
      mov dx,cx
      mov di,ax
      sub di,320
      mov si,ax
      mov cx,bx
      shr cx,2
      db $f3,$66,$a5  {rep movsd}
      mov cx,bx
      and cx,3
      rep movsb

    @2:
      mov cx,dx
      add ax,320
      loop @1
      pop ds
    end;

    { MISCELANEOUS }

    procedure WaitRet; assembler;
    asm   {OK}
      mov dx,3dah
      @1:
        in al,dx
        test al,08h
        jnz @1
      @2:
        in al,dx
        test al,08h
        jz @2
    end;

    { VESA }

    var  VI : record
                 MAtrib : word;
                 WinA : byte;
                 WinB : byte;
                 WGran : word;
                 WSize : word;
                 WsegA : word;
                 WsegB : word;
                 SetBank : procedure;
                 ScanLn : word;
                 ScreenW : word;
                 ScreenH : word;
                 CharW : byte;
                 CharH : byte;
                 Planes : byte;
                 BitsPixel : byte;
                 Banks : byte;
                 MemModel : byte;
                 BnkSize : byte;
                 ImgPages : byte;
                 Res1 : byte;
                 RMSize : byte;
                 RFPos : byte;
                 GMSize : byte;
                 GFPos : byte;
                 BMSize : byte;
                 BFPos : byte;
                 MSize : byte;
                 MPos : byte;
                 DCinfo : byte;
                 Res2 : byte;
                 trash : array [$2a..255] of byte;
    end;
    cbank : byte;

    procedure GetMode(mode:word);assembler;
    asm   {OK}
      mov ax,ds       { protoze je to vlastne promenna }
      mov es,ax
      mov ax,4f01h
      mov cx,mode
      mov di,offset VI
      int 10h
    end;

    function SetVesa(mode:word):boolean;assembler;
    asm   {OK}
      mov ax,4f02h
      mov bx,mode
      int 10h
      sub ax,004fh
      mov [bp-1],al
    end;

    function GetVesa:word;assembler;
    asm   {OK}
      mov ax,4f03h
      int 10h
      cmp ax,004fh
      je @ok
      mov ax,-1
      jmp @end
    @ok:
      mov ax,bx
    @end:
     end;

    procedure GScanLn(var BytesPerScanline,PixsPerScanline,NumOfScanlines:word);assembler;
    asm   {OK}
      mov ax,4f06h
      mov bl,01h
      int 10h
      les di,dword ptr [bp+0eh]
      mov word ptr es:[di],bx
      les di,dword ptr [bp+0ah]
      mov word ptr es:[di],cx
      les di,dword ptr [bp+6]
      mov word ptr es:[di],dx
    end;

    procedure SScanLn(width:word);assembler;
    asm   {OK}
    mov ax,4f06h
    mov bl,00h
    mov cx,word ptr width
    int 10h
    end;

    procedure GDStart(var x,y:integer);assembler; { Get Display Start }
    asm   {OK}
      mov ax,4f07h
      mov bx,0001h
      int 10h
      les di,dword ptr [bp+0ah]
      mov word ptr es:[di],cx
      les di,dword ptr [bp+6]
      mov word ptr es:[di],dx
    end;

    procedure SDStart(x,y:integer);assembler; { Set Display Start }
    asm   {OK}
      mov ax,4f07h
      sub bx,bx
      mov cx,word ptr x
      mov dx,word ptr y
      int 10h
    end;

    procedure PPix8(x,y:word;c:byte);assembler;
    { vypocet efektivni adresy:
    1024x768x256:
    db 66h;mov di,y
    db 66h;shl di,10
    db 66h;add di,x      ;  y:=y*1024+x
    db 66h;mov dx,di     ;  puvodni mul uklada to co se nevleze do r16,r/m16
    db 66h;shr dx,16     ;  do dx:ax, s dx se ale dal pracuje a nepouziva se
    edx proto nakonci ten shrdx,16}
    asm   {OK}
      mov ax,$0a000
      mov es,ax
      mov di,x
      mov ax,y
      mul vi.screenw
      add di,ax
      adc dx,0
      cmp dl,cbank
      je @skip
      mov cbank,dl
      mov ax,4f05h
      xor bx,bx
      adc dx,0
      int 10h
    @skip:
      mov al,byte ptr c
      mov es:[di],al
    end;

    { ********************************* MATH ********************************** }
    { 8087x }

    procedure Init8087;assembler;
    asm
      finit
    end;

    function fmul(s1,s2:single):single;
    var s:single;
    begin
    asm
      fld s1
      fmul s2
      fstp s
    end;
      fmul:=s;
    end;

    function fdiv(s1,s2:single):single;
    var s:single;
    begin
    asm
      fld s1
      fdiv s2
      fstp s
    end;
      fdiv:=s;
    end;

    function fadd(s1,s2:single):single;
    var s:single;
    begin
    asm
      fld s1
      fadd s2
      fstp s
    end;
      fadd:=s;
    end;

    function fsub(s1,s2:single):single;
    var s:single;
    begin
    asm
      fld s1
      fsub s2
      fstp s
    end;
      fsub:=s;
    end;

    function fabs(s1:single):single;
    var s:single;
    begin
    asm
      fld s1
      fabs
      fstp s
    end;
      fabs:=s;
    end;

    function fneg(s1:single):single;
    var s:single;
    begin
    asm
      fld s1
      fchs
      fstp s
    end;
      fneg:=s;
    end;

    function fsqrt(s1:single):single;
    var s:single;
    begin
    asm
      fld s1
      fsqrt
      fstp s
    end;
      fsqrt:=s;
    end;

    function fround(s1:single):single;
    var s:single;
    begin
    asm
      fld s1
      frndint
      fstp s
    end;
      fround:=s;
    end;

    procedure fnop;assembler;
    asm
    fnop
    end;

    function esc:byte;assembler;
    asm
    in al,60h
    mov [bp-1],al
    end;

    { ----------------------------- CUT HERE ---------------------------------- }

    var va1,c,color:word;
    x,y,Gd,Gm:integer;
    vs1:vpointer;
    p:pointer;

    const Cur: array [0..1,0..15] of word=
                         (($FFCF,                    { 1111111111001111 } { PenCursor}
                           $FF87,                    { 1111111110000111 }
                           $FF03,                    { 1111111100000011 }
                           $FE01,                    { 1111111000000001 }
                           $FC03,                    { 1111110000000011 }
                           $F807,                    { 1111100000000111 }
                           $F00F,                    { 1111000000001111 }
                           $E01F,                    { 1110000000011111 }
                           $C03F,                    { 1100000000111111 }
                           $807F,                    { 1000000001111111 }
                           $00FF,                    { 0000000011111111 }
                           $01FF,                    { 0000000111111111 }
                           $03FF,                    { 0000001111111111 }
                           $07FF,                    { 0000011111111111 }
                           $0FFF,                    { 0000111111111111 }
                           $9FFF),                   { 1001111111111111 }
                          ($0000,                    { 0000000000000000 }
                           $0030,                    { 0000000000110000 }
                           $0078,                    { 0000000001111000 }
                           $009C,                    { 0000000010011100 }
                           $01E8,                    { 0000000111101000 }
                           $03F0,                    { 0000001111110000 }
                           $07E0,                    { 0000011111100000 }
                           $0FC0,                    { 0000111111000000 }
                           $1F80,                    { 0001111110000000 }
                           $2700,                    { 0010011100000000 }
                           $7A00,                    { 0111101000000000 }
                           $5C00,                    { 0101110000000000 }
                           $4800,                    { 0100100000000000 }
                           $5000,                    { 0101000000000000 }
                           $6000,                    { 0110000000000000 }
                           $0000));                  { 0000000000000000 }

    const Cur2: array [0..1,0..15] of word=
                         (($0000,                    { 0000000000000000 }
                           $0000,                    { 0000000000110000 }
                           $0000,                    { 0000000001111000 }
                           $0000,                    { 0000000010011100 }
                           $0000,                    { 0000000111101000 }
                           $0000,                    { 0000001111110000 }
                           $0000,                    { 0000011111100000 }
                           $0000,                    { 0000111111000000 }
                           $0000,                    { 0001111110000000 }
                           $0000,                    { 0010011100000000 }
                           $0000,                    { 0111101000000000 }
                           $0000,                    { 0101110000000000 }
                           $0000,                    { 0100100000000000 }
                           $0000,                    { 0101000000000000 }
                           $0000,                    { 0110000000000000 }
                           $0000)
                           ,($FFfF,                    { 1111111111001111 } { PenCursor}
                           $FFff,                    { 1111111110000111 }
                           $FFff,                    { 1111111100000011 }
                           $Ffff,                    { 1111111000000001 }
                           $Ffff,                    { 1111110000000011 }
                           $Ffff,                    { 1111100000000111 }
                           $FffF,                    { 1111000000001111 }
                           $fffF,                    { 1110000000011111 }
                           $fffF,                    { 1100000000111111 }
                           $ffff,                    { 1000000001111111 }
                           $ffFF,                    { 0000000011111111 }
                           $fffF,                    { 0000000111111111 }
                           $fFfF,                    { 0000001111111111 }
                           $fFFf,                    { 0000011111111111 }
                           $FfFF,                    { 0000111111111111 }
                           $FFfF));                  { 1001111111111111 }
                                            { 0000000000000000 }

    const map:array[1..7,1..17] of byte=(
    (05,15,05,15,05,15,05,15,05,15,05,15,05,15,05,15,05),
    (15,05,15,05,15,05,15,05,15,05,15,05,15,05,15,05,15),
    (05,15,05,15,05,15,05,15,05,15,05,15,05,15,05,15,05),
    (15,05,15,05,15,05,15,05,15,05,15,05,15,05,15,05,15),
    (05,15,05,15,05,15,05,15,05,15,05,15,05,15,05,15,05),
    (15,05,15,05,15,05,15,05,15,05,15,05,15,05,15,05,15),
    (05,15,05,15,05,15,05,15,05,15,05,15,05,15,05,15,05));

    const map2:array[1..7,1..17] of byte=(
    (02,15,02,15,02,15,02,15,02,15,02,15,02,15,02,15,02),
    (15,02,15,02,15,02,15,02,15,02,15,02,15,02,15,02,15),
    (02,15,02,15,02,15,02,15,02,15,02,15,02,15,02,15,02),
    (15,02,15,02,15,02,15,02,15,02,15,02,15,02,15,02,15),
    (02,15,02,15,02,15,02,15,02,15,02,15,02,15,02,15,02),
    (15,02,15,02,15,02,15,02,15,02,15,02,15,02,15,02,15),
    (02,15,02,15,02,15,02,15,02,15,02,15,02,15,02,15,02));

    const bar1 : coordtyp =((0,100,100,0,0,0,0,0,0,0,0,0),{x}
                            (0,0,100,100,0,0,0,0,0,0,0,0));{y}

    begin
    setvesa($101);
    getmode($101);
    ppix8(100,100,156);
    ppix8(200,200,14);
    readln;
    setvga($13);
    rlebitmap(100,100,17,7,map);
    readln;
    scbitmap(20,20,17,7,100,100,map2);
    readln;
    mouseinit(0);
    mouseinit(1);
    readln;
    newcur(1,1,cur);
    readln;
    newcur(1,2,cur2);
    readln;
    xtriangle(50,50,100,100,100,0,14,$0a000);
    xcircle(170,100,85,300,9,400,20,$0a000);
    ppix(100,100,2,$0a000);
    c:=gpix(100,100,$0a000);
    ppix(101,100,c,$0a000);
    repeat
    SetRGB(16,x,y,63);
    xcircle(170,100,85,300,16,400,20,$0a000);
    x:=succ(x);
    if x=63 then begin y:=y+9; x:=0;end;
    xdelay(5);
    until y=63;
    p:=gmem(150);
    {if realloc(p,10000)=nil then writeln('ee');}
    {realloc(p,10050);}
    p:=gmem(10050);
    gimage(0,0,100,100,p);
    ccls(14,$0a000);
    pimage(30,30,p);
    waitret;

    readln;
    cls($0a000);
    Xline(0,0,300,199,1,$0a000);
    {Poly(100,100,15,05,45,45,94,43,2,$0a000);}
    readln;
    va1:=vsetup(vs1);
    flip($0a000,va1);
    cls($0a000);
    xline(0,100,319,100,2,$0a000);
    randomize;
    x:=0;
    repeat
    inc(x);
    ppix(random(320),random(100),random(15),$0a000);
    until x=200;

    readln;

    flip(va1,$0a000);
    Vdispose(va1);
    readln;
    cls($0a000);
    x:=330;
    repeat
    inc(x);

    until x=3000;
    x:=0;
    repeat
    ppix(random(320),random(200),random(15),$0a000);
    inc(x);
    until x=3000;{
    polyinit(bar1,4);
    xpoly(4,2,$0a000);
    coord[1].x:=0;
    coord[1].y:=0;
    coord[2].x:=20;
    coord[2].y:=5;
    coord[3].x:=30;
    coord[3].y:=30;
    coord[4].x:=50;
    coord[4].y:=40;
    coord[5].x:=28;
    coord[5].y:=100;
    coord[6].x:=10;
    coord[6].y:=60;
    Xpoly(6,1,$0a000);
    va1:=vsetup(vs1);
    fimage(0,0,100,100,0,0,$0a000,va1);
    readln;
    fimage(0,0,100,100,219,100,va1,$0a000);
    vdispose(va1);
    readln;                                 }
    rotpal(63,0,0,false,false,false,63,18);

    end.

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