home *** CD-ROM | disk | FTP | other *** search
/ ftp.ncsa.uiuc.edu / ftp.ncsa.uiuc.edu.zip / ftp.ncsa.uiuc.edu / Contour / threeD.p < prev    next >
Text File  |  2017-03-03  |  10KB  |  366 lines
  1. {$U-}
  2. unit ThreeD(35);
  3.  
  4. interface
  5.     uses
  6.         MemTypes, QuickDraw, OSIntf, ToolIntf,MacPrint,FixMath,Graf3D,
  7.         Globals, Utilities;
  8.  
  9. procedure ThreeDPlot(bounds : rect);
  10. procedure redrawBox;
  11. procedure Refresh3D;
  12. procedure Prepare3DPlot;
  13. procedure CreateData(x,y:integer);
  14.     
  15. implementation
  16. const
  17.     zID = 253;
  18.     yID = 254;
  19.     xID = 255;
  20.     HBarID = 256;
  21.     VBarID = 257;
  22.     WindID = 32503;
  23.     
  24.     MagLevel = 7;
  25. type
  26.     directions = (up,dn,rt,lt);
  27. var
  28.     Dx,Dy,Dz : integer;
  29.     
  30.     PlotAxis, choice1,choice2 : directions;
  31.     
  32.     rgnA,rgnB : PolyHandle;
  33.     
  34. {-----------------------------------------------------------------------}
  35. function fix(normal:longint):fixed; { convert a longint to fixed }
  36. begin
  37.     fix := normal*65536;
  38. end;
  39.  
  40. {-----------------------------------------------------------------------}
  41. procedure PlotData(method : directions);
  42. var
  43.     row, col,
  44.     curRow, curCol : longint;
  45.     regionA,
  46.     regionB : RgnHandle;
  47.     
  48.     maxRow, maxColumn,
  49.     minX, minY, minZ : longint;
  50.     
  51. begin
  52.     maxRow := fix(90);
  53.     maxColumn := maxRow;
  54.     minX := fix(-85);
  55.     minY := fix(-85);
  56.     minZ := 0;
  57.     regionB := NewRgn;
  58.     SetEmptyRgn(regionB);
  59.     regionA := NewRgn;
  60.     case method of 
  61.     
  62.     rt :
  63.         for row := 1 to 25 do begin
  64.             curRow := fix(row*magLevel-85);
  65.             OpenRgn;
  66.             MoveTo3D(curRow,MaxColumn,minZ);
  67.             LineTo3D(minX,maxColumn,minZ);
  68.             LineTo3D(minX,minY,minZ);
  69.             LineTo3D(curRow,minY,minZ);
  70.             for col := 1 to 25 do
  71.                 LineTo3D(curRow,fix(col*magLevel-85),fix(data3D[row,col]));
  72.             LineTo3D(curRow,maxColumn,minZ);
  73.             closeRgn(regionA);
  74.             unionRgn(regionA,regionB,regionB);
  75.             FrameRgn(regionB);
  76.         end;
  77.     Up :
  78.         for col := 25 downto 1 do begin
  79.             curCol := fix(col*magLevel-85);
  80.             openRgn;
  81.             MoveTo3D(minX,curCol,minZ);
  82.             LineTo3D(minX,maxColumn,minZ);
  83.             LineTo3D(maxRow,maxColumn,minZ);
  84.             LineTo3D(maxRow,curCol,minZ);
  85.             for row := 25 downto 1 do
  86.                 LineTo3D(fix(row*maglevel-85),curCol,fix(data3D[row,col]));
  87.             LineTo3D(minX,curCol,minZ);
  88.             closeRgn(regionA);
  89.             unionRgn(regionA,regionB,regionB);
  90.             FrameRgn(regionB);
  91.         end;
  92.     lt :
  93.         for row := 25 downto 1 do begin
  94.             curRow := fix(row*magLevel-85);
  95.             openRgn;
  96.             MoveTo3D(curRow,minY,minZ);
  97.             LineTo3D(maxRow,minY,minZ);
  98.             LineTo3D(maxRow,maxColumn,minZ);
  99.             LineTo3D(curRow,maxColumn,minZ);
  100.             for col := 25 downto 1 do
  101.                 LineTo3D(curRow,fix(col*magLevel-85),fix(data3D[row,col]));
  102.             LineTo3D(curRow,minY,minZ);
  103.             closeRgn(regionA);
  104.             unionRgn(regionA,regionB,regionB);
  105.             FrameRgn(regionB);
  106.         end;
  107.     dn :
  108.         for col := 1 to 25 do begin
  109.             curCol := fix(col*magLevel-85);
  110.             openRgn;
  111.             MoveTo3D(maxRow,curCol,minZ);
  112.             LineTo3D(maxRow,minY,minZ);
  113.             LineTo3D(minX,minY,minZ);
  114.             LineTo3D(minX,curCol,minZ);
  115.             for row := 1 to 25 do
  116.                 LineTo3D(fix(row*maglevel-85),curCol,fix(data3D[row,col]));
  117.             LineTo3D(maxRow,curCol,minZ);
  118.             closeRgn(regionA);
  119.             unionRgn(regionA,regionB,regionB);
  120.             FrameRgn(regionB);
  121.         end;
  122.     end;
  123.     disposeRgn(regionB);
  124.     disposeRgn(regionA);
  125. end;
  126.  
  127. procedure drawBox;
  128. var
  129.     src,dst : Point3D;
  130.     length : longint;
  131.     pState : PenState;
  132.     
  133. begin
  134.     GetPenState(pState);
  135.     length := fix(20);
  136.     MoveTo3D(length,-length,length);
  137.     PenSize(2,2);
  138.     LineTo3D(length,-length,-length);
  139.     MoveTo3D(length,length,length);
  140.     LineTo3D(length,length,-length);
  141.     PenSize(1,1);
  142.     MoveTo3D(-length,length,length);
  143.     LineTo3D(-length,length,-length);
  144.     MoveTo3D(-length,-length,length);
  145.     LineTo3D(-length,-length,-length);
  146.     
  147.     rgnA := OpenPoly;
  148.         MoveTo3D(-length,-length,-length);
  149.         LineTo3D(length,-length,-length);
  150.         LineTo3D(length,length,-length);
  151.         LineTo3D(-length,length,-length);
  152.         LineTo3D(-length,-length,-length);
  153.     closePoly;
  154.     
  155.     rgnB := OpenPoly;
  156.         MoveTo3D(-length,-length,length);
  157.         LineTo3D(length,-length,length);
  158.         LineTo3D(length,length,length);
  159.         LineTo3D(-length,length,length);
  160.         LineTo3D(-length,-length,length);
  161.     closePoly;
  162.     
  163.     with src do begin
  164.         x := 0;
  165.         y := 0;
  166.         z := length;
  167.     end;
  168.     Transform(src,dst);
  169.     if dst.z >= 0 then begin
  170.         PenSize(1,1);
  171.         FramePoly(rgnA);
  172.         FillPoly(rgnB,white);
  173.         PenSize(2,2);
  174.         FramePoly(rgnB);
  175.         PenSize(1,1);
  176.     end
  177.     else begin
  178.         PenSize(2,2);
  179.         FramePoly(rgnB);
  180.         FillPoly(rgnA,white);
  181.         PenSize(1,1);
  182.         FramePoly(rgnA);
  183.     end;
  184.     SetPenState(pState);
  185. end;
  186.  
  187. procedure redrawBox;
  188. var
  189.     newPt,
  190.     oldPt : Point;
  191.     deltaX,
  192.     deltaY : longint;
  193.     boxRect : rect;
  194.     changed : boolean;
  195.  
  196. begin
  197.     GetMouse(oldPt);
  198.     Translate(fix(40),fix(155),0);
  199.     repeat
  200.         GetMouse(newPt);
  201.         deltaX := newPt.h - oldPt.h;
  202.         deltaY := newPt.v - oldPt.v;
  203.         if (abs(deltaX) > 5) or (abs(deltaY) > 5) then begin
  204.             changed := true;
  205.             setRect(boxRect,0,10,100,340);
  206.             EraseRect(boxRect);
  207.             Translate(fix(-40),fix(-155),0);
  208.             Yaw(-fix(deltaX));
  209.             Pitch(fix(deltaY));
  210.             Translate(fix(40),fix(155),0);
  211.             drawBox;
  212.             oldPt := newPt;
  213.         end;
  214.     until not StillDown;
  215.     Translate(-fix(40),-fix(155),0);
  216.     if changed then
  217.         InvalRect(myRect[windowIndex]);
  218. end;
  219.  
  220. procedure Prepare3DPlot;
  221. var
  222.     src,dst : Point3D;
  223. begin
  224.     if toggle[windowIndex] then begin
  225.         with src do begin
  226.             x := fix(20);
  227.             y := 0;
  228.             z := 0;
  229.         end;
  230.         Transform(src,dst);
  231.         if dst.z >= 0 then
  232.             plotAxis := lt
  233.         else
  234.             plotAxis := rt;
  235.     end
  236.     else begin
  237.         with src do begin
  238.             x := 0; 
  239.             y := fix(20);
  240.             z := 0;
  241.         end;
  242.         Transform(src,dst);
  243.         if dst.z >= 0 then
  244.             plotAxis := up
  245.         else
  246.             plotAxis := dn;
  247.     end;
  248.     Translate(fix(Dx),fix(Dy),fix(Dz));
  249.     PlotData(PlotAxis);
  250.     Translate(-fix(Dx),-fix(Dy),-fix(Dz));
  251. end;
  252. {-----------------------------------------------------------------------}
  253. procedure CreateData {(x,y : integer)};
  254. var
  255.     a,b,c : longint;
  256.     min,max : integer;
  257. begin
  258.     SetCursor(clockCursor^^);
  259.     min := 0;
  260.     max := 0;
  261.     for a := 1 to 25 do begin
  262.         c := ((a-1)*yStep+y)*maxX[windowIndex];
  263.         resultCode := setFPos(theFile[windowIndex],FSFromStart,c);
  264.         if resultCode <> 0 then sysBeep(1);
  265.         resultCode := FSRead(theFile[windowIndex],count,ptr(data[0]));
  266.         if resultCode <> 0 then sysBeep(1);
  267.         for b := 1 to 25 do begin
  268.             data3D[b,a] := ord(data[0]^[x+xStep*(b-1)]);
  269.             if data3D[b,a] < min then
  270.                 min := data3D[b,a]
  271.             else 
  272.                 if data3D[b,a] > max then
  273.                     max := data3D[b,a];
  274.         end;
  275.     end;
  276.     for a := 1 to 25 do
  277.         for b := 1 to 25 do begin
  278.             data3D[b,a] := data3D[b,a]*100 div (max-min);
  279.         end;
  280.     InitCursor;
  281. end;
  282.  
  283. {-----------------------------------------------------------------------}
  284. procedure Refresh3D;
  285. begin
  286.     SetPort3D(@my3DPort);
  287.     ShowControl(TDHBar[windowIndex]);
  288.     ShowControl(TDVBar[windowIndex]);
  289.     DrawControls(ThreeDWindow[windowIndex]);
  290.     Translate(fix(40),fix(155),0);
  291.     drawBox;
  292.     Translate(-fix(40),-fix(155),0);
  293. end;
  294.  
  295.     
  296. {-----------------------------------------------------------------------}
  297. procedure InitStuff;
  298. begin
  299.     ThreeDWindow[windowIndex] := GetNewWindow(WindID,nil,pointer(-1));
  300.     SetPort(ThreeDWindow[windowIndex]);
  301.     open3DPort(@my3DPort[windowIndex]);
  302.     Identity;
  303.     setRect(myRect[windowIndex],0,0,460,284);
  304.     ViewPort(myRect[windowIndex]);
  305.     LookAt(0,0,fix(460),fix(284));
  306.     ViewAngle(fix(25));
  307.     Dx := 300; Dy := 145; Dz := 0;
  308.     PenNormal;
  309.     toggle[windowIndex] := false;
  310.     Pitch(fix(-40));
  311.     Yaw(fix(-30));
  312.     Roll(0);
  313.     xTops[windowIndex] := 0;
  314.     yTops[windowIndex] := 0;
  315.     TDHBar[windowIndex] := GetNewControl(HBarID,ThreeDWindow[windowIndex]);
  316.     TDVBar[windowIndex] := GetNewControl(VBarID,ThreeDWindow[windowIndex]);
  317. end;
  318.  
  319. procedure ThreeDPlot; { bounds: rect }
  320. begin
  321.     if ThreeDWindow[windowIndex] = nil then
  322.         InitStuff
  323.     else
  324.     if secondTime[windowIndex] and (FrontWindow <> ThreeDWindow[windowIndex]) then begin
  325.         SelectWindow(ThreeDWindow[windowIndex]);
  326.         ShowWindow(ThreeDWindow[windowIndex]);
  327.     end
  328.     else
  329.         secondTime[windowIndex] := true;
  330.     GetMatrixBounds(bounds,Xlow,Xhigh,Ylow,Yhigh);
  331.     if (Xhigh - Xlow) < 24 then begin
  332.         if (Xlow+24) > maxX[windowIndex] then
  333.             Xlow := Xhigh-24
  334.         else
  335.             Xhigh := Xlow+24;
  336.         xStep := 1;
  337.     end
  338.     else
  339.         xStep := round((Xhigh-Xlow+1)/25);
  340.     if (Yhigh-Ylow)<24 then begin
  341.         if (Ylow+24) > maxY[windowIndex] then 
  342.             Ylow := Yhigh-24
  343.         else
  344.             Yhigh := Ylow+24;
  345.         yStep := 1;
  346.     end
  347.     else
  348.         yStep := round((Yhigh-Ylow+1)/25);
  349.     if (maxX[windowIndex]-xStep*25) < 0 then
  350.         SetCtlMax(TDHBar[windowIndex],0)
  351.     else
  352.         SetCtlMax(TDHBar[windowIndex],MaxX[windowIndex]-xStep*25);
  353.     if (maxY[windowIndex]-yStep*25) < 0 then
  354.         SetCtlMax(TDVBar[windowIndex],0)
  355.     else
  356.         SetCtlMax(TDVBar[windowIndex],MaxY[windowIndex]-yStep*25);
  357.     SetCtlValue(TDHBar[windowIndex],Xlow);
  358.     SetCtlValue(TDVBar[windowIndex],Ylow);
  359.     
  360.     enableItem(PlotMenu,5);
  361.     CreateData(Xlow,Ylow);
  362. end;
  363. end.
  364.     
  365.     
  366.