home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / aijournl / ai_may89.arc / DIVAR.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-29  |  39KB  |  962 lines
  1. {PROGRAM:  DIVAR
  2.  AUTHOR :  Jonthan Kraidin
  3.  SITE   :  Medical College of Pennsylvania, Anatomy Department
  4.  DATE   :  9/20/88
  5. }
  6.  
  7. {$m 65520,0,0}
  8. PROGRAM AIPROG;
  9.  
  10. { This is the Main Code.  The units are as follows:
  11.  
  12.   AIGLOB........Global variables used by AI routines
  13.   AIBINA........Cursor control, Image contrasting, and Menus
  14.   INITUNIT......Routines to initialize video board
  15.   BORDUNIT......Routines to access video board
  16.   AIEDGE........AI routine library
  17.   AIMATH........Statistical functions
  18.   AIUSER........User interface routines
  19.   AIIMGS........Image enhancement
  20.   CHARUNIT......Routines to number marked nuclei
  21.  
  22.   The video board represents each pixel as a gray level between 0 and 255 on
  23.   a 512x512 memory image.  Zero is the darkest and 255 is the brightest. All
  24.   odd values are represented on the monitor as RED.
  25.  
  26.   The program is used as follows.  The user sets the lighting on the
  27.   microscope and finds an appropriate section.  A Shading Correct makes sure
  28.   that the lighting is uniform.  The user selects the brightest, darkest,
  29.   largest, and smallest nuclei.  In addition, the shading of the nucleoli is
  30.   checked.  These Options all appear in the Menu Driver as well as the
  31.   following choices.  The user then selects the size of S1, the window
  32.   in which to scan for the nuclei, and the coordinates are passed to
  33.   ScanDriver.  The size of S2, the scan-window, is set by the program.
  34.  
  35.   After the run the program allows the user to add missed nuclei.  If the
  36.   LearnMode is ON the thresholds are set to account for the missed nuclei.
  37.   Likewise, the user can delete errors and Learning ensues.  Finally, the
  38.   nuclei are numbered and the user can print the area and perimeter of all
  39.   good nuclei.
  40. }
  41.  
  42. Uses
  43.      crt,globunit,aiglob,
  44.      aibina,initunit,bordunit,printer,
  45.      aiedge2,aimath,aiuser,aiimgs,charunit;
  46.  
  47. Var
  48.      xv1,xv2,yv1,yv2 : word;
  49.      Mval2,Mvalx2    : double;
  50.      graystriketemp,
  51.      strikes         : byte;
  52.      hx,lx,num       : byte;
  53.      xz,yz           : word;
  54.      nulltrys        : limitarray;
  55.      Decision,
  56.      SubDecision1,
  57.      SubDecision2    : byte;
  58.      Finished        : boolean;
  59.      subfinished,
  60.      subfinished2    :boolean;
  61.      a,p,a2x,p2x     : word;
  62.      _q              : double;
  63.      i               : word;
  64.      _mean,_stdev,
  65.      background      : byte;
  66.      miss,
  67.      seenx           : byte;
  68.      x1,y1,x2,y2     : word;
  69.      Ok_to_continue  : boolean;
  70.      p1,p2,p3,p4     : pointer;
  71.      nucsize         : byte;
  72.      small,Goodfill  : boolean;
  73.      forecomp,
  74.      _foredev        : double;
  75.      Mval            : double;
  76.      Narea           : word;
  77.      oldx,oldy       : word;
  78.      _f,_s           : double;
  79.      below           : byte;
  80.      ku,stout,rx,rx2,
  81.      hypothet        : double;
  82.  
  83. {&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&}
  84.  
  85. {--------------------RESTRICT SCAN REGION----------------------------}
  86.  
  87. {This procedure is given the (x,y) coordinates that describe a box that
  88.  contains the nucleus and then restricts that zone from being scanned
  89.  for any other nuclei.  MARK is the number of restricted zones that are
  90.  stored in stored in two arrays.  Rather than restrict the entire box,
  91.  the routine looks for the bottom of the RED-shaded nucleus and resets
  92.  the bottom of the box to be 5 lines below it.  STARTLIMITS contains
  93.  the starting coordinates and FINISHLIMITS contains the end coordinates.}
  94.  
  95. Procedure RestrictSpot(x1,y1,x2,y2:word;Var mark : word;
  96.                   Var startlimits,finshlimits:limitarray);
  97. Var
  98.     j,k:word;
  99.     notdone : boolean;
  100. begin
  101.   notdone := true;
  102.   k := (y1+y2) shr 1;                      {start at center}
  103.   while ((k <= y2) and notdone) do         {till last y2}
  104.   begin
  105.      notdone := false;                     {scan from left to right    }
  106.      for j := x1 to x2 do                  {until a RED is found. If RED}
  107.        if oldgrayvalue(j,k) and 1 = 1 then {is found, NOTDONE is set to}
  108.          notdone := true;                  {TRUE and a new line is scanned}
  109.      k := k+1;              {If no RED exists then the loop stops and the }
  110.   end;                      {restriction is set 5 lines below nucleus.    }
  111.   k := k+5;
  112.                                             {now store new restriction coords}
  113.   mark := mark + 1;
  114.   startlimits[mark].x := x1;
  115.   startlimits[mark].y := y1;
  116.   finshlimits[mark].x := x2;
  117.   finshlimits[mark].y := k;
  118. end;{end procedure RestrictSpot}
  119.  
  120. {This function complements RestrictSpot and scans the array in order to
  121.  determine if a coordinate pair is within a restricted zone.}
  122.  
  123. Function IsItRestricted(x,y,totalSpots:word;
  124.                startlimits,finshlimits:limitarray):boolean;
  125. Var
  126.    i : byte;
  127.    NotDone : boolean;
  128. begin
  129.    i := 1;
  130.    NotDone := TRUE;
  131.    IsItRestricted := FALSE;
  132.    While (i <= totalspots) and NotDone do
  133.    begin
  134.      If ((x >= StartLimits[i].x) and (x <= FinshLimits[i].x) and
  135.         (y >= StartLimits[i].y) and (y <= FinshLimits[i].y)) then
  136.         begin
  137.            IsItRestricted := TRUE;
  138.            NotDone := FALSE;
  139.         end;
  140.      i := i + 1;
  141.    end;
  142. end;{end function IsItRestricted}
  143.  
  144. {This procedure initializes the arrays to zero.}
  145.  
  146. Procedure Settrys;
  147. Var
  148.     i : byte;
  149. begin
  150.   for i := 1 to 20 do
  151.   begin
  152.     nulltrys[i].x := 0;
  153.     nulltrys[i].y := 0;
  154.   end;
  155. end;
  156.  
  157. {When the program thinks it is looking at a nucleus but is not positive
  158.  it stores the coordinates in the array NULLTRYS.  TRIEDAFEW is given the
  159.  (a,b) location under scrutiny.  If these coordinates are within a fixed
  160.  distance from other attempts a value of TRUE is returned as well as
  161.  the number of times this region has been questionable.}
  162.  
  163. Function TriedaFew(a,b:word;Var count : byte):boolean;
  164. Var
  165.     i     : byte;
  166.     dist  : double;
  167.     j,k   : word;
  168. begin
  169.   count := 0;
  170.   for i := 1 to 20 do             {cycle through a list of twenty locations}
  171.   begin
  172.     j := nulltrys[i].x;
  173.     k := nulltrys[i].y;
  174.     dist := ( (a-j)*(a-j) ) + ( (b-k)*(b-k) );
  175.     If dist < 300 then
  176.       count := count+1;
  177.   end;
  178.   If count >= 1 then
  179.     TriedaFew := true
  180.   else
  181.     triedafew := false;
  182. end;
  183. {____________________________________________________________________________}
  184.  
  185. {When deleting an area, this routine, given the cursor coordinates,
  186.  will find the closest stored nucleus by finding the
  187.  least distance between the cursor location and the nucli centers.}
  188.  
  189. Procedure Findclosest(x,y:word;Var closeX,closeY:word;Var itemp:byte);
  190. Var
  191.     i : byte;
  192.     temp : double;
  193.     smallest : double;
  194.     xt,yt : word;
  195. begin
  196.   smallest := 99999E+70;
  197.   For i := 1 to CellCount do
  198.   begin
  199.      xt := AiCells[i].xcoord;
  200.      yt := AiCells[i].ycoord;
  201.      Temp :=  ((xt-x)*(xt-x)) + ((yt-y)*(yt-y));
  202.      Temp := sqrt(temp);
  203.      If temp < smallest then
  204.      begin
  205.        smallest := temp;
  206.        itemp := i;
  207.        closeX := xt;
  208.        closeY := yt;
  209.      end;
  210.      If smallest > 100 then
  211.        itemp := 0;
  212.  end;
  213. end;{end procedure findclosest}
  214.  
  215. {------------------------------DATA STORAGE-------------------------}
  216.  
  217. {This procedure will store all pertinent data on the nuclei in case
  218.  Learning is necessary.}
  219.  
  220. Procedure HouseKeep(Areax,Perimeterx,x,y,a,p:word;
  221.                     gray1:byte;cmval,blackcmp,_for,_std,_stdx,_forx:double;
  222.                     _dadb:word;rxa,rxb:double);
  223. begin
  224.   cellcount := cellcount+1;               {next cell}
  225.   With AiCells[cellcount] do              {store in record}
  226.   begin
  227.     Area := Areax;                        {pixel area}
  228.     Perimeter := Perimeterx;              {pixel perimeter}
  229.     _area := a;                           {calibrated area and perimeter}
  230.     _perim := p;
  231.     Good := TRUE;                         {Flag = FALSE if deleted.}
  232.     xcoord := x;                          {Coords of center of search.}
  233.     ycoord := y;
  234.     gray := gray1;                        {gray value used by Spot-Scanner}
  235.     mval := cmval;                        {Sample gray value}
  236.     black := blackcmp;                    {% of sample that was nucleolus}
  237.     foregnd := _for;                      {% above background value}
  238.     _stdev := _std;                       {standard deviation of sample}
  239.     dadb := _dadb;                        {hypothetical area}
  240.     stdx := _stdx;                        {standard dev of entire nucleus}
  241.     forx := _forx;                        {average gray value of nucleus}
  242.     cytost := stout;               {standard dev of surrounding cytoplasm}
  243.     kux    := ku;                         {kurtosis of nucleus}
  244.     rx1    := rxa;                        {nucleus-sample/cytoplasm ratio}
  245.     rx2    := rxb;                        {nucleus/cytoplasm ratio}
  246.   end;
  247. end;{end procedure housekeep}
  248.  
  249. {This procedure generates a simple report giving the area and
  250.  perimeter.  If a nucleus is deleted its data are not reported.}
  251.  
  252. Procedure ReportAll;
  253. Var
  254.    total : word;          {Total nuclei printed}
  255. begin
  256.   total := 0;
  257.   Writeln(LST,'***  CELL AREA DATA REPORT ***');
  258.   Writeln(LST);
  259.   For i := 1 to cellcount do
  260.     with aicells[i] do
  261.       If Good then        {Check if Deleted}
  262.       begin
  263.         total := total + 1;
  264.         Writeln(LST,'CELL #: ',i:3,' AREA: ',_Area/(calibfactor2*calibfactor2):10:4,
  265.           ' PERIMETER: ',_Perim/calibfactor2:10:4);
  266.       end;
  267.     Writeln(LST);
  268.     Writeln(LST,'TOTAL COUNT: ',Total);
  269. end; {end procedure ReportAll}
  270.  
  271. {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  272.  
  273. {This is the Main Driver routine for the program.  SCANDRIVER is given
  274.  the window (x1,y1,x2,y2) to search for all nuclei and the width and height
  275.  of the scan-box within which data are sampled to find each nuclei.
  276.  NUCSIZE is a value describing the size of the nucleus to the recognition
  277.  algorithms.  MVAL is an average gray-level threshold.}
  278.  
  279. Procedure ScanDriver(x1,y1,x2,y2,width,height:word;nucsize:byte;mval:double);
  280.  
  281. Var
  282.     j,k               : word;
  283.     s,t               : word;
  284.     hw,hh             : byte;
  285.     incrm             : byte;
  286.     xstart,ystart     : word;
  287.     y,x               : word;
  288.     xa,ya             : word;
  289.     Ok_to_continue,
  290.     Intensity_Ok,
  291.     goodifnucleolus,
  292.     goodifsmall,
  293.     cytcond,
  294.     abscyt            : boolean;
  295.     _mean,_stdev      : double;
  296.     temp              : double;
  297.     ForeComp,
  298.     blackcomp         : double;
  299.     Roundness         : double;
  300.     seenbefore        : byte;
  301.     smallnuc          : byte;
  302.     da,db             : byte;
  303.     standardD         : double;
  304.     sd                : byte;
  305.     count             : byte;
  306.     rxq               : double;
  307.     Mhigh             : byte;
  308.     gray1             : byte;
  309.     xm,ym             : word;
  310.     _forex,_stdx      : double;
  311.     startlimits,
  312.     finshlimits       : limitarray;
  313.     totalspots        : word;
  314.     Uncertain         : boolean;
  315.     debug             : boolean;
  316.     icount            : word;
  317.     incrmy            : byte;
  318.     n2size            : byte;
  319.     hits              : byte;
  320.     foundcell         : boolean;
  321.     Cmval             : double;
  322.     stout             : double;
  323.     tx,
  324.     sx                : byte;
  325. begin
  326.  settrys;                              {Initialize arrays and variables}
  327.  cellcount := 0;
  328.  tx := 0;
  329.  sx := 0;
  330.  graystriketemp := 255;
  331.  debug := false;
  332.  icount := 0;
  333.  totalspots := 0;
  334.  hw := width shr 1;
  335.  hh := height shr 1;
  336.  y := y1-hh;
  337.  x := x1-hw;
  338.  incrm := 5;
  339.  incrmy := 3;
  340.  n2size := nucsize shl 1;
  341.  smallnuc := round(nucsize/3);
  342.  standardd := 2*nucsize*nucsize;
  343.  sd        := 1;
  344.  hits := 0;
  345.  FoundCell := FALSE;
  346.  
  347. {-------------------------execution begins here-----------------------}
  348.  
  349.  While (Y+hh < Y2) do                       {Vertical bounds}
  350.  begin
  351.    While (X+hw < X2) do                     {horizontal bounds}
  352.    begin
  353.      xa := x + hw;                          {move to new location}
  354.      ya := y + hh;
  355.      Foundcell := FALSE;
  356.      MakeCross(xa,ya,0);                    {mark center-point on monitor}
  357.      Intensity_Ok := IntensityCheck(xa,ya,n2size); {ON/OFF routine to
  358.                                               check if above threshold}
  359.  
  360. {------------------------------Level One Spot-Scanner----------------------}
  361.  
  362.      If  Intensity_Ok and                   {SpotContrast returns an ON/OFF }
  363.      (SpotContrast(xa,ya,n2size,goodifsmall)) and {value, but uses an Energy routine}
  364.      Not(IsItRestricted(xa,ya,totalspots,startlimits,finshlimits)) then
  365.      begin                                  {Restriction routine is ON/OFF}
  366.        ok_to_continue := TRUE;              {*** ADJUST SCAN RESOLUTION ***}
  367.        icount := 0;                         {If something is there reduce}
  368.        incrm := 2;                          {the horizontal scan increments}
  369.      end
  370.      else
  371.      begin
  372.        ok_to_continue := FALSE;             {otherwise, increase them if }
  373.        icount := icount+1;                  {nothing is found after 5 trys}
  374.        If icount = 5 then
  375.          incrm := round(nucsize/1.5);
  376.      end;
  377.  
  378. {---------------------------Level Two Spot-Scanner--------------------------}
  379.  
  380.      IF OK_TO_CONTINUE THEN   {check if region has been questionable before}
  381.      BEGIN
  382.         Uncertain:= triedafew(xa,ya,seenbefore);
  383.         tx := tx+1;
  384.         if tx = 21 then       {If program has gotten this far then region }
  385.           tx := 1;            {is of some interest.  Therefore, store coords}
  386.         nulltrys[tx].x := xa; {incase region fails later tests but is }
  387.         nulltrys[tx].y := ya; {encountered again.}
  388.         Cmval := Mscan(xa,ya,smallnuc,blackcomp);  {Get average gray-level }
  389.                                               {and % of nucleolus in sample}
  390.  
  391.         if (cmval > 0.9*mvalx) and
  392.          (blackcomp<Maxblack) and ((blackcomp>Minblack) or (blackcomp=0)) then
  393.          begin                                {check nuc. staining pattern}
  394.  
  395.           If shellscan(xa,ya,nucsize,Uncertain,goodifnucleolus) then
  396.           begin
  397.      {---------------Spot-Scanner ends...Determine composition %--------}
  398.  
  399.             Escan(xa,ya,nucsize,round(mval),da,db);  {get edge distances}
  400.  
  401.             If ( ((da*db > 0) and (blackcomp <> 0)) or
  402.                  ((da*db > dadbx) and (blackcomp = 0)) ) then
  403.             begin
  404.                 Mhigh := 0;
  405.                 for t := ya-2 to ya+2 do             {center on bright pixel}
  406.                   for s := xa-2 to xa+2 do
  407.                   begin
  408.                     gray1 := oldgrayvalue(s,t);
  409.                     if gray1 > Mhigh then
  410.                     begin
  411.                       Mhigh := gray1;
  412.                       xm := s;
  413.                       ym := t;
  414.                     end;
  415.                   end;                               {get crude estimate}
  416.  
  417.              If (da*db < 0.4*standardd/sd) then
  418.                         small := TRUE
  419.              else
  420.                         Small := FALSE;
  421.               HowMuchFore(xm,ym,(smallnuc shr 1)+1,ForeComp,_stdev);
  422.  
  423.               If (small or (Not(small) and (cmval > 0.93*mvalx))) and
  424.                  ((_stdev < _stqset) or (Uncertain and (_stdev < _stqset+5))
  425.                  or (seenbefore > 2))
  426.                  and ((forecomp > forset) or (Seenbefore > 2)) and
  427.                  (Not(goodifsmall) or (goodifsmall and small)) then
  428.               begin                                  {get crude size est.}
  429.           {shade in nucleus}
  430.  
  431.                     FillIn(x,y,x+width,y+height,small,
  432.                            round(1.3*nucsize),seenbefore); {get area}
  433.                     a := 1+findarea(x,y,x+width,y+height,_forex,_stdx);
  434.  
  435.                     If (da*db < 50) or ((_stdx < _stqxset) or Uncertain) and
  436.                         ((_forex > forxset) or (Seenbefore > 2)) then
  437.                     begin
  438.  
  439.                      histoanalysis(xa,ya,nucsize,below,ku,stout,
  440.                                    rx,rx2,cytcond,abscyt);
  441.                      db := max(da,db);
  442.                      hypothet := a/(db*db);  {determine actual_area/guess}
  443.                      if hypothet > 1.2 then
  444.                          previous := TRUE
  445.                      else
  446.                          previous := FALSE;
  447.                      If (below > 7) and (rx < rx2) then
  448.                      begin
  449.                        temp    := rx2;
  450.                        rx2     := rx;
  451.                        rx      := temp;
  452.                      end;
  453. {cross ref. data}    if (abscyt) and (Not(goodifnucleolus) or
  454.                             (goodifnucleolus and (below > 7)) or
  455.                             (seenbefore > 2)) and
  456.  
  457.                      ((_stdx <_stqxset) or
  458.                      ((seenbefore > 2) and (_stdx < 1.5*_stqxset)) or
  459.                      ((Below > 7) and (_stdx < 2.5*_stqxset)) ) then
  460.                      begin
  461.                      if ((cytcond) or ((Hypothet < 1.5) and (_stdx < 25))
  462.                      or (seenbefore > 3)) and
  463.                      ((hypothet>lowhyp) or ((hypothet > -2) and
  464.                                             (_stdx < 25)))
  465.                      and ((hypothet<dadbq) or
  466.                               ((below>11) and (hypothet<4))) and
  467.                      (rx > rx1low) and (rx < rx1high)        and
  468.                      (rx2 > rx2low) and (rx2 < rx2high)      and
  469.                      (ku > kulow) and (ku < kuhigh) and
  470.                      (rx > rx2) and (rx2 > 1.02) then
  471.                      begin
  472.                       if small then
  473.                          seenbefore := seenbefore + 2;
  474. {cross ref. data}     if (stout < 30) or
  475.                          ((seenbefore > 0) and (stout < 33)) or
  476.                          ((seenbefore > 0) and (stout < 36)) or
  477.                          ((seenbefore > 1) and (stout < 42)) or
  478.                          ((seenbefore > 2) and (stout < 46)) or
  479.                          ((seenbefore > 3) and (stout < 50)) or
  480.                          ((seenbefore > 4) and (stout < 55)) then
  481.                       begin
  482. {check area}            if (a > MinArea) and (A < MaxArea) then
  483.                         begin
  484.                          p := scanedge(x,y,x+width,y+height);
  485.                          Roundness := p*p/(12.56*a);
  486. {check roundness}        If (Roundness > ShapeLow) and
  487.                             ((Roundness < ShapeHigh) or
  488.                             ((seenbefore > 2) and (Roundness < 1.1))) then
  489. {we have a cell}         begin
  490.                             standardd := standardd+(da*db);
  491.                             sd := sd+1;
  492.                             a2x := 1+findarea(x,y,x+width,y+height,_q,_q);
  493.                             p2x := scanedge(x,y,x+width,y+height);
  494.                             FoundCell := TRUE;
  495.                             hits := hits+1;
  496. {so not scan this region}   RestrictSpot(x,y,x+width,y+height,totalspots,
  497.                                startlimits,finshlimits);
  498.                             makedark(x-(nucsize shr 1),y-(nucsize shr 1),
  499.                              x+width+(nucsize shr 1),y+height+(nucsize shr 1));
  500.                             Gray1 := Max(oldgrayvalue(xa,ya),
  501.                                            oldgrayvalue(xa-1,y));
  502.                             Gray1 := Max(gray1,oldgrayvalue(xa+1,y));
  503. {Reset striking value}      If gray1 < graystriketemp then
  504.                               graystriketemp := gray1;
  505.                             If (hits > strikes) and
  506.                                (0.98*graystriketemp > graystrike) then
  507.                                  graystrike := round(0.98*graystriketemp);
  508.  {store data}               HouseKeep(a,p,xa,ya,a2x,p2x,gray1,Cmval,
  509.                               blackcomp,forecomp,_stdev,_stdx,_forex,da*db,
  510.                               rx,rx2);
  511.                          end;   {end shape index check}
  512.                         end;    {end area check}
  513. end;
  514.                       end;      {end hist data and cyto standard deviation}
  515.                      end;       {end hist data and ratios}
  516.                     end;        {end standard dev. and foreground of sample}
  517.               end;              {end st. dev and foreground before FillIn}
  518.             end;                {end da*db check}
  519.               If Not(FoundCell) then
  520.                  erosion2(x-10,y-10,x+width+10,y+height+10);
  521.           end;                  {end shellscan}
  522.          end;                   {end nucleolus check}
  523.      END;                       {end ok_to_continue--level 1 spotscanner}
  524.      If Not(FoundCell) then     {marker of current center-point}
  525.        erasecross(xa,ya,0);
  526.      FoundCell := FALSE;
  527.      x := x + incrm;            {move horizontally}
  528.    end;                         {end While X}
  529.    x := x1-hw;
  530.    y := y + incrmy;             {next line}
  531.  end;                           {end While Y}
  532. end;  {end procedure scandriver}
  533.  
  534. {!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
  535.  
  536. Begin                                          {Begin Program Code         }
  537.  
  538. textbackground(black);
  539. clrscr;
  540. strikes := 3;
  541. Cellcount := 0;
  542. Calibfactor2 := 1.690;                         {pixels/micron @ 40x        }
  543. Initialize;                                    {initialize video board     }
  544. InitWindow;                                    {initialize window routines }
  545. hx := 255;
  546. lx := 0;
  547. SetUpMenu;                                     {set up Menu Window data    }
  548. SetSubMenu1;
  549. SetSubMenu2;
  550. DisplayMenu(true);                             {display main menu          }
  551. Finished := FALSE;
  552. LearnMode := TRUE;
  553. forecomp := 1;                                 {set lax constraints...     }
  554. dadbq := 2;                                    {These variables are used   }
  555. lowhyp := 0.2;                                 { by the Learn Routines.    }
  556. MaxBlack := 0.20;                              {Max/Min allowable nucleolus}
  557. MinBlack := 0.02;
  558. _stqset := 15;                                {st. devs of nuc. sample    }
  559. _stqxset := 25;
  560. DaDbx  := 15;                                  {product of edge lengths    }
  561. forset := 0.5;                                 {sample foreground          }
  562. forxset := 0.0;
  563. ShapeHigh := 1.03;                             {roundness limits           }
  564. ShapeLow := 0.6;
  565. cytoset  := 8;                                 {max st. dev. of surrounding}
  566. kulow    := -0.8;                              {  cytoplasm.               }
  567. kuhigh   := 30;                                {shape of nuclear histogram }
  568. rx1low   := 1;                                 {nuc/cyt ratios             }
  569. rx1high  := 2;
  570. rx2low   := 1;
  571. rx2high  := 2;
  572. minarea := 10;                                 {Used when first setting nuc}
  573. maxarea := 9999;                               {  size limits.             }
  574. setaddress;                                    {Sets memory address of a   }
  575. p1 := @isitbackground;                         {  routine used by assembly }
  576. p2 := @isitforeground;                         {  code for shading nucleus.}
  577. p3 := @isitbackgroundv;
  578. p4 := @isitforegroundv;
  579. previous := FALSE;
  580. seenx := 0;
  581. {--------------------------BEGIN MAIN MENU DRIVER---------------------------}
  582. While Not(Finished) do
  583. begin
  584.    Decision := ChooseMenu(0,34,8);             {Get user choice}
  585.    Case Decision of
  586.    1: Begin                                    {Mark cursor location on }
  587.         PixelFinder;                           { monitor with gray-level}
  588.         DisplayMenu(false);                    {Redraw menu             }
  589.       end;
  590.    2: begin                                    {Sub Menu to set up image}
  591.        SubFinished := FALSE;                   {not done with sub menu  }
  592.        DisplaySubMenu1(true);                  {display sub menu        }
  593.        While Not(SubFinished) do
  594.        begin
  595.         SubDecision1 := ChooseMenu(1,30,7);
  596.         Case subDecision1 of
  597.         1: begin
  598.               Storeshading;                    {store blank image       }
  599.               displaysubMenu1(false);
  600.              Repeat                            {Get location            }
  601.                Digitlocate(xdig,ydig,butdig,errdig);
  602.              Until (butdig = 0);
  603.            end;
  604.         2: begin
  605.              acquiresingle;                    {freeze image            }
  606.              shadingcorrect;                   {perform shading correct }
  607.              Repeat                            {Get location            }
  608.                Digitlocate(xdig,ydig,butdig,errdig);
  609.              Until (butdig = 0);
  610.              DisplaySubMenu1(false);
  611.            end;
  612.         3: begin
  613.              centerlighter := true;            {get initial nuc data    }
  614.              GoodFill := FALSE;                {accept data only if user}
  615.              oldx := 2;                        {  acknowledges that OK  }
  616.              oldy := 2;
  617.              Repeat                            {Get location            }
  618.                Digitlocate(xdig,ydig,butdig,errdig);
  619.              Until (butdig = 0);
  620.  
  621.              {-------Get brightest cell----------}
  622.  
  623.              MakeAnotherWindow;
  624.              Message3;                         {Tell user what to get   }
  625.              REPEAT
  626.              Repeat
  627.                DigitLocate(xdig,ydig,butdig,errdig);
  628.                If ((xdig <> oldx) or (ydig <> oldy)) then
  629.                begin
  630.                   erasecross(oldx,oldy,3);     {Mark location           }
  631.                   Makecross(xdig,ydig,3);
  632.                   oldx := xdig;
  633.                   oldy := ydig;
  634.                end;
  635.              Until (butdig <> 0);
  636.              Repeat
  637.                Digitlocate(xdig,ydig,butdig,errdig);
  638.              Until (butdig = 0);
  639.              Lowdiv := 50;                        {don't have this value yet}
  640.              fillin(xdig-30,ydig-30,xdig+30,ydig+30,  {shade and see if OK  }
  641.                        false,20{nucsize},seenx);
  642.              If Askwindow then                        {is it OK?            }
  643.                GoodFill := TRUE
  644.              else
  645.                Erosion2(xdig-round(2*20),ydig-round(2*20),
  646.                  xdig+round(2*20),ydig+round(2*20));
  647.              UNTIL goodfill;
  648.              Mval := GetGray(xdig,ydig,5);             {set data            }
  649.              Mvalx := 0.93*Mval;
  650.              CriticalValue := round(0.97*Mval);
  651.              GrayStrike := round(mval);
  652.              If 1.1*Mval < 255 then
  653.                CriticalHigh  := round(1.1*Mval)
  654.              else if 1.08*mval < 255 then
  655.                criticalhigh := round(1.08*mval)
  656.              else if 1.06*mval < 255 then
  657.                criticalhigh := round(1.06*mval)
  658.              else if 1.04*mval < 255 then
  659.                criticalhigh := round(1.04*mval)
  660.              else
  661.                CriticalHigh := 255;
  662.              Lowdiv        := round(Criticalvalue/1.13); {set nucleolus }
  663.              EraseIt(xdig,ydig,nucsize);
  664.  
  665.              {-------Get darkest cell------------}
  666.  
  667.              GoodFill := FALSE;
  668.              Message4;
  669.              REPEAT
  670.              Repeat
  671.                DigitLocate(xdig,ydig,butdig,errdig);
  672.                If ((xdig <> oldx) or (ydig <> oldy)) then
  673.                begin
  674.                   erasecross(oldx,oldy,3);
  675.                   Makecross(xdig,ydig,3);
  676.                   oldx := xdig;
  677.                   oldy := ydig;
  678.                end;
  679.              Until (butdig <> 0);
  680.              Repeat
  681.                Digitlocate(xdig,ydig,butdig,errdig);
  682.              Until (butdig = 0);
  683.              fillin(xdig-30,ydig-30,xdig+30,ydig+30,
  684.                        false,20{nucsize},seenx);
  685.              If Askwindow then
  686.                GoodFill := TRUE
  687.              else
  688.                Erosion2(xdig-round(2*20),ydig-round(2*20),
  689.                  xdig+round(2*20),ydig+round(2*20));
  690.              UNTIL goodfill;
  691.              Mval2 := GetGray(xdig,ydig,5);    {See if any values have to  }
  692.              Mvalx2 := 0.94*Mval2;             {  be changed to account for}
  693.  
  694.              If Mval2 <  Mval then  {darker nuclei.    }
  695.              begin
  696.                Mval := Mval2;
  697.                Mvalx := Mvalx2;
  698.                criticalvalue := round(0.97*Mval);
  699.                Graystrike := round(mval);
  700.              end
  701.              else
  702.              begin
  703.                lowdiv := round(0.96*Mval2/1.13);
  704.                If 1.1*Mval2 < 255 then
  705.                  CriticalHigh  := round(1.1*Mval2)
  706.                else if 1.08*mval2 < 255 then
  707.                  criticalhigh := round(1.08*mval2)
  708.                else if 1.06*mval2 < 255 then
  709.                  criticalhigh := round(1.06*mval2)
  710.                else if 1.04*mval2 < 255 then
  711.                  criticalhigh := round(1.04*mval2)
  712.                else
  713.                  CriticalHigh := 255;
  714.              end;
  715.              EraseIt(xdig,ydig,nucsize);
  716.              forxset := round(criticalvalue/1.015);
  717.  
  718.              lowdiv := 80;
  719.  
  720.              {------------Largest cell---------------}
  721.  
  722.              GoodFill := FALSE;
  723.              Message1;
  724.              REPEAT
  725.              Repeat
  726.                DigitLocate(xdig,ydig,butdig,errdig);
  727.                If ((xdig <> oldx) or (ydig <> oldy)) then
  728.                begin
  729.                   erasecross(oldx,oldy,3);
  730.                   Makecross(xdig,ydig,3);
  731.                   oldx := xdig;
  732.                   oldy := ydig;
  733.                end;
  734.              Until (butdig <> 0);
  735.              Repeat
  736.                Digitlocate(xdig,ydig,butdig,errdig);
  737.              Until (butdig = 0);
  738.              fillin(xdig-30,ydig-30,xdig+30,ydig+30,
  739.                        false,20{nucsize},seenx);
  740.              If Askwindow then
  741.                GoodFill := TRUE
  742.              else
  743.                Erosion2(xdig-round(2*20),ydig-round(2*20),
  744.                  xdig+round(2*20),ydig+round(2*20));
  745.              UNTIL goodfill;
  746. {set area}   NArea := 1+findarea(xdig-30,ydig-30,xdig+30,ydig+30,_f,_s);
  747.              MaxArea := round(1.3*Narea);
  748.              Nucsize := round( 1.2*sqrt(Narea/3.14) );
  749.              Eraseit(xdig,ydig,nucsize);
  750.  
  751.              {---------------smallest cell---------------}
  752.  
  753.              GoodFill := FALSE;
  754.              Message2;
  755.              REPEAT
  756.              Repeat
  757.                DigitLocate(xdig,ydig,butdig,errdig);
  758.                If ((xdig <> oldx) or (ydig <> oldy)) then
  759.                begin
  760.                   erasecross(oldx,oldy,3);
  761.                   Makecross(xdig,ydig,3);
  762.                   oldx := xdig;
  763.                   oldy := ydig;
  764.                end;
  765.              Until (butdig <> 0);
  766.              Repeat
  767.                Digitlocate(xdig,ydig,butdig,errdig);
  768.              Until (butdig = 0);
  769.              fillin(xdig-40,ydig-40,xdig+40,ydig+40,
  770.                        true,20{nucsize},seenx);
  771.              If Askwindow then
  772.                GoodFill := TRUE
  773.              else
  774.                Erosion2(xdig-round(1.5*nucsize),ydig-round(1.5*nucsize),
  775.                  xdig+round(1.5*nucsize),ydig+round(1.5*nucsize));
  776.              UNTIL goodfill;
  777.              NArea := 1+findarea(xdig-40,ydig-40,xdig+40,ydig+40,_f,_s);
  778.              MinArea := round(0.6*Narea);
  779.              EraseIt(xdig,ydig,nucsize);
  780.              zapMwindow;                     {erase small window  }
  781.              DisplaySUbMenu1(false);         {reset sub menu      }
  782.            end;
  783.         4: begin
  784.              Histogramstretch(hx,lx);        {histogram stretch   }
  785.              visionfix(xv1,yv1,xv2,yv2);
  786.              Repeat
  787.                 digitlocate(xdig,ydig,butdig,errdig);
  788.              until (butdig = 0);
  789.            end;
  790.         5: begin
  791.              Subfinished2 := FALSE;          {real-world interface}
  792.              DisplaySubMenu2(true);
  793.              While Not(SubFinished2) do
  794.              begin
  795.                SubDecision2 := ChooseMenu(2,40,10);
  796.                Case SubDecision2 of
  797.                1: begin                             {nothing}
  798.                    Repeat
  799.                      digitlocate(xdig,ydig,butdig,errdig);
  800.                    until (butdig = 0);
  801.                   end;
  802.                2: begin                              {toggle LEARN mode}
  803.                    LearnMode := Not(LearnMode);
  804.                    If LearnMode then
  805.                      Menu2[2] := 'Learn Mode ON            '
  806.                    else
  807.                      Menu2[2] := 'Learn Mode OFF           ';
  808.                    Repeat
  809.                      digitlocate(xdig,ydig,butdig,errdig);
  810.                    until (butdig = 0);
  811.                   end;
  812.                3: begin                              {reinitialize video}
  813.                     Initialize;
  814.                     Repeat
  815.                      digitlocate(xdig,ydig,butdig,errdig);
  816.                     until (butdig = 0);
  817.                   end;
  818.                4: begin
  819.                     ReportAll;                       {report data to printer}
  820.                     Repeat
  821.                      digitlocate(xdig,ydig,butdig,errdig);
  822.                     until (butdig = 0);
  823.                   end;
  824.                5: begin                              {set S1}
  825.                     tabletdriver(xv1,yv1,xv2,yv2,false);
  826.                     Repeat
  827.                      digitlocate(xdig,ydig,butdig,errdig);
  828.                     until (butdig = 0);
  829.                   end;
  830.                6: begin                              {end "real world " menu}
  831.                     ZapMWindow;
  832.                     SubFinished2 := TRUE;
  833.                     repeat
  834.                       digitlocate(xdig,ydig,butdig,errdig);
  835.                     until (butdig = 0);
  836.                   end;
  837.                end;{end case}
  838.              end;{end while}
  839.              DisplaySubMenu1(false);
  840.            end;
  841.         6: begin                                     {end submenu}
  842.              ZapMWindow;
  843.              Repeat                            {Get location            }
  844.                Digitlocate(xdig,ydig,butdig,errdig);
  845.              Until (butdig = 0);
  846.              SubFinished := TRUE;
  847.            end;
  848.         end;{end case}
  849.        end;{end while}
  850.        DisplayMenu(false);
  851.       end;
  852.    3: begin                                          {execute scan}
  853.         scandriver(xv1,yv1,xv2,yv2,round(2*Nucsize), {xv1,...= S1}
  854.               round(3*nucsize),nucsize,mval);        {2*nucsize,3*nucsize = }
  855.         While (askwindow2) do                        {width and height of S2}
  856.         begin                                        {did it get all nuclei?}
  857.           oldx := 2;
  858.           oldy := 2;
  859.           Repeat
  860.                Digitlocate(xdig,ydig,butdig,errdig); {point to nuclei to fill}
  861.              Until (butdig = 0);
  862.              Repeat
  863.                DigitLocate(xdig,ydig,butdig,errdig);
  864.                If (xdig <> oldx) or (ydig <> oldy) then
  865.                begin
  866.                   erasecross(oldx,oldy,3);
  867.                   makecross(xdig,ydig,3);
  868.                   oldx := xdig;
  869.                   oldy := ydig;
  870.                end;
  871.              Until (butdig = 1);
  872.              Repeat
  873.                Digitlocate(xdig,ydig,butdig,errdig);
  874.              Until (butdig = 0);                      {fill in}
  875.              fillin(xdig-nucsize,ydig-nucsize,xdig+nucsize,ydig+nucsize,
  876.                        false,nucsize,seenx);
  877.              If Askwindow then                        {is it OK?}
  878.              begin                                    {Learn}
  879.                LearnFromAddition(xdig,ydig,Nucsize,40,40,Mval);
  880.                MakeDark(xdig-20,ydig-20,xdig+20,ydig+20);
  881.              end
  882.              else
  883.                EraseIt(xdig,ydig,nucsize);
  884.         end;
  885.         MakeVideobox(xv1,yv1,xv2,yv2);         {put box back to align}
  886.         blacktored(xv1-nucsize,yv1-nucsize,xv2+nucsize,yv2+nucsize);
  887.         for i := 1 to cellcount do             {write nuclei numbers}
  888.         begin
  889.           Writenum(i,aicells[i].xcoord+15,aicells[i].ycoord-15);
  890.         end;
  891.         fixit;                                 {unstretch}
  892.         acquirecontinuous;                     {get live image}
  893.       end;
  894.    4: begin                                    {manually add area}
  895.              centerlighter := true;
  896.              oldx := 0;
  897.              oldy := 0;
  898.              Repeat
  899.                Digitlocate(xdig,ydig,butdig,errdig);
  900.              Until (butdig = 0);
  901.              Repeat
  902.                DigitLocate(xdig,ydig,butdig,errdig);
  903.                If (xdig <> oldx) or (ydig <> oldy) then
  904.                begin
  905.                   erasecross(oldx,oldy,3);
  906.                   makecross(xdig,ydig,3);
  907.                   oldx := xdig;
  908.                   oldy := ydig;
  909.                end;
  910.              Until (butdig = 1);
  911.              Repeat
  912.                Digitlocate(xdig,ydig,butdig,errdig);
  913.              Until (butdig = 0);
  914.              fillin(xdig-20,ydig-20,xdig+20,ydig+20,
  915.                        false,nucsize,seenx);
  916.              If Askwindow then
  917.              begin
  918.                LearnFromAddition(xdig,ydig,Nucsize,40,40,Mval);
  919.                MakeDark(xdig-20,ydig-20,xdig+20,ydig+20);
  920.              end
  921.              else
  922.                EraseIt(xdig,ydig,nucsize);
  923.       end;
  924.    5: Begin                                    {manually delete area}
  925.             centerlighter := true;
  926.              Repeat
  927.                Digitlocate(xdig,ydig,butdig,errdig);
  928.              Until (butdig = 0);
  929.              oldx := 2;
  930.              oldy := 2;
  931.              Repeat
  932.                DigitLocate(xdig,ydig,butdig,errdig);
  933.                If (xdig <> oldx) or (ydig <> oldy) then
  934.                begin
  935.                   erasecross(oldx,oldy,3);
  936.                   makecross(xdig,ydig,3);
  937.                   oldx := xdig;
  938.                   oldy := ydig;
  939.                end;
  940.              Until (butdig = 1);
  941.              Repeat
  942.                Digitlocate(xdig,ydig,butdig,errdig);
  943.              Until (butdig = 0);
  944.              erasecross(xdig,ydig,3);
  945.              eraseit(xdig,ydig,nucsize);
  946.              If LearnMode then
  947.              begin
  948.                findclosest(xdig,ydig,xz,yz,num); {find closest cell to   }
  949.                If num = 0 then                   {  the cursor (on video)}
  950.                  writeln(chr(7))
  951.                else
  952.                begin
  953.                   AiCells[num].good := false;    {do not print this data}
  954.                   LearnFromDeletion(num);        {Learn                 }
  955.                end;
  956.              end;
  957.       end;
  958.    6: Finished := TRUE;                          {Exit                  }
  959.    end;{end case}
  960. End;{end While}
  961.  
  962. END.