Hi, I have been slowly introducing myslef into the 3d programming through qbaisc and I have been having trouble on the subject of texutre mapping and/ poly filling. I created my own routine to do texture mapping within a quadratic, but it is extremely slow and is only for a 30 by 30 image. Could any body show give me a useful tutorial on the subject in qbaisc. Or help me in this forum?
Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
texutre mapping and/ polygon filling 1
- Thread starter instinct
- Start date
-
1
- #2
qbasicking
Programmer
I've never done texture mapping on a polygon before, but I am fairly skilled with 3-d graphics. Why not instead of using polygons, using a voxel engine.
Voxels have decent speed and can show any shape.
'$DYNAMIC
DEFINT A-Z
SCREEN 13
DIM vox (30,30,30)
FOR x = 1 TO 60
FOR y = 1 TO 60
FOR z = 1 TO 30
IF vox (x\2,y\2,z) THEN
PSET (x,y),vox(x\2,y\2,z)
EXIT FOR
END IF
NEXT
NEXT
NEXT
This is an extremely simple example of a voxel engine, it does not do anything like angles, or focal points or anything like that, but you get the idea.
You'd have to fill in the vox() array with some number for you to see how it would work.
If a man says something in the forest and no woman hears it is he still wrong?
Voxels have decent speed and can show any shape.
'$DYNAMIC
DEFINT A-Z
SCREEN 13
DIM vox (30,30,30)
FOR x = 1 TO 60
FOR y = 1 TO 60
FOR z = 1 TO 30
IF vox (x\2,y\2,z) THEN
PSET (x,y),vox(x\2,y\2,z)
EXIT FOR
END IF
NEXT
NEXT
NEXT
This is an extremely simple example of a voxel engine, it does not do anything like angles, or focal points or anything like that, but you get the idea.
You'd have to fill in the vox() array with some number for you to see how it would work.
If a man says something in the forest and no woman hears it is he still wrong?
qbasicking
Programmer
voxel engines normally also shade, the further away an object gets the darker it normally is
If a man says something in the forest and no woman hears it is he still wrong?
If a man says something in the forest and no woman hears it is he still wrong?
- Thread starter
- #4
I tried the program out and it seems to work nicely. Thank you for the info. I will look into this voxel engine more closely, but I would still like help on the texture mapping subject.
Again thank you for the information on the voxel engine. I am sure I can get it work for a transformed set of coordinates.
Again thank you for the information on the voxel engine. I am sure I can get it work for a transformed set of coordinates.
qbasicguru
Programmer
Wow, that is truly impressive. (innocent bystander)
Doug
Doug
Hey Instinct!
I didn't know anyone was doing 3D stuff in Qbasic.
I won't waste your time.
I would like a copy of your quadratic routine after telling the method I would use for texture mapping.
It would allow any shape to be t-mapped!
Send me a reply if your wit it it.
this is just to let you know i'm no fool:
this is actually part of a 3d engine i created from the ground up. i also have my own z buffer routine.
i'm just curious about "other" methods.
x=_ : y=_
xs=x*sin(a+90) xc=x*cos(a+90)
ys=y*sin(a):yc=y*cos(a)
x=xs+ys:y=xc+yc
i don't have 3d collision detection,lighting algorithms
know anyone that does or knows a good source?
I didn't know anyone was doing 3D stuff in Qbasic.
I won't waste your time.
I would like a copy of your quadratic routine after telling the method I would use for texture mapping.
It would allow any shape to be t-mapped!
Send me a reply if your wit it it.
this is just to let you know i'm no fool:
this is actually part of a 3d engine i created from the ground up. i also have my own z buffer routine.
i'm just curious about "other" methods.
x=_ : y=_
xs=x*sin(a+90) xc=x*cos(a+90)
ys=y*sin(a):yc=y*cos(a)
x=xs+ys:y=xc+yc
i don't have 3d collision detection,lighting algorithms
know anyone that does or knows a good source?
qbasicking
Programmer
I have good 3d collision detection and lighting algorithms.
To do 3d collision detection simple use:
FUNCTION collision%(x,y,z,x2,y2,z2)
xydis = SQR(((x2-x)^2)+((y2-y)^2))
xyzdis = SQR((xydis^2)+((z2-z)^2))
IF xyzdis < 1 THEN collision% = TRUE
END FUNTION
To do 3d collision detection simple use:
FUNCTION collision%(x,y,z,x2,y2,z2)
xydis = SQR(((x2-x)^2)+((y2-y)^2))
xyzdis = SQR((xydis^2)+((z2-z)^2))
IF xyzdis < 1 THEN collision% = TRUE
END FUNTION
qbasicking: You had me going for a second there. I'm a pretty decent 3D programmer and for a second I was thinking "No way, you could have 3D collision with that little code!" But then I didn't know you weren't talking about POLYGON collision (denggit)
Also, I see some nice ideas but with no idea why they work. :-\ Does anyone think they could write a tutorial on texture mapping and this voxel engine i see? I have no idea how to incorporate that into a complete engine as of yet.
~PlystirE~
(denggit)Also, I see some nice ideas but with no idea why they work. :-\ Does anyone think they could write a tutorial on texture mapping and this voxel engine i see? I have no idea how to incorporate that into a complete engine as of yet.
~PlystirE~
qbasicking
Programmer
My mistake, the code that I posted simply returns if two 3d points have collided, not polygons, but the idea would be the same. If your collisions don't have to be totally accurate you could simply find the centre of gravity of the polygons and see if they come close to each other.
I'll try to write a tutorial on voxel engines, but I am fairly busy, not texture mapping though, I have done a great deal of texturing in 3d environments, but that was a simple raycaster, not polygons.
I'll try to write a tutorial on voxel engines, but I am fairly busy, not texture mapping though, I have done a great deal of texturing in 3d environments, but that was a simple raycaster, not polygons.
qbasicking
Programmer
I found this program on Toshi's webpage
'===========================================================================
' Subject: 3D TEXTURED POLYGON ENGINE V2.0 Date: 12-24-97 (15:25)
' Author: Sami Kyostila Code: QB, QBasic, PDS
' Origin: hiteck@freenet.hut.fi Packet: GRAPHICS.ABC
'===========================================================================
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' 3D Polygon Engine v2.0 (C) Sami Ky”stil„ 1997
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' Comments & questions can be sent to hiteck@freenet.hut.fi
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'
' Here's a new version of my previous 3d engine. Actually it's almost a
' complete rewrite, with tons of new features. Currently there are 4
' drawing modes:
'
' + Z-Shaded Wireframe
' + Z-Gouraud shaded and filled
' + Z-Shaded Flat, ASM-Filled
' + Z-Gouraud shaded and texturemapped
'
' These drawing modes can be selected with the F1-F4 keys. In addition
' there are also 4 animated textures:
'
' + Fire - Looks very kewl
' + BumpMap - Nice and fast bumpmap
' + Panning textures - Looks like flowing green ooze
' + Sinus plasma - An animated plasma
'
' These can be toggled on/off with the F9-F12 keys. NOTE: After you have
' selected an animated texture, you must press that same key again to
' disable it.
'
' The object is rotated with the arrow keys and the plus/minus keys. Zoom
' in/out with the A/Z keys. The object can be panned with the J/K/L/I keys.
' 5 stops movement, and 0 resets the object to the starting position.
' You can also rotate the object with the mouse by pressing the left mouse
' button.
'
' All of the drawing modes are shaded, and the ambient lighting level can
' be varied with the F5/F6 keys. F7 toggles point number display on/off
' F9 toggles FPS display on/off (this slows the engine down a bit, you can
' also see the FPS in the exit screen)
'
' If the texture mapping seems too slow, you can adjust the texture size
' by changing the TSize-constant below.
'
' See the end of the program to find out how to make your own objects
' If you want to save you objects to a file, insert the following
' statement to the SUB TheEnd:
'
' SaveObject "filename.dat"
'
' When you press ESC, the object is saved. To load a saved object, use the
' SUB LoadObject
'
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' You may use any of this code freely in you own programs, as long as you
' mention my name somewhere in you program.
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
DEFINT A-Z
'$DYNAMIC
DECLARE SUB HiiriLue (vasen%, oikea%, keski%, x%, y%)
DECLARE SUB Hiiriajuri (ax%, bx%, cx%, dx%)
DECLARE FUNCTION Hiiritarkista% ()
DECLARE SUB LoadObject (File$)
DECLARE SUB SaveObject (File$)
DECLARE SUB HandleKeys ()
DECLARE SUB TheEnd ()
DECLARE SUB RotatePoints ()
DECLARE SUB ColPrint (Text$)
DECLARE FUNCTION ShadeName$ (Model%)
DECLARE SUB Separator (Col&, Char$)
DECLARE SUB MakePalette ()
DECLARE SUB MakeFirePalette (MaxColors%)
DECLARE SUB MakeTexture ()
DECLARE SUB Switch (Var%, Value1%, Value2%)
DECLARE SUB MakeLight ()
DECLARE SUB Fillchar (segment%, offset%, value%, bytes%)
DECLARE SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
DECLARE SUB t3d2d (x%, y%, z%, SX%, SY%)
DECLARE SUB RotatePoint (x%, y%, z%, Rx%, Ry%, Rz%, Nx%, Ny%, Nz%)
DECLARE SUB DrawPoly (x%, y%, x2%, y2%, x3%, y3%, P1%, P2%, P3%, Num)
DECLARE SUB DrawLine (x%, y%, x2%, y2%, Col1%, Col2%, Tx1, Ty1, Tx2, Ty2)
DEFINT A-Z
TYPE Filltype 'Buffer to hold polygon data
x1 AS INTEGER
x2 AS INTEGER
Col1 AS INTEGER
Col2 AS INTEGER
Tx AS INTEGER
Ty AS INTEGER
Tx2 AS INTEGER
Ty2 AS INTEGER
END TYPE
TYPE PointType
x3 AS INTEGER 'Original X
y3 AS INTEGER 'Original Y
z3 AS INTEGER 'Original Z
x AS INTEGER 'Screen X
y AS INTEGER 'Screen Y
Nx AS INTEGER 'New X
Ny AS INTEGER 'New Y
Nz AS INTEGER 'New Z
Shade AS INTEGER 'Shade
END TYPE
TYPE Polygontype
P1 AS INTEGER 'Point 1
P2 AS INTEGER 'Point 2
P3 AS INTEGER 'Point 3
Col AS INTEGER 'Color
Culled AS INTEGER 'Culled/Not Culled
AvgZ AS INTEGER
END TYPE
'----------------------------------------------------------------------------
' Constants
'----------------------------------------------------------------------------
CONST True = 0
CONST False = NOT True
CONST PI = 22 / 7
CONST TSize = 40
CONST LSize = TSize \ 2
DIM SHARED Polygons, Points
DIM SHARED Sine(360) AS INTEGER 'SIN table
DIM SHARED Cosine(360) AS INTEGER 'COS table
DIM SHARED Fill(199) AS Filltype 'Polygon data buffer
DIM SHARED Upper AS INTEGER
DIM SHARED Lower AS INTEGER
DIM SHARED SrX AS INTEGER
DIM SHARED SrY AS INTEGER
DIM SHARED Zoom AS INTEGER
DIM SHARED Buffer(319, 199) AS STRING * 1
DIM SHARED ShadingModel AS INTEGER
DIM SHARED Ambient AS INTEGER
DIM SHARED Mx, My
DIM SHARED Fire AS INTEGER
DIM SHARED Anim AS INTEGER
DIM SHARED AnimType AS INTEGER
DIM SHARED l(0 TO LSize, 0 TO LSize) AS INTEGER
DIM SHARED MaxPoints, MaxPolygons
DIM SHARED Xr AS INTEGER
DIM SHARED Yr AS INTEGER
DIM SHARED Zr AS INTEGER
DIM SHARED Vx, Vy, Vz
DIM SHARED FDisp, PDisp
DIM SHARED FPS&
DIM SHARED WaveSide1, WaveSide2, WaveSide3
DIM SHARED R1, R2, R3
FOR i = 0 TO 360
Sine(i) = SIN(i * PI / 180) * 1024
Cosine(i) = COS(i * PI / 180) * 1024
NEXT
SrX = 320 \ 2 'Screen center
SrY = 200 \ 2
Zoom = 700 'Initial values
Xr = 200
Yr = 315
Zr = 100
Mx = 0
My = 0
Ambient = 10
PDisp = False
FDisp = False
Fire = False
ShadingModel = 2
SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1
PRINT STRING$(80, " "
LOCATE 1, 1
PRINT " 3D Polygon Engine v2.0 by Sami Ky”stil„ 1997"
COLOR 3, 0
PRINT
RESTORE ObjectData
READ MaxPoints
READ MaxPolygons
DIM SHARED Pnt(1 TO MaxPoints) AS PointType
DIM SHARED Poly(1 TO MaxPolygons) AS Polygontype
DIM SHARED Pointer(1 TO MaxPolygons)
DIM SHARED Txt(-1 TO TSize + 1, -1 TO TSize + 1) AS INTEGER
DIM SHARED ASMMemCopy$
DIM SHARED ASMFillChar$
asm$ = ""
asm$ = asm$ + CHR$(85)
asm$ = asm$ + CHR$(137) + CHR$(229)
asm$ = asm$ + CHR$(30)
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10)
asm$ = asm$ + CHR$(142) + CHR$(192)
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14)
asm$ = asm$ + CHR$(142) + CHR$(216)
asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8)
asm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12)
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)
asm$ = asm$ + CHR$(243)
asm$ = asm$ + CHR$(164)
asm$ = asm$ + CHR$(31)
asm$ = asm$ + CHR$(93)
asm$ = asm$ + CHR$(203)
ASMMemCopy$ = asm$
asm$ = ""
asm$ = asm$ + CHR$(85)
asm$ = asm$ + CHR$(137) + CHR$(229)
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)
asm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8)
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12)
asm$ = asm$ + CHR$(30)
asm$ = asm$ + CHR$(142) + CHR$(216)
asm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10)
asm$ = asm$ + CHR$(136) + CHR$(23)
asm$ = asm$ + CHR$(67)
asm$ = asm$ + CHR$(226) + CHR$(251)
asm$ = asm$ + CHR$(31)
asm$ = asm$ + CHR$(93)
asm$ = asm$ + CHR$(203)
ASMFillChar$ = asm$
PRINT "Number of points:", , MaxPoints
PRINT "Number of polygons:", , MaxPolygons
PRINT "Starting position (XYZ)", , Xr; Yr; Zr
PRINT "Texture size: ", , TSize; "x"; TSize
PRINT "Initial shading model:", , " "; ShadeName$(ShadingModel)
PRINT "Ambient lighting level:", , Ambient
Separator 1, "Ä"
COLOR 7
PRINT " þ Reading points...";
FOR i = 1 TO MaxPoints
READ Pnt(i).x3
READ Pnt(i).y3
READ Pnt(i).z3
NEXT
PRINT "Done"
PRINT " þ Reading polygons...";
FOR i = 1 TO MaxPolygons
READ Poly(i).P1
READ Poly(i).P2
READ Poly(i).P3
READ Poly(i).Col
Poly(i).Col = Poly(i).Col * 64
NEXT
PRINT "Done"
PRINT " þ Generating texture...";
MakeTexture
PRINT "Done"
PRINT " þ Initializing mouse...";
RESTORE MouseData
DIM SHARED hiiri$
hiiri$ = SPACE$(57)
FOR i% = 1 TO 57
READ a$
h$ = CHR$(VAL("&H" + a$))
MID$(hiiri$, i%, 1) = h$
NEXT i%
napit% = Hiiritarkista%
IF (napit% = 0) THEN
PRINT "Mouse not found!"
MouseNotFound = 1
ELSE
PRINT "Done (Press left MButton to rotate)"
END IF
PRINT
Separator 3, "Ä"
ColPrint " &FF1&7 - Wireframe &FF2&7 - Z-Gouraud &FF3&7 - Z-Flat &FF4&7 - Textured"
PRINT
ColPrint " &FArrows/-/+&7 - Rotate &FA/Z&7 - Zoom In/Out &FJ/K/L/I&7 - Pan &F5&7 - Stop &F0&7 - Reset"
PRINT
ColPrint " &FF5&7/&FF6&7 - Adjust ambient lighting level "
PRINT
ColPrint " &FF7&7 - Point display toggle"
PRINT
ColPrint " &FF8&7 - Frame rate toggle"
PRINT
ColPrint " &FF9&7 - Animated texture 1 - &EFire"
PRINT
ColPrint " &FF10&7 - Animated texture 2 - &EBumpmap"
PRINT
ColPrint " &FF11&7 - Animated texture 3 - &ETexture panning"
PRINT
ColPrint " &FF12&7 - Animated texture 4 - &EPlasma"
MakeLight
DO: LOOP UNTIL INKEY$ <> ""
SCREEN 13: CLS
MakePalette
COLOR 255
DIM Temp(0 TO TSize, 0 TO TSize) AS INTEGER
FOR y& = 0 TO TSize
FOR x& = 0 TO TSize
Temp(x&, y&) = Txt(x&, y&)
NEXT
NEXT
DIM Cosinus(160) AS INTEGER
DIM Rand(255) AS INTEGER
FOR c = 0 TO 160
Cosinus(c) = COS(c * 2 * PI / 80) * 16 + 16
NEXT
FOR c = 0 TO 255
Rand(c) = INT(RND * 4) + 1
NEXT
XAdd& = 1
YAdd& = 1
Anim = False
DO
RotatePoints
FOR i& = 1 TO MaxPolygons
Poly(i&).AvgZ = (Pnt(Poly(i&).P1).Nz + Pnt(Poly(i&).P2).Nz + Pnt(Poly(i&).P3).Nz) \ 3
Pointer(i&) = i&
Poly(i&).Culled = False
NEXT
FOR i& = 1 TO MaxPolygons
coord1 = Poly(i&).P1
coord2 = Poly(i&).P2
coord3 = Poly(i&).P3
z1& = Pnt(coord1).Nz
z2& = Pnt(coord2).Nz
z3& = Pnt(coord3).Nz
x1& = Pnt(coord1).Nx
x2& = Pnt(coord2).Nx
x3& = Pnt(coord3).Nx
y1& = Pnt(coord1).Ny
y2& = Pnt(coord2).Ny
y3& = Pnt(coord3).Ny
IF (x1& - x2&) * (y3& - y2&) - (y1& - y2&) * (x3& - x2&) < 0 THEN Poly(i&).Culled = True
NEXT
FOR i& = 1 TO MaxPolygons
FOR ii& = 1 TO MaxPolygons - 1
IF Poly(Pointer(ii&)).AvgZ > Poly(Pointer(ii& + 1)).AvgZ THEN SWAP Pointer(ii&), Pointer(ii& + 1)
NEXT
NEXT
FOR ii& = 1 TO MaxPolygons
i& = Pointer(ii&)
IF NOT Poly(i&).Culled = True THEN
DrawPoly Pnt(Poly(i&).P1).x + SrX, Pnt(Poly(i&).P1).y + SrY, Pnt(Poly(i&).P2).x + SrX, Pnt(Poly(i&).P2).y + SrY, Pnt(Poly(i&).P3).x + SrX, Pnt(Poly(i&).P3).y + SrY, Pnt(Poly(i&).P1).Shade + Poly(i&).Col, Pnt(Poly(i&).P2).Shade + Poly(i&).Col, _
Pnt(Poly(i&).P3).Shade + Poly(i&).Col, INT(i&)
END IF
NEXT
Memcopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00
Fillchar VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), 0, &HFA00
'Print Point numbers
IF PDisp = True THEN
FOR i = 1 TO MaxPoints
Ty = (Pnt(i).y + SrY) \ 8 + 1
Tx = (Pnt(i).x + SrX) \ 8 + 1
IF Ty > 23 THEN Ty = 23
IF Ty < 1 THEN Ty = 1
IF Tx < 1 THEN Tx = 1
IF Tx > 40 THEN Tx = 40
LOCATE Ty, Tx
PRINT LTRIM$(RTRIM$(STR$((i))))
NEXT
END IF
HandleKeys
SELECT CASE AnimType
CASE 1
ShadingModel = 4
FOR y = 0 TO TSize - 1
FOR x = 0 TO TSize
Txt(x, y + 1) = (Txt(x - 1, y - 1) + Txt(x, y - 1) + Txt(x + 1, y - 1) + Txt(x + 1, y) + Txt(x + 1, y + 1) + Txt(x, y + 1) + Txt(x - 1, y + 1) + Txt(x - 1, y)) \ 8 - 1
NEXT
NEXT
FOR i = 0 TO TSize \ 4
XPos = RND * TSize
Temp = RND * 63
Txt(XPos, -1) = RND * Temp
Txt(XPos, 0) = RND * Temp
NEXT
CASE 2
ShadingModel = 4
Lx& = Lx& + XAdd&
Ly& = Ly& + YAdd&
FOR y& = 0 TO TSize
FOR x& = 0 TO TSize
Txt(x&, y&) = Temp(x&, y&)
NEXT
NEXT
FOR y& = 0 TO LSize
FOR x& = 0 TO LSize
Txt((x& + Lx&) MOD TSize, (y& + Ly&) MOD TSize) = Txt((x& + Lx&) MOD TSize, (y& + Ly&) MOD TSize) + l(x&, y&)
NEXT
NEXT
Lx& = Lx& + XAdd&
Ly& = Ly& + YAdd&
IF Lx& = TSize THEN XAdd& = -XAdd&
IF Lx& = 0 THEN XAdd& = -XAdd&
IF Ly& = TSize - 2 THEN YAdd& = -YAdd&
IF Ly& = 0 THEN YAdd& = -YAdd&
CASE 3
ShadingModel = 4
FOR y = 1 TO TSize - 1
FOR x = 0 TO TSize
Txt(x, y - 1) = Txt(x, y)
NEXT
NEXT
FOR i = 0 TO TSize
Txt(i, TSize - 1) = Txt(i, 0)
NEXT
CASE 4
ShadingModel = 4
WAVE1 = WAVE1 + WaveSide1
IF WAVE1 >= 80 THEN
WAVE1 = 0
R1 = (R1 + 1) AND 255
WaveSide1 = Rand(R1)
END IF
WAVE2 = WAVE2 + WaveSide2
IF WAVE2 >= 80 THEN
WAVE2 = 0
R2 = (R2 + 2) AND 255
WaveSide2 = Rand(R2)
END IF
WAVE3 = WAVE3 + WaveSide3
IF WAVE3 >= 80 THEN
WAVE3 = 0
R3 = (R3 + 2) AND 255
WaveSide3 = Rand(R3)
END IF
FOR y& = 0 TO TSize
E = Cosinus(y& + WAVE1)
FOR x& = 0 TO TSize
Col = Cosinus(x& + WAVE2) + E + Cosinus(x& + WAVE3) + Cosinus(x& + y&)
IF Col > 127 THEN Col = 127
Txt(x&, y&) = Col
NEXT
NEXT
END SELECT
'----------------------------------------------------------------------------
' Update rotation velocities
'----------------------------------------------------------------------------
Xr = Xr + Vx
Yr = Yr + Vy
Zr = Zr + Vz
IF Xr < 0 THEN Xr = 360 + Xr
IF Yr < 0 THEN Yr = 360 + Yr
IF Zr < 0 THEN Zr = 360 + Zr
Xr = Xr MOD 361
Yr = Yr MOD 361
Zr = Zr MOD 361
IF TIMER >= start& + 2 THEN
FPS& = INT(Frame / 2)
Frame = 0
start& = INT(TIMER)
END IF
Frame = Frame + 1
IF FDisp = True THEN
COLOR 255
LOCATE 1, 1: PRINT FPS&; "fps "
END IF
IF MouseNotFound = 0 THEN
HiiriLue B1, B2, B3, MouseX, MouseY
IF B1 = -1 THEN
Xr = MouseX
Zr = MouseY
END IF
END IF
LOOP
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' Object data
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
ObjectData:
' Number of points
DATA 5
' Number of polygons
DATA 6
' Point data
'
' X Y Z
DATA -100, 0, 100
DATA -100, 0, -100
DATA 100, 0, -100
DATA 100, 0, 100
DATA 0, -190, 0
' Polygon data
'
' Pnt1 Pnt2 Pnt3 Color (1-4)
DATA 5, 1, 4, 1
DATA 5, 4, 3, 2
DATA 5, 2, 1, 3
DATA 5, 3, 2, 4
DATA 4, 1, 2, 1
DATA 4, 2, 3, 1
MouseData:
DATA 55, 89, E5, 8B, 5E, 0C, 8B, 07, 50, 8B, 5E, 0A, 8B, 07, 50, 8B
DATA 5E, 08, 8B, 0F, 8B, 5E, 06, 8B, 17, 5B, 58, 1E, 07, CD, 33, 53
DATA 8B, 5E, 0C, 89, 07, 58, 8B, 5E, 0A, 89, 07, 8B, 5E, 08, 89, 0F
DATA 8B, 5E, 06, 89, 17, 5D, CA, 08, 00
REM $STATIC
SUB ColPrint (Text$)
'----------------------------------------------------------------------------
' SúYúSúTúEúM
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
' Prints color-coded text
'----------------------------------------------------------------------------
' Color codes:
'
' & followed by a color value between 0-15 (in hex)
'
' Example:
'
' This text is &Cred
'----------------------------------------------------------------------------
FOR i = 1 TO LEN(Text$)
Done = 0
DO
IF MID$(Text$, i, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN
COLOR VAL("&H" + MID$(Text$, i + 1, 1))
i = i + 2
ELSE
Done = 1
END IF
LOOP UNTIL Done
PRINT MID$(Text$, i, 1);
NEXT
END SUB
SUB DrawLine (x, y, x2, y2, Col1, Col2, Tx1, Ty1, Tx2, Ty2)
'----------------------------------------------------------------------------
' Calculate the points of a polygon into the buffer
'----------------------------------------------------------------------------
IF y < Upper THEN Upper = y
IF y > Lower THEN Lower = y
IF Upper < 0 THEN Upper = 0
IF Lower > 199 THEN Lower = 199
'Calculate deltas and scale by 1024
Steps = SQR((x2 - x) ^ 2 + ((y2 - y) ^ 2))
IF Steps > 0 THEN
XStep& = ((x2 - x) / Steps) * 1024
YStep& = ((y2 - y) / Steps) * 1024
ColStep& = ((Col2 - Col1) / Steps) * 1024
ELSE
EXIT SUB
END IF
Tempxx& = x
Tempyy& = y
xxx& = Tempxx& * 1024
yyy& = Tempyy& * 1024
Col& = CLNG(Col1) * 1024
IF ShadingModel = 4 THEN
Tx& = CLNG(Tx1) * 1024
Ty& = CLNG(Ty1) * 1024
TxDelta& = ((Tx2 - Tx1) / Steps) * 1024
TyDelta& = ((Ty2 - Ty1) / Steps) * 1024
FOR i& = 1 TO Steps
IF yyy& >= 0 AND yyy& < 204800 THEN
IF xxx& \ 1024 < Fill(yyy& \ 1024).x1 THEN
Fill(yyy& \ 1024).x1 = xxx& \ 1024
Fill(yyy& \ 1024).Tx = Tx& \ 1024
Fill(yyy& \ 1024).Ty = Ty& \ 1024
Fill(yyy& \ 1024).Col1 = Col& \ 1024
END IF
IF xxx& \ 1024 > Fill(yyy& \ 1024).x2 THEN
Fill(yyy& \ 1024).x2 = xxx& \ 1024
Fill(yyy& \ 1024).Tx2 = Tx& \ 1024
Fill(yyy& \ 1024).Ty2 = Ty& \ 1024
Fill(yyy& \ 1024).Col2 = Col& \ 1024
END IF
END IF
xxx& = xxx& + XStep&
yyy& = yyy& + YStep&
Tx& = Tx& + TxDelta&
Ty& = Ty& + TyDelta&
Col& = Col& + ColStep&
NEXT
ELSE
FOR i& = 1 TO Steps
IF yyy& >= 0 AND yyy& < 204800 THEN
IF xxx& \ 1024 < Fill(yyy& \ 1024).x1 THEN
Fill(yyy& \ 1024).x1 = xxx& \ 1024
Fill(yyy& \ 1024).Col1 = Col& \ 1024
END IF
IF xxx& \ 1024 > Fill(yyy& \ 1024).x2 THEN
Fill(yyy& \ 1024).x2 = xxx& \ 1024
Fill(yyy& \ 1024).Col2 = Col& \ 1024
END IF
END IF
xxx& = xxx& + XStep&
yyy& = yyy& + YStep&
Col& = Col& + ColStep&
NEXT
END IF
END SUB
SUB DrawPoly (x, y, x2, y2, x3, y3, P1, P2, P3, Num)
FOR i2 = 1 TO 199
Fill(i2).x1 = 321
Fill(i2).x2 = -1
Fill(i2 - 1).x1 = 321
Fill(i2 - 1).x2 = -1
Fill(i2).Col1 = 0
Fill(i2).Col2 = 0
Fill(i2 - 1).Col1 = 0
Fill(i2 - 1).Col2 = 0
NEXT
DrawLine x, y, x2, y2, P1, P2, TSize \ 2, TSize, TSize, 0
DrawLine x3, y3, x, y, P3, P1, 0, 0, TSize \ 2, TSize
DrawLine x2, y2, x3, y3, P2, P3, TSize, 0, 0, 0
SELECT CASE ShadingModel
CASE 1
OldPos1 = 321
OldPos2 = 321
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 AND Fill(yy&).x1 > 0 AND Fill(yy&).x2 < 319 AND Fill(yy&).x1 < 319 AND Fill(yy&).x2 > 0 THEN
IF OldPos1 < 320 AND OldPos1 > 0 THEN
IF OldPos1 > Fill(yy&).x1 THEN
FOR xx& = OldPos1 - 1 TO Fill(yy&).x1 STEP -1
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col1 MOD 255)
NEXT
ELSE
FOR xx& = OldPos1 + 1 TO Fill(yy&).x1
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col1 MOD 255)
NEXT
END IF
ELSE
Buffer(Fill(yy&).x1, yy&) = CHR$(Fill(yy&).Col1 MOD 255)
END IF
IF OldPos2 < 320 AND OldPos2 > 0 THEN
IF OldPos2 > Fill(yy&).x2 THEN
FOR xx& = OldPos2 TO Fill(yy&).x2 STEP -1
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col2 MOD 255)
NEXT
ELSE
FOR xx& = OldPos2 TO Fill(yy&).x2
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col2 MOD 255)
NEXT
END IF
ELSE
Buffer(Fill(yy&).x2, yy&) = CHR$(Fill(yy&).Col2 MOD 255)
END IF
END IF
OldPos1 = Fill(yy&).x1
OldPos2 = Fill(yy&).x2
NEXT
CASE 2
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
ColDelta& = (Fill(yy&).Col2 - Fill(yy&).Col1) / XLen * 1024
Col& = CLNG(Fill(yy&).Col1) * 1024
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN XLen = XLen + Fill(yy&).x1: Col& = Col& + ColDelta& * -Fill(yy&).x1: Fill(yy&).x1 = 0
FOR xx& = Fill(yy&).x1 TO Fill(yy&).x1 + XLen
Buffer(xx&, yy&) = CHR$(ABS(Col& \ 1024) MOD 255)
Col& = Col& + ColDelta&
NEXT
END IF
NEXT
CASE 3
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN
XLen = XLen + Fill(yy&).x1
Fill(yy&).x1 = 0
END IF
IF Fill(yy&).x1 < 319 AND XLen > 0 THEN Fillchar VARSEG(Buffer(Fill(yy&).x1, yy&)), VARPTR(Buffer(Fill(yy&).x1, yy&)), (Pnt(Poly(Num).P1).Shade + Pnt(Poly(Num).P2).Shade + Pnt(Poly(Num).P3).Shade) \ 3 + Poly(Num).Col, XLen + 1
END IF
NEXT
CASE 4
IF Anim = False THEN
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
TxDelta& = (Fill(yy&).Tx2 - Fill(yy&).Tx) / XLen * 1024
TyDelta& = (Fill(yy&).Ty2 - Fill(yy&).Ty) / XLen * 1024
Tx& = CLNG(Fill(yy&).Tx) * 1024
Ty& = CLNG(Fill(yy&).Ty) * 1024
ColDelta& = (Fill(yy&).Col2 - Fill(yy&).Col1) / XLen * 1024
Col& = CLNG(Fill(yy&).Col1) * 1024
IF Fill(yy&).x2 > 319 THEN Fill(yy&).x2 = 319
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN
XLen = XLen + Fill(yy&).x1
Col& = Col& + ColDelta& * -Fill(yy&).x1
Tx& = Tx& + TxDelta& * -Fill(yy&).x1
Ty& = Ty& + TyDelta& * -Fill(yy&).x1
Fill(yy&).x1 = 0
END IF
FOR xx& = Fill(yy&).x1 TO Fill(yy&).x1 + XLen
XPos& = Tx& \ 1024
YPos& = Ty& \ 1024
Buffer(xx&, yy&) = CHR$((Txt(XPos&, YPos&) + ((Col& \ 1024))) MOD 255)
Tx& = Tx& + TxDelta&
Ty& = Ty& + TyDelta&
Col& = Col& + ColDelta&
NEXT
END IF
NEXT
ELSE
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
TxDelta& = (Fill(yy&).Tx2 - Fill(yy&).Tx) / XLen * 1024
TyDelta& = (Fill(yy&).Ty2 - Fill(yy&).Ty) / XLen * 1024
Tx& = CLNG(Fill(yy&).Tx) * 1024
Ty& = CLNG(Fill(yy&).Ty) * 1024
IF Fill(yy&).x2 > 319 THEN Fill(yy&).x2 = 319
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN
XLen = XLen + Fill(yy&).x1
Col& = Col& + ColDelta& * -Fill(yy&).x1
Tx& = Tx& + TxDelta& * -Fill(yy&).x1
Ty& = Ty& + TyDelta& * -Fill(yy&).x1
Fill(yy&).x1 = 0
END IF
FOR xx& = Fill(yy&).x1 TO Fill(yy&).x2
XPos& = Tx& \ 1024
YPos& = Ty& \ 1024
Buffer(xx&, yy&) = CHR$(ABS((Txt(XPos&, YPos&)) + Ambient) MOD 255)
Tx& = Tx& + TxDelta&
Ty& = Ty& + TyDelta&
NEXT
END IF
NEXT
END IF
END SELECT
END SUB
SUB Fillchar (segment%, offset%, value%, bytes%)
DEF SEG = VARSEG(ASMFillChar$)
CALL absolute(BYVAL segment%, BYVAL offset%, BYVAL value%, BYVAL bytes%, SADD(ASMFillChar$))
DEF SEG
END SUB
SUB HandleKeys
DEF SEG = 0: k = INP(&H60)
WHILE LEN(INKEY$): WEND 'Empty keyboard buffer
SELECT CASE k
CASE &H3B 'F1
ShadingModel = 1
CASE &H3C 'F2
ShadingModel = 2
CASE &H3D 'F3
ShadingModel = 3
CASE &H3E 'F4
ShadingModel = 4
CASE &H3F 'F5
Ambient = Ambient - 1
IF Ambient < 0 THEN Ambient = 0
CASE &H40 'F6
Ambient = Ambient + 1
IF Ambient > 63 THEN Ambient = 63
CASE &H41 'F7
Switch PDisp, True, False
CASE &H42 'F8
Switch FDisp, True, False
CASE &H43 'F9
Switch Anim, True, False
IF Anim = True THEN
AnimType = 1
MakeFirePalette 63
FOR x = 0 TO TSize
FOR y = 0 TO TSize
Txt(x, y) = 0
NEXT
NEXT
FOR i = 64 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H44 'F10
Switch Anim, True, False
IF Anim = True THEN
AnimType = 2
FOR i = 1 TO 63
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, i
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, i
OUT &H3C9, 63
NEXT
FOR i = 128 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
FOR y = 0 TO TSize
FOR x = 0 TO TSize
Txt(x, y) = RND * 64
NEXT
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H57 'F11
Switch Anim, True, False
IF Anim = True THEN
AnimType = 3
FOR i = 1 TO 63
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, i
OUT &H3C9, 0
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, 63
OUT &H3C9, i
NEXT
FOR i = 128 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H58 'F12
Switch Anim, True, False
IF Anim = True THEN
AnimType = 4
WaveSide1 = 1
WaveSide2 = 3
WaveSide3 = 2
R1 = 1
R2 = 10
R3 = 20
FOR i = 1 TO 63
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, 0
OUT &H3C9, 0
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, i
OUT &H3C9, i
NEXT
FOR i = 128 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H52 '0
Zoom = 700
Xr = 400
Yr = 315
Zr = 0
Mx = 0
My = 0
CASE &H4C '5
Vx = 0
Vy = 0
Vz = 0
CASE &H1E 'A
Zoom = Zoom - 10
IF Zoom < 0 THEN Zoom = 0
CASE &H50 '2
Vx = Vx + 1
CASE &H48 '8
Vx = Vx - 1
CASE &H4B '4
Vy = Vy + 1
CASE &H4D '6
Vy = Vy - 1
CASE &H4A '+
Vz = Vz + 1
CASE &H4E '-
Vz = Vz - 1
CASE &H2C 'Z
Zoom = Zoom + 10
CASE &H17 'I
My = My + 5
CASE &H25 'K
My = My - 5
CASE &H24 'J
Mx = Mx + 5
CASE &H26 'L
Mx = Mx - 5
CASE 1 'ESC
TheEnd
END SELECT
END SUB
SUB Hiiriajuri (ax%, bx%, cx%, dx%)
DEF SEG = VARSEG(hiiri$) 'Segmentti talteen
hiiri% = SADD(hiiri$) 'Offsetti talteen
CALL absolute(ax%, bx%, cx%, dx%, hiiri%) 'Kutsu
END SUB
SUB HiiriLue (vasen%, oikea%, keski%, x%, y%)
ax% = 3 'Funktio 3
Hiiriajuri ax%, bx%, cx%, dx% 'Kutsutaan hiiriajuria
vasen% = ((bx% AND 1) <> 0) 'Luetaan nappien asennot
oikea% = ((bx% AND 2) <> 0) 'bx:st„
keski% = ((bx% AND 4) <> 0)
x% = cx% 'ja hiiren koordinaatit
y% = dx% 'cx:st„ ja dx:st„
END SUB
FUNCTION Hiiritarkista%
ax% = 0 'Funktio 0
Hiiriajuri ax%, bx%, 0, 0 'Kutsutaan hiiriajuria
IF (ax% = 0) THEN 'Onko ajuri k„yt”ss„?
Hiiritarkista% = 0 'jos ei, palautetaan 0
ELSEIF (bx% = 3) THEN 'Kolminappinen hiiri?
Hiiritarkista% = 3
ELSEIF (bx% = 0) THEN 'Ep„standardi hiiri?
Hiiritarkista% = 1
ELSE
Hiiritarkista% = 2 'Tavallinen kaksinappinen hiiri?
END IF
END FUNCTION
DEFSNG A-Z
SUB InterPolate (x, y, x2, y2)
P1 = POINT(x, y)
P2 = POINT(x2, y)
P3 = POINT(x, y2)
P4 = POINT(x2, y2)
YDelta1& = (P3 - P1) / (y2 - y) * 1024
YDelta2& = (P4 - P2) / (y2 - y) * 1024
Col1& = P1 * 1024
Col2& = P3 * 1024
FOR yy& = y TO y2
PSET (x, yy&), Col1& \ 1024
PSET (x2, yy&), Col2& \ 1024
Col1& = Col1& + YDelta1&
Col2& = Col2& + YDelta2&
NEXT
XLen = x2 - x
FOR yy& = y TO y2
P1 = POINT(x, yy&)
P2 = POINT(x2, yy&)
XDelta& = (P2 - P1) / XLen * 1024
Col& = P1 * 1024
FOR xx& = x TO x2
PSET (xx&, yy&), Col& \ 1024
Col& = Col& + XDelta&
NEXT
NEXT
END SUB
DEFINT A-Z
SUB LoadObject (File$)
OPEN File$ FOR INPUT AS #1
LINE INPUT #1, Temp$
INPUT #1, MaxPoints
INPUT #1, MaxPolygons
LINE INPUT #1, Temp$
LINE INPUT #1, Temp$
FOR i = 1 TO MaxPoints
INPUT #1, Pnt(i).x3, Pnt(i).y3, Pnt(i).z3
NEXT
LINE INPUT #1, Temp$
LINE INPUT #1, Temp$
FOR i = 1 TO MaxPolygons
INPUT #1, Poly(i).P1, Poly(i).P2, Poly(i).P3, Poly(i).Col
NEXT
CLOSE #1
END SUB
SUB MakeFirePalette (MaxColors) 'Asettaa paletin
FOR x% = 1 TO MaxColors
OUT &H3C8, x%
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
FOR x% = 0 TO (MaxColors \ 4) - 1
OUT &H3C8, x%
OUT &H3C9, x% * (63 / (MaxColors \ 4))
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C8, x% + (MaxColors \ 4)
OUT &H3C9, 63
OUT &H3C9, x% * (63 / (MaxColors \ 4))
OUT &H3C9, 0
OUT &H3C8, x% + ((MaxColors \ 4) * 2)
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, x% * (63 / (MaxColors \ 4))
NEXT x%
END SUB
SUB MakeLight
FOR x& = 0 TO LSize
FOR y& = 0 TO LSize
Xd! = (x& - (LSize \ 2)) / (LSize \ 2)
Yd! = (y& - (LSize \ 2)) / (LSize \ 2)
Light! = (1 - SQR(Xd! ^ 2 + Yd! ^ 2))
IF Light! < 0 THEN Light! = 0
l(x&, y&) = CINT(Light! * (LSize * 4))
NEXT
NEXT
END SUB
SUB MakePalette
FOR i = 0 TO 63
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, i
OUT &H3C9, 0
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, 0
OUT &H3C9, 0
NEXT
FOR i = 129 TO 192
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, i
OUT &H3C9, 0
NEXT
FOR i = 193 TO 255
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, i
NEXT
END SUB
SUB MakeTexture
FOR y = 0 TO TSize
FOR x = 0 TO TSize
Txt(x, y) = RND * 32
NEXT
NEXT
FOR Iter = 0 TO 0
FOR y = 0 TO TSize
FOR x = 0 TO TSize
Txt(x, y) = (Txt(x - 1, y - 1) + Txt(x, y - 1) + Txt(x + 1, y - 1) + Txt(x + 1, y) + Txt(x + 1, y + 1) + Txt(x, y + 1) + Txt(x - 1, y + 1) + Txt(x - 1, y)) \ 8
NEXT
NEXT
NEXT
END SUB
SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
DEF SEG = VARSEG(ASMMemCopy$)
CALL absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(ASMMemCopy$))
DEF SEG
END SUB
SUB ReadObject (File$)
IF File$ = "" THEN
END IF
END SUB
SUB RotatePoint (xo, yo, zo, Rx, Ry, Rz, Nx, Ny, Nz)
'----------------------------------------------------------------------------
' Rotate a point in 3D space
'----------------------------------------------------------------------------
s1& = Sine(Rx MOD 360)
s2& = Sine(Ry MOD 360)
s3& = Sine(Rz MOD 360)
c1& = Cosine(Rx MOD 360)
c2& = Cosine(Ry MOD 360)
c3& = Cosine(Rz MOD 360)
x1 = (xo * c1& - zo * s1&) \ 1024
z1 = (xo * s1& + zo * c1&) \ 1024
z3 = (z1 * c3& - yo * s3&) \ 1024 + oz
y2 = (z1 * s3& + yo * c3&) \ 1024
x2 = (x1 * c2& + y2 * s2&) \ 1024 + ox
y3 = (y2 * c2& - x1 * s2&) \ 1024 + oy
Nx = x2
Ny = y3
Nz = z3
END SUB
SUB RotatePoints
FOR i& = 1 TO MaxPoints
RotatePoint Pnt(i&).x3, Pnt(i&).y3, Pnt(i&).z3, Xr, Yr, Zr, x3, y3, z3
t3d2d x3, y3, z3, SX, SY
Pnt(i&).Nx = x3
Pnt(i&).Ny = y3
Pnt(i&).Nz = z3
Pnt(i&).x = SX
Pnt(i&).y = SY
Pnt(i&).Shade = z3 / 6 + Ambient
IF ShadingModel = 4 THEN
IF Pnt(i&).Shade > 32 THEN Pnt(i&).Shade = 32
ELSE
IF Pnt(i&).Shade > 63 THEN Pnt(i&).Shade = 63
END IF
IF Pnt(i&).Shade < 1 THEN Pnt(i&).Shade = 1
NEXT
END SUB
SUB SaveObject (File$)
OPEN File$ FOR OUTPUT AS #1
PRINT #1, "--------[ 3D Engine (C) Sami Ky”stil„ - Object Data file ]--------"
PRINT #1, MaxPoints
PRINT #1, MaxPolygons
PRINT #1, "---------------------------------------------[ Start Point data ]-"
PRINT #1, "X", "Y", "Z"
FOR i = 1 TO MaxPoints
PRINT #1, Pnt(i).x3, Pnt(i).y3, Pnt(i).z3
NEXT
PRINT #1, "-------------------------------------------[ Start Polygon data ]-"
PRINT #1, "Point 1", "Point 2", "Point 3", "Color"
FOR i = 1 TO MaxPolygons
PRINT #1, Poly(i).P1, Poly(i).P2, Poly(i).P3, Poly(i).Col
NEXT
CLOSE #1
END SUB
DEFLNG A-Z
SUB Separator (Col, Char$)
'----------------------------------------------------------------------------
' Prints a separator line
'----------------------------------------------------------------------------
SELECT CASE Col
CASE IS = 1
Col1 = 1
Col2 = 9
Col3 = 3
Col4 = 11
Col5 = 15
CASE IS = 2
Col1 = 2
Col2 = 10
Col3 = 14
Col4 = 15
Col5 = 15
CASE IS = 3
Col1 = 8
Col2 = 7
Col3 = 15
Col4 = 15
Col5 = 15
END SELECT
COLOR Col1
PRINT STRING$(5, Char$);
COLOR Col2
PRINT STRING$(5, Char$);
COLOR Col3
PRINT STRING$(5, Char$);
COLOR Col4
PRINT STRING$(5, Char$);
COLOR Col5
PRINT STRING$(40, Char$);
COLOR Col4
PRINT STRING$(5, Char$);
COLOR Col3
PRINT STRING$(5, Char$);
COLOR Col2
PRINT STRING$(5, Char$);
COLOR Col1
PRINT STRING$(5, Char$)
END SUB
DEFINT A-Z
FUNCTION ShadeName$ (Model)
SELECT CASE Model
CASE 1: ShadeName$ = "Wireframe"
CASE 2: ShadeName$ = "Z-Gouraud"
CASE 3: ShadeName$ = "Z-Flat"
CASE 4: ShadeName$ = "Textured"
END SELECT
END FUNCTION
SUB Switch (Var, Value1, Value2)
'----------------------------------------------------------------------------
' Switches values
'----------------------------------------------------------------------------
'
' Var - Variable to be changed
' Value1 - Value 1
' Value2 - Value 2
'
'----------------------------------------------------------------------------
'
' if Var = Value1 then Value2 will be assigned to Var
'
' if Var = Value2 then Value1 will be assigned to Var
'
' This SUB is used with Checkboxes and Radiobuttons
'
'----------------------------------------------------------------------------
IF Var = Value1 THEN Var = Value2: EXIT SUB
IF Var = Value2 THEN Var = Value1
END SUB
SUB t3d2d (x, y, z, SX, SY)
'----------------------------------------------------------------------------
' Transforms 3D coordinates into 2D screen coordinates
'----------------------------------------------------------------------------
IF z - Zoom <> 0 THEN SY = CLNG(y + My) * 100 \ INT(z - Zoom)
IF z - Zoom <> 0 THEN SX = CLNG(x + Mx) * 100 \ INT(z - Zoom)
END SUB
SUB TheEnd
SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1
PRINT STRING$(80, " "
LOCATE 1, 1
PRINT " 3D Polygon Engine v2.0 by Sami Ky”stil„ 1997"
COLOR 3, 0
PRINT
PRINT "Average FPS:", , , FPS&; "fps"
PRINT "Ending position (XYZ)", , Xr; Yr; Zr
PRINT "Shading model:", , " "; ShadeName$(ShadingModel)
PRINT "Ambient lighting level:", , Ambient
SYSTEM
END SUB
'===========================================================================
' Subject: 3D TEXTURED POLYGON ENGINE V2.0 Date: 12-24-97 (15:25)
' Author: Sami Kyostila Code: QB, QBasic, PDS
' Origin: hiteck@freenet.hut.fi Packet: GRAPHICS.ABC
'===========================================================================
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' 3D Polygon Engine v2.0 (C) Sami Ky”stil„ 1997
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' Comments & questions can be sent to hiteck@freenet.hut.fi
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
'
' Here's a new version of my previous 3d engine. Actually it's almost a
' complete rewrite, with tons of new features. Currently there are 4
' drawing modes:
'
' + Z-Shaded Wireframe
' + Z-Gouraud shaded and filled
' + Z-Shaded Flat, ASM-Filled
' + Z-Gouraud shaded and texturemapped
'
' These drawing modes can be selected with the F1-F4 keys. In addition
' there are also 4 animated textures:
'
' + Fire - Looks very kewl
' + BumpMap - Nice and fast bumpmap
' + Panning textures - Looks like flowing green ooze
' + Sinus plasma - An animated plasma
'
' These can be toggled on/off with the F9-F12 keys. NOTE: After you have
' selected an animated texture, you must press that same key again to
' disable it.
'
' The object is rotated with the arrow keys and the plus/minus keys. Zoom
' in/out with the A/Z keys. The object can be panned with the J/K/L/I keys.
' 5 stops movement, and 0 resets the object to the starting position.
' You can also rotate the object with the mouse by pressing the left mouse
' button.
'
' All of the drawing modes are shaded, and the ambient lighting level can
' be varied with the F5/F6 keys. F7 toggles point number display on/off
' F9 toggles FPS display on/off (this slows the engine down a bit, you can
' also see the FPS in the exit screen)
'
' If the texture mapping seems too slow, you can adjust the texture size
' by changing the TSize-constant below.
'
' See the end of the program to find out how to make your own objects
' If you want to save you objects to a file, insert the following
' statement to the SUB TheEnd:
'
' SaveObject "filename.dat"
'
' When you press ESC, the object is saved. To load a saved object, use the
' SUB LoadObject
'
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' You may use any of this code freely in you own programs, as long as you
' mention my name somewhere in you program.
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
DEFINT A-Z
'$DYNAMIC
DECLARE SUB HiiriLue (vasen%, oikea%, keski%, x%, y%)
DECLARE SUB Hiiriajuri (ax%, bx%, cx%, dx%)
DECLARE FUNCTION Hiiritarkista% ()
DECLARE SUB LoadObject (File$)
DECLARE SUB SaveObject (File$)
DECLARE SUB HandleKeys ()
DECLARE SUB TheEnd ()
DECLARE SUB RotatePoints ()
DECLARE SUB ColPrint (Text$)
DECLARE FUNCTION ShadeName$ (Model%)
DECLARE SUB Separator (Col&, Char$)
DECLARE SUB MakePalette ()
DECLARE SUB MakeFirePalette (MaxColors%)
DECLARE SUB MakeTexture ()
DECLARE SUB Switch (Var%, Value1%, Value2%)
DECLARE SUB MakeLight ()
DECLARE SUB Fillchar (segment%, offset%, value%, bytes%)
DECLARE SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
DECLARE SUB t3d2d (x%, y%, z%, SX%, SY%)
DECLARE SUB RotatePoint (x%, y%, z%, Rx%, Ry%, Rz%, Nx%, Ny%, Nz%)
DECLARE SUB DrawPoly (x%, y%, x2%, y2%, x3%, y3%, P1%, P2%, P3%, Num)
DECLARE SUB DrawLine (x%, y%, x2%, y2%, Col1%, Col2%, Tx1, Ty1, Tx2, Ty2)
DEFINT A-Z
TYPE Filltype 'Buffer to hold polygon data
x1 AS INTEGER
x2 AS INTEGER
Col1 AS INTEGER
Col2 AS INTEGER
Tx AS INTEGER
Ty AS INTEGER
Tx2 AS INTEGER
Ty2 AS INTEGER
END TYPE
TYPE PointType
x3 AS INTEGER 'Original X
y3 AS INTEGER 'Original Y
z3 AS INTEGER 'Original Z
x AS INTEGER 'Screen X
y AS INTEGER 'Screen Y
Nx AS INTEGER 'New X
Ny AS INTEGER 'New Y
Nz AS INTEGER 'New Z
Shade AS INTEGER 'Shade
END TYPE
TYPE Polygontype
P1 AS INTEGER 'Point 1
P2 AS INTEGER 'Point 2
P3 AS INTEGER 'Point 3
Col AS INTEGER 'Color
Culled AS INTEGER 'Culled/Not Culled
AvgZ AS INTEGER
END TYPE
'----------------------------------------------------------------------------
' Constants
'----------------------------------------------------------------------------
CONST True = 0
CONST False = NOT True
CONST PI = 22 / 7
CONST TSize = 40
CONST LSize = TSize \ 2
DIM SHARED Polygons, Points
DIM SHARED Sine(360) AS INTEGER 'SIN table
DIM SHARED Cosine(360) AS INTEGER 'COS table
DIM SHARED Fill(199) AS Filltype 'Polygon data buffer
DIM SHARED Upper AS INTEGER
DIM SHARED Lower AS INTEGER
DIM SHARED SrX AS INTEGER
DIM SHARED SrY AS INTEGER
DIM SHARED Zoom AS INTEGER
DIM SHARED Buffer(319, 199) AS STRING * 1
DIM SHARED ShadingModel AS INTEGER
DIM SHARED Ambient AS INTEGER
DIM SHARED Mx, My
DIM SHARED Fire AS INTEGER
DIM SHARED Anim AS INTEGER
DIM SHARED AnimType AS INTEGER
DIM SHARED l(0 TO LSize, 0 TO LSize) AS INTEGER
DIM SHARED MaxPoints, MaxPolygons
DIM SHARED Xr AS INTEGER
DIM SHARED Yr AS INTEGER
DIM SHARED Zr AS INTEGER
DIM SHARED Vx, Vy, Vz
DIM SHARED FDisp, PDisp
DIM SHARED FPS&
DIM SHARED WaveSide1, WaveSide2, WaveSide3
DIM SHARED R1, R2, R3
FOR i = 0 TO 360
Sine(i) = SIN(i * PI / 180) * 1024
Cosine(i) = COS(i * PI / 180) * 1024
NEXT
SrX = 320 \ 2 'Screen center
SrY = 200 \ 2
Zoom = 700 'Initial values
Xr = 200
Yr = 315
Zr = 100
Mx = 0
My = 0
Ambient = 10
PDisp = False
FDisp = False
Fire = False
ShadingModel = 2
SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1
PRINT STRING$(80, " "
LOCATE 1, 1
PRINT " 3D Polygon Engine v2.0 by Sami Ky”stil„ 1997"
COLOR 3, 0
RESTORE ObjectData
READ MaxPoints
READ MaxPolygons
DIM SHARED Pnt(1 TO MaxPoints) AS PointType
DIM SHARED Poly(1 TO MaxPolygons) AS Polygontype
DIM SHARED Pointer(1 TO MaxPolygons)
DIM SHARED Txt(-1 TO TSize + 1, -1 TO TSize + 1) AS INTEGER
DIM SHARED ASMMemCopy$
DIM SHARED ASMFillChar$
asm$ = ""
asm$ = asm$ + CHR$(85)
asm$ = asm$ + CHR$(137) + CHR$(229)
asm$ = asm$ + CHR$(30)
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(10)
asm$ = asm$ + CHR$(142) + CHR$(192)
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(14)
asm$ = asm$ + CHR$(142) + CHR$(216)
asm$ = asm$ + CHR$(139) + CHR$(118) + CHR$(8)
asm$ = asm$ + CHR$(139) + CHR$(126) + CHR$(12)
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)
asm$ = asm$ + CHR$(243)
asm$ = asm$ + CHR$(164)
asm$ = asm$ + CHR$(31)
asm$ = asm$ + CHR$(93)
asm$ = asm$ + CHR$(203)
ASMMemCopy$ = asm$
asm$ = ""
asm$ = asm$ + CHR$(85)
asm$ = asm$ + CHR$(137) + CHR$(229)
asm$ = asm$ + CHR$(139) + CHR$(78) + CHR$(6)
asm$ = asm$ + CHR$(139) + CHR$(86) + CHR$(8)
asm$ = asm$ + CHR$(139) + CHR$(70) + CHR$(12)
asm$ = asm$ + CHR$(30)
asm$ = asm$ + CHR$(142) + CHR$(216)
asm$ = asm$ + CHR$(139) + CHR$(94) + CHR$(10)
asm$ = asm$ + CHR$(136) + CHR$(23)
asm$ = asm$ + CHR$(67)
asm$ = asm$ + CHR$(226) + CHR$(251)
asm$ = asm$ + CHR$(31)
asm$ = asm$ + CHR$(93)
asm$ = asm$ + CHR$(203)
ASMFillChar$ = asm$
PRINT "Number of points:", , MaxPoints
PRINT "Number of polygons:", , MaxPolygons
PRINT "Starting position (XYZ)", , Xr; Yr; Zr
PRINT "Texture size: ", , TSize; "x"; TSize
PRINT "Initial shading model:", , " "; ShadeName$(ShadingModel)
PRINT "Ambient lighting level:", , Ambient
Separator 1, "Ä"
COLOR 7
PRINT " þ Reading points...";
FOR i = 1 TO MaxPoints
READ Pnt(i).x3
READ Pnt(i).y3
READ Pnt(i).z3
NEXT
PRINT "Done"
PRINT " þ Reading polygons...";
FOR i = 1 TO MaxPolygons
READ Poly(i).P1
READ Poly(i).P2
READ Poly(i).P3
READ Poly(i).Col
Poly(i).Col = Poly(i).Col * 64
NEXT
PRINT "Done"
PRINT " þ Generating texture...";
MakeTexture
PRINT "Done"
PRINT " þ Initializing mouse...";
RESTORE MouseData
DIM SHARED hiiri$
hiiri$ = SPACE$(57)
FOR i% = 1 TO 57
READ a$
h$ = CHR$(VAL("&H" + a$))
MID$(hiiri$, i%, 1) = h$
NEXT i%
napit% = Hiiritarkista%
IF (napit% = 0) THEN
PRINT "Mouse not found!"
MouseNotFound = 1
ELSE
PRINT "Done (Press left MButton to rotate)"
END IF
Separator 3, "Ä"
ColPrint " &FF1&7 - Wireframe &FF2&7 - Z-Gouraud &FF3&7 - Z-Flat &FF4&7 - Textured"
ColPrint " &FArrows/-/+&7 - Rotate &FA/Z&7 - Zoom In/Out &FJ/K/L/I&7 - Pan &F5&7 - Stop &F0&7 - Reset"
ColPrint " &FF5&7/&FF6&7 - Adjust ambient lighting level "
ColPrint " &FF7&7 - Point display toggle"
ColPrint " &FF8&7 - Frame rate toggle"
ColPrint " &FF9&7 - Animated texture 1 - &EFire"
ColPrint " &FF10&7 - Animated texture 2 - &EBumpmap"
ColPrint " &FF11&7 - Animated texture 3 - &ETexture panning"
ColPrint " &FF12&7 - Animated texture 4 - &EPlasma"
MakeLight
DO: LOOP UNTIL INKEY$ <> ""
SCREEN 13: CLS
MakePalette
COLOR 255
DIM Temp(0 TO TSize, 0 TO TSize) AS INTEGER
FOR y& = 0 TO TSize
FOR x& = 0 TO TSize
Temp(x&, y&) = Txt(x&, y&)
NEXT
NEXT
DIM Cosinus(160) AS INTEGER
DIM Rand(255) AS INTEGER
FOR c = 0 TO 160
Cosinus(c) = COS(c * 2 * PI / 80) * 16 + 16
NEXT
FOR c = 0 TO 255
Rand(c) = INT(RND * 4) + 1
NEXT
XAdd& = 1
YAdd& = 1
Anim = False
DO
RotatePoints
FOR i& = 1 TO MaxPolygons
Poly(i&).AvgZ = (Pnt(Poly(i&).P1).Nz + Pnt(Poly(i&).P2).Nz + Pnt(Poly(i&).P3).Nz) \ 3
Pointer(i&) = i&
Poly(i&).Culled = False
NEXT
FOR i& = 1 TO MaxPolygons
coord1 = Poly(i&).P1
coord2 = Poly(i&).P2
coord3 = Poly(i&).P3
z1& = Pnt(coord1).Nz
z2& = Pnt(coord2).Nz
z3& = Pnt(coord3).Nz
x1& = Pnt(coord1).Nx
x2& = Pnt(coord2).Nx
x3& = Pnt(coord3).Nx
y1& = Pnt(coord1).Ny
y2& = Pnt(coord2).Ny
y3& = Pnt(coord3).Ny
IF (x1& - x2&) * (y3& - y2&) - (y1& - y2&) * (x3& - x2&) < 0 THEN Poly(i&).Culled = True
NEXT
FOR i& = 1 TO MaxPolygons
FOR ii& = 1 TO MaxPolygons - 1
IF Poly(Pointer(ii&)).AvgZ > Poly(Pointer(ii& + 1)).AvgZ THEN SWAP Pointer(ii&), Pointer(ii& + 1)
NEXT
NEXT
FOR ii& = 1 TO MaxPolygons
i& = Pointer(ii&)
IF NOT Poly(i&).Culled = True THEN
DrawPoly Pnt(Poly(i&).P1).x + SrX, Pnt(Poly(i&).P1).y + SrY, Pnt(Poly(i&).P2).x + SrX, Pnt(Poly(i&).P2).y + SrY, Pnt(Poly(i&).P3).x + SrX, Pnt(Poly(i&).P3).y + SrY, Pnt(Poly(i&).P1).Shade + Poly(i&).Col, Pnt(Poly(i&).P2).Shade + Poly(i&).Col, _
Pnt(Poly(i&).P3).Shade + Poly(i&).Col, INT(i&)
END IF
NEXT
Memcopy VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), &HA000, 0, &HFA00
Fillchar VARSEG(Buffer(0, 0)), VARPTR(Buffer(0, 0)), 0, &HFA00
'Print Point numbers
IF PDisp = True THEN
FOR i = 1 TO MaxPoints
Ty = (Pnt(i).y + SrY) \ 8 + 1
Tx = (Pnt(i).x + SrX) \ 8 + 1
IF Ty > 23 THEN Ty = 23
IF Ty < 1 THEN Ty = 1
IF Tx < 1 THEN Tx = 1
IF Tx > 40 THEN Tx = 40
LOCATE Ty, Tx
PRINT LTRIM$(RTRIM$(STR$((i))))
NEXT
END IF
HandleKeys
SELECT CASE AnimType
CASE 1
ShadingModel = 4
FOR y = 0 TO TSize - 1
FOR x = 0 TO TSize
Txt(x, y + 1) = (Txt(x - 1, y - 1) + Txt(x, y - 1) + Txt(x + 1, y - 1) + Txt(x + 1, y) + Txt(x + 1, y + 1) + Txt(x, y + 1) + Txt(x - 1, y + 1) + Txt(x - 1, y)) \ 8 - 1
NEXT
NEXT
FOR i = 0 TO TSize \ 4
XPos = RND * TSize
Temp = RND * 63
Txt(XPos, -1) = RND * Temp
Txt(XPos, 0) = RND * Temp
NEXT
CASE 2
ShadingModel = 4
Lx& = Lx& + XAdd&
Ly& = Ly& + YAdd&
FOR y& = 0 TO TSize
FOR x& = 0 TO TSize
Txt(x&, y&) = Temp(x&, y&)
NEXT
NEXT
FOR y& = 0 TO LSize
FOR x& = 0 TO LSize
Txt((x& + Lx&) MOD TSize, (y& + Ly&) MOD TSize) = Txt((x& + Lx&) MOD TSize, (y& + Ly&) MOD TSize) + l(x&, y&)
NEXT
NEXT
Lx& = Lx& + XAdd&
Ly& = Ly& + YAdd&
IF Lx& = TSize THEN XAdd& = -XAdd&
IF Lx& = 0 THEN XAdd& = -XAdd&
IF Ly& = TSize - 2 THEN YAdd& = -YAdd&
IF Ly& = 0 THEN YAdd& = -YAdd&
CASE 3
ShadingModel = 4
FOR y = 1 TO TSize - 1
FOR x = 0 TO TSize
Txt(x, y - 1) = Txt(x, y)
NEXT
NEXT
FOR i = 0 TO TSize
Txt(i, TSize - 1) = Txt(i, 0)
NEXT
CASE 4
ShadingModel = 4
WAVE1 = WAVE1 + WaveSide1
IF WAVE1 >= 80 THEN
WAVE1 = 0
R1 = (R1 + 1) AND 255
WaveSide1 = Rand(R1)
END IF
WAVE2 = WAVE2 + WaveSide2
IF WAVE2 >= 80 THEN
WAVE2 = 0
R2 = (R2 + 2) AND 255
WaveSide2 = Rand(R2)
END IF
WAVE3 = WAVE3 + WaveSide3
IF WAVE3 >= 80 THEN
WAVE3 = 0
R3 = (R3 + 2) AND 255
WaveSide3 = Rand(R3)
END IF
FOR y& = 0 TO TSize
E = Cosinus(y& + WAVE1)
FOR x& = 0 TO TSize
Col = Cosinus(x& + WAVE2) + E + Cosinus(x& + WAVE3) + Cosinus(x& + y&)
IF Col > 127 THEN Col = 127
Txt(x&, y&) = Col
NEXT
NEXT
END SELECT
'----------------------------------------------------------------------------
' Update rotation velocities
'----------------------------------------------------------------------------
Xr = Xr + Vx
Yr = Yr + Vy
Zr = Zr + Vz
IF Xr < 0 THEN Xr = 360 + Xr
IF Yr < 0 THEN Yr = 360 + Yr
IF Zr < 0 THEN Zr = 360 + Zr
Xr = Xr MOD 361
Yr = Yr MOD 361
Zr = Zr MOD 361
IF TIMER >= start& + 2 THEN
FPS& = INT(Frame / 2)
Frame = 0
start& = INT(TIMER)
END IF
Frame = Frame + 1
IF FDisp = True THEN
COLOR 255
LOCATE 1, 1: PRINT FPS&; "fps "
END IF
IF MouseNotFound = 0 THEN
HiiriLue B1, B2, B3, MouseX, MouseY
IF B1 = -1 THEN
Xr = MouseX
Zr = MouseY
END IF
END IF
LOOP
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
' Object data
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
ObjectData:
' Number of points
DATA 5
' Number of polygons
DATA 6
' Point data
'
' X Y Z
DATA -100, 0, 100
DATA -100, 0, -100
DATA 100, 0, -100
DATA 100, 0, 100
DATA 0, -190, 0
' Polygon data
'
' Pnt1 Pnt2 Pnt3 Color (1-4)
DATA 5, 1, 4, 1
DATA 5, 4, 3, 2
DATA 5, 2, 1, 3
DATA 5, 3, 2, 4
DATA 4, 1, 2, 1
DATA 4, 2, 3, 1
MouseData:
DATA 55, 89, E5, 8B, 5E, 0C, 8B, 07, 50, 8B, 5E, 0A, 8B, 07, 50, 8B
DATA 5E, 08, 8B, 0F, 8B, 5E, 06, 8B, 17, 5B, 58, 1E, 07, CD, 33, 53
DATA 8B, 5E, 0C, 89, 07, 58, 8B, 5E, 0A, 89, 07, 8B, 5E, 08, 89, 0F
DATA 8B, 5E, 06, 89, 17, 5D, CA, 08, 00
REM $STATIC
SUB ColPrint (Text$)
'----------------------------------------------------------------------------
' SúYúSúTúEúM
'----------------------------------------------------------------------------
'----------------------------------------------------------------------------
' Prints color-coded text
'----------------------------------------------------------------------------
' Color codes:
'
' & followed by a color value between 0-15 (in hex)
'
' Example:
'
' This text is &Cred
'----------------------------------------------------------------------------
FOR i = 1 TO LEN(Text$)
Done = 0
DO
IF MID$(Text$, i, 1) = "&" AND INSTR("0123456789ABCDEF", MID$(Text$, i + 1, 1)) AND i < LEN(Text$) THEN
COLOR VAL("&H" + MID$(Text$, i + 1, 1))
i = i + 2
ELSE
Done = 1
END IF
LOOP UNTIL Done
PRINT MID$(Text$, i, 1);
NEXT
END SUB
SUB DrawLine (x, y, x2, y2, Col1, Col2, Tx1, Ty1, Tx2, Ty2)
'----------------------------------------------------------------------------
' Calculate the points of a polygon into the buffer
'----------------------------------------------------------------------------
IF y < Upper THEN Upper = y
IF y > Lower THEN Lower = y
IF Upper < 0 THEN Upper = 0
IF Lower > 199 THEN Lower = 199
'Calculate deltas and scale by 1024
Steps = SQR((x2 - x) ^ 2 + ((y2 - y) ^ 2))
IF Steps > 0 THEN
XStep& = ((x2 - x) / Steps) * 1024
YStep& = ((y2 - y) / Steps) * 1024
ColStep& = ((Col2 - Col1) / Steps) * 1024
ELSE
EXIT SUB
END IF
Tempxx& = x
Tempyy& = y
xxx& = Tempxx& * 1024
yyy& = Tempyy& * 1024
Col& = CLNG(Col1) * 1024
IF ShadingModel = 4 THEN
Tx& = CLNG(Tx1) * 1024
Ty& = CLNG(Ty1) * 1024
TxDelta& = ((Tx2 - Tx1) / Steps) * 1024
TyDelta& = ((Ty2 - Ty1) / Steps) * 1024
FOR i& = 1 TO Steps
IF yyy& >= 0 AND yyy& < 204800 THEN
IF xxx& \ 1024 < Fill(yyy& \ 1024).x1 THEN
Fill(yyy& \ 1024).x1 = xxx& \ 1024
Fill(yyy& \ 1024).Tx = Tx& \ 1024
Fill(yyy& \ 1024).Ty = Ty& \ 1024
Fill(yyy& \ 1024).Col1 = Col& \ 1024
END IF
IF xxx& \ 1024 > Fill(yyy& \ 1024).x2 THEN
Fill(yyy& \ 1024).x2 = xxx& \ 1024
Fill(yyy& \ 1024).Tx2 = Tx& \ 1024
Fill(yyy& \ 1024).Ty2 = Ty& \ 1024
Fill(yyy& \ 1024).Col2 = Col& \ 1024
END IF
END IF
xxx& = xxx& + XStep&
yyy& = yyy& + YStep&
Tx& = Tx& + TxDelta&
Ty& = Ty& + TyDelta&
Col& = Col& + ColStep&
NEXT
ELSE
FOR i& = 1 TO Steps
IF yyy& >= 0 AND yyy& < 204800 THEN
IF xxx& \ 1024 < Fill(yyy& \ 1024).x1 THEN
Fill(yyy& \ 1024).x1 = xxx& \ 1024
Fill(yyy& \ 1024).Col1 = Col& \ 1024
END IF
IF xxx& \ 1024 > Fill(yyy& \ 1024).x2 THEN
Fill(yyy& \ 1024).x2 = xxx& \ 1024
Fill(yyy& \ 1024).Col2 = Col& \ 1024
END IF
END IF
xxx& = xxx& + XStep&
yyy& = yyy& + YStep&
Col& = Col& + ColStep&
NEXT
END IF
END SUB
SUB DrawPoly (x, y, x2, y2, x3, y3, P1, P2, P3, Num)
FOR i2 = 1 TO 199
Fill(i2).x1 = 321
Fill(i2).x2 = -1
Fill(i2 - 1).x1 = 321
Fill(i2 - 1).x2 = -1
Fill(i2).Col1 = 0
Fill(i2).Col2 = 0
Fill(i2 - 1).Col1 = 0
Fill(i2 - 1).Col2 = 0
NEXT
DrawLine x, y, x2, y2, P1, P2, TSize \ 2, TSize, TSize, 0
DrawLine x3, y3, x, y, P3, P1, 0, 0, TSize \ 2, TSize
DrawLine x2, y2, x3, y3, P2, P3, TSize, 0, 0, 0
SELECT CASE ShadingModel
CASE 1
OldPos1 = 321
OldPos2 = 321
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 AND Fill(yy&).x1 > 0 AND Fill(yy&).x2 < 319 AND Fill(yy&).x1 < 319 AND Fill(yy&).x2 > 0 THEN
IF OldPos1 < 320 AND OldPos1 > 0 THEN
IF OldPos1 > Fill(yy&).x1 THEN
FOR xx& = OldPos1 - 1 TO Fill(yy&).x1 STEP -1
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col1 MOD 255)
NEXT
ELSE
FOR xx& = OldPos1 + 1 TO Fill(yy&).x1
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col1 MOD 255)
NEXT
END IF
ELSE
Buffer(Fill(yy&).x1, yy&) = CHR$(Fill(yy&).Col1 MOD 255)
END IF
IF OldPos2 < 320 AND OldPos2 > 0 THEN
IF OldPos2 > Fill(yy&).x2 THEN
FOR xx& = OldPos2 TO Fill(yy&).x2 STEP -1
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col2 MOD 255)
NEXT
ELSE
FOR xx& = OldPos2 TO Fill(yy&).x2
Buffer(xx&, yy&) = CHR$(Fill(yy&).Col2 MOD 255)
NEXT
END IF
ELSE
Buffer(Fill(yy&).x2, yy&) = CHR$(Fill(yy&).Col2 MOD 255)
END IF
END IF
OldPos1 = Fill(yy&).x1
OldPos2 = Fill(yy&).x2
NEXT
CASE 2
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
ColDelta& = (Fill(yy&).Col2 - Fill(yy&).Col1) / XLen * 1024
Col& = CLNG(Fill(yy&).Col1) * 1024
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN XLen = XLen + Fill(yy&).x1: Col& = Col& + ColDelta& * -Fill(yy&).x1: Fill(yy&).x1 = 0
FOR xx& = Fill(yy&).x1 TO Fill(yy&).x1 + XLen
Buffer(xx&, yy&) = CHR$(ABS(Col& \ 1024) MOD 255)
Col& = Col& + ColDelta&
NEXT
END IF
NEXT
CASE 3
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN
XLen = XLen + Fill(yy&).x1
Fill(yy&).x1 = 0
END IF
IF Fill(yy&).x1 < 319 AND XLen > 0 THEN Fillchar VARSEG(Buffer(Fill(yy&).x1, yy&)), VARPTR(Buffer(Fill(yy&).x1, yy&)), (Pnt(Poly(Num).P1).Shade + Pnt(Poly(Num).P2).Shade + Pnt(Poly(Num).P3).Shade) \ 3 + Poly(Num).Col, XLen + 1
END IF
NEXT
CASE 4
IF Anim = False THEN
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
TxDelta& = (Fill(yy&).Tx2 - Fill(yy&).Tx) / XLen * 1024
TyDelta& = (Fill(yy&).Ty2 - Fill(yy&).Ty) / XLen * 1024
Tx& = CLNG(Fill(yy&).Tx) * 1024
Ty& = CLNG(Fill(yy&).Ty) * 1024
ColDelta& = (Fill(yy&).Col2 - Fill(yy&).Col1) / XLen * 1024
Col& = CLNG(Fill(yy&).Col1) * 1024
IF Fill(yy&).x2 > 319 THEN Fill(yy&).x2 = 319
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN
XLen = XLen + Fill(yy&).x1
Col& = Col& + ColDelta& * -Fill(yy&).x1
Tx& = Tx& + TxDelta& * -Fill(yy&).x1
Ty& = Ty& + TyDelta& * -Fill(yy&).x1
Fill(yy&).x1 = 0
END IF
FOR xx& = Fill(yy&).x1 TO Fill(yy&).x1 + XLen
XPos& = Tx& \ 1024
YPos& = Ty& \ 1024
Buffer(xx&, yy&) = CHR$((Txt(XPos&, YPos&) + ((Col& \ 1024))) MOD 255)
Tx& = Tx& + TxDelta&
Ty& = Ty& + TyDelta&
Col& = Col& + ColDelta&
NEXT
END IF
NEXT
ELSE
FOR yy& = Upper TO Lower - 1
XLen = Fill(yy&).x2 - Fill(yy&).x1
IF XLen > 0 THEN
TxDelta& = (Fill(yy&).Tx2 - Fill(yy&).Tx) / XLen * 1024
TyDelta& = (Fill(yy&).Ty2 - Fill(yy&).Ty) / XLen * 1024
Tx& = CLNG(Fill(yy&).Tx) * 1024
Ty& = CLNG(Fill(yy&).Ty) * 1024
IF Fill(yy&).x2 > 319 THEN Fill(yy&).x2 = 319
IF Fill(yy&).x1 + XLen > 319 THEN XLen = 319 - Fill(yy&).x1
IF Fill(yy&).x1 < 0 THEN
XLen = XLen + Fill(yy&).x1
Col& = Col& + ColDelta& * -Fill(yy&).x1
Tx& = Tx& + TxDelta& * -Fill(yy&).x1
Ty& = Ty& + TyDelta& * -Fill(yy&).x1
Fill(yy&).x1 = 0
END IF
FOR xx& = Fill(yy&).x1 TO Fill(yy&).x2
XPos& = Tx& \ 1024
YPos& = Ty& \ 1024
Buffer(xx&, yy&) = CHR$(ABS((Txt(XPos&, YPos&)) + Ambient) MOD 255)
Tx& = Tx& + TxDelta&
Ty& = Ty& + TyDelta&
NEXT
END IF
NEXT
END IF
END SELECT
END SUB
SUB Fillchar (segment%, offset%, value%, bytes%)
DEF SEG = VARSEG(ASMFillChar$)
CALL absolute(BYVAL segment%, BYVAL offset%, BYVAL value%, BYVAL bytes%, SADD(ASMFillChar$))
DEF SEG
END SUB
SUB HandleKeys
DEF SEG = 0: k = INP(&H60)
WHILE LEN(INKEY$): WEND 'Empty keyboard buffer
SELECT CASE k
CASE &H3B 'F1
ShadingModel = 1
CASE &H3C 'F2
ShadingModel = 2
CASE &H3D 'F3
ShadingModel = 3
CASE &H3E 'F4
ShadingModel = 4
CASE &H3F 'F5
Ambient = Ambient - 1
IF Ambient < 0 THEN Ambient = 0
CASE &H40 'F6
Ambient = Ambient + 1
IF Ambient > 63 THEN Ambient = 63
CASE &H41 'F7
Switch PDisp, True, False
CASE &H42 'F8
Switch FDisp, True, False
CASE &H43 'F9
Switch Anim, True, False
IF Anim = True THEN
AnimType = 1
MakeFirePalette 63
FOR x = 0 TO TSize
FOR y = 0 TO TSize
Txt(x, y) = 0
NEXT
NEXT
FOR i = 64 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H44 'F10
Switch Anim, True, False
IF Anim = True THEN
AnimType = 2
FOR i = 1 TO 63
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, i
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, i
OUT &H3C9, 63
NEXT
FOR i = 128 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
FOR y = 0 TO TSize
FOR x = 0 TO TSize
Txt(x, y) = RND * 64
NEXT
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H57 'F11
Switch Anim, True, False
IF Anim = True THEN
AnimType = 3
FOR i = 1 TO 63
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, i
OUT &H3C9, 0
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, 63
OUT &H3C9, i
NEXT
FOR i = 128 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H58 'F12
Switch Anim, True, False
IF Anim = True THEN
AnimType = 4
WaveSide1 = 1
WaveSide2 = 3
WaveSide3 = 2
R1 = 1
R2 = 10
R3 = 20
FOR i = 1 TO 63
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, 0
OUT &H3C9, 0
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, i
OUT &H3C9, i
NEXT
FOR i = 128 TO 255
OUT &H3C8, i
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
ELSE
MakePalette
MakeTexture
AnimType = 0
END IF
CASE &H52 '0
Zoom = 700
Xr = 400
Yr = 315
Zr = 0
Mx = 0
My = 0
CASE &H4C '5
Vx = 0
Vy = 0
Vz = 0
CASE &H1E 'A
Zoom = Zoom - 10
IF Zoom < 0 THEN Zoom = 0
CASE &H50 '2
Vx = Vx + 1
CASE &H48 '8
Vx = Vx - 1
CASE &H4B '4
Vy = Vy + 1
CASE &H4D '6
Vy = Vy - 1
CASE &H4A '+
Vz = Vz + 1
CASE &H4E '-
Vz = Vz - 1
CASE &H2C 'Z
Zoom = Zoom + 10
CASE &H17 'I
My = My + 5
CASE &H25 'K
My = My - 5
CASE &H24 'J
Mx = Mx + 5
CASE &H26 'L
Mx = Mx - 5
CASE 1 'ESC
TheEnd
END SELECT
END SUB
SUB Hiiriajuri (ax%, bx%, cx%, dx%)
DEF SEG = VARSEG(hiiri$) 'Segmentti talteen
hiiri% = SADD(hiiri$) 'Offsetti talteen
CALL absolute(ax%, bx%, cx%, dx%, hiiri%) 'Kutsu
END SUB
SUB HiiriLue (vasen%, oikea%, keski%, x%, y%)
ax% = 3 'Funktio 3
Hiiriajuri ax%, bx%, cx%, dx% 'Kutsutaan hiiriajuria
vasen% = ((bx% AND 1) <> 0) 'Luetaan nappien asennot
oikea% = ((bx% AND 2) <> 0) 'bx:st„
keski% = ((bx% AND 4) <> 0)
x% = cx% 'ja hiiren koordinaatit
y% = dx% 'cx:st„ ja dx:st„
END SUB
FUNCTION Hiiritarkista%
ax% = 0 'Funktio 0
Hiiriajuri ax%, bx%, 0, 0 'Kutsutaan hiiriajuria
IF (ax% = 0) THEN 'Onko ajuri k„yt”ss„?
Hiiritarkista% = 0 'jos ei, palautetaan 0
ELSEIF (bx% = 3) THEN 'Kolminappinen hiiri?
Hiiritarkista% = 3
ELSEIF (bx% = 0) THEN 'Ep„standardi hiiri?
Hiiritarkista% = 1
ELSE
Hiiritarkista% = 2 'Tavallinen kaksinappinen hiiri?
END IF
END FUNCTION
DEFSNG A-Z
SUB InterPolate (x, y, x2, y2)
P1 = POINT(x, y)
P2 = POINT(x2, y)
P3 = POINT(x, y2)
P4 = POINT(x2, y2)
YDelta1& = (P3 - P1) / (y2 - y) * 1024
YDelta2& = (P4 - P2) / (y2 - y) * 1024
Col1& = P1 * 1024
Col2& = P3 * 1024
FOR yy& = y TO y2
PSET (x, yy&), Col1& \ 1024
PSET (x2, yy&), Col2& \ 1024
Col1& = Col1& + YDelta1&
Col2& = Col2& + YDelta2&
NEXT
XLen = x2 - x
FOR yy& = y TO y2
P1 = POINT(x, yy&)
P2 = POINT(x2, yy&)
XDelta& = (P2 - P1) / XLen * 1024
Col& = P1 * 1024
FOR xx& = x TO x2
PSET (xx&, yy&), Col& \ 1024
Col& = Col& + XDelta&
NEXT
NEXT
END SUB
DEFINT A-Z
SUB LoadObject (File$)
OPEN File$ FOR INPUT AS #1
LINE INPUT #1, Temp$
INPUT #1, MaxPoints
INPUT #1, MaxPolygons
LINE INPUT #1, Temp$
LINE INPUT #1, Temp$
FOR i = 1 TO MaxPoints
INPUT #1, Pnt(i).x3, Pnt(i).y3, Pnt(i).z3
NEXT
LINE INPUT #1, Temp$
LINE INPUT #1, Temp$
FOR i = 1 TO MaxPolygons
INPUT #1, Poly(i).P1, Poly(i).P2, Poly(i).P3, Poly(i).Col
NEXT
CLOSE #1
END SUB
SUB MakeFirePalette (MaxColors) 'Asettaa paletin
FOR x% = 1 TO MaxColors
OUT &H3C8, x%
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63
NEXT
FOR x% = 0 TO (MaxColors \ 4) - 1
OUT &H3C8, x%
OUT &H3C9, x% * (63 / (MaxColors \ 4))
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C8, x% + (MaxColors \ 4)
OUT &H3C9, 63
OUT &H3C9, x% * (63 / (MaxColors \ 4))
OUT &H3C9, 0
OUT &H3C8, x% + ((MaxColors \ 4) * 2)
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, x% * (63 / (MaxColors \ 4))
NEXT x%
END SUB
SUB MakeLight
FOR x& = 0 TO LSize
FOR y& = 0 TO LSize
Xd! = (x& - (LSize \ 2)) / (LSize \ 2)
Yd! = (y& - (LSize \ 2)) / (LSize \ 2)
Light! = (1 - SQR(Xd! ^ 2 + Yd! ^ 2))
IF Light! < 0 THEN Light! = 0
l(x&, y&) = CINT(Light! * (LSize * 4))
NEXT
NEXT
END SUB
SUB MakePalette
FOR i = 0 TO 63
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, i
OUT &H3C9, 0
NEXT
FOR i = 64 TO 128
OUT &H3C8, i
OUT &H3C9, i
OUT &H3C9, 0
OUT &H3C9, 0
NEXT
FOR i = 129 TO 192
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, i
OUT &H3C9, 0
NEXT
FOR i = 193 TO 255
OUT &H3C8, i
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, i
NEXT
END SUB
SUB MakeTexture
FOR y = 0 TO TSize
FOR x = 0 TO TSize
Txt(x, y) = RND * 32
NEXT
NEXT
FOR Iter = 0 TO 0
FOR y = 0 TO TSize
FOR x = 0 TO TSize
Txt(x, y) = (Txt(x - 1, y - 1) + Txt(x, y - 1) + Txt(x + 1, y - 1) + Txt(x + 1, y) + Txt(x + 1, y + 1) + Txt(x, y + 1) + Txt(x - 1, y + 1) + Txt(x - 1, y)) \ 8
NEXT
NEXT
NEXT
END SUB
SUB Memcopy (fromseg%, fromoffset%, toseg%, tooffset%, bytes%)
DEF SEG = VARSEG(ASMMemCopy$)
CALL absolute(BYVAL fromseg%, BYVAL fromoffset%, BYVAL toseg%, BYVAL tooffset%, BYVAL bytes%, SADD(ASMMemCopy$))
DEF SEG
END SUB
SUB ReadObject (File$)
IF File$ = "" THEN
END IF
END SUB
SUB RotatePoint (xo, yo, zo, Rx, Ry, Rz, Nx, Ny, Nz)
'----------------------------------------------------------------------------
' Rotate a point in 3D space
'----------------------------------------------------------------------------
s1& = Sine(Rx MOD 360)
s2& = Sine(Ry MOD 360)
s3& = Sine(Rz MOD 360)
c1& = Cosine(Rx MOD 360)
c2& = Cosine(Ry MOD 360)
c3& = Cosine(Rz MOD 360)
x1 = (xo * c1& - zo * s1&) \ 1024
z1 = (xo * s1& + zo * c1&) \ 1024
z3 = (z1 * c3& - yo * s3&) \ 1024 + oz
y2 = (z1 * s3& + yo * c3&) \ 1024
x2 = (x1 * c2& + y2 * s2&) \ 1024 + ox
y3 = (y2 * c2& - x1 * s2&) \ 1024 + oy
Nx = x2
Ny = y3
Nz = z3
END SUB
SUB RotatePoints
FOR i& = 1 TO MaxPoints
RotatePoint Pnt(i&).x3, Pnt(i&).y3, Pnt(i&).z3, Xr, Yr, Zr, x3, y3, z3
t3d2d x3, y3, z3, SX, SY
Pnt(i&).Nx = x3
Pnt(i&).Ny = y3
Pnt(i&).Nz = z3
Pnt(i&).x = SX
Pnt(i&).y = SY
Pnt(i&).Shade = z3 / 6 + Ambient
IF ShadingModel = 4 THEN
IF Pnt(i&).Shade > 32 THEN Pnt(i&).Shade = 32
ELSE
IF Pnt(i&).Shade > 63 THEN Pnt(i&).Shade = 63
END IF
IF Pnt(i&).Shade < 1 THEN Pnt(i&).Shade = 1
NEXT
END SUB
SUB SaveObject (File$)
OPEN File$ FOR OUTPUT AS #1
PRINT #1, "--------[ 3D Engine (C) Sami Ky”stil„ - Object Data file ]--------"
PRINT #1, MaxPoints
PRINT #1, MaxPolygons
PRINT #1, "---------------------------------------------[ Start Point data ]-"
PRINT #1, "X", "Y", "Z"
FOR i = 1 TO MaxPoints
PRINT #1, Pnt(i).x3, Pnt(i).y3, Pnt(i).z3
NEXT
PRINT #1, "-------------------------------------------[ Start Polygon data ]-"
PRINT #1, "Point 1", "Point 2", "Point 3", "Color"
FOR i = 1 TO MaxPolygons
PRINT #1, Poly(i).P1, Poly(i).P2, Poly(i).P3, Poly(i).Col
NEXT
CLOSE #1
END SUB
DEFLNG A-Z
SUB Separator (Col, Char$)
'----------------------------------------------------------------------------
' Prints a separator line
'----------------------------------------------------------------------------
SELECT CASE Col
CASE IS = 1
Col1 = 1
Col2 = 9
Col3 = 3
Col4 = 11
Col5 = 15
CASE IS = 2
Col1 = 2
Col2 = 10
Col3 = 14
Col4 = 15
Col5 = 15
CASE IS = 3
Col1 = 8
Col2 = 7
Col3 = 15
Col4 = 15
Col5 = 15
END SELECT
COLOR Col1
PRINT STRING$(5, Char$);
COLOR Col2
PRINT STRING$(5, Char$);
COLOR Col3
PRINT STRING$(5, Char$);
COLOR Col4
PRINT STRING$(5, Char$);
COLOR Col5
PRINT STRING$(40, Char$);
COLOR Col4
PRINT STRING$(5, Char$);
COLOR Col3
PRINT STRING$(5, Char$);
COLOR Col2
PRINT STRING$(5, Char$);
COLOR Col1
PRINT STRING$(5, Char$)
END SUB
DEFINT A-Z
FUNCTION ShadeName$ (Model)
SELECT CASE Model
CASE 1: ShadeName$ = "Wireframe"
CASE 2: ShadeName$ = "Z-Gouraud"
CASE 3: ShadeName$ = "Z-Flat"
CASE 4: ShadeName$ = "Textured"
END SELECT
END FUNCTION
SUB Switch (Var, Value1, Value2)
'----------------------------------------------------------------------------
' Switches values
'----------------------------------------------------------------------------
'
' Var - Variable to be changed
' Value1 - Value 1
' Value2 - Value 2
'
'----------------------------------------------------------------------------
'
' if Var = Value1 then Value2 will be assigned to Var
'
' if Var = Value2 then Value1 will be assigned to Var
'
' This SUB is used with Checkboxes and Radiobuttons
'
'----------------------------------------------------------------------------
IF Var = Value1 THEN Var = Value2: EXIT SUB
IF Var = Value2 THEN Var = Value1
END SUB
SUB t3d2d (x, y, z, SX, SY)
'----------------------------------------------------------------------------
' Transforms 3D coordinates into 2D screen coordinates
'----------------------------------------------------------------------------
IF z - Zoom <> 0 THEN SY = CLNG(y + My) * 100 \ INT(z - Zoom)
IF z - Zoom <> 0 THEN SX = CLNG(x + Mx) * 100 \ INT(z - Zoom)
END SUB
SUB TheEnd
SCREEN 0: CLS
WIDTH 80, 25
COLOR 15, 4
LOCATE 1, 1
PRINT STRING$(80, " "
LOCATE 1, 1
PRINT " 3D Polygon Engine v2.0 by Sami Ky”stil„ 1997"
COLOR 3, 0
PRINT "Average FPS:", , , FPS&; "fps"
PRINT "Ending position (XYZ)", , Xr; Yr; Zr
PRINT "Shading model:", , " "; ShadeName$(ShadingModel)
PRINT "Ambient lighting level:", , Ambient
SYSTEM
END SUB
qbasicking
Programmer
Huh... looks like the program got cut off, so here is the address to it:
- Thread starter
- #12
It's been awhile since I have been to this site, mainly because I foregot my password, but that looks long and I will try looking through it. I have done some math and wrote algorithms for texture mapping and an algorithm that rotates around all 3 axies instead of the ones you find that only rotate around 2 for 3d rotation. I plan on sharing them soon.
whoah! talk about reviving an old topic!
geez, i feel so left out with all this 3d talk...
anyways, i tried (and miserably failed) to learn 3d before my time. (my explanation why i couldn't understand most of it) i found some good tuts and stuff on the net though.
- i found lots and lots of stuff here. in graphics demos or utilities.
deltacode.cjb.net - the best place to look for raytracers or whatever, not what your looking for but may be useful...
- has a few useful 3d things...
- i found a few useful things on this site
dunno if any have texture mapping on the sites though.
geez, i feel so left out with all this 3d talk...
anyways, i tried (and miserably failed) to learn 3d before my time. (my explanation why i couldn't understand most of it) i found some good tuts and stuff on the net though.
- i found lots and lots of stuff here. in graphics demos or utilities.
deltacode.cjb.net - the best place to look for raytracers or whatever, not what your looking for but may be useful...
- has a few useful 3d things...
- i found a few useful things on this site
dunno if any have texture mapping on the sites though.
whoah! is down right now, so you'll have to go to...
trust me, this is the site you want to go to.
trust me, this is the site you want to go to.
oh, can't forget this site! here, this site has some good stuff. i also saw texturemapping in there somewhere 
- Status