procedure ShowTime(nPixels, startTicks: integer);
var
  time: real;
  cr: string;
begin
  time := (TickCount - StartTicks) / 60;
  cr := chr(13);
  PutMessage(nPixels:1, ' pixels', cr, time:1:2, ' seconds',
     cr, nPixels/time:1:0, ' pixels/second');
end;

macro 'Fast Invert';
var
  width, height, StartTicks: integer;
begin
  GetPicSize(width,height);
  StartTicks := TickCount;
  Invert;
  ShowTime(width*height, StartTicks);
end;

macro 'Slow Invert';
{
This macro illustrates why it's not a good idea to use
macros for pixel-by-pixel processing.
}
var
  width,height,value,x,y,StartTicks: integer;
begin
  GetPicSize(width,height);
  if width = 0 then begin
     beep;
     PutMessage('Image required.');
     exit;
  end;
  StartTicks := TickCount;
  for y:=0 to height-1 do begin
    GetRow(0,y,width);
    for x:=0 to width-1 do LineBuffer[x]:=255-LineBuffer[x];
    PutRow(0,y,width);
  end;
  ShowTime(width*height, StartTicks);
end;

macro 'Real Slow Invert';
{
This macro illustrates why it's better to use GetRow
and PutRow instead of GetPixel and PutPixel.
}
var
  width,height,value,x,y,StartTicks: integer;
begin
  GetPicSize(width,height);
  if width = 0 then begin
     beep;
     PutMessage('Image required.');
     exit;
  end;
  StartTicks := TickCount;
  for y:=0 to height-1 do
    for x:=0 to width-1 do PutPixel(x, y, 255-GetPixel(x,y));
  ShowTime(width*height, StartTicks);
end;

macro '(---'; begin end;

macro 'Show Status [S]';
var
  roiType: integer;
begin
  NewTextWindow('Status');
  writeln('MaxMeasuements = ', Get('MaxMeasurements'):1);
  writeln('UndoBufSize = ', Get('UndoBufSize')/1024:1,'K');
  writeln('FreeMem = ', Get('FreeMem')/1024:1,'K');
  writeln('MaxBlock = ', Get('MaxBlock')/1024:1,'K');
  roiType := Get('RoiType');
  write('RoiType: ');
  if roiType = 0 then write('No ROI or no image')
  else if roiType = 1 then write('rectangle')
  else if roiType = 2 then write('ellipse')
  else if roiType = 3 then write('polygon')
  else if roiType = 4 then write('freehand')
  else if roiType = 5 then write('traced')
  else if roiType = 6 then write('straight line')
  else if roiType = 7 then write('freehand line')
  else if roiType = 8 then write('segmented line');
end

macro 'Draw Vertical Calibration Bar';
var
  left,top,width,height,i,x,y2,inc:integer;
  y:real;
begin
  GetRoi(left,top,width,height);
  if width=0 then begin
    beep;
    PutMessage('Make a rectangular selection first.');
    exit;
  end;
  SetFont('Helvetica');
  SetFontSize(10);
  SetText('Plain; Left; no background');
  SetLineWidth(1);
  Setforeground(255);
  DrawScale;
  x:=left;
  y:=top;
  inc:=height/10;
  for i:=1 to 11 do begin
    MoveTo(x+width+10,round(y)+2);
    y2:=round(y);
    if i=11 then y2:=y2-1;
    write(cvalue(GetPixel(x,y2)):1:2);
    y:=y+inc;
  end;
end;

macro 'ASCII Dump';
{
Generates an alphanumeric listing of pixels values starting at
the upper left corner of the current selection. 20 rows and 44 columns
can be displayed with the default 552 x 436 window.
}
var
  image,dump,roiLeft,roiTop,roiWidth,roiHeight:integer;
  h,v,value,MaxWidth,MaxHeight,width,height:integer;
begin
  image:=PicNumber;
  GetRoi(RoiLeft,RoiTop,RoiWidth,RoiHeight);
  if roiWidth=0 then begin
    beep;
    PutMessage('This macro requires a rectangular selection.');
    exit;
  end;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  MakeNewWindow('ASCII Dump');
  dump:=PicNumber;
  GetPicSize(width,height);
  MaxWidth:=width div 24 - 2;
  MaxHeight:=height div 9 - 3;
  if roiWidth>MaxWidth then roiWidth:=MaxWidth;
  if roiHeight>MaxHeight then roiHeight:=MaxHeight;
  SetFont('Monaco');
  SetFontSize(9);
  SetText('With background; Left Justified');
  MoveTo(2,12);
  write('    ');
  for h:=roiLeft to roiLeft+roiWidth-1 do write(h:4);
  writeln;
  writeln;
  for v:=roiTop to roiTop+roiHeight-1 do begin
    write(v:3,' ');
    for h:=roiLeft to roiLeft+roiWidth-1 do begin
      ChoosePic(image);
      value:=GetPixel(h,v);
      ChoosePic(dump);
      write(value:4);
    end;
    writeln;
  end;
  ChoosePic(image);
end;

 
function hexDigit(digit: integer): string;
begin
		 if digit <= 9 then
					 hexDigit := chr(digit + ord('0'))
			else
					 hexDigit := chr(digit - 10 + ord('A'));
end;


function hex(value: integer): string;
begin
    hex := concat(hexDigit(value div 16), hexDigit(value mod 16));
end;


function GetByte(loc: integer): integer;
begin
    GetByte := GetPixel(loc mod width, loc div width);
end;


macro 'Hex Dump';
{
Generates a hex listing of pixels values starting at
the first byte of the image. It can be useful
for decoding image file headers.
}
var
  width, height, nLines, line: integer;
  i, j, BytesPerLine, loc, value: integer;
  image, ascii, char: string;
begin
  SaveState;
  nLines := 52;
  BytesPerLine := 10;
  image:=WindowTitle;
  GetPicSize(width, height);
  if width = 0 then begin
     beep;
     PutMessage('Image required.');
     exit;
  end;
  SetFont('Monaco');
  SetFontSize(9);
  NewTextWindow('Hex Dump');
  loc := 0;
  for line := 0 to nLines - 1 do begin
       write(loc:4, '  ');
       ascii := '  ';
       for i := 0 to BytesPerLine - 1 do begin
           value := GetByte(loc);
           write(hex(value), ' ');
           if (value >= 32) and (value <= 127) then
               char := chr(value)
           else
               char := '-';
           ascii := concat(ascii, char);
           loc := loc + 1;
       end;
       writeln(ascii);
  end;
  RestoreState;
end;


macro 'Scale and Rotate All';
{
Resizes and/or rotates all currently open widows. For example,
change the  ScaleAndRotate command below to
ScaleAndRotate(2,2,0)  to change the size of all the images
in a movie loop sequence from 128 x 128 to 256 x 256.
}
var
  i:integer;
begin
  SaveState;
  SetScaling('Bilinear; Create New Window');
  for i:=1 to nPics do begin
    ChoosePic(1);
    ScaleAndRotate(1.9,1.9,0);
    ChoosePic(1);
    Close;
  end;
  for i:=1 to nPics do begin
    ChoosePic(i);
    SetPicName(i);
  end;
  RestoreState;
end;


macro 'Dispose All';
begin
  DisposeAll;
end;

macro 'Average two Images';
  {Generates the arithmetic average of two images.}
begin
  RequiresVersion(1.53);
  if nPics<>2 then begin
    PutMessage('This macro requires exactly two image windows to be open.');
    Exit;
  End;
  ImageMath('add' ,1 ,2, 0.5, 0, 'Average');
 end;


macro 'Make Montage [M]';
{Opens a new window and creates in it a composite image made from all}
{currently open images. All the images must be the same size.}
var
  width,height,w,h,mWidth,mHeight,nWindows,left,top:integer;
  RoiWidth,RoiHeight,RoiWidth,RoiHeight,i,hloc,vloc:integer;
  montage,temp:integer;
  scale:real;
  SameSize:boolean;
begin
  nWindows:=nPics;
  SameSize:=true;
  GetPicSize(width,height);
  for i:=1 to nPics do begin
    SelectPic(i);
    GetPicSize(w,h);
    SameSize:=SameSize and (w=width) and (h=height);
  end;
  if (nWindows<2) or not SameSize then begin
    PutMessage('This macro needs two or more images of the same size in order to create a montage.');
    Exit;
  end;
  SetBackground(0);
  MakeNewWindow('Montage');
  montage:=nWindows+1;
  GetPicSize(mWidth,mHeight);
  SelectPic(1);
  Duplicate('Temp');
  temp:=nWindows+2;
  scale:=GetNumber('Scaling Factor:',0.25);
  hloc:=-(RoiWidth);
  vloc:=0;
  for i:=1 to nWindows do begin
    SelectPic(i);
    SelectAll;
    copy;
    SelectPic(temp);
    paste;
    SelectAll;
    ScaleSelection(scale,scale);
    RestoreRoi;
    if i=1 then begin
      GetRoi(left,top,RoiWidth,RoiHeight);
      hloc:=-RoiWidth;
      vloc:=0;
    end;
    Copy;
    SelectPic(montage);
    hloc:=hloc+RoiWidth;
    if (hloc+RoiWidth)>mWidth then begin
      hloc:=0;
      vloc:=vloc+RoiHeight;
    end;
    MakeRoi(hloc,vloc,RoiWidth,RoiHeight);
    Paste;
  end;
  KillRoi;
  SelectPic(temp);
  Dispose;
end;


macro 'Make Sine Wave';
var
  left,top,width,height,i:integer;
  ppp,scale:real;
begin
  SaveState;
  MakeNewWindow('Sine Wave');
  SelectAll;
  GetRoi(left,top,Width,Height);
  if width=0 then begin
    PutMessage('This macro requires a rectangular selection.');
    Exit;
  end;
  ppp:=GetNumber('Pixels per period',100);
  Scale:=ppp/6.28;
  MakeRoi(left,top,1,height);
  for i:=1 to width do begin
    SetForeground(sin(i/scale)*127 +128);
    {SetForeground((sin(i/scale)*127 +128)*(i+30)/(width));}
    {SetForeground(sin(i/(ppp*((width-i+3)/width)/6.28))*127 +128);}
    fill;
    MoveRoi(1,0);
  end;
  KillRoi;
  RestoreState;
end;

macro 'Beep if No Selection [B]';
var 
  left,top,width,height:integer;
begin
  GetRoi(left,top,width,height);
  if width=0 then beep;
end;

function power(x, n: real): real;
{raise x to the nth power}
begin
    power := exp(ln(x) * n);
end;


macro 'Exponention DemoÉ';
var
    base, ex: real;
begin
    base := GetNumber('Base:', 2);
    ex := GetNumber('Exponent:', 5);
    PutMessage(power(base, ex):6:3);
end;

macro 'Convert Number to String TestÉ';
var
    n: real;
    s1, s2, s3, s4: string;
begin
    n:=GetNumber('Enter a Number', 12.345);
    s1 := concat(n);
    s2 := concat(n:1:2);
    s3 := concat(n:10:4);
    s4 := concat(n:0);
    PutMessage('s1=',s1,', s2=',s2,', s3=',s3', s4=',s4);
end;


function factorial(n: integer):integer;
begin
   if n > 1 then
      factorial := n * factorial(n-1)
   else
      factorial := 1;
end;


macro 'Compute N Factorial...';
var
  n: integer;
begin
   n := GetNumber('N:', 3, 0);
   PutMessage(n:1, ' factoral = ', factorial(n):1);
end;


macro '(---'; begin end;

{These macros allow you to easily switch}
{transfer modes while pasting by tapping keys.}
macro 'Copy Mode[1]'; begin SetOption; DoCopy; end;
macro 'AND Mode[2]';  begin SetOption; DoAnd; end;
macro 'OR Mode [3]';  begin SetOption; DoOr; end;
macro 'XOR Mode[4]'; begin SetOption; DoXor; end;
macro 'REPLACE Mode[5]';  begin SetOption; DoReplace; end;
macro 'BLEND [6]';  begin SetOption; DoBlend; end;
macro 'Terminate Paste [7]'; begin KillRoi end;