Subversion Repositories Kolibri OS

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
7350 leency 1
AppTitle "3D Cube Demo","hasta la vista"
2
While f$<>"1" And f$<>"2"
3
 f$=Input("Fullscreen (1) or Windowed? (2)")
4
 If f$="1"
5
  Graphics 320,240,16,1
6
 EndIf
7
 If f$="2"
8
  Graphics 320,240,16,2
9
 EndIf
10
Wend
11
 
12
SetBuffer BackBuffer()
13
 
14
; -- init texturemapper
15
texturefile$="wall3.bmp"
16
If FileType(texturefile$)=1 Then ; if it exists then load it...
17
 txt=LoadImage(texturefile$); use any 256*256 pixel texture
18
Else
19
 txt=CreateImage(256,256)   ; else create one on the fly
20
 SetBuffer ImageBuffer(txt)
21
 For i=0 To 255
22
  Color i,255-i,0
23
  Line 255-i,0,255,i
24
  Color 255,255-i,255-i
25
  Line 0,255-i,i,255
26
 Next
27
 SetBuffer BackBuffer()
28
EndIf
29
Global imgtxt=ImageBuffer(txt)
30
 
31
Dim Lefttable%(480, 2), Righttable%(480, 2)  ;Scan converter tables (make shure to reserve enough)
32
Dim Polypoints%(3, 1) ; Array for polygon co-ords, 4 pairs(x,y) co -ords
33
Global Miny%, Maxy%
34
Global Pwidth%, Pheight%
35
 
36
 
37
Pwidth = 63 Shl 16   ;original picture width in pixels -1 shl 16
38
Pheight = 63 Shl 16 ;original picture height in pixels -1 shl 16
39
 
40
; eo init texturemapper
41
 
42
Dim zbuffer(10000) ; maximum of 10k Quads (don't worry, would be too slow anyway :) )
43
 
44
; Read in a mesh
45
Restore building
46
Read anz
47
Dim xwww(anz),ywww(anz),zwww(anz)
48
Dim xw(anz),yw(anz),zw(anz)
49
 
50
For i=0 To anz
51
 Read xwww(i)
52
 Read ywww(i)
53
 Read zwww(i)
54
Next
55
 
56
a=0
57
 
58
alpha=1
59
beta=1
60
gamma=1
61
 
62
zoom=-500
63
 
64
; MMMMMMMMMMMMMMMMMMMMMMMMMmmmmmain
65
 
66
While KeyDown(1)=0
67
 
68
 Miny% = 32767
69
 Maxy% = 0
70
 
71
 Color 0,0,0
72
 Rect 0,0,320,240,1
73
 
74
 a=a+1.0 ; automatic rotation...
75
 If a>359.9 Then a=0
76
 alpha=a
77
 beta=a
78
 gamma=a+a Mod 360
79
 
80
 mausy#=0.1+(MouseY()/50.0)
81
 ;mausy#=2.0
82
 For i=0 To anz
83
  xl1#=zwww(i)*Sin(gamma)+xwww(i)*Cos(gamma)
84
  yl1#=ywww(i)
85
  zl1#=zwww(i)*Cos(gamma)-xwww(i)*Sin(gamma)
86
 
87
  xl2#=xl1
88
  yl2#=yl1*Cos(beta)-zl1*Sin(beta)
89
  zl2#=yl1*Sin(beta)+zl1*Cos(beta)
90
 
91
  xl3#=(yl2*Sin(alpha)+xl2*Cos(alpha))
92
  yl3#=(yl2*Cos(alpha)-xl2*Sin(alpha))
93
  zl3#=(zl2)
94
 
95
;  xl3#=xwww(i)
96
;  yl3#=ywww(i)
97
;  zl3#=zwww(i)
98
 
99
  If yloc# - Zoom <> 0 Then yloc = Int(yl3 ) * 200 / (zl3 - Zoom)
100
  If xloc# - Zoom <> 0 Then xloc = Int(xl3 ) * 200 / (zl3 - Zoom)
101
 
102
  xw(i)=((mausy#)*xloc) +160
103
  yw(i)=((mausy#)*yloc) +120
104
  zw(i)=(zl3+256)
105
 Next
106
 
107
 ; z-sorting...
108
 For i=0 To 10000
109
  zbuffer(i)=-1
110
 Next
111
 For i=0 To anz-3 Step 4
112
  If zw(i)>=0 ; clip Quads behind Camera
113
   zwmax=zw(i)
114
   If zwmax
115
   If zwmax
116
   If zwmax
117
   While zbuffer(zwmax)<>-1 And zwmax<10000
118
    zwmax=zwmax+1
119
   Wend
120
   zbuffer(zwmax)=i
121
  EndIf
122
 Next
123
 
124
 LockBuffer ImageBuffer(txt)
125
 LockBuffer BackBuffer()
126
 
127
 For i2=10000 To 0 Step -1 ; reading quads in z-order from far to near
128
  i=zbuffer(i2)
129
 
130
  If i>-1 And i< anz-2 ; if it isn't -1 then it's a Quad Point 1 ID
131
   ; Mapping...
132
   GetPolygonPoints(i)
133
   FindSmallLargeY()
134
   X1% = Polypoints%(0, 0)
135
   Y1% = Polypoints%(0, 1)
136
   X2% = Polypoints%(1, 0)
137
   Y2% = Polypoints%(1, 1)
138
   ScanConvert(X1%, Y1%, X2%, Y2%, 1)     ;scan top of picture
139
   X1% = Polypoints%(1, 0)
140
   Y1% = Polypoints%(1, 1)
141
   X2% = Polypoints%(2, 0)
142
   Y2% = Polypoints%(2, 1)
143
   ScanConvert(X1%, Y1%, X2%, Y2%, 2)   ;scan Right of picture
144
   X1% = Polypoints%(2, 0)
145
   Y1% = Polypoints%(2, 1)
146
   X2% = Polypoints%(3, 0)
147
   Y2% = Polypoints%(3, 1)
148
   ScanConvert(X1%, Y1%, X2%, Y2%, 3)  ;scan bottom of picture
149
   X1% = Polypoints%(3, 0)
150
   Y1% = Polypoints%(3, 1)
151
   X2% = Polypoints%(0, 0)
152
   Y2% = Polypoints%(0, 1)
153
   ScanConvert(X1%, Y1%, X2%, Y2%, 4)    ;scan Left of picture
154
 
155
   TextureMap()
156
  EndIf
157
 Next
158
 
159
 UnlockBuffer BackBuffer()
160
 UnlockBuffer ImageBuffer(txt)
161
 
162
 Color 0,255,0
163
 Text 20,20,"Move Mouse"
164
 
165
 Flip 0
166
Wend
167
 
168
End
169
 
170
 
171
 
172
 
173
 
174
 
175
; --- texture mapping functions
176
 
177
Function GetPolygonPoints(ilocal%) ; initially read in a rectangle
178
 For Count% = 0 To 3
179
  Polypoints%(Count%, 0) = xw(ilocal%+Count%)
180
  Polypoints%(Count%, 1) = yw(ilocal%+Count%)
181
 Next
182
End Function
183
 
184
Function FindSmallLargeY()
185
 For Count% = 0 To 3
186
  Ycoord% = Polypoints%(Count%, 1)
187
  If Ycoord% < Miny% Then       ; is this the New lowest y co-ord?
188
   Miny% = Ycoord%             ; Yes...
189
  End If
190
  If Ycoord% > Maxy% Then       ; is this the New highest y co-ord?
191
   Maxy% = Ycoord%             ; Yes...
192
  End If
193
 Next
194
End Function
195
 
196
Function ScanConvert (X1%, Y1%, X2%, Y2%, Pside)
197
 If Y2% < Y1% Then
198
  temp%=X1% : X1%=X2% : X2%=temp%
199
  temp%=Y1% : Y1%=Y2% : Y2%=temp%
200
  Lineheight% = (Y2% - Y1%)
201
  ScanLeftSide(X1%, X2%, Y1%, Lineheight%, Pside)
202
 Else
203
  Lineheight% = (Y2% - Y1%)
204
  ScanRightSide(X1%, X2%, Y1%, Lineheight%, Pside)
205
 End If
206
End Function
207
 
208
Function ScanLeftSide (X1%, X2%, Ytop%, Lineheight%, Pside)
209
 Lineheight% = Lineheight% + 1       ; prevent divide by zero
210
 Xadd = (X2% - X1%) Shl 16
211
 Xadd = Xadd / Lineheight%
212
 
213
 
214
 If Pside = 1 Then
215
  Px = Pwidth% - 1
216
  Py = 0
217
  Pxadd = -Pwidth%  / Lineheight%
218
  Pyadd = 0
219
 End If
220
 If Pside = 2 Then
221
  Px = Pwidth%
222
  Py = Pheight%
223
  Pxadd = 0
224
  Pyadd = -Pheight%  / Lineheight%
225
 End If
226
 If Pside = 3 Then
227
  Px = 0
228
  Py = Pheight%
229
  Pxadd = Pwidth%  / Lineheight%
230
  Pyadd = 0
231
 End If
232
 If Pside = 4 Then
233
  Px = 0
234
  Py = 0
235
  Pxadd = 0
236
  Pyadd = Pheight%  / Lineheight%
237
 End If
238
 
239
 x = X1% Shl 16
240
 For y% = 0 To Lineheight%
241
  Ytopy%=Ytop%+y%
242
  If Ytopy%<0 Then Ytopy%=0
243
  Lefttable(Ytopy%, 0) = x Sar 16    ;polygon x
244
  Lefttable(Ytopy%, 1) = Px          ;picture x
245
  Lefttable(Ytopy%, 2) = Py          ;picture y
246
  x = x + Xadd                       ;Next polygon x
247
  Px = Px + Pxadd                    ;Next picture x
248
  Py = Py + Pyadd                    ;Next picture y
249
 Next
250
End Function
251
 
252
Function ScanRightSide (X1%, X2%, Ytop%, Lineheight%, Pside)
253
 Lineheight% = Lineheight% + 1    ; No divide by zero
254
 Xadd = (X2% - X1%) Shl 16
255
 Xadd = Xadd / Lineheight%
256
 
257
 If Pside = 1 Then
258
  Px = 0
259
  Py = 0
260
  Pxadd = Pwidth% / Lineheight%
261
  Pyadd = 0
262
 End If
263
 If Pside = 2 Then
264
  Px = Pwidth%
265
  Py = 0
266
  Pxadd = 0
267
  Pyadd = Pheight% / Lineheight%
268
 End If
269
 If Pside = 3 Then
270
  Px = Pwidth%
271
  Py = Pheight%
272
  Pxadd = -Pwidth% / Lineheight%
273
  Pyadd = 0
274
 End If
275
 If Pside = 4 Then
276
  Px = 0
277
  Py = Pheight%
278
  Pxadd = 0
279
  Pyadd = -Pheight% / Lineheight%
280
 End If
281
 
282
 x = X1% Shl 16
283
 For y% = 0 To Lineheight%
284
  Ytopy%=Ytop%+y%
285
  If Ytopy%<0 Then Ytopy%=0
286
  Righttable(Ytopy%, 0) = x Sar 16   ;polygon x
287
  Righttable(Ytopy%, 1) = Px         ;picture x
288
  Righttable(Ytopy%, 2) = Py         ;picture y
289
  x = x + Xadd                       ;Next polygon x
290
  Px = Px + Pxadd                    ;Next picture x
291
  Py = Py + Pyadd                    ;Next picture y
292
 Next
293
End Function
294
 
295
 
296
 
297
 
298
 
299
Function TextureMap()
300
 For y% = Miny% To Maxy%
301
  If y>0 And y<=239
302
   Polyx1% = Lefttable((y%), 0)
303
   Px1 = Lefttable(y%, 1)
304
   Py1 = Lefttable(y%, 2)
305
 
306
   Polyx2% = Righttable((y%), 0)
307
   Px2 = Righttable(y%, 1)
308
   Py2 = Righttable(y%, 2)
309
   Linewidth% = Polyx2% - Polyx1%
310
   Linewidth%=Linewidth% Or 1
311
   Pxadd = ((Px2 - Px1)) / Linewidth%
312
   Pyadd = ((Py2 - Py1)) / Linewidth%
313
 
314
   For x% = Polyx1% To Polyx2%
315
     If x>0 And x<=319
316
      Col%=ReadPixelFast((Px1 Shr 16),(Py1 Shr 16),imgtxt)
317
      WritePixelFast x%,y%,Col%
318
     EndIf
319
     Px1 = Px1 + Pxadd
320
     Py1 = Py1 + Pyadd
321
   Next
322
  EndIf
323
 Next
324
End Function
325
 
326
 
327
 
328
.building
329
Data 23  ; number of pts -1
330
;    x   y   z
331
 
332
Data -100,-100,-100
333
Data -100,100,-100
334
Data -100,100,100
335
Data -100,-100,100
336
 
337
Data -100,-100,-100
338
Data  -100,-100,100
339
Data  100,-100, 100
340
Data 100,-100, -100
341
 
342
Data -100,100,-100
343
Data  100,100,-100
344
Data  100,100, 100
345
Data -100,100, 100
346
 
347
Data 100,-100,-100
348
Data 100,-100,100
349
Data 100,100,100
350
Data 100,100,-100
351
 
352
Data -100,100,100
353
Data 100,100,100
354
Data 100,-100,100
355
Data -100,-100,100
356
 
357
Data -100,100,-100
358
Data -100,-100,-100
359
Data 100,-100,-100
360
Data 100,100,-100