~ubuntu-branches/ubuntu/utopic/mricron/utopic

1 by Michael Hanke
Import upstream version 0.20100725.1~dfsg.1
1
unit rendernothreads;
2
interface
3
{$include isthreaded.inc}
4
{$mode objfpc}{$H+}
5
6
uses
7
{$IFDEF SHOWPROG}Forms,{$ENDIF}
8
 ComCtrls,Classes, SysUtils, define_types,GraphicsMathLibrary;
9
const
10
 kSh = 10; //bits to shift - precision for integers to simulate floats
11
 type
12
  TRotateVals = record
13
             InSliceSz,ZDimStart,ZDimEnd,YDimStart,YDimEnd,OutPivot,OutDim,OutSliceSz: integer;
14
             XPivotInU2,YDimIN,YPivotInU2,ZDimIN,ZPivotInU2,XDimIN: integer;
15
             XPivotIn,YPivotIn,ZPivotIn: integer;
16
             Xxra,Xyra,Xzra: longintp;
17
             //RenderCutout: boolean;
18
  end;
19
procedure NNRotate (lBar: TProgressBar; l: TRotateVals; var lM: TMatrix; lRenderCutout: boolean; var lBuffIn,lBuffOut: ByteP);
20
procedure TriRotate (lBar: TProgressBar; l: TRotateVals; var lM: TMatrix; lRenderCutout: boolean; var lBuffIn,lBuffOut: ByteP);
21
22
implementation
23
24
{$IFDEF SHOWPROG}
25
procedure VisualProg(lBar: TProgressBar; lPos: Integer);
26
begin
27
  lBar.Position := lPos;
28
  Application.ProcessMessages;
29
end;
30
31
{$ENDIF}//IFDEF SHOWPROG
32
33
34
procedure FindXBounds (var lXMax,lXMin: integer;
35
lXDimIN,lYxiZxi,lXPivotInU2,lYDimIN,lYyiZyi,lYPivotInU2,lZDimIN,lYziZzi,lZPivotInU2,lOutDim:integer;
36
 lXxra,lXyra,lXzra : LongIntP);
37
var
38
 lXo,lYo,lZo,Xo_at_one,Xo_at_two,Xo_grad,Xo_offs,lShiftedOne : integer;
39
 when_it_is_zero, when_it_is_max: double;
40
 lReallySmall {, debugx0, debugx1, debugy0, debugy1, debugz0, debugz1}: double;
41
 l2: integer;
42
begin
43
		  lXMax := lOutDim;
44
		  lXMin := 1;
45
		  l2 := 2;
46
		  lShiftedOne := 1 shl ksh;
47
		  lReallySmall := 1e-6;
48
		  Xo_at_one := lXxRA^[1] +lYxiZxi + (lXPivotInU2 shl kSh);
49
		  Xo_at_two := lXxRA^[l2] +lYxiZxi + (lXPivotInU2 shl kSh);
50
		  Xo_grad := Xo_at_two - Xo_at_one; Xo_offs := Xo_at_one - Xo_grad;
51
		  if Abs(Xo_grad) > lReallySmall then begin
52
			 when_it_is_zero := (lShiftedOne-Xo_offs) / Xo_grad;
53
			 when_it_is_max := ((lXDimIn shl kSh)-Xo_offs) / Xo_grad;
54
			 //debugx0 := when_it_is_zero; debugx1 := when_it_is_max;
55
			 if (when_it_is_zero < when_it_is_max) then begin
56
			   if when_it_is_zero > lXMin then lXMin := Round(when_it_is_zero+0.5);
57
			   if when_it_is_max < lXMax then lXMax := Round(when_it_is_max-0.5);
58
59
			 end else begin
60
				if when_it_is_max > lXMin then lXMin := Round(when_it_is_max+0.5);
61
				if when_it_is_zero < lXMax then lXMax := Round(when_it_is_zero-0.5);
62
			 end;
63
		  end;
64
		  Xo_at_one := lXyRA^[1]  +lYyiZyi + (lYPivotInU2 shl kSh);
65
		  Xo_at_two := lXyRA^[l2] +lYyiZyi + (lYPivotInU2 shl kSh);
66
		  Xo_grad := Xo_at_two - Xo_at_one; Xo_offs := Xo_at_one - Xo_grad;
67
		  if Abs(Xo_grad) > lReallySmall then begin
68
			 when_it_is_zero := (lShiftedOne-Xo_offs) / Xo_grad;
69
			 when_it_is_max := ((lYDimIn shl kSh)-Xo_offs) / Xo_grad;
70
			 //debugy0 := when_it_is_zero; debugy1 := when_it_is_max;
71
			 if (when_it_is_zero < when_it_is_max) then begin
72
				if when_it_is_zero > lXMin then lXMin := Round(when_it_is_zero+0.5);
73
				if when_it_is_max < lXMax then lXMax := Round(when_it_is_max-0.5);
74
75
			 end else begin
76
				if when_it_is_max > lXMin then lXMin := Round(when_it_is_max+0.5);
77
				if when_it_is_zero < lXMax then lXMax := Round(when_it_is_zero-0.5);
78
			 end;
79
		  end;
80
		  Xo_at_one := lXzRA^[1]  +lYziZzi + (lZPivotInU2 shl kSh);
81
		  Xo_at_two := lXzRA^[l2] +lYziZzi + (lZPivotInU2 shl kSh);
82
		  Xo_grad := Xo_at_two - Xo_at_one; Xo_offs := Xo_at_one - Xo_grad;
83
		  if Abs(Xo_grad) > lReallySmall then begin
84
			 when_it_is_zero := (lShiftedOne-Xo_offs) / Xo_grad;
85
			 when_it_is_max := ((lZDimIn shl kSh)-Xo_offs) / Xo_grad;
86
			 //debugz0 := when_it_is_zero; debugz1 := when_it_is_max;
87
			 if (when_it_is_zero < when_it_is_max) then begin
88
				if when_it_is_zero > lXMin then lXMin := Round(when_it_is_zero+0.5);
89
				if when_it_is_max < lXMax then lXMax := Round(when_it_is_max-0.5);
90
			 end else begin
91
				if when_it_is_max > lXMin then lXMin := Round(when_it_is_max+0.5);
92
				if when_it_is_zero < lXMax then lXMax := Round(when_it_is_zero-0.5);
93
			 end;
94
		  end;
95
		  // even with all the care about rounding, it's possible that we've got the
96
		  // edges wrong in ultra-high-gradient cases
97
		  if lXMin < lXMax then begin
98
			 while true do begin
99
				lXo :=  ((lXxRA^[lXMin] +lYxiZxi) shr kSh)+lXPivotInU2;
100
				lYo :=  ((lXyRA^[lXMin] +lYyiZyi) shr kSh)+lYPivotInU2;
101
				lZo :=  ((lXzRA^[lXMin] +lYziZzi) shr kSh)+lZPivotInU2;
102
				if (lXMin < lXMax) and ((lXo<1) or (lXo>lXDimIn) or (lYo<1) or (lYo>lYDimIn) or (lZo<1) or (lZo>lZDimIn)) then begin
103
				   lXMin := 1+lXMin;
104
				end else
105
				   break;
106
			 end;
107
			 while true do begin
108
				lXo :=  ((lXxRA^[lXMax] +lYxiZxi) shr kSh)+lXPivotInU2;
109
				lYo :=  ((lXyRA^[lXMax] +lYyiZyi) shr kSh)+lYPivotInU2;
110
				lZo :=  ((lXzRA^[lXMax] +lYziZzi) shr kSh)+lZPivotInU2;
111
				if (lXMax > lXMin) and ((lXo<1) or (lXo>lXDimIn) or (lYo<1) or (lYo>lYDimIn) or (lZo<1) or (lZo>lZDimIn)) then begin
112
				  lXMax := lXMax-1;
113
				end else
114
				   break;
115
			 end;
116
		  end;
117
end;//proc findXBounds
118
119
procedure NNRotate (lBar: TProgressBar; l: TRotateVals; var lM: TMatrix; lRenderCutout: boolean; var lBuffIn,lBuffOut: ByteP);
120
const kshx = ksh shr 1;
121
var
122
123
   lZxi,lZyi,lZzi,lYxiZxi,lYyiZyi,lYziZzi,lZ,lY,lX,lOutPos,
124
   lMaxX,lMinX,lXo,lYo,lZo: integer;
125
begin
126
     for lZ := l.ZDimStart to l.ZDimEnd do begin
127
		 lZxi := round(lZ*lM.matrix[1,3]* (1 shl kSh)  );
128
		 lZyi := round(lZ*lM.matrix[2,3]* (1 shl kSh)  );
129
		 lZzi := round(lZ*lM.matrix[3,3]* (1 shl kSh)  );
130
                   {$IFDEF SHOWPROG}  //flicker with lazarus
131
                 if ((lZ mod 30)=0) then
132
                    VisualProg(lBar,lZ);
133
                 {$ENDIF}
134
		 //ImgForm.ProgressBar1.Position := lZ;
135
		 for lY := l.YDimStart to l.YDimEnd do begin
136
		  lYxiZxi := round(lY * lM.matrix[1,2]* (1 shl kSh)  )+lZxi;
137
		  lYyiZyi := round(lY * lM.matrix[2,2]* (1 shl kSh)  )+lZyi;
138
		  lYziZzi := round(lY * lM.matrix[3,2]* (1 shl kSh)  )+lZzi;
139
		  lOutPos := ((lZ+l.OutPivot-1)*l.OutSliceSz)+((lY+l.OutPivot-1)*l.Outdim);
140
		  //if gAbortRender > 0 then goto 345;
141
		  FindXBounds (lMaxX,lMinX,l.XDimIN,lYxiZxi,l.XPivotInU2,l.YDimIN,lYyiZyi,l.YPivotInU2,l.ZDimIN,lYziZzi,l.ZPivotInU2,l.OutDim,l.Xxra,l.Xyra,l.Xzra);
142
			 if lMaxX > lMinX then
143
				for lX := lMinX to lMaxX do begin
144
					lXo :=  ((l.XxRA^[lX] +lYxiZxi) shr kSh)+l.XPivotInU2;
145
					lYo :=  ((l.XyRA^[lX] +lYyiZyi) shr kSh)+l.YPivotInU2;
146
					lZo :=  ((l.XzRA^[lX] +lYziZzi) shr kSh)+l.ZPivotInU2;
147
                                        {lXo := (lXo shr 1) + 1;
148
                                        lYo := lYo shr 1;
149
                                        lZo := lZo shr 1;}
150
					   lBuffOut[lX+lOutPos] := lBuffIn[(lXo)+((lYo-1)*l.XdimIn)+((lZo-1)*l.InSliceSz)]
151
				end;
152
		 end; //for y
153
		end; //for z
154
end;
155
156
procedure TriRotate (lBar: TProgressBar; l: TRotateVals; var lM: TMatrix; lRenderCutout: boolean; var lBuffIn,lBuffOut: ByteP);
157
//Trilinear - this uses integer math, and on CoreDuo CPUs is 30% faster than Floating Point
158
//For precision, integers are multiplied by kSh (~2^10 bits) to simulate floats
159
// However, we will use 32-bit integers and the image intensity is 8 bit values,
160
// with the final interpolation multiplying X*Y*Z*intensity
161
// Therefore, this final interpolation adjusts kSh to be 2^8, avoiding overflow
162
var
163
   lMi: TMatrixi;
164
   lXr,lYr,lZr,lYxi,lYyi,lYzi,lXxi,lXyi,lXzi,lZxi,lZyi,lZzi,
165
   lYxiZxi,lYyiZyi,lYziZzi,lZ,lY,lX,lOutPos,
166
   lXPiv,lYPiv,lZPiv,lXrM1i,lYrM1i,lZrM1i,
167
   lShr,lShl,lShlTo8,lShl8,
168
   lMinZ,lMaxZ,lMinY,lMaxY,lMaxX,lMinX,lXo,lYo,lZo: integer;
169
begin
170
     lShl := 1 shl kSh;
171
     lShl8 := 1 shl 8; //8bit precision
172
     lShlTo8 := (kSh - 8); //shr the kSh precision by this to get 8-bit precision
173
     lShr := 24;//24-bits * 8 bit intensity = 32 bits
174
     lXPiv := l.XPivotIn * lShl;
175
     lYPiv := l.YPivotIn * lShl;
176
     lZPiv := l.ZPivotIn * lShl;
177
     for lX := 1 to 3 do
178
         for lY := 1 to 3 do
179
             lMi.matrix[lX,lY] := round(lM.matrix[lX,lY] * lShl);
180
     if (lRenderCutout )  then begin //only separated to unroll IF rendercutout
181
        for lZ := l.ZDimStart to l.ZDimEnd do begin
182
		 lZxi := (lZ*lMi.matrix[1,3]  );
183
		 lZyi := (lZ*lMi.matrix[2,3]  );
184
		 lZzi := (lZ*lMi.matrix[3,3]  );
185
                   {$IFDEF SHOWPROG}  //flicker with lazarus
186
                 if ((lZ mod 30)=0) then
187
                    VisualProg(lBar,lZ);
188
                 {$ENDIF}
189
	  for lY := l.YDimStart to l.YDimEnd do begin
190
		  lYxi := lY * lMi.matrix[1,2];
191
		  lYyi := lY * lMi.matrix[2,2];
192
		  lYzi := lY * lMi.matrix[3,2];
193
		  lYxiZxi := (lY * lMi.matrix[1,2]  )+lZxi;
194
		  lYyiZyi := (lY * lMi.matrix[2,2] )+lZyi;
195
		  lYziZzi := (lY * lMi.matrix[3,2]  )+lZzi;
196
		  FindXBounds (lMaxX,lMinX,l.XDimIN,lYxiZxi,l.XPivotInU2,l.YDimIN,lYyiZyi,l.YPivotInU2,l.ZDimIN,lYziZzi,l.ZPivotInU2,l.OutDim,l.Xxra,l.Xyra,l.Xzra);
197
		  lMaxX := lMaxX - l.OutPivot -1 ;
198
		  lMinX := lMinX - l.OutPivot+1;
199
		  if lMaxX > lMinX then
200
			for lX := lMinX to lMaxX do begin
201
			  lXr := ( (lX*lMi.matrix[1,1])+lYxi+lZxi)+lXPiv;
202
			  lYr := ((lX*lMi.matrix[2,1])+lYyi+lZyi)+lYPiv;
203
			  lZr := ( (lX*lMi.matrix[3,1])+lYzi+lZzi)+lZPiv;
204
			  lXo := (lXr shr kSh);
205
			  lYo := (lYr shr kSh);
206
			  lZo := (lZr shr kSh);
207
			  if (lXo > 0) and (lXo < l.XDimIn)
208
			  and (lYo > 0) and (lYo < l.YDimIn) and
209
			  (lZo > 0) and (lZo < l.ZDimIn) then begin
210
			   lXr := (lXr- (lXo  * lShl)) shr lShlTo8;
211
			   lYr := (lYr- (lYo * lShl)) shr lShlTo8;
212
			   lZr := (lZr- (lZo * lShl)) shr lShlTo8;
213
			   lXrM1i := lShl8-lXr;
214
			   lYrM1i := lShl8-lYr;
215
			   lZrM1i := lShl8-lZr;
216
			   lMinY := ((lYo-1)*l.XdimIn);
217
			   lMinZ := ((lZo-1)*l.InSliceSz);
218
			   lMaxY := ((lYo)*l.XdimIn);
219
			   lMaxZ := ((lZo)*l.InSliceSz);
220
		           lOutPos := ((lZ+l.OutPivot-1)*l.OutSliceSz)+((lY+l.OutPivot-1)*l.Outdim);
221
			   if {(lRenderCutout )  and} ((lBuffIn^[lXo+lMinY+lMinZ]=255) or (lBuffIn^[lXo+1+lMinY+lMinZ]=255)
222
			   or (lBuffIn^[lXo+lMaxY+lMinZ]=255) or (lBuffIn^[lXo+1+lMaxY+lMinZ]=255)
223
			   or (lBuffIn^[lXo+lMinY+lMaxZ]=255) or (lBuffIn^[lXo+1+lMinY+lMaxZ]=255)
224
			   or (lBuffIn^[lXo+lMaxY+lMaxZ]=255) or (lBuffIn^[lXo+1+lMaxY+lMaxZ]=255))
225
				then lBuffOut^[lX+l.OutPivot+lOutPos] := 255
226
			   else
227
                               lBuffOut^[lX+l.OutPivot+lOutPos] :=  (
228
			    (lXrM1i*lYrM1i*lZrM1i *lBuffIn^[lXo+lMinY+lMinZ] )
229
			   +(lXr*lYrM1i*lZrM1i *lBuffIn^[lXo+1+lMinY+lMinZ])
230
			   +(lXrM1i*lYr*lZrM1i *lBuffIn^[lXo+lMaxY+lMinZ] )
231
			   +(lXrM1i*lYrM1i*lZr *lBuffIn^[lXo+lMinY+lMaxZ] )
232
			   +(lXr*lYr*lZrM1i *lBuffIn^[lXo+1+lMaxY+lMinZ] )
233
			   +(lXr*lYrM1i*lZr *lBuffIn^[lXo+1+lMinY+lMaxZ] )
234
			   +(lXrM1i*lYr*lZr *lBuffIn^[lXo+lMaxY+lMaxZ])
235
			   +(lXr*lYr*lZr *lBuffIn^[lXo+1+lMaxY+lMaxZ] )
236
                           ) shr lShr;
237
			  end; //values in range
238
		  end; //for x
239
	   end; //for y
240
        end; //for z
241
        exit;
242
     end; //if RenderCutout
243
     for lZ := l.ZDimStart to l.ZDimEnd do begin
244
         lZxi := (lZ*lMi.matrix[1,3]  );
245
         lZyi := (lZ*lMi.matrix[2,3]  );
246
         lZzi := (lZ*lMi.matrix[3,3]  );
247
                   {$IFDEF SHOWPROG}  //flicker with lazarus
248
                 if ((lZ mod 30)=0) then
249
                    VisualProg(lBar,lZ);
250
                 {$ENDIF}
251
	  for lY := l.YDimStart to l.YDimEnd do begin
252
		  lYxi := lY * lMi.matrix[1,2];
253
		  lYyi := lY * lMi.matrix[2,2];
254
		  lYzi := lY * lMi.matrix[3,2];
255
		  lYxiZxi := (lY * lMi.matrix[1,2]  )+lZxi;
256
		  lYyiZyi := (lY * lMi.matrix[2,2] )+lZyi;
257
		  lYziZzi := (lY * lMi.matrix[3,2]  )+lZzi;
258
		  FindXBounds (lMaxX,lMinX,l.XDimIN,lYxiZxi,l.XPivotInU2,l.YDimIN,lYyiZyi,l.YPivotInU2,l.ZDimIN,lYziZzi,l.ZPivotInU2,l.OutDim,l.Xxra,l.Xyra,l.Xzra);
259
		  lMaxX := lMaxX - l.OutPivot -1 ;
260
		  lMinX := lMinX - l.OutPivot+1;
261
		  if lMaxX > lMinX then
262
			for lX := lMinX to lMaxX do begin
263
			  lXr := ( (lX*lMi.matrix[1,1])+lYxi+lZxi)+lXPiv;
264
			  lYr := ((lX*lMi.matrix[2,1])+lYyi+lZyi)+lYPiv;
265
			  lZr := ( (lX*lMi.matrix[3,1])+lYzi+lZzi)+lZPiv;
266
			  lXo := (lXr shr kSh);
267
			  lYo := (lYr shr kSh);
268
			  lZo := (lZr shr kSh);
269
			  if (lXo > 0) and (lXo < l.XDimIn)
270
			  and (lYo > 0) and (lYo < l.YDimIn) and
271
			  (lZo > 0) and (lZo < l.ZDimIn) then begin
272
			   lXr := (lXr- (lXo  * lShl)) shr lShlTo8;
273
			   lYr := (lYr- (lYo * lShl)) shr lShlTo8;
274
			   lZr := (lZr- (lZo * lShl)) shr lShlTo8;
275
			   lXrM1i := lShl8-lXr;
276
			   lYrM1i := lShl8-lYr;
277
			   lZrM1i := lShl8-lZr;
278
			   lMinY := ((lYo-1)*l.XdimIn);
279
			   lMinZ := ((lZo-1)*l.InSliceSz);
280
			   lMaxY := ((lYo)*l.XdimIn);
281
			   lMaxZ := ((lZo)*l.InSliceSz);
282
		           lOutPos := ((lZ+l.OutPivot-1)*l.OutSliceSz)+((lY+l.OutPivot-1)*l.Outdim);
283
                           lBuffOut^[lX+l.OutPivot+lOutPos] :=(
284
			    (lXrM1i*lYrM1i*lZrM1i *lBuffIn^[lXo+lMinY+lMinZ] )
285
			   +(lXr*lYrM1i*lZrM1i *lBuffIn^[lXo+1+lMinY+lMinZ])
286
			   +(lXrM1i*lYr*lZrM1i *lBuffIn^[lXo+lMaxY+lMinZ] )
287
			   +(lXrM1i*lYrM1i*lZr *lBuffIn^[lXo+lMinY+lMaxZ] )
288
			   +(lXr*lYr*lZrM1i *lBuffIn^[lXo+1+lMaxY+lMinZ] )
289
			   +(lXr*lYrM1i*lZr *lBuffIn^[lXo+1+lMinY+lMaxZ] )
290
			   +(lXrM1i*lYr*lZr *lBuffIn^[lXo+lMaxY+lMaxZ])
291
			   +(lXr*lYr*lZr *lBuffIn^[lXo+1+lMaxY+lMaxZ] )
292
                           ) shr lShr;
293
			  end; //values in range
294
		  end; //for x
295
	   end; //for y
296
	  end; //for z
297
end;
298
299
300
end.
301