unit P_CellList;
interface
 uses
Memory, QuickDraw, Packages, Menus, Events, Fonts, Scrap, ToolUtils, Resources, Errors, Palettes, StandardFile,Palettes,PictUtils, Globals, Utilities, Analysis, File2,{}
  Graphics, Filters, Camera, Background, Lut, Text,pictutils;


 const
  cDescriptionHeight = 2;
  cFrameWidth = 0;
  cP_ForeColor = 20;
  cResizeWidth = 5;
  cDecimalCount = 2;
  cArrowHorizontal = 25;
  cArrowWing = 6;
  cMinsize = 10;
 type

  P_CircleH = ^P_CirclePtr;
  P_CirclePtr = ^P_Circle;
  P_Circle = record
    fRectangle: rect;
    fDescription: rect;
    fNumber: integer;
    fStr: Str255;
    next: P_CircleH;
    prev: P_CircleH;
    fValid: boolean;
   end;

  P_ListH = ^P_ListPtr;
  P_ListPtr = ^P_ListType;
  P_ListType = record
    P_Current, P_Head, P_Tail: P_CircleH;
    P_Counter: integer;
    WindowName: str255;
    next: P_listH;
    CountCircles: integer;
   end;


  P_FileinfoPtr = ^P_FileInfo;
  P_FileInfo = record
    VersionNumber: integer;
    CountLists: integer;
    Rmin, Rmax, Sf1, Sf2, Kd: extended;
    UseRatio: boolean;
    TreshHold: extended;
    RScalemin, RScalemax: extended;
   end;

  P_CircleContainer = record
    fRectangle: rect;
    fDescription: rect;
    fNumber: integer;
    fStr: Str255;
    fValid: boolean;
   end;

  P_ListContainer = record
    P_Counter: integer;
    WindowName: string[32];
    CountCircles: integer;
   end;

 procedure Draw;
 procedure Move;
 procedure Select;
 procedure DeSelect;


 procedure DrawCircle;
 procedure DrawDescription;
 function InSquare (itsPoint: point; itsCircle: P_CircleH): boolean;
 function InSquareNew (itsPoint: point; itsCircle: P_CircleH): boolean;
 procedure Initdata (itsRect: rect; itsNumber: integer);
 procedure SetNewLocation (DeltaX, DeltaY: integer);
 procedure ResizeCircle (DeltaX, DeltaY: integer);

 procedure InitP_CellList;
 procedure DoneP_CellList;
 procedure AppendToList (itsRect: rect);

 function ReturnCircle (itsPoint: Point): boolean;
 procedure DisposeList;
 procedure CreateStructures;
 procedure DuplicatetoNextWindow;
 procedure RedrawCurrent;
 procedure SetOvalRoi (itsRect: rect);
 procedure ComputeAllResults;
 procedure P_SuperMeasure;
 procedure P_SaveNewFile;
 procedure P_LoadFromFile;
 function GetCountLists: integer;
 function GetCountCircles (itsCircle: P_CircleH): integer;

 procedure CopyCircleToContainer (itsCircle: P_CircleH; var itsContainer: P_CircleContainer);
 procedure CopyListToContainer (itsList: P_ListH; var itsContainer: P_ListContainer);
 procedure CopyContainerTocircle (itsContainer: P_CircleContainer; var itsCircle: P_CircleH);
 procedure CopyContainerToList (itsContainer: P_ListContainer; var itsList: P_ListH);
 procedure AssignLists;
 procedure ResetInfoHandles;

 procedure RatioDialog;
 procedure InitRatioValues;
 procedure DeValid;

 procedure DeleteOneCircle;
 procedure DeleteCirclebyNumber (WhichCircle: integer);
 procedure DeleteAllinWindow;

 procedure EnablePrinting;
 var

  PointToTest: point;
  P_Counter: integer;
  P_Current, P_Head, P_Tail: P_CircleH;
  P_ListHead, P_ListCurrent, P_ListTail: P_ListH;
  P_SaveCounter: integer;
  P_Rmin, P_Rmax, P_Sf1, P_Sf2, P_Kd, P_RScalemin, P_RScalemax: extended;
  P_UseRatio: boolean;
  P_TreshHold: extended;

implementation

 procedure InitP_CellList;
 begin
  P_ListHead := nil;
  P_ListTail := nil;
  P_CircleMode := False;
 end;

 procedure DisposeCellList (var itsCell: P_CircleH);
  var
   aDisp: P_CircleH;

 begin
  while (itsCell <> nil) do
   begin
    aDisp := itsCell;
    itsCell := itsCell^^.Next;
    disposeHandle(Handle(aDisp));
   end;
 end;


 procedure DisposeList;
  var
   aDisp, aHead: P_ListH;

 begin
  while (P_ListHead <> nil) do
   begin
    aDisp := P_ListHead;
    P_ListHead := P_ListHead^^.Next;
    DisposeCellList(aDisp^^.P_head);
    disposeHandle(Handle(aDisp));
   end;
  P_ListHead := nil;
 end;


 procedure CreateStructures;
  var
   I: integer;
   TempInfo: InfoPtr;
   aTempList: P_ListH;
 begin
  if nPics > 0 then
   begin
    P_SaveCounter := 0;
    initRatioValues;
    for i := 1 to nPics do
     begin
      TempInfo := pointer(WindowPeek(PicWindow[i])^.RefCon);
      if PicWindow[i] <> nil then
       begin
       aTempList := P_ListH(newhandle(sizeof(P_ListType)));
       with aTempList^^ do
       begin
       Next := nil;
       P_Counter := 0;
       WindowName := TempInfo^.title;
       P_Head := nil;
       P_Tail := nil;
       P_Current := nil;
       CountCircles := 0;
       end;
       tempinfo^.P_List := handle(aTempList);
       if (P_ListHead = nil) then
       begin
       P_ListHead := aTempList;
       P_ListTail := aTempList;
       P_ListCurrent := aTempList;
       end
       else
       begin

       P_ListTail^^.Next := aTempList;
       P_ListTail := aTempList;

       end;

       end
     end;
   end;
 end;

 procedure DuplicatetoNextWindow;
  var
   aoldList, anewList: P_ListH;
   n: integer;
   aTemp1, aTemp2: P_CircleH;
   aRect: rect;
 begin
  aOldList := P_ListH(info^.P_List);
  n := info^.PicNum + 1;
  if n > nPics then
   n := 1;
  StopDigitizing;
  SaveRoi;
  DisableDensitySlice;
  SelectWindow(PicWindow[n]);
  Info := pointer(WindowPeek(PicWindow[n])^.RefCon);
  ActivateWindow;
  GenerateValues;
  LoadLUT(info^.cTable);
{UpdatePicWindow;}
  aNewList := P_ListH(info^.P_List);
  aTemp1 := aOldList^^.P_Head;
  setPort(info^.wptr);
  while (aTemp1 <> nil) do
   begin
    AppendToList(aTemp1^^.fRectangle);
    if (aTemp1^^.fValid = false) then
     Devalid;

    aTemp1 := aTemp1^^.next;
   end;
 end;

 function InSquare (ItsPoint: point; itsCircle: P_CircleH): boolean;

 begin
  with itsCircle^^ do
   begin
    if (P_Mode <> P_ResizeCircle) then
     begin
      with fRectangle, itsPoint do
       begin
       if ((h >= left) and (h <= right) and (v >= top) and (v <= bottom)) then
       InSquare := true
       else
       InSquare := False;
       end;
     end
    else
     begin
      with fRectangle, itsPoint do
       begin
       if ((h >= right - cResizeWidth) and (h <= right) and (v >= bottom - cResizeWidth) and (v <= bottom)) then
       InSquare := true
       else
       InSquare := False;
       end;
     end;
   end;
 end;


 function InSquareNew (ItsPoint: point; itsCircle: P_CircleH): boolean;
  var
   aResult: boolean;
 begin
  with itsCircle^^ do
   begin
    with fRectangle, itsPoint do
     begin
      if ((h >= right - cResizeWidth) and (h <= right) and (v >= bottom - cResizeWidth) and (v <= bottom)) then
       begin
       aResult := true;
       P_Mode := P_ResizeCircle;
       end
      else
       aResult := False;
     end;

    if not (aResult) then
     begin
      with fRectangle, itsPoint do
       begin
       if ((h >= left) and (h <= right) and (v >= top) and (v <= bottom)) then
       begin
       aResult := true;
       P_Mode := P_MoveCircle;
       end
       else
       aResult := False;
       end;
     end;
   end;
  InSquareNew := aResult;
 end;


 procedure AppendToList (itsRect: rect);
  var
   aCircle, oldCurrent: P_circleH;

 begin

  with P_ListH(info^.P_List)^^ do
   begin
    aCircle := P_CircleH(newHandle(sizeof(P_Circle)));    	 {HERE WE ARE DOING NON CORRECT< YOU SHOULD CHECK WHETHER ENOUGH MEMORY}
    P_Counter := P_Counter + 1;
    oldCurrent := P_Current;   {Remember the current handle for circle}
    P_Current := aCircle;
    CountCircles := CountCircles + 1;
    InitData(itsRect, P_Counter);
    Draw;
    P_Current := oldCurrent;    {Restore it}
    if (P_Head = nil) then
     begin
      P_Head := aCircle;
      P_Tail := aCircle;
      P_Current := aCircle;
     end
    else
     begin
      P_Tail^^.Next := aCircle;
      aCircle^^.Prev := P_Tail;
      P_Tail := aCircle;
      P_Current := aCircle;
     end;
   end;
 end;



 procedure InitData (itsRect: rect; itsNumber: integer);
  var
   aVx, aVy: integer;

 begin
  with P_ListH(info^.P_List)^^ do
   begin
    with P_Current^^ do
     begin
      with itsRect do
       begin
       fRectangle.Top := Top;
       if ((bottom - top) < cMinSize) then
       bottom := top + cMinSize;
       fRectangle.bottom := bottom;

       fRectangle.left := left;
       if ((right - left) < cMinSize) then
       right := left + cMinSize;
       fRectangle.right := right;
       end;
      with fRectangle do
       begin
       aVx := left + ((right - left) div 2) - round(cDescriptionHeight / 2) - cFrameWidth;
       aVy := top + ((bottom - top) div 2) - round(cDescriptionHeight / 2) - cFrameWidth;
       end;
      with fDescription do
       begin
       left := aVx;
       top := aVy;
       right := left + cDescriptionHeight + cFrameWidth;
       bottom := top + cDescriptionHeight + cFrameWidth;
       end;
      fNumber := itsNumber;
      NumToString(fNumber, fStr);
      fValid := True;
      Next := nil;
      Prev := nil;
     end;
   end;
 end;



 procedure SetNewLocation (DeltaX, DeltaY: integer);
  var
   aVx, aVy: integer;

 begin
  with P_ListH(info^.P_List)^^ do
   begin
    with P_Current^^ do
     begin
      with fRectangle do
       begin
       fRectangle.Top := Top + DeltaY;
       fRectangle.bottom := bottom + DeltaY;
       fRectangle.left := left + DeltaX;
       fRectangle.right := right + DeltaX;
       end;
      with fDescription do
       begin
       Top := Top + DeltaY;
       bottom := bottom + DeltaY;
       left := left + DeltaX;
       right := right + DeltaX;
       end;
     end;
   end;
 end;

 procedure Resizecircle (DeltaX, DeltaY: integer);
  var
   aVx, aVy: integer;
   aU, aV: point;
   aDeltaX, aDeltaY: integer;
 begin
  with P_ListH(info^.P_List)^^ do
   begin
    with P_Current^^ do
     begin
      with fRectangle do
       begin
       aU.h := left;
       aU.v := top;
       aVx := Right - left;   {pozri sa na rozmery}
       aVy := bottom - top;

       aVx := aVx + DeltaX;{prepocitaj zmenu}
       aVy := aVy + DeltaY;
       aV.h := left + aVx;
       aV.v := top + aVy;

       end;
      Pt2Rect(aU, aV, fRectangle);
      with fRectangle do
       begin
       aVx := left + ((right - left) div 2) - round(cDescriptionHeight / 2) - cFrameWidth;
       aVy := top + ((bottom - top) div 2) - round(cDescriptionHeight / 2) - cFrameWidth;
       end;
      with fDescription do
       begin
       left := aVx;
       top := aVy;
       right := left + cDescriptionHeight + cFrameWidth;
       bottom := top + cDescriptionHeight + cFrameWidth;
       end;
     end;
   end;
 end;



 procedure DrawDescription;
  var
   OldPenState: Penstate;
 begin
  GetPenState(OldPenstate);
  PenNormal;
  PenMode(PatXor);
  PenSize(1, 1);
  pmForeColor(ForeGroundIndex);
  TextMode(srcXor);
  with P_ListH(info^.P_List)^^ do
   begin
    with P_Current^^ do
     begin
      with fDescription do
       begin
       MoveTo(left + cFrameWidth, top + cFrameWidth);
       end;
      DrawString(fStr);
     end;
    SetPenState(OldPenstate);
   end;
 end;

 procedure Draw;

  var
   OldPenState: Penstate;
   aRect: rect;
 begin
  GetPenState(OldPenstate);
  PenNormal;
  PenMode(PatXor);
  PenSize(1, 1);
  pmForeColor(ForeGroundIndex);
  with P_ListH(info^.P_List)^^ do
   begin
    with P_Current^^ do
     begin
      FrameOval(fRectangle);
{FrameRect(fDescription);}
      DrawDescription;

{if (P_Mode = P_ResizeCircle) then}
{begin}
      SetRect(aRect, fRectangle.Right - cResizewidth, fRectangle.bottom - cResizeWidth, fRectangle.Right, fRectangle.bottom);
      FrameRect(aRect);
{    end;}
     end;
   end;
  setPenstate(oldPenState);
 end;

 procedure DrawCircle;
  var
   OldPenState: PenState;
   aRect: rect;
 begin
  GetPenState(OldPenstate);
  PenNormal;
  PenMode(PatXor);
  PenSize(1, 1);
  pmForeColor(foreGroundIndex);
  with P_ListH(info^.P_List)^^ do
   begin
    with P_Current^^ do
     begin
      FrameOval(fRectangle);
{if (P_Mode = P_ResizeCircle) then}
{begin}
      SetRect(aRect, fRectangle.Right - cResizewidth, fRectangle.bottom - cResizeWidth, fRectangle.Right, fRectangle.bottom);
      FrameRect(aRect);
{    end;}
     end;
   end;
  SetPenState(OldPenState);
 end;




 function ReturnCircle (itsPoint: Point): boolean;   {looks into the list whether click was in circle}
  var
   aTemp: P_CircleH;

   aResult: boolean;
   aRect: rect;
 begin

  with P_ListH(info^.P_List)^^ do
   begin
    aTemp := P_Head;
    aResult := false;
    while (aTemp <> nil) and (aResult = False) do
     begin
      P_Current := aTemp;
      aResult := InSquareNew(itsPoint, aTemp);
      aTemp := aTemp^^.Next;
     end;
    ReturnCircle := aResult;
   end;
 end;

 procedure RedrawCurrent;
  var
   aTemp: P_CircleH;
   OldPenState: PenState;
   oldPort: GrafPtr;
   aRect: rect;
   aTempH, aTempV: integer;
 begin

{UpdatePicWindow;}
  getPort(oldPort);

  SetPort(info^.wptr);
  GetPenState(OldPenstate);
  PenNormal;
  PenMode(patCopy);
  PenSize(1, 1);
  SetFColor(ForeGroundIndex);
  TextMode(srcOr);


  with P_ListH(info^.P_List)^^ do
   begin
    aTemp := P_Head;
    while (aTemp <> nil) do
     begin
      with aTemp^^ do
       begin
       FrameOval(fRectangle);
       with fDescription do
       begin
       MoveTo(left + cFrameWidth, top + cFrameWidth);
       end;
       DrawString(fStr);
{if (P_Mode = P_ResizeCircle) then}
       begin
       SetRect(aRect, fRectangle.Right - cResizewidth, fRectangle.bottom - cResizeWidth, fRectangle.Right, fRectangle.bottom);
       FrameRect(aRect);
       end;
       if not fValid then
       with fRectangle do
       begin
       MoveTo(left, bottom);
       LineTo(right, top);
       MoveTo(left, top);
       LineTo(right, bottom);
       end;
       end;
      aTemp := aTemp^^.Next;
     end;
    with P_Current^^ do
     begin
      with fRectangle do
       begin
       aTemph := left;
       aTempV := top + trunc((bottom - top) / 2);
       end;
      MoveTo(aTempH - cArrowHorizontal, aTempV);
      Line(cArrowHorizontal, 0);
      Line(-cArrowWing, -cArrowWing);
      MoveTo(aTempH, aTempV);
      Line(-cArrowWing, cArrowWing);
     end;
   end;




  SetPenState(OldPenState);
  SetPort(OldPort);
 end;

 procedure SetOvalRoi (itsRect: rect);

 begin
{KillRoi;}
  with Info^ do
   begin
    RoiType := OvalRoi;
    with itsrect do
     SetRect(RoiRect, left, top, right, bottom);
    MakeRegion;
    RoiShowing := true;
   end;
 end;

 procedure ComputeAllResults;
  var
   OK: Boolean;
   aTempList: P_listH;
   aTempCell: P_CircleH;
   I: integer;
   aStr: str255;
   aTempMean, aTempR: extended;
   aResult: extended;
 begin

  OK := MakeNewTextWindow('Computed results', 500, 400);
  if (OK) then
   begin
    for i := 1 to npics do
     begin
      SelectWindow(PicWindow[i]);
      Info := pointer(WindowPeek(PicWindow[i])^.RefCon);
      ActivateWindow;
      GenerateValues;
      LoadLUT(info^.cTable);
      aTempList := P_ListH(info^.P_List);
      aTempCell := aTempList^^.P_Head;
      while (aTempCell <> nil) do
       begin
       if (aTempCell^^.fValid) then
       begin
       SetOvalRoi(aTempCell^^.fRectangle);
       mcount := 0;
       P_SuperMeasure;
       if P_UseRatio then
       begin
       aTempMean := results.UnCalibratedMean / P_TreshHold;
       aTempMean := P_RScaleMax - (aTempMean * (P_RScaleMax - P_RScaleMin));
       aTempR := P_Rmax - aTempMean;
       if (P_Sf2 = 0) then
       aStr := 'ndef Sf2'
       else if aTempR = 0 then
       aStr := 'ndef'
       else
       begin
       aResult := P_Kd * P_Sf1 * (aTempMean - P_Rmin) / (P_Sf2 * (P_Rmax - aTempMean));
       RealTostring(aResult, 6, 2, aStr);
       end
       end

       else
       RealTostring(results.UnCalibratedMean, 6, 2, aStr);
       end
       else
       aStr := 'nval';
       InsertText(aStr, False);
       aTempCell := aTempCell^^.Next;
       if (aTempCell <> nil) then
       begin
       aStr := Char(9);
       InsertText(aStr, False);
       end
       else
       begin
       aStr := Char(13);
       InsertText(aStr, False);
       end;
       end;  {while}
     end; {for}
   end
  else
   PutMessage('Cannot open text window');
 end;

 procedure P_SuperMeasure;
  var
   AutoSelectAll: boolean;
   SaveN: integer;
 begin
  if NotInBounds then
   exit(P_SuperMeasure);
  with info^ do
   begin
    FindThresholdingMode;
    if ThresholdingMode = BinaryImage then
     ThresholdingMode := NoThresholding;
    AutoSelectAll := not RoiShowing;
    if AutoSelectAll then
     SelectAll(false);
    if (RoiType = RectRoi) and (not RedirectSampling) then
     GetRectHistogram
    else
     GetHistogram;
    if MeasurementToRedo > 0 then
     begin
      SaveN := mCount;
      mCount := MeasurementToRedo - 1;
      ComputeResults;
{ShowInfo;}
      mCount := SaveN;
      MeasurementToRedo := 0;
      UpdateList;
     end
    else
     begin
      ComputeResults;
{ShowInfo;}
      AppendResults;
      if RoiType = LineRoi then
       if nLengths = 1 then
       if not (LengthM in Measurements) then
       UpdateList;
     end;
    RoiShowing := true;
    WhatToUndo := UndoMeasurement;
    if AutoSelectAll then
     KillRoi;
{UpdateScreen(OldRoiRect);}
   end;
 end;


 function GetCountLists: integer;
  var
   aList: P_ListH;
   aCount: integer;
 begin
  aList := P_ListHead;
  aCount := 0;
  while aList <> nil do
   begin
    aCount := aCount + 1;
    aList := aList^^.Next;
   end;

  GetCountLists := aCount;
 end;

 function GetCountCircles (itsCircle: P_CircleH): integer;
  var
   aCircle: P_CircleH;
   aCount: integer;
 begin
  aCircle := itsCircle;
  aCount := 0;
  while aCircle <> nil do
   begin
    aCount := aCount + 1;
    aCircle := aCircle^^.Next;
   end;
  GetCountCircles := aCount;
 end;

 procedure P_SaveNewFile;


  var
   aListSize, aCircleSize, aSize: longint;
   aFileInfo: P_FileInfoPtr;
   where: Point;
   reply: SFReply;
   aNumStr: str255;
   aFilename: str255;
   aRefnum: integer;
   fRef: integer;
   err: integer;
   aTempList: P_ListH;
   aTempCircle: P_CircleH;
   aByteCount: longint;
   TheInfo: FInfo;
   aWriteCircle: P_CircleContainer;
   aWriteList: P_ListContainer;



  procedure MyCheckIO (itserr: OsErr);
  begin
   if CheckIO(err) <> 0 then
    begin
     err := fsclose(fRef);
     err := FSDelete(aFilename, aRefNum);
     exit(P_SaveNewFile);
    end;
  end;



 begin
  aListSize := sizeof(P_ListContainer);
  aCircleSize := sizeof(P_CircleContainer);
  aFileInfo := P_FileInfoPtr(newPtr(sizeof(P_FileInfo)));
  with aFileInfo^ do
   begin
    CountLists := GetCountLists;
    VersionNumber := 1;
    Rmin := P_Rmin;
    Rmax := P_Rmax;
    Sf1 := P_Sf1;
    Sf2 := P_Sf2;
    Kd := P_Kd;
    UseRatio := P_UseRatio;
    TreshHold := P_TreshHold;
    RScalemin := P_RScalemin;
    RScalemax := P_RScalemax;
   end;
  aByteCount := 0;
  where.v := 60;
  where.h := 100;
  NumtoString(P_SaveCounter, aNumStr);
  aNumstr := Concat('Circle location ', aNumStr);
  SFPutFile(where, 'Circle location?', aNumStr, nil, reply);
  if reply.good then
   begin
    P_SaveCounter := P_SaveCounter + 1;
    with reply do
     begin
      aFileName := fname;
      aRefnum := vRefNum;
     end;

    err := GetFInfo(aFilename, aRefNum, TheInfo);
    case err of
     NoErr: 
      if TheInfo.fdType <> 'BIPR' then
       begin
       TypeMismatch(aFileName);
       exit(P_SaveNewFile)
       end;
     FNFerr: 
      begin
       err := create(reply.fname, reply.vRefnum, 'Imag', 'BIPR');
       MyCheckIO(err);
      end;
     otherwise

      if CheckIO(err) <> 0 then
       exit(P_SaveNewFile)
    end;
    err := fsopen(aFilename, aRefnum, fRef);
    err := SetFPos(fref, FSFromStart, 0);
    MyCheckIO(err);

    aSize := sizeof(P_FileInfo);

    err := FSWrite(fRef, aSize, Ptr(aFileInfo));
    aByteCount := aBytecount + aSize;
    MyCheckIO(err);
    aTempList := P_ListHead;

    while aTempList <> nil do
     begin
      hlock(handle(aTempList));
      CopyListToContainer(aTempList, aWriteList);
      err := FSWrite(fRef, aListSize, @aWriteList);
      MyCheckIO(err);
      aByteCount := aBytecount + aListSize;
      hunlock(handle(aTempList));
      aTempCircle := aTempList^^.P_Head;
      while aTempCircle <> nil do
       begin
       hLock(handle(aTempCircle));
       CopyCircleToContainer(aTempCircle, aWriteCircle);
       err := FSWrite(fRef, aCircleSize, @aWriteCircle);
       MyCheckIO(err);
       aByteCount := aByteCount + aCircleSize;
       hunlock(handle(aTempCircle));
       aTempCircle := aTempCircle^^.Next;
       end;
      aTempList := aTempList^^.Next;
     end;
    err := SetEof(fRef, aByteCount);
    MyCheckIO(err);
    err := FsClose(fRef);
    MyCheckIO(err);
    err := flushvol(nil, aRefNum);
    MyCheckIO(err);
   end;
 end;




 procedure CopyCircleToContainer (itsCircle: P_CircleH; var itsContainer: P_CircleContainer);
 begin
  with itsCircle^^ do
   begin
    itsContainer.fRectangle := fRectangle;
    itsContainer.FDescription := fDescription;
    itsContainer.fNumber := fNumber;
    itsContainer.fStr := fStr;
    itsContainer.fValid := fValid;
   end;
 end;


 procedure CopyListToContainer (itsList: P_ListH; var itsContainer: P_ListContainer);
 begin
  with itsList^^ do
   begin
    itsContainer.P_Counter := P_Counter;
    itsContainer.Windowname := WindowName;
    itsContainer.CountCircles := CountCircles;

   end;
 end;

 procedure CopyContainerToCircle (itsContainer: P_CircleContainer; var itsCircle: P_CircleH);

 begin
  with itsCircle^^ do
   begin

    fRectangle := itsContainer.fRectangle;
    fDescription := itsContainer.FDescription;
    fNumber := itsContainer.fNumber;
    fStr := itsContainer.fStr;
    fValid := itsContainer.fValid;
    Next := nil;
    Prev := nil;
   end;
  with P_ListCurrent^^ do
   begin
    if (P_Head = nil) then
     begin
      P_Head := itsCircle;
      P_Tail := itsCircle;
      P_Current := itsCircle;
     end
    else
     begin
      P_Tail^^.Next := itsCircle;
      itsCircle^^.Prev := P_Tail;
      P_Tail := itsCircle;
      P_Current := itsCircle;
     end;
   end;
 end;


 procedure CopyContainerToList (itsContainer: P_ListContainer; var itsList: P_ListH);

 begin
  with itsList^^ do
   begin
    P_Counter := itsContainer.P_Counter;
    Windowname := itsContainer.Windowname;
    CountCircles := itsContainer.CountCircles;
    Next := nil;
    P_Head := nil;
    P_Tail := nil;
    P_Current := nil;
   end;
  if (P_ListHead = nil) then
   begin
    P_ListHead := itsList;
    P_ListTail := itsList;
    P_ListCurrent := itsList;
   end
  else
   begin
    P_ListTail^^.Next := itsList;
    P_ListTail := itsList;
    P_ListCurrent := itsList;
   end;
 end;


 procedure P_LoadFromFile;

  var
   where: Point;
   reply: SFReply;
   b: boolean;
   sfPtr: SFTypeList;
   TypeList: array[0..10] of OSType;
   FileType: OSType;
   OKToContinue: boolean;
   FinderInfo: FInfo;
   err: OSErr;
   aFileName: str255;
   aFileType: OSType;
   aRefNum, aDefaultRefNum: integer;
   I, J, K: integer;
   f: integer;
   aListSize, aCircleSize, aFileSize: Longint;
   aListContainer: P_ListContainer;
   aCircleContainer: P_CircleContainer;
   aTempList: P_ListH;
   atempCircle: P_CircleH;
   aFileInfo: P_FileInfo;

  procedure MyCheckIO (itserr: OsErr);
  begin
   if CheckIO(err) <> 0 then
    begin
     err := fsclose(f);
     exit(P_LoadFromFile);
    end;
  end;


 begin
  aListSize := sizeof(P_ListContainer);
  aCircleSize := sizeof(P_CircleContainer);
  aFilesize := sizeof(P_FileInfo);
  DisposeList;															{UVolnujeme struktury}
  where.v := 50;
  where.h := 50;
  typeList[0] := 'BIPR';
  {sfPtr := @TypeList;}
  SFGetFile(Where, 'Open circle location', nil, 1, @TypeList, nil, reply);
  if reply.good then
   begin
    with reply do
     begin
      aFileName := fname;
      aFileType := ftype;
      aRefNum := vRefNum;
     end;
    err := GetFInfo(aFilename, aRefNum, FinderInfo);
    err := fsopen(aFilename, aRefNum, f);
    MyCheckIO(err);
    err := SetFPos(f, FSfromStart, 0);
    MyCheckIO(err);
    err := FSRead(f, aFileSize, @aFileInfo);
    MyCheckIO(err);
    if (aFileinfo.CountLists > 0) then
     begin
      with aFileinfo do
       begin
       P_Rmin := Rmin;
       P_Rmax := Rmax;
       P_Sf1 := Sf1;
       P_Sf2 := Sf2;
       P_Kd := Kd;
       P_UseRatio := UseRatio;
       P_TreshHold := TreshHold;
       P_RScalemin := RScalemin;
       P_RScalemax := RScalemax;
       end;
      for I := 1 to aFileinfo.CountLists do
       begin

       err := FSRead(f, aListSize, @aListContainer);
       MyCheckIO(err);
       aTempList := P_ListH(newHandle(sizeof(P_ListType)));
       CopyContainerToList(aListContainer, aTempList);

       if (aListContainer.CountCircles > 0) then
       begin
       for J := 1 to aListContainer.CountCircles do
       begin
       err := FSRead(f, aCircleSize, @aCircleContainer);
       MyCheckIO(err);
       aTempCircle := P_CircleH(newHandle(sizeof(P_Circle)));
       CopyContainerToCircle(aCircleContainer, aTempCircle);
       end;
       end;
       end;
      err := fsclose(f);
      AssignLists;
     end
    else
     begin
      PutMessage('Zero objects in the list');
      err := fsclose(f);
     end;
   end;
 end;


 function ReturnWindowInfo (var itsName: Str255): infoPtr;
  var
   ResultInfo, TempInfo: infoPtr;
   WPeek, NextWPeek: WindowPeek;
   wTitle: Str255;

 begin
  ResultInfo := nil;
  wPeek := WindowPeek(FrontWindow);
  while ((wPeek <> nil) and (ResultInfo = nil)) do
   begin
    NextWPeek := wPeek^.NextWindow;
    if wPeek^.WindowKind = PicKind then
     begin
      TempInfo := InfoPtr(wPeek^.RefCon);
      wTitle := TempInfo^.title;
      if (wTitle = itsName) then
       ResultInfo := TempInfo;
     end;
    wPeek := NextWPeek;
   end;
  ReturnWindowInfo := ResultInfo;
 end;


 procedure AssignLists;
  var
   aTempList: P_ListH;
   TempInfo: InfoPtr;
 begin
  aTempList := P_ListHead;
  while (aTempList <> nil) do
   begin
    TempInfo := ReturnWindowInfo(aTempList^^.WindowName);
    if TempInfo <> nil then
     TempInfo^.P_List := handle(aTempList);
    aTempList := aTempList^^.Next;
   end;
 end;

 procedure ResetInfoHandles;
  var
   wPeek: WindowPeek;
   TempInfo: Infoptr;
 begin
  wPeek := WindowPeek(FrontWindow);
  while wPeek <> nil do
   begin
    TempInfo := InfoPtr(wPeek^.RefCon);
    Tempinfo^.P_List := nil;
    wPeek := wPeek^.NextWindow;
   end;
 end;

 procedure RatioDialog;
  const
   cRmin = 3;
   cRmax = 10;
   cKd = 11;
   cSf1 = 12;
   cSf2 = 13;
   cUseRatio = 14;
   ctreshHold = 16;
   cRScalemin = 20;
   cRScaleMax = 21;
  var
   mylog: DialogPtr;
   item, i: integer;
   newRatio: boolean;
   newRmin, newRMax, newSf1, newSf2, newKd, newTreshHold, newRScalemin, newRScaleMax: extended;
 begin
  InitCursor;
  mylog := GetNewDialog(6501, nil, pointer(-1));
  SetDReal(mylog, cRmin, P_Rmin, cDecimalCount);
  SetDReal(mylog, cRmax, P_Rmax, cDecimalCount);
  SetDReal(mylog, cKd, P_Kd, cDecimalCount);
  SetDReal(mylog, cSf1, P_Sf1, cDecimalCount);
  SetDReal(mylog, cSf2, P_Sf2, cDecimalCount);
  SetDReal(myLog, cTreshHold, P_TreshHold, cDecimalCount);
  SetDReal(mylog, cRScalemin, P_RScalemin, cDecimalCount);
  SetDReal(mylog, cRScalemax, P_RScalemax, cDecimalCount);
  SetDlogItem(mylog, cUseRatio, ord(P_UseRatio));
  newRmin := P_Rmin;
  newRMax := P_Rmax;
  newSf1 := P_Sf1;
  newSF2 := P_Sf2;
  newKd := P_Kd;
  newRatio := P_UseRatio;
  newratio := P_UseRatio;
  newTreshHold := P_TreshHold;
  newRScalemin := P_RScalemin;
  newRScalemax := P_RScalemax;
  outlinebutton(Mylog, OK, 16);

  repeat
   ModalDialog(nil, item);
   case item of
    cRmin: 
     newRmin := GetDReal(mylog, cRmin);
    cRmax: 
     newRmax := GetDReal(mylog, cRmax);
    cKd: 
     newKd := GetDReal(mylog, cKd);
    cSf1: 
     newSf1 := GetDReal(mylog, cSf1);
    cSf2: 
     newSf2 := GetDReal(mylog, cSf2);
    cUseratio: 
     begin
      newRatio := not newratio;
      SetDlogItem(mylog, cUseRatio, ord(newRatio));
     end;
    cTreshHold: 
     newTreshHold := GetDReal(myLog, cTreshHold);
    cRScalemin: 
     newRScalemin := GetDReal(mylog, cRScalemin);
    cRScalemax: 
     newRScalemax := GetDReal(mylog, cRScalemax);
   end;
  until (item = ok) or (item = cancel);
  DisposeDialog(mylog);
  if item = ok then
   begin
    P_Rmin := newRMin;
    P_Rmax := newRMax;
    P_Kd := newKd;
    P_Sf1 := newSf1;
    P_Sf2 := newSf2;
    P_UseRatio := newRatio;
    P_TreshHold := newTreshHold;
    P_RScalemin := newRScaleMin;
    P_RScalemax := newRScaleMax;
   end;
 end;

 procedure InitRatioValues;
 begin
  P_Rmin := 0.3;
  P_Rmax := 1.8;
  P_Kd := 300;
  P_Sf1 := 254;
  P_Sf2 := 50;
  P_UseRatio := true;
  P_TreshHold := 255;
  P_RScalemin := 0.3;
  P_RScalemax := 2.5;
 end;


 procedure Select;
  var
   aTemph, aTempV: integer;
   OldPenState: Penstate;
 begin
  GetPenState(OldPenstate);
  PenNormal;
  PenMode(PatXor);
  PenSize(1, 1);
  pmForeColor(ForeGroundIndex);
  with P_ListH(info^.P_List)^^ do
   with P_Current^^ do
    begin
     with fRectangle do
      begin
       aTemph := left;
       aTempV := top + trunc((bottom - top) / 2);
      end;
     MoveTo(aTempH - cArrowHorizontal, aTempV);
     Line(cArrowHorizontal, 0);
     Line(-cArrowWing, -cArrowWing);
     MoveTo(aTempH, aTempV);
     Line(-cArrowWing, cArrowWing);
    end;
  SetPenState(OldPenState);
 end;

 procedure DeValid;

 begin
  with P_ListH(info^.P_List)^^ do
   with P_Current^^ do
    fValid := not fValid;
 end;


 procedure DeleteOneCircle;
  var
   aDelNumber: integer;

 begin
  with P_ListH(info^.P_List)^^ do
   with P_Current^^ do
    aDelNumber := fNumber;
  DeleteCirclebyNumber(aDelNumber);
  UpdatePicWindow;
 end;

 procedure DeleteCirclebyNumber (WhichCircle: integer);

  var
   aTemp: P_ListH;
   aCircleTemp, aCircleTemp1: P_CircleH;
   aNumber: integer;
   aFounded, aEndReached: boolean;
 begin
  aTemp := P_Listhead;

  while aTemp <> nil do

   begin
    aFounded := false;
    aEndReached := false;

    with aTemp^^ do
     begin
      aCircleTemp1 := P_Head;
      if (aCircleTemp1 = nil) then
       aEndreached := true;
      while not (aFounded or aEndReached) do
       begin

       if aCircleTemp1 <> nil then
       aNumber := aCircleTemp1^^.fNumber;
       if (aNumber = WhichCircle) then
       aFounded := true;

       if (not (aEndReached)) then
       begin
       aCircleTemp := aCircleTemp1;
       aCircleTemp1 := aCircleTemp1^^.next;
       end;
       if (aCircleTemp1 = nil) then
       aEndreached := true;
       end;

      if (aFounded) then
       begin
       if (aCircleTemp = P_Head) then
       begin
       P_Head := aCircleTemp^^.next;
       P_Head^^.Prev := nil;
       end
       else if (aCircleTemp = P_Tail) then
       begin
       P_Tail := aCircleTemp^^.prev;
       P_Tail^^.next := nil;
       end
       else
       begin
       aCircleTemp^^.Prev^^.Next := aCircleTemp^^.Next;
       aCircleTemp^^.Next^^.Prev := aCircleTemp^^.Prev;
       end;
       disposehandle(Handle(aCircleTemp));
       while aCircleTemp1 <> nil do
       begin
       with aCircleTemp1^^ do
       begin
       fNumber := fNumber - 1;
       Numtostring(fNumber, fstr);
       end;
       aCircleTemp1 := aCircleTemp1^^.next;
       end;
       P_Counter := P_Counter - 1;
       CountCircles := CountCircles - 1;
       P_Current := P_Tail;
       end;
     end;
    aTemp := aTemp^^.Next;
   end;
 end;

 procedure DeleteAllinWindow;
 begin

  with P_ListH(info^.P_List)^^ do
   begin
    DisposeCellList(P_Head);
    P_Head := nil;
    P_Tail := nil;
    P_Current := nil;
    P_Counter := 0;
    CountCircles := 0;
   end;
  UpdatePicWindow;
 end;

 procedure EnablePrinting;
  var
   a, b: point;
   aRect: rect;
   aTemp: P_CircleH;
   aTempH, aTempV: integer;
 begin
  with P_ListH(info^.P_List)^^ do
   begin
    aTemp := P_Head;
    while (aTemp <> nil) do
     begin
      with aTemp^^ do
       begin

       DrawObject(oval, fRectangle.topleft, fRectangle.botright);
       with fDescription do
       begin
       Textstart.h := left + cFrameWidth;
       Textstart.v := top + cFrameWidth;
       end;
       TextStr := fstr;
       isInsertionPoint := true;
       DisplayText(false);
       isInsertionPoint := false;
{if (P_Mode = P_ResizeCircle) then}
       begin
       SetRect(aRect, fRectangle.Right - cResizewidth, fRectangle.bottom - cResizeWidth, fRectangle.Right, fRectangle.bottom);
       DrawObject(Rectangle, aRect.Topleft, aRect.botright);
       end;
       if not fValid then
       with fRectangle do
       begin
       DrawObject(lineobj, topleft, botright);
       a.h := left;
       a.v := bottom;
       b.h := right;
       b.v := top;
       DrawObject(lineobj, a, b);
       end;
       end;
      aTemp := aTemp^^.Next;
     end;
    with P_Current^^ do
     begin
      with fRectangle do
       begin
       aTemph := left;
       aTempV := top + trunc((bottom - top) / 2);
       end;
      a.h := aTempH - cArrowHorizontal;
      a.v := aTempV;
      b.h := aTempH;
      b.v := aTempV;
      DrawObject(lineobj, a, b);

{MoveTo(aTempH - cArrowHorizontal, aTempV);}
{Line(cArrowHorizontal, 0);}
      a.h := aTempH - cArrowWing;
      a.v := aTempV - cArrowWing;
      DrawObject(lineobj, a, b);

{Line(-cArrowWing, -cArrowWing);}
      a.h := aTempH;
      a.v := aTempV;
      b.h := aTempH - cArrowWing;
      b.v := aTempV + cArrowWing;
      DrawObject(lineobj, a, b);

{MoveTo(aTempH, aTempV);}
{Line(-cArrowWing, cArrowWing);}
     end;
   end;
 end;
end.